Annotation of embedaddon/pciutils/maint/release.pm, revision 1.1.1.1

1.1       misho       1: #!/usr/bin/perl
                      2: # A simple system for making software releases
                      3: # (c) 2003--2011 Martin Mares <mj@ucw.cz>
                      4: 
                      5: package UCW::Release;
                      6: use strict;
                      7: use warnings;
                      8: use Getopt::Long;
                      9: 
                     10: our $verbose = 0;
                     11: 
                     12: sub new($$) {
                     13:        my ($class,$basename) = @_;
                     14:        my $s = {
                     15:                "PACKAGE" => $basename,
                     16:                "rules" => [
                     17:                        # p=preprocess, s=subst, -=discard
                     18:                        '(^|/)(CVS|\.arch-ids|{arch}|\.git|tmp)/' => '-',
                     19:                        '\.(lsm|spec)$' => 'ps',
                     20:                        '(^|/)README$' => 's'
                     21:                        ],
                     22:                "directories" => [
                     23:                        ],
                     24:                "conditions" => {
                     25:                        },
                     26:                "DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
                     27:                "LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
                     28:                "distfiles" => [
                     29:                        ],
                     30:                "archivedir" => "/home/mj/tmp/archives/$basename",
                     31:                "uploads" => [
                     32:                        ],
                     33:                # Options
                     34:                "do_test" => 1,
                     35:                "do_patch" => 1,
                     36:                "diff_against" => "",
                     37:                "do_upload" => 1,
                     38:                "do_sign" => 1,
                     39:        };
                     40:        bless $s;
                     41:        return $s;
                     42: }
                     43: 
                     44: sub GetVersionFromFile($) {
                     45:        my ($s,$file,$rx) = @_;
                     46:        open F, $file or die "Unable to open $file for version autodetection";
                     47:        while (<F>) {
                     48:                chomp;
                     49:                if (/$rx/) {
                     50:                        $s->{"VERSION"} = $1;
                     51:                        print "Detected version $1 from $file\n" if $verbose;
                     52:                        last;
                     53:                }
                     54:        }
                     55:        close F;
                     56:        if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
                     57:        return $s->{"VERSION"};
                     58: }
                     59: 
                     60: sub GetVersionsFromChangelog($) {
                     61:        my ($s,$file,$rx) = @_;
                     62:        open F, $file or die "Unable to open $file for version autodetection";
                     63:        while (<F>) {
                     64:                chomp;
                     65:                if (/$rx/) {
                     66:                        if (!defined $s->{"VERSION"}) {
                     67:                                $s->{"VERSION"} = $1;
                     68:                                print "Detected version $1 from $file\n" if $verbose;
                     69:                        } elsif ($s->{"VERSION"} eq $1) {
                     70:                                # do nothing
                     71:                        } else {
                     72:                                $s->{"OLDVERSION"} = $1;
                     73:                                print "Detected previous version $1 from $file\n" if $verbose;
                     74:                                last;
                     75:                        }
                     76:                }
                     77:        }
                     78:        close F;
                     79:        if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
                     80:        return $s->{"VERSION"};
                     81: }
                     82: 
                     83: sub InitDist($) {
                     84:        my ($s,$dd) = @_;
                     85:        $s->{"DISTDIR"} = $dd;
                     86:        print "Initializing dist directory $dd\n" if $verbose;
                     87:        `rm -rf $dd`; die if $?;
                     88:        `mkdir -p $dd`; die if $?;
                     89: }
                     90: 
                     91: sub ExpandVar($$) {
                     92:        my ($s,$v) = @_;
                     93:        if (defined $s->{$v}) {
                     94:                return $s->{$v};
                     95:        } else {
                     96:                die "Reference to unknown variable $v";
                     97:        }
                     98: }
                     99: 
                    100: sub CopyFile($$$$) {
                    101:        my ($s,$f,$dir,$action) = @_;
                    102: 
                    103:        (my $d = $f) =~ s@(^|/)[^/]*$@@;
                    104:        $d = "$dir/$d";
                    105:        -d $d || `mkdir -p $d`; die if $?;
                    106: 
                    107:        my $preprocess = ($action =~ /p/);
                    108:        my $subst = ($action =~ /s/);
                    109:        if ($preprocess || $subst) {
                    110:                open I, "$f" or die "open($f): $?";
                    111:                open O, ">$dir/$f" or die "open($dir/$f): $!";
                    112:                my @ifs = ();   # stack of conditions, 1=satisfied
                    113:                my $empty = 0;  # last line was empty
                    114:                my $is_makefile = ($f =~ /(Makefile|.mk)$/);
                    115:                while (<I>) {
                    116:                        if ($subst) {
                    117:                                s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
                    118:                        }
                    119:                        if ($preprocess) {
                    120:                                if (/^#/ || $is_makefile) {
                    121:                                        if (/^#?ifdef\s+(\w+)/) {
                    122:                                                if (defined ${$s->{"conditions"}}{$1}) {
                    123:                                                        push @ifs, ${$s->{"conditions"}}{$1};
                    124:                                                        next;
                    125:                                                }
                    126:                                                push @ifs, 0;
                    127:                                        } elsif (/^#ifndef\s+(\w+)/) {
                    128:                                                if (defined ${$s->{"conditions"}}{$1}) {
                    129:                                                        push @ifs, -${$s->{"conditions"}}{$1};
                    130:                                                        next;
                    131:                                                }
                    132:                                                push @ifs, 0;
                    133:                                        } elsif (/^#if\s+/) {
                    134:                                                push @ifs, 0;
                    135:                                        } elsif (/^#?endif/) {
                    136:                                                my $x = pop @ifs;
                    137:                                                defined $x or die "Improper nesting of conditionals";
                    138:                                                $x && next;
                    139:                                        } elsif (/^#?else/) {
                    140:                                                my $x = pop @ifs;
                    141:                                                defined $x or die "Improper nesting of conditionals";
                    142:                                                push @ifs, -$x;
                    143:                                                $x && next;
                    144:                                        }
                    145:                                }
                    146:                                @ifs && $ifs[$#ifs] < 0 && next;
                    147:                                if (/^$/) {
                    148:                                        $empty && next;
                    149:                                        $empty = 1;
                    150:                                } else { $empty = 0; }
                    151:                        }
                    152:                        print O;
                    153:                }
                    154:                close O;
                    155:                close I;
                    156:                ! -x $f or chmod(0755, "$dir/$f") or die "chmod($dir/$f): $!";
                    157:        } else {
                    158:                `cp -a "$f" "$dir/$f"`; die if $?;
                    159:        }
                    160: }
                    161: 
                    162: sub GenPackage($) {
                    163:        my ($s) = @_;
                    164:        $s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
                    165:        my $dd = $s->{"DISTDIR"};
                    166:        my $pkg = $s->{"PKG"};
                    167:        my $dir = "$dd/$pkg";
                    168:        print "Generating $dir\n";
                    169: 
                    170:        FILES: foreach my $f (`find . -type f`) {
                    171:                chomp $f;
                    172:                $f =~ s/^\.\///;
                    173:                my $action = "";
                    174:                my @rules = @{$s->{"rules"}};
                    175:                while (@rules) {
                    176:                        my $rule = shift @rules;
                    177:                        my $act = shift @rules;
                    178:                        if ($f =~ $rule) {
                    179:                                $action = $act;
                    180:                                last;
                    181:                        }
                    182:                }
                    183:                ($action =~ /-/) && next FILES;
                    184:                print "$f ($action)\n" if $verbose;
                    185:                $s->CopyFile($f, $dir, $action);
                    186:        }
                    187: 
                    188:        foreach my $d (@{$s->{"directories"}}) {
                    189:                `mkdir -p $dir/$d`; die if $?;
                    190:        }
                    191: 
                    192:        if (-f "$dir/Makefile") {
                    193:                print "Cleaning up\n";
                    194:                `cd $dir && make distclean >&2`; die if $?;
                    195:        }
                    196: 
                    197:        print "Creating $dd/$pkg.tar.gz\n";
                    198:        my $tarvv = $verbose ? "vv" : "";
                    199:        `cd $dd && tar cz${tarvv}f $pkg.tar.gz $pkg >&2`; die if $?;
                    200:        push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz";
                    201: 
                    202:        if ($s->{'do_sign'}) {
                    203:                print "Signing package\n";
                    204:                system "gpg", "--armor", "--detach-sig", "$dd/$pkg.tar.gz";
                    205:                die if $?;
                    206:                rename "$dd/$pkg.tar.gz.asc", "$dd/$pkg.tar.gz.sign" or die "No signature produced!?\n";
                    207:                push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz.sign";
                    208:        }
                    209: 
                    210:        my $adir = $s->{"archivedir"};
                    211:        my $afile = "$adir/$pkg.tar.gz";
                    212:        print "Archiving to $afile\n";
                    213:        -d $adir or `mkdir -p $adir`;
                    214:        `cp $dd/$pkg.tar.gz $afile`; die if $?;
                    215: 
                    216:        return $dir;
                    217: }
                    218: 
                    219: sub GenFile($$) {
                    220:        my ($s,$f) = @_;
                    221:        my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
                    222:        my $df = $s->{"DISTDIR"} . "/$f";
                    223:        print "Generating $df\n";
                    224:        `cp $sf $df`; die if $?;
                    225:        push @{$s->{"distfiles"}}, $df;
                    226: }
                    227: 
                    228: sub ParseOptions($) {
                    229:        my ($s) = @_;
                    230:        GetOptions(
                    231:                "verbose!" => \$verbose,
                    232:                "test!" => \$s->{"do_test"},
                    233:                "patch!" => \$s->{"do_patch"},
                    234:                "diff-against=s" => \$s->{"diff_against"},
                    235:                "upload!" => \$s->{"do_upload"},
                    236:                "sign!" => \$s->{"do_sign"},
                    237:        ) || die "Syntax: release [--verbose] [--test] [--nopatch] [--diff-against=<version>] [--noupload] [--nosign]";
                    238: }
                    239: 
                    240: sub Test($) {
                    241:        my ($s) = @_;
                    242:        my $dd = $s->{"DISTDIR"};
                    243:        my $pkg = $s->{"PKG"};
                    244:        my $log = "$dd/$pkg.log";
                    245:        print "Doing a test compilation\n";
                    246:        `( cd $dd/$pkg && make ) >$log 2>&1`;
                    247:        die "There were errors. Please inspect $log" if $?;
                    248:        `grep -q [Ww]arning $log`;
                    249:        $? or print "There were warnings! Please inspect $log.\n";
                    250:        print "Cleaning up\n";
                    251:        `cd $dd/$pkg && make distclean`; die if $?;
                    252: }
                    253: 
                    254: sub MakePatch($) {
                    255:        my ($s) = @_;
                    256:        my $dd = $s->{"DISTDIR"};
                    257:        my $pkg1 = $s->{"PKG"};
                    258:        my $oldver;
                    259:        if ($s->{"diff_against"} ne "") {
                    260:                $oldver = $s->{"diff_against"};
                    261:        } elsif (defined $s->{"OLDVERSION"}) {
                    262:                $oldver = $s->{"OLDVERSION"};
                    263:        } else {
                    264:                print "WARNING: No previous version known. No patch generated.\n";
                    265:                return;
                    266:        }
                    267:        my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;
                    268: 
                    269:        my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
                    270:        -f $oldarch or die "MakePatch: $oldarch not found";
                    271:        print "Unpacking $pkg0 from $oldarch\n";
                    272:        `cd $dd && tar xzf $oldarch`; die if $?;
                    273: 
                    274:        my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
                    275:        print "Creating a patch from $pkg0 to $pkg1: $diff\n";
                    276:        `cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
                    277:        push @{$s->{"distfiles"}}, "$dd/$diff";
                    278: }
                    279: 
                    280: sub Upload($) {
                    281:        my ($s) = @_;
                    282:        foreach my $u (@{$s->{"uploads"}}) {
                    283:                my $url = $u->{"url"};
                    284:                print "Upload to $url :\n";
                    285:                my @files = ();
                    286:                my $filter = $u->{"filter"} || ".*";
                    287:                foreach my $f (@{$s->{"distfiles"}}) {
                    288:                        if ($f =~ $filter) {
                    289:                                print "\t$f\n";
                    290:                                push @files, $f;
                    291:                        }
                    292:                }
                    293:                print "<confirm> "; <STDIN>;
                    294:                if ($url =~ m@^scp://([^/]+)(.*)@) {
                    295:                        $, = " ";
                    296:                        my $host = $1;
                    297:                        my $dir = $2;
                    298:                        $dir =~ s@^/~@~@;
                    299:                        $dir =~ s@^/\./@@;
                    300:                        my $cmd = "scp @files $host:$dir\n";
                    301:                        `$cmd`; die if $?;
                    302:                } elsif ($url =~ m@ftp://([^/]+)(.*)@) {
                    303:                        my $host = $1;
                    304:                        my $dir = $2;
                    305:                        open FTP, "|ftp -v $host" or die;
                    306:                        print FTP "cd $dir\n";
                    307:                        foreach my $f (@files) {
                    308:                                (my $ff = $f) =~ s@.*\/([^/].*)@$1@;
                    309:                                print FTP "put $f $ff\n";
                    310:                        }
                    311:                        print FTP "bye\n";
                    312:                        close FTP;
                    313:                        die if $?;
                    314:                } else {
                    315:                        die "Don't know how to handle this URL scheme";
                    316:                }
                    317:        }
                    318: }
                    319: 
                    320: sub Dispatch($) {
                    321:        my ($s) = @_;
                    322:        $s->Test if $s->{"do_test"};
                    323:        $s->MakePatch if $s->{"do_patch"};
                    324:        $s->Upload if $s->{"do_upload"};
                    325: }
                    326: 
                    327: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>