create-module.pl

   1 #!/usr/local/bin/perl
   2 # create-module.pl
   3 # Creates a single .wbm file containing multiple modules, possibly with
   4 # forced versions
   5
   6 @ARGV >= 2 || die "usage: create-module.pl [--dir name] <file.wbm> <module>[/version] ..";
   7
   8 chop($pwd = `pwd`);
   9
  10 # Parse command-line options
  11 while(@ARGV) {
  12         if ($ARGV[0] eq "--dir") {
  13                 shift(@ARGV);
  14                 $forcedir = shift(@ARGV);
  15                 }
  16         elsif ($ARGV[0] eq "--sign") {
  17                 shift(@ARGV);
  18                 $createsig = 1;
  19                 }
  20         else {
  21                 last;
  22                 }
  23         }
  24
  25 $file = shift(@ARGV);
  26 if ($file !~ /^\//) {
  27         $file = "$pwd/$file";
  28         }
  29 unlink($file);
  30 foreach $m (@ARGV) {
  31         # Parse module and forced version
  32         $m =~ s/\/$//;
  33         if ($m =~ /^(.*)\/(.*)$/) {
  34                 $mod = $1;
  35                 $ver = $2;
  36                 }
  37         else {
  38                 $mod = $m;
  39                 $ver = undef;
  40                 }
  41
  42         # Copy module to temp dir
  43         system("rm -rf /tmp/create-module");
  44         mkdir("/tmp/create-module", 0755);
  45         $subdir = $forcedir || $mod;
  46         $copydir = "/tmp/create-module/$subdir";
  47         system("rm -rf $copydir");
  48         system("cp -r -L $mod $copydir 2>/dev/null || cp -R -L $mod $copydir");
  49
  50         # Find type from .info file
  51         undef(%minfo);
  52         if (&read_file($ifile = "$copydir/module.info", \%minfo)) {
  53                 $type = 0;
  54                 }
  55         elsif (&read_file($ifile = "$copydir/theme.info", \%minfo)) {
  56                 $type = 1;
  57                 }
  58         else {
  59                 die "Module or theme $mod not found";
  60                 }
  61         if ($ver) {
  62                 $minfo{'version'} = $ver;
  63                 &write_file($ifile, \%minfo);
  64                 }
  65         $flags = !-r $file ? "chf" : "rhf";
  66         system("cd /tmp/create-module && find . -name .svn | xargs rm -rf");
  67         system("cd /tmp/create-module && find . -name '*~' -o -name '*.rej' -o -name '*.orig' -o -name '.*.swp' | xargs rm -rf");
  68         unlink("/tmp/create-module/$subdir/IDEAS");
  69         system("cd /tmp/create-module && find . -name \\*.svn-work | xargs rm -rf");
  70         system("cd /tmp/create-module && find . -name \\*.svn-base | xargs rm -rf");
  71         system("cd /tmp/create-module && find . -name \\*.cgi | xargs chmod +x");
  72         system("cd /tmp/create-module && find . -name \\*.pl | xargs chmod +x");
  73         system("cd /tmp/create-module && tar $flags $file $subdir") && die "Failed to create tar file";
  74         }
  75 if ($file =~ /^(.*)\.gz$/i) {
  76         system("mv $file $1");
  77         system("gzip -c $1 >$file");
  78         unlink("$1");
  79         }
  80 if ($createsig) {
  81         system("rm -f $file-sig.asc");
  82         system("gpg --armor --output $file-sig.asc --detach-sig $file");
  83         }
  84
  85 # read_file(file, &assoc, [&order], [lowercase])
  86 # Fill an associative array with name=value pairs from a file
  87 sub read_file
  88 {
  89 open(ARFILE, $_[0]) || return 0;
  90 while(<ARFILE>) {
  91         s/\r|\n//g;
  92         if (!/^#/ && /^([^=]*)=(.*)$/) {
  93                 $_[1]->{$_[3] ? lc($1) : $1} = $2;
  94                 push(@{$_[2]}, $1) if ($_[2]);
  95                 }
  96         }
  97 close(ARFILE);
  98 return 1;
  99 }
 100
 101 # write_file(file, array)
 102 # Write out the contents of an associative array as name=value lines
 103 sub write_file
 104 {
 105 local(%old, @order);
 106 &read_file($_[0], \%old, \@order);
 107 open(ARFILE, ">$_[0]");
 108 foreach $k (@order) {
 109         print ARFILE $k,"=",$_[1]->{$k},"\n" if (exists($_[1]->{$k}));
 110         }
 111 foreach $k (keys %{$_[1]}) {
 112         print ARFILE $k,"=",$_[1]->{$k},"\n" if (!exists($old{$k}));
 113         }
 114 close(ARFILE);
 115 }