Annotation of embedaddon/pciutils/maint/release.pm, revision 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>