eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
    & eval 'exec perl -w -S $0 $argv:q'
    if 0;

# ******************************************************************
#  Author: Chad Elliott
#    Date: 12/05/2005
#     registry.pl,v 1.2 2006/02/15 18:44:00 elliott_c Exp
# ******************************************************************

# ******************************************************************
# Pragma Section
# ******************************************************************

use strict;
use FindBin;
use FileHandle;
use File::Basename;

# ******************************************************************
# Data Section
# ******************************************************************

my($Registry) = undef;
my($MPC_ROOT) = $FindBin::Bin;
$MPC_ROOT =~ s!/!\\!g;

my($version) = 'registry.pl,v 1.2 2006/02/15 18:44:00 elliott_c Exp';
$version =~ s/.*\s+(\d+[\.\d]+)\s+.*/$1/;

my(%types) = ('nmake' => 'NMAKE',
              'bmake' => 'Borland Make',
              'vc6'   => 'DSW',
              'vc71'  => 'SLN 7.1',
              'vc8'   => 'SLN 8.0',
             );

# ******************************************************************
# Subroutine Section
# ******************************************************************

sub set_ext_icon {
  my($ext)  = shift;
  my($num)  = shift;
  my($extf) = $ext . 'file';
  $Registry->{"HKEY_CLASSES_ROOT/.$ext/"} = {'/' => $extf};
  $Registry->{"HKEY_CLASSES_ROOT/$extf/"} = {};
  $Registry->{"HKEY_CLASSES_ROOT/$extf/DefaultIcon/"} =
                           {'/' => "$MPC_ROOT\\MPC.ico,$num"};
}


sub set_dir_command {
  my($type)  = shift;
  my($desc)  = shift;
  my($shell) = 'HKEY_CLASSES_ROOT/Directory/shell';
  my($hash)  = $Registry->{$shell};

  if (!defined $hash) {
    $Registry->{$shell} = {};
    $hash = $Registry->{$shell};
  }

  my($key) = 'MPC' . uc($type) . '/';
  $hash->{$key} = {'/' => "MPC -> $desc"};

  $key .= 'command/';
  $hash->{$key} = {'/' => "cmd /c \"cd %L && $MPC_ROOT\\mwc.pl -type $type -recurse || pause\""};
}


sub set_mwc_command {
  my($type)  = shift;
  my($desc)  = shift;
  my($shell) = 'HKEY_CLASSES_ROOT/mwcfile/shell';
  my($hash)  = $Registry->{$shell};

  if (!defined $hash) {
    $Registry->{$shell} = {};
    $hash = $Registry->{$shell};
  }

  my($key) = 'MPC' . uc($type) . '/';
  $hash->{$key} = {'/' => "MPC -> $desc"};

  $key .= 'command/';
  $hash->{$key} = {'/' => "cmd /c \"$MPC_ROOT\\mwc.pl -type $type %L || pause\""};

  set_dir_command($type, $desc);
}


sub delete_key {
  my($key) = shift;
  my($val) = $Registry->{$key};

  if (UNIVERSAL::isa($val, 'HASH')) {
    foreach my $k (keys %$val) {
      delete_key($key . $k);
    }
  }
  delete $Registry->{$key};
}

# ******************************************************************
# Main Section
# ******************************************************************

if ($^O eq 'MSWin32') {
  require Win32::TieRegistry;
  Win32::TieRegistry->import(TiedRef => \$Registry,
                             Delimiter => '/');
}
else {
  print "ERROR: This script will only run on Windows.\n";
  exit(1);
}

if (defined $ARGV[0]) {
  if ($ARGV[0] eq '-r') {
    delete $Registry->{'HKEY_CURRENT_USER/Environment/MPC_ROOT'};

    delete_key('HKEY_CLASSES_ROOT/.mwc/');
    delete_key('HKEY_CLASSES_ROOT/mwcfile/');
    delete_key('HKEY_CLASSES_ROOT/.mpc/');
    delete_key('HKEY_CLASSES_ROOT/mpcfile/');
    delete_key('HKEY_CLASSES_ROOT/.mpb/');
    delete_key('HKEY_CLASSES_ROOT/mpbfile/');

    foreach my $type (keys %types) {
      delete_key('HKEY_CLASSES_ROOT/Directory/shell/MPC' . uc($type) . '/');
    }
  }
  else {
    print STDERR "registry v$version\n",
                 "Usage: ", basename($0), " [-r]\n\n",
                 "       -r  Remove MPC related registry keys (this does not work).\n\n",
                 "Set the MPC_ROOT environment variable to the location of this script.\n",
                 "Also, add context menus for .mwc files and directories.\n";
    exit(0);
  }
}

$Registry->{'HKEY_CURRENT_USER/Environment/MPC_ROOT'} = [$MPC_ROOT, 'REG_SZ'];

set_ext_icon('mwc', 0);
set_ext_icon('mpc', 1);
set_ext_icon('mpb', 1);

foreach my $type (keys %types) {
  set_mwc_command($type, $types{$type});
}

print "You may need to log out and then ",
      "log back in for these settings to take effect.\n";

exit(0);
