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