source: tags/0.1/make-release.pl @ 696

Last change on this file since 696 was 1, checked in by xinha, 15 years ago

Bootstrap

File size: 7.0 KB
Line 
1#! /usr/bin/perl -w
2# $Id: make-release.pl,v 1.3 2003/09/28 12:10:52 mishoo 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
15use strict;
16# use diagnostics;
17use HTML::Mason;
18use File::Find;
19use XML::Parser;
20use Data::Dumper;
21
22my $verbosity = 1;
23
24my $tmpdir = '/tmp';
25
26my $config = parseXML("project-config.xml");
27speak(3, Data::Dumper::Dumper($config));
28
29my ($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
37speak(1, "Project: $basename");
38
39## create directory tree
40my ($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
50process_directory();
51
52## make the ZIP file
53chdir "$basedir/..";
54speak(1, "Making ZIP file /tmp/$basename.zip");
55system ("zip -r $basename.zip $basename > /dev/null");
56system ("ls -la /tmp/$basename.zip");
57
58## remove the basedir
59system("rm -rf $basedir");
60
61## back
62#chdir $cwd;
63
64
65
66### SUBROUTINES
67
68# handle _one_ file
69sub 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
101sub 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
131sub 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
193sub 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)
256sub 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}
Note: See TracBrowser for help on using the repository browser.