home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 April / CMCD0404.ISO / Software / Freeware / Programare / groupoffice-com-2.01 / controls / htmlarea / make-release.pl < prev    next >
Perl Script  |  2004-03-08  |  7KB  |  264 lines
  1. #! /usr/bin/perl -w
  2. # $Id: make-release.pl,v 1.4 2004/03/03 11:22:41 mschering Exp $
  3.  
  4. # Script for creating a distribution archive.  Based on make-release.pl from
  5. # jscalendar.
  6.  
  7. # Author: Mihai Bazon, http://dynarch.com/mishoo
  8. # NO WARRANTIES WHATSOEVER.  READ GNU LGPL.
  9.  
  10. # This file requires HTML::Mason; this module is used for automatic
  11. # substitution of the version/release number as well as for selection of the
  12. # changelog (at least in the file release-notes.html).  It might not work
  13. # without HTML::Mason.
  14.  
  15. use strict;
  16. # use diagnostics;
  17. use HTML::Mason;
  18. use File::Find;
  19. use XML::Parser;
  20. use Data::Dumper;
  21.  
  22. my $verbosity = 1;
  23.  
  24. my $tmpdir = '/tmp';
  25.  
  26. my $config = parseXML("project-config.xml");
  27. speak(3, Data::Dumper::Dumper($config));
  28.  
  29. my ($project, $version, $release, $basename);
  30.  
  31. $project = $config->{project}{ATTR}{title};
  32. $version = $config->{project}{version}{DATA};
  33. $release = $config->{project}{release}{DATA};
  34. $basename = "$project-$version";
  35. $basename .= "-$release" if ($release);
  36.  
  37. speak(1, "Project: $basename");
  38.  
  39. ## create directory tree
  40. my ($basedir);
  41. {
  42.     # base directory
  43.     $basedir = "$tmpdir/$basename";
  44.     if (-d $basedir) {
  45.         speak(-1, "$basedir already exists, removing... >:-]\n");
  46.         system "rm -rf $basedir";
  47.     }
  48. }
  49.  
  50. process_directory();
  51.  
  52. ## make the ZIP file
  53. chdir "$basedir/..";
  54. speak(1, "Making ZIP file /tmp/$basename.zip");
  55. system ("zip -r $basename.zip $basename > /dev/null");
  56. system ("ls -la /tmp/$basename.zip");
  57.  
  58. ## remove the basedir
  59. system("rm -rf $basedir");
  60.  
  61. ## back
  62. #chdir $cwd;
  63.  
  64.  
  65.  
  66. ### SUBROUTINES
  67.  
  68. # handle _one_ file
  69. sub process_one_file {
  70.     my ($attr, $target) = @_;
  71.  
  72.     $target =~ s/\/$//;
  73.     $target .= '/';
  74.     my $destination = $target.$attr->{REALNAME};
  75.  
  76.     # copy file first
  77.     speak(1, "   copying $attr->{REALNAME}");
  78.     system "cp $attr->{REALNAME} $destination";
  79.  
  80.     my $masonize = $attr->{masonize} || '';
  81.     if ($masonize =~ /yes|on|1/i) {
  82.         speak(1, "   > masonizing to $destination...");
  83.         my $args = $attr->{args} || '';
  84.         my @vars = split(/\s*,\s*/, $args);
  85.         my %args = ();
  86.         foreach my $i (@vars) {
  87.             $args{$i} = eval '$'.$i;
  88.             speak(1, "      > argument: $i => $args{$i}");
  89.         }
  90.         my $outbuf;
  91.         my $interp = HTML::Mason::Interp->new ( comp_root    => $target,
  92.                                                 out_method   => \$outbuf );
  93.         $interp->exec("/$attr->{REALNAME}", %args);
  94.         open (FILE, "> $destination");
  95.         print FILE $outbuf;
  96.         close (FILE);
  97.     }
  98. }
  99.  
  100. # handle some files
  101. sub process_files {
  102.     my ($files, $target) = @_;
  103.  
  104.     # proceed with the explicitely required files first
  105.     my %options = ();
  106.     foreach my $i (@{$files}) {
  107.         $options{$i->{ATTR}{name}} = $i->{ATTR};
  108.     }
  109.  
  110.     foreach my $i (@{$files}) {
  111.         my @expanded = glob "$i->{ATTR}{name}";
  112.         foreach my $file (@expanded) {
  113.             $i->{ATTR}{REALNAME} = $file;
  114.             if (defined $options{$file}) {
  115.                 unless (defined $options{$file}->{PROCESSED}) {
  116.                     speak(1, "EXPLICIT FILE: $file");
  117.                     $options{$file}->{REALNAME} = $file;
  118.                     process_one_file($options{$file}, $target);
  119.                     $options{$file}->{PROCESSED} = 1;
  120.                 }
  121.             } else {
  122.                 speak(2, "GLOB: $file");
  123.                 process_one_file($i->{ATTR}, $target);
  124.                 $options{$file} = 2;
  125.             }
  126.         }
  127.     }
  128. }
  129.  
  130. # handle _one_ directory
  131. sub process_directory {
  132.     my ($dir, $path) = @_;
  133.     my $cwd = '..';             # ;-)
  134.  
  135.     (defined $dir) || ($dir = '.');
  136.     (defined $path) || ($path = '');
  137.     speak(2, "DIR: $path$dir");
  138.     $dir =~ s/\/$//;
  139.     $dir .= '/';
  140.  
  141.     unless (-d $dir) {
  142.         speak(-1, "DIRECTORY '$dir' NOT FOUND, SKIPPING");
  143.         return 0;
  144.     }
  145.  
  146.     # go where we have stuff to do
  147.     chdir $dir;
  148.  
  149.     my $target = $basedir;
  150.     ($path =~ /\S/) && ($target .= "/$path");
  151.     ($dir ne './') && ($target .= $dir);
  152.  
  153.     speak(1, "*** Creating directory: $target");
  154.     mkdir $target;
  155.  
  156.     unless (-f 'makefile.xml') {
  157.         speak(-1, "No makefile.xml in this directory");
  158.         chdir $cwd;
  159.         return 0;
  160.     }
  161.     my $config = parseXML("makefile.xml");
  162.     speak(3, Data::Dumper::Dumper($config));
  163.  
  164.     my $tmp = $config->{files}{file};
  165.     if (defined $tmp) {
  166.         my $files;
  167.         if (ref($tmp) eq 'ARRAY') {
  168.             $files = $tmp;
  169.         } else {
  170.             $files = [ $tmp ];
  171.         }
  172.         process_files($files, $target);
  173.     }
  174.  
  175.     $tmp = $config->{files}{dir};
  176.     if (defined $tmp) {
  177.         my $subdirs;
  178.         if (ref($tmp) eq 'ARRAY') {
  179.             $subdirs = $tmp;
  180.         } else {
  181.             $subdirs = [ $tmp ];
  182.         }
  183.         foreach my $i (@{$subdirs}) {
  184.             process_directory($i->{ATTR}{name}, $path.$dir);
  185.         }
  186.     }
  187.  
  188.     # get back to our previous location
  189.     chdir $cwd;
  190. }
  191.  
  192. # this does all the XML parsing shit we'll need for our little task
  193. sub parseXML {
  194.     my ($filename) = @_;
  195.     my $rethash = {};
  196.  
  197.     my @tagstack;
  198.  
  199.     my $handler_start = sub {
  200.         my ($parser, $tag, @attrs) = @_;
  201.         my $current_tag = {};
  202.         $current_tag->{NAME} = $tag;
  203.         $current_tag->{DATA} = '';
  204.         push @tagstack, $current_tag;
  205.         if (scalar @attrs) {
  206.             my $attrs = {};
  207.             $current_tag->{ATTR} = $attrs;
  208.             while (scalar @attrs) {
  209.                 my $name = shift @attrs;
  210.                 my $value = shift @attrs;
  211.                 $attrs->{$name} = $value;
  212.             }
  213.         }
  214.     };
  215.  
  216.     my $handler_char = sub {
  217.         my ($parser, $data) = @_;
  218.         if ($data =~ /\S/) {
  219.             $tagstack[$#tagstack]->{DATA} .= $data;
  220.         }
  221.     };
  222.  
  223.     my $handler_end = sub {
  224.         my $current_tag = pop @tagstack;
  225.         if (scalar @tagstack) {
  226.             my $tmp = $tagstack[$#tagstack]->{$current_tag->{NAME}};
  227.             if (defined $tmp) {
  228.                 ## better build an array, there are more elements with this tagname
  229.                 if (ref($tmp) eq 'ARRAY') {
  230.                     ## oops, the ARRAY is already there, just add the new element
  231.                     push @{$tmp}, $current_tag;
  232.                 } else {
  233.                     ## create the array "in-place"
  234.                     $tagstack[$#tagstack]->{$current_tag->{NAME}} = [ $tmp, $current_tag ];
  235.                 }
  236.             } else {
  237.                 $tagstack[$#tagstack]->{$current_tag->{NAME}} = $current_tag;
  238.             }
  239.         } else {
  240.             $rethash->{$current_tag->{NAME}} = $current_tag;
  241.         }
  242.     };
  243.  
  244.     my $parser = new XML::Parser
  245.       ( Handlers => { Start => $handler_start,
  246.                       Char  => $handler_char,
  247.                       End   => $handler_end } );
  248.     $parser->parsefile($filename);
  249.  
  250.     return $rethash;
  251. }
  252.  
  253. # print somethign according to the level of verbosity
  254. # receives: verbosity_level and message
  255. # prints message if verbosity_level >= $verbosity (global)
  256. sub speak {
  257.     my ($v, $t) = @_;
  258.     if ($v < 0) {
  259.         print STDERR "\033[1;31m!! $t\033[0m\n";
  260.     } elsif ($verbosity >= $v) {
  261.         print $t, "\n";
  262.     }
  263. }
  264.