Want more features on Pastebin? Sign Up, it's FREE!
Guest

petchema

By: a guest on Sep 2nd, 2011  |  syntax: Perl  |  size: 4.04 KB  |  views: 63  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4.  
  5. my($install_dir) = $ARGV[0];
  6. my($install_dir_logical) = 'C:';
  7. my($scriptname) = 'install_script.iss';
  8.  
  9. if(!-d $install_dir) {
  10.     print "Usage: $0 [install dir]\n";
  11.     exit 1;
  12. }
  13.  
  14. my $defaultdirname;
  15. my $defaultdirname_logical;
  16. my $current_subkey = '<None>';
  17.  
  18. my $setup_section = 0;
  19. my $files_section = 0;
  20. my $registry_section = 0;
  21.  
  22. sub eval_check {
  23.     my($check) = @_;
  24.      my(%atoms) = (
  25.         'IsWinXP' => 1,
  26.         'IsVISTA' => 0,
  27.         'IsWindows7' => 0,
  28.  
  29.         'IsWindows32' => 1,
  30.         'IsWindows64' => 0,
  31.         );
  32.     $check =~ s@\band\b@&&@gi;
  33.     while(my($key, $value) = each(%atoms)) {
  34.         $check =~ s@\b$key\b@$value@egi;
  35.     }
  36.     eval $check;
  37. }
  38.  
  39. sub esc_chars {
  40.     # will change, for example, a!!a to a\!\!a
  41.     $_[0] =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'" ])/\\$1/g;
  42.     return $_[0];
  43. }
  44.  
  45. sub any_case {
  46.     my($filename) = @_;
  47.     $filename =~ s@([a-zA-Z])@"[".lc($1).uc($1)."]"@ge;
  48.     $filename;
  49. }
  50.  
  51. open(SCRIPT, '<', $scriptname) or die "$scriptname not found";
  52. print "#/bin/sh -x\n";
  53. while(defined(my $line = <SCRIPT>)) {
  54.     $line =~ s/[\n\r]+$//;
  55. #    print STDERR "# $line\n";
  56.     if($line =~ /^\[.*\]$/) {
  57.         if($registry_section) {
  58.             print "EOF\n";
  59.         }
  60.         $setup_section = $files_section = $registry_section = 0;
  61.         $setup_section = 1 if $line eq '[Setup]';
  62.         $files_section = 1 if $line eq '[Files]';
  63.         $registry_section = 1 if $line eq '[Registry]';
  64.         if($registry_section) {
  65.             print "cat > install.reg <<EOF\nREGEDIT4\n";
  66.         }
  67.     }
  68.     if($setup_section && $line =~ /^DefaultDirName=(.*)$/) {
  69.         $defaultdirname = $defaultdirname_logical = $1;
  70.         $defaultdirname =~ s@\\@/@g;
  71.         $defaultdirname =~ s@{pf}@$install_dir."/Program Files"@e;
  72.         $defaultdirname_logical =~ s@\{pf\}@${install_dir_logical}."\\Program Files"@e;
  73.     }
  74.     if($files_section && $line =~ /^Source: "(.*?)"; DestDir: "(.*?)"; (?:Components: "(.*?)"; )?(?:Flags: (.*))?$/) {
  75.         my($source, $destdir, $components, $flags) = ($1, $2, $3, $4);
  76.         $flags = '' unless defined $flags;
  77.         if($flags !~ /dontcopy/) {
  78.             $source =~ s@\\@/@g;
  79.             if(-f $source) {
  80.                 $destdir =~ s@\\@/@g;
  81.                 $destdir =~ s@\{tmp\}@$install_dir."/windows/temp"@e;
  82.                 $destdir =~ s@\{app\}@$defaultdirname@e;
  83.  
  84.                 my($source_filename) = $source;
  85.                 $source_filename =~ s@^.*/@@g;
  86.  
  87.                 my($target) = "$destdir/$source_filename";
  88.  
  89.                 if(!-f $target || $flags !~ /onlyifdoesntexist/) {
  90.                     print "mkdir -p ".esc_chars($destdir)."\n";
  91.                     print "cp -av ".any_case(esc_chars($source))." ".esc_chars($target)."\n";
  92.                 }
  93.             }
  94.             elsif ($flags !~ /skipifsourcedoesntexist/) {
  95.                 die "Source file $source missing";
  96.             }
  97.         }
  98.     }
  99.     if($registry_section && $line =~ /^Root: (.*?); Subkey: "(.*?)"; ValueName: "(.*?)"; ValueType: (.*?); ValueData: "(.*?)"; Components: "(.*?)"; (?:Check: "(.*?)"; )?Flags: (.*)$/) {
  100.         my($root, $subkey, $valuename, $valuetype, $valuedata, $components, $check, $flags) = ($1, $2, $3, $4, $5, $6, $7);
  101.         $check = '' unless defined $check;
  102.        
  103.         if($check eq '' || eval_check($check)) {
  104.             my(%root_map) = (
  105.                 'HKLM' => 'HKEY_LOCAL_MACHINE',
  106.                 'HKLM64' => 'HKEY_LOCAL_MACHINE',
  107.                 'HKCU' => 'HKEY_CURRENT_CONFIG',
  108.                 );
  109.             die "Don't know how to handle registry root $root" if !exists $root_map{$root};
  110.             my $full_subkey = "$root_map{$root}\\$subkey";
  111.             if($current_subkey ne $full_subkey) {
  112.                 print "\n[$full_subkey]\n";
  113.                 $current_subkey = $full_subkey;
  114.             }
  115.             my(%value_map) = (
  116.                 'String' => sub { "\"$_[0]\"" },
  117.                 'Dword' => sub { $_[0] =~ s/^\$//; "dword:$_[0]" },
  118.                 );
  119.             die "Don't know how to handle registry value type $valuetype" if !exists $value_map{$valuetype};
  120.             $valuename =~ s@\{tmp\}@${install_dir_logical}."\\windows\\temp"@e;
  121.             $valuename =~ s@\{app\}@$defaultdirname_logical@e;
  122.             $valuedata =~ s@\{tmp\}@${install_dir_logical}."\\windows\\temp"@e;
  123.             $valuedata =~ s@\{app\}@$defaultdirname_logical@e;
  124.             print "\"$valuename\"=".(&{$value_map{$valuetype}}($valuedata))."\n";
  125.         }
  126.     }
  127. }
  128. close(SCRIPT);
  129. print "echo \"Don't forget to import install.reg in your environment with regedit\"";
clone this paste RAW Paste Data