$VERSION = 1.2;
use G;
use File::Which qw(which);
use Win32::Registry;

$HKEY_LOCAL_MACHINE->Open('SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths',$apps) || die $!,"\n";

if (-t STDERR) {
 print STDERR "RegApp $VERSION by Jan Krynicky <Jenda\@Krynicky.cz>\n";
 print STDERR "To register applications so that you do not have to use full paths.\n\n";
}

sub help {
 print STDERR "Ussage: regapp [items] [/del item ...] [/show item ...] [/add name path [extra]]\n";
 print STDERR "\t/show items \t= shows the information for items\n";
 print STDERR "\t/del  items \t= delete registration for items\n";
 print STDERR "\t/add  name exepath other params = adds a registration\n";
 print STDERR "\t\tthe params are in form \"name=value\", eg Path=e:\\soft\\reg_search\n";
 print STDERR "\t\tsince version 1.2 the path is also looked up in PATH \n\t\tand in registered applications.";
 print STDERR "\n";
 print STDERR "\tregapp item1 item2 ... is the same as   regapp /show item1 item2 ...\n";
}

sub params {
 my $arr = shift;
 my @argv;
 while ($#$arr>=0 && $$arr[0] !~ m#^[/-]#) {
  push @argv,(shift @$arr);
 }
 return @argv;
}

sub readdata {
 $apps->GetKeys(\@keys);

 foreach $item (@keys) {
 
  my %tmp;

  $apps->Open($item,$regval);
  $regval->GetValues(\%tmp);
  $regval->Close;

  foreach $val (keys %tmp) {
   $tmp{$val}=$tmp{$val}[2];
  }
  $data{lc $item} = {};
  %{$data{lc $item}}=%tmp;
 }
}

sub delitem {
 my $name;
 while ($name=lc shift) {
  $name .= '.exe' if ($name !~ /\.exe$/);
  if (! $apps->DeleteKey($name)) {
   print STDERR "!!ERROR!! Application \"$name\" was not unregistered!\n";
  } else {
   print STDERR "The registration of \"$name\" successfully deleted.\n";
  }
 }
}

sub showitem {

 readdata unless (defined %data);
 my @in = @_;
 my $item;

 while ( $item = shift) {
  $item = lc $item;
  $item .= '.exe' if ($item !~ /\.exe$/);

  if (exists $data{$item}) {
   print "$item\n";
  
   foreach $val (keys %{$data{$item}}) {
    print " $val\t= $data{$item}{$val}\n";
   }
   print "\n";
  } else {
   print STDERR "!!ERROR!! Application \"$item\" is not registered!\n";
  }
 }
1;
}

sub additem {
 my ($name,$exe,@other) = @_;

 if (! $name || ! $exe) {
  print STDERR "!!ERROR!! Not enough parameters to /add, need 2+ !\n\n";
  help;
  exit;
 }

 if ($name =~ m#/#) {
  print STDERR "!!ERROR!! The first argument to /add must be a name not a path!\n\t(Eg. myprog or myprog.exe)\n\n";
  help;
  exit;
 }

 $exe = which($exe) || $exe  # look it up in path
  unless $exe =~ m#[\\/]#;

 if ($exe !~ m#[\\/]#) { # look it up in registered applications
    my $old;
    if ($apps->Open($exe, $old)
        or $apps->Open($exe.'.exe', $old)
       ) {
       my %tmp;
       $old->GetValues(\%tmp);
       $exe = $tmp{''}[2];
       delete $tmp{''};
       foreach (keys %tmp) {
        push @other, "$_=$tmp{$_}[2]";
       }
    }
 }

 if (! -e $exe) {
  print STDERR "!!ERROR!! The file \"$exe\" doesn't exist!\n\n";
  help;
  exit;
 }

 $name = lc $name;
 $name .= '.exe' unless ($name =~ /\.exe$/);
 $apps->Create($name,$new) || die $!,"\n";
 while ($_ = $other[0]) {
  /=/ and last;
  $exe .= ' ' . $_;
  shift @other;
 }
 $new->SetValue('',REG_SZ,$exe);
 my $other;
 while ($other = shift @other) {
  if ($other !~ /=/) {
   print STDERR "!!ERROR!! \"$other\" is not in form  \"name=value\"!\n";
  }
  my ($other_name,$other_value) = split /=/,$other;
  $new->SetValueEx($other_name,'',REG_SZ,$other_value);
 }
 print STDERR "\"$name\" registered successfully.\n";
 $name =~ s/\.exe$//;
 print STDERR "To set up a doskey macro :\n\tdoskey $name=\"$exe\" $*\n";
}


if ($#ARGV < 0) {

 $apps->GetKeys(\@keys);

 readdata;

 foreach $item (sort (keys %data)) {
 
  print "$item\n";
  
  foreach $val (keys %{$data{$item}}) {
   print " $val\t= $data{$item}{$val}\n";
  }
  print "\n";

 }

} else {

 while ($#ARGV>=0) {
  if ($ARGV[0] =~ s#^[/-]##) {
   if ($ARGV[0] =~ m#del#i) {
    shift @ARGV;
    delitem (params \@ARGV);
   } elsif ($ARGV[0] =~ m#show#i) {
    shift @ARGV;
    showitem (params \@ARGV);
   } elsif ($ARGV[0] =~ m#add#i) {
    shift @ARGV;
    additem (params \@ARGV);
   } elsif ($ARGV[0] eq 'h' or $ARGV[0] eq 'H' or $ARGV[0] eq '?' or $ARGV[0] eq 'j' or $ARGV[0] eq 'C') {
    help;
    shift @ARGV;
   } else {
    print STDERR "!!ERROR!! Unrecognised switch : $ARGV[0] !\n";
    help;
    exit;
   }
  } else {
   showitem (shift @ARGV);
  }
 }
}

close STDOUT;