OpenPKG Specs: openpkg/dev.pl@a2c6460cfb16 (annotated)

openpkg/dev.pl@a2c6460cfb16 (annotated)

openpkg/dev.pl

Mon, 28 Jan 2013 17:37:18 +0100

author: Michael Schloh von Bennewitz <michael@schloh.com>
date: Mon, 28 Jan 2013 17:37:18 +0100
changeset 758: a2c6460cfb16
permissions: -rw-r--r--

Correct socket error reporting improvement with IPv6 portable code,
after helpful recommendation by Saúl Ibarra Corretgé on OSips devlist.

 ##
 ##  openpkg dev -- OpenPKG Package Development Tool
 ##  Copyright (c) 2008-2012 OpenPKG GmbH <http://openpkg.com/>
 ##
 ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
 ##  All rights reserved. Licenses which grant limited permission to use,
 ##  copy, modify and distribute this software are available from the
 ##  OpenPKG GmbH.
 ##
 ##  THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
 ##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 ##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 ##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
 ##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 ##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 ##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 ##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 ##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 ##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 ##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ##  SUCH DAMAGE.
 ##
 require 5;
 #   OpenPKG instance prefix and RPM
 my $openpkg_prefix = $ENV{'OPENPKG_PREFIX'};
 delete $ENV{'OPENPKG_PREFIX'};
 #   program identification
 my $prog_name  = "dev";
 my $prog_vers  = "20100111";
 #   home-brewn getopt(3) style option parser
 sub getopts ($$@) {
     my ($opt_spec, $opts, @argv_orig) = @_;
     my (%optf) = map { m/(\w)/; $1 => $_ } $opt_spec =~ m/(\w:|\w)/g;
     my (@argv, $optarg);
     foreach (@argv_orig) {
         if (@argv) {
             push @argv, $_;
         } elsif (defined $optarg) {
             if (exists $opts->{$optarg}) {
                 $opts->{$optarg} .= " $_";
             } else {
                 $opts->{$optarg} = $_;
             }
             $optarg = undef;
         } elsif (!/^[-]/) {
             push @argv, $_;
         } else {
             while (/^\-(\w)(.*)/) {
                 if (exists $optf{$1}) {
                     if (length($optf{$1}) > 1) {
                         if ($2 ne '') {
                             if (exists $opts->{$1}) {
                                 $opts->{$1} .= " $2";
                             } else {
                                 $opts->{$1} = $2;
                             }
                         } else {
                             $optarg = $1;
                         }
                         last;
                     } else {
                         $opts->{$1} = 1;
                     }
                 } else {
                     warn "openpkg:$prog_name:WARNING: unknown option $_\n";
                 }
                 $_ = "-$2";
             }
         }
     }
     if (defined $optarg) {
         warn "openpkg:$prog_name:WARNING: option $optarg requires an argument\n";
     }
     foreach my $opt (keys %optf) {
         if (not exists $opts->{$opt}) {
             $opts->{$opt} = (length($optf{$opt}) > 1 ? "" : 0);
         }
     }
     return @argv;
 }
 #   determine reasonable temporary directory
 my $tmpdir = ($ENV{"TMPDIR"} || "/tmp");
 $tmpdir .= "/openpkg-$prog_name-$$";
 my $rc = system("umask 022; $openpkg_prefix/lib/openpkg/shtool mkdir -f -p -m 755 $tmpdir || exit $?");
 if ($rc != 0) {
     die "failed to create temporary directory: $tmpdir";
 }
 #   parse command line options
 my $opts = {};
 @ARGV = getopts("h", $opts, @ARGV);
 #   usage sanity check and usage help
 sub usage {
     my ($rc) = @_;
     my $usage =
         "openpkg:$prog_name:USAGE: openpkg dev <command> [<options>]\n";
     if ($rc == 0) {
         print STDOUT $usage;
     }
     else {
         print STDERR $usage;
     }
     exit($rc);
 }
 if ($opts->{"h"}) {
     usage(0);
 }
 if (@ARGV == 0) {
     usage(1);
 }
 #   command map
 my $map = {
     "unpack "            => { -alias => qr/^(up|ex)$/,   -key => "x" },
     "edit\n"             => { -alias => qr/^(ed|vi)$/,   -key => "v" },
     "build -s track\n"   => { -alias => qr/^(bt|tr)$/,   -key => "t" },
     "build -s fetch\n"   => { -alias => qr/^(bf|fe)$/,   -key => "f" },
     "build\n"            => { -alias => qr/^(ba|bu)$/,   -key => "b" },
     "build -s prep\n"    => { -alias => qr/^bp$/,        -key => "1" },
     "build -s compile\n" => { -alias => qr/^bc$/,        -key => "2" },
     "build -s install\n" => { -alias => qr/^bi$/,        -key => "3" },
     "build -s binary\n"  => { -alias => qr/^bb$/,        -key => "4" },
     "build -s source\n"  => { -alias => qr/^bs$/,        -key => "s" },
     "peek\n"             => { -alias => qr/^pe$/,        -key => "p" },
     "diff\n"             => { -alias => qr/^di$/,        -key => "d" },
     "install\n"          => { -alias => qr/^in(?:st)?$/, -key => "i" },
     "erase\n"            => { -alias => qr/^er$/,        -key => "e" },
     "lint\n"             => { -alias => qr/^li$/,        -key => "l" },
     "release "           => { -alias => qr/^rel?$/,      -key => "r" },
 };
 #   dispatch command
 my $cmd = shift(@ARGV);
 foreach my $c (keys %{$map}) {
     my $a = $map->{$c}->{-alias};
     if ($cmd =~ $a) {
         $c =~ s/\n$//;
         my @args = split(/\s+/, $c);
         $cmd = shift(@args);
         unshift(@ARGV, @args);
         print STDOUT "\033[34m\$ opd $cmd " . join(" ", map {
             my $x = $_;
             $x =~ s/"/\\"/g;
             $x =~ s/^(.*[ \t].*)$/"$1"/;
             $x
         } @ARGV) . "\033[0m\n";
     }
 }
 my $func = "cmd_$cmd";
 if (not defined(&$func)) {
     print STDERR "openpkg:$prog_name:ERROR: invalid command \"$cmd\"\n";
     usage(1);
 }
 my $rc = &$func($opts, @ARGV);
 exit($rc);
 #   execute a shell command
 sub run {
     my ($cmd) = @_;
     print STDOUT "\033[34m\$ $cmd\033[0m\n";
     my $rc = system($cmd);
     return $rc;
 }
 #   determine path to package specification
 sub specfile {
     my $specfile = (glob("*.spec"))[0];
     if (not defined $specfile) {
         $specfile = (glob("src/*.spec"))[0];
         if (not defined $specfile) {
             $specfile = (glob("*/*.spec"))[0];
             if (not defined $specfile) {
                 print STDERR "openpkg:$prog_name:ERROR: unable to determine package specification file\n";
                 exit(1);
             }
         }
     }
     return $specfile;
 }
 #   command: interactive shell
 sub cmd_shell ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("s", $lopts, @argv);
     #   determine release
     my $release = `$openpkg_prefix/bin/openpkg release -F '%t'`;
     $release =~ s/\n$//s;
     #   create dot files
     my $screenrc = "$tmpdir/dot.screenrc";
     my $bashsh   = "$tmpdir/bash.sh";
     my $bashrc   = "$tmpdir/dot.bashrc";
     my $inputrc  = "$tmpdir/dot.inputrc";
     unlink("$screenrc");
     unlink("$bashsh");
     unlink("$bashrc");
     unlink("$inputrc");
     my $title = "openpkg dev";
     $title .= '%? %{= rW} %n %{-}%?';
     $title .= ' %=%-w%{= rW}%50>%n %t%{-}%+w';
     my $screenrc_data = "";
     $screenrc_data .= "source \"$ENV{HOME}/.screenrc\"\n" if (-f "$ENV{HOME}/.screenrc");
     $screenrc_data .=
         "escape          ^Aa\n" .
         "startup_message off\n" .
         "vbell           off\n" .
         "defscrollback   10000\n" .
         "defmonitor      off\n" .
         "msgminwait      1\n" .
         "msgwait         1\n" .
         "hardstatus      alwayslastline \" $title \"\n" .
         "shell           $bashsh\n";
     my $bashsh_data =
         "##\n" .
         "##\  bash.sh -- \"openpkg dev shell\" GNU bash wrapper script\n" .
         "##\n" .
         "\n" .
         "OPENPKG_PREFIX=\"$openpkg_prefix\"\n" .
         "export OPENPKG_PREFIX\n" .
         "INPUTRC=\"$inputrc\"\n" .
         "export INPUTRC\n" .
         "SHELL=\"$openpkg_prefix/lib/openpkg/bash\"\n" .
         "export SHELL\n" .
         "eval `$openpkg_prefix/bin/openpkg rpm --eval 'T=\"\%{_tmppath}\"; S=\"\%{_specdir}\"; D=\"\%{_sourcedir}\"'`\n" .
         "export T S D\n" .
         "\$SHELL --rcfile $bashrc";
     my $bashrc_data =
         "##\n" .
         "##  dot.bashrc -- \"openpkg dev shell\" GNU bash configuration\n" .
         "##\n" .
         "\n" .
         "#   load user's standard bash run-command script\n" .
         "if [ -f ~/.bashrc ]; then\n" .
         "    . ~/.bashrc\n" .
         "fi\n" .
         "\n" .
         "#   configure a special command-line prompt\n" .
         "if [ \".\$TERM\" = .screen ]; then\n" .
         "    PS1=\"\\\\u@\\\\h:\\\\w [P=\\\\e[1m\\\${OPENPKG_PREFIX}\\\\e[0m]\\n\\\\\\\$ \\\\ek\\\\W\\\\e\\\\\\\\\"\n" .
         "else\n" .
         "    PS1=\"\\\\u@\\\\h:\\\\w [P=\\\\e[1m\\\${OPENPKG_PREFIX}\\\\e[0m]\\n\\\\\\\$ \"\n" .
         "fi\n" .
         "alias openpkg=\"\\\${OPENPKG_PREFIX}/bin/openpkg\"\n" .
         "alias opd=\"\\\${OPENPKG_PREFIX}/bin/openpkg dev\"\n" .
         "\n";
     my $inputrc_data =
         "##\n" .
         "##  dot.inputrc -- \"openpkg dev shell\" GNU readline configuration\n" .
         "##\n" .
         "\n";
     foreach my $c (keys %{$map}) {
         my $k = $map->{$c}->{-key};
         $c =~ s/\n/\\n/sg;
         $inputrc_data .= "\"\\e$k\": \"opd $c\"\n";
     }
     $inputrc_data .= "\n";
     open(SCREENRC, ">$screenrc");
     print(SCREENRC $screenrc_data);
     close(SCREENRC);
     open(BASHSH, ">$bashsh");
     print(BASHSH $bashsh_data);
     close(BASHSH);
     system("chmod a+x $bashsh");
     open(BASHRC, ">$bashrc");
     print(BASHRC $bashrc_data);
     close(BASHRC);
     open(INPUTRC, ">$inputrc");
     print(INPUTRC $inputrc_data);
     close(INPUTRC);
     #   run interactive shell
     print STDOUT "\033[34m++ entering OpenPKG $release development shell\033[0m\n";
     my $rc;
     if ($lopts->{"s"}) {
         $rc = system("screen -c $screenrc -S 'openpkg-dev-shell' -d -R");
     }
     else {
         $rc = system("$bashsh");
     }
     #   cleanup
     unlink("$tmpdir/dot.screenrc");
     unlink("$tmpdir/bash.sh");
     unlink("$tmpdir/dot.bashrc");
     unlink("$tmpdir/dot.inputrc");
     unlink("$tmpdir");
     return $rc;
 }
 #   command: unpack source RPM
 sub cmd_unpack ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("l:b:sd", $lopts, @argv);
     if ($lopts->{"l"} eq "") {
         $lopts->{"l"} = "structured";
     }
     if ($lopts->{"l"} !~ m/^(global|local|simple|structured|distributed)$/) {
         die sprintf("invalid layout type \"%s\"", $lopts->{"l"});
     }
     if (@argv != 1) {
         die sprintf("exactly one SRPM has to be given");
     }
     my $srpm = $argv[0];
     if (not -f $srpm) {
         die sprintf("SRPM \"%s\" has to be a regular file", $srpm);
     }
     my $name = `$openpkg_prefix/bin/openpkg rpm -qp --qf '\%{NAME}' $srpm 2>/dev/null || true`;
     $name =~ s/\r?\n$//s;
     if ($name eq '') {
         die sprintf("unable to determine package name from SRPM \"%s\"", $srpm);
     }
     if ($lopts->{"b"} eq "") {
         $lopts->{"b"} = $srpm;
         if ($lopts->{"b"} =~ m/\.src\.rpm$/) {
             $lopts->{"b"} =~ s/\.src\.rpm$//;
         }
         else {
             my $subdir = `$openpkg_prefix/bin/openpkg rpm -qp --qf '\%{NAME}-\%{VERSION}-\%{RELEASE}' $srpm 2>/dev/null || true`;
             $lopts->{"b"} = $subdir;
         }
     }
     #   determine result directory
     my $basedir = $lopts->{"b"};
     my ($macrosfile, $specdir, $sourcedir);
     if ($lopts->{"l"} eq "global") {
         $macrosdir  = "$openpkg_prefix/etc/openpkg";
         $macrosfile = "$openpkg_prefix/etc/openpkg/rpmmacros";
         $specdir    = "$openpkg_prefix/RPM/SRC/$name";
         $sourcedir  = "$openpkg_prefix/RPM/SRC/$name";
         $builddir   = "$openpkg_prefix/RPM/TMP";
         $tmpdir     = "$openpkg_prefix/RPM/TMP";
         $binrpmdir  = "$openpkg_prefix/RPM/PKG";
         $srcrpmdir  = "$openpkg_prefix/RPM/PKG";
     }
     elsif ($lopts->{"l"} eq "local") {
         $macrosdir  = "$basedir/.openpkg";
         $macrosfile = "$basedir/.openpkg/rpmmacros";
         $specdir    = "$basedir";
         $sourcedir  = "$basedir";
         $builddir   = "$basedir";
         $tmpdir     = "$basedir";
         $binrpmdir  = "$basedir";
         $srcrpmdir  = "$basedir";
     }
     elsif ($lopts->{"l"} eq "simple") {
         $macrosdir  = "$basedir/.openpkg";
         $macrosfile = "$basedir/.openpkg/rpmmacros";
         $specdir    = "$basedir";
         $sourcedir  = "$basedir";
         $builddir   = "$tmpdir";
         $tmpdir     = "$tmpdir";
         $binrpmdir  = "$basedir/..";
         $srcrpmdir  = "$basedir/..";
     }
     elsif ($lopts->{"l"} eq "structured") {
         $macrosdir  = "$basedir/.openpkg";
         $macrosfile = "$basedir/.openpkg/rpmmacros";
         $specdir    = "$basedir/src";
         $sourcedir  = "$basedir/dst";
         $builddir   = "$basedir/tmp";
         $tmpdir     = "$basedir/tmp";
         $binrpmdir  = "$basedir/pkg/bin";
         $srcrpmdir  = "$basedir/pkg/src";
     }
     elsif ($lopts->{"l"} eq "distributed") {
         $macrosdir  = "$basedir/.openpkg";
         $macrosfile = "$basedir/.openpkg/rpmmacros";
         $specdir    = "$basedir/src/$name";
         $sourcedir  = "$basedir/dst/$name";
         $builddir   = "$basedir/tmp";
         $tmpdir     = "$basedir/tmp";
         $binrpmdir  = "$basedir/pkg/bin";
         $srcrpmdir  = "$basedir/pkg/src";
     }
     #   create still missing directories
     foreach my $dir ($macrosdir, $specdir, $sourcedir, $builddir, $tmpdir, $binrpmdir, $srcrpmdir) {
         if (not -d $dir) {
             print STDOUT "openpkg:$prog_name: creating directory \"$dir\"\n";
             system("$openpkg_prefix/lib/openpkg/shtool mkdir -f -p -m 755 $dir");
         }
     }
     #   unpack SRPM
     print STDOUT "openpkg:$prog_name: unpacking source: \"$srpm\"\n";
     print STDOUT "openpkg:$prog_name: unpacking target: \"$specdir\"\n";
     print STDOUT "openpkg:$prog_name: unpacking target: \"$sourcedir\"\n";
     my $abs_specdir = $specdir;
     my $abs_sourcedir = $sourcedir;
     my $pwd = `pwd`; $pwd =~ s/\r?\n$//s;
     $abs_specdir   = "$pwd/$abs_specdir"   if ($abs_specdir   !~ m/^\//);
     $abs_sourcedir = "$pwd/$abs_sourcedir" if ($abs_sourcedir !~ m/^\//);
     my $rc = system(
         "$openpkg_prefix/bin/openpkg" .
         " --keep-privileges" .
         " rpm" .
         " -i" .
         " --define '_specdir $abs_specdir'" .
         " --define '_sourcedir $abs_sourcedir'" .
         " $srpm"
     );
     #   fix location of files
     if (not -f "$specdir/$name.spec") {
         die sprintf("failed to install package \"%s\": file \"%s\" not found\n", $srpm, "$specdir/$name.spec");
     }
     open(SPEC, "<$specdir/$name.spec");
     my $spec = ""; { local $/; $spec = <SPEC>; }
     close(SPEC);
     my $src = {};
     $spec =~ s/^(?:Source|Patch)\d+:\s+(\S+)/$src->{$1} = 1, ''/mgei;
     foreach my $file (keys %{$src}) {
         if ($file !~ m/^(https?|ftp):\/\//) {
             if (not -f "$specdir/$file" and -f "$sourcedir/$file") {
                 system("mv $sourcedir/$file $specdir/$file");
             }
         }
     }
     #   create .openpkg/rpmmacros file
     if (not -f $macrosfile) {
         print STDOUT "openpkg:$prog_name: creating file: \"$macrosfile\"\n";
         my $rpmmacros =
             "##\n" .
             "##  .openpkg/rpmmacros -- local OpenPKG RPM macro definitions\n" .
             "##\n" .
             "\n" .
             "\%openpkg_layout" .
             " macrosfile=\%{macrosfile}" .
             " layout=" . $lopts->{"l"} .
             " shared=" . ($lopts->{"s"} ? "yes" : "no") .
             " debug=" . ($lopts->{"d"} ? "yes" : "no") .
             "\n" .
             "\n";
         open(MACROS, ">$macrosfile");
         print(MACROS $rpmmacros);
         close(MACROS);
     }
     return $rc;
 }
 #   command: edit package specification
 sub cmd_edit ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   run editor
     my $editor = ($ENV{"EDITOR"} || "vi");
     my $specfile = ($argv[0] || specfile());
     run("$editor $specfile");
     return $rc;
 }
 #   command: build package
 sub cmd_build ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("s:D:w:", $lopts, @argv);
     if ($lopts->{"s"} eq '') {
         $lopts->{"s"} = "all";
     }
     if ($lopts->{"s"} !~ m/^(track|fetch|prep|compile|install|binary|source|all)$/) {
         die "invalid step";
     }
     #   assembly defines
     my $defs = "";
     if ($lopts->{"D"}) {
         foreach my $def (split(/\s+/, $lopts->{"D"})) {
             if ($def =~ m/^([^=]+)=(.+)$/) {
                 $defs .= "--define '$1 $2' ";
             }
             else {
                 $defs .= "--define '$def yes' ";
             }
         }
     }
     if ($lopts->{"w"}) {
         foreach my $def (split(/\s+/, $lopts->{"w"})) {
             $defs .= "--with $def ";
         }
     }
     #   run build command
     my $specfile = ($argv[0] || specfile());
     if ($lopts->{"s"} eq 'track') {
         run("$openpkg_prefix/bin/openpkg rpm -bt $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'fetch') {
         run("$openpkg_prefix/bin/openpkg rpm -bf $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'prep') {
         run("$openpkg_prefix/bin/openpkg rpm -bp $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'compile') {
         run("$openpkg_prefix/bin/openpkg rpm -bc --short-circuit $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'install') {
         run("$openpkg_prefix/bin/openpkg rpm -bi --short-circuit $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'binary') {
         run("$openpkg_prefix/bin/openpkg rpm -bb --short-circuit $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'source') {
         run("$openpkg_prefix/bin/openpkg rpm -bs $defs$specfile");
     }
     elsif ($lopts->{"s"} eq 'all') {
         run("$openpkg_prefix/bin/openpkg rpm -ba $defs$specfile");
     }
     return $rc;
 }
 #   command: peek into package
 sub cmd_peek ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   run query command
     my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{_rpmfilename}'`;
     $template =~ s/\n$//s;
     my $specfile = specfile();
     my $rpm = `$openpkg_prefix/bin/openpkg rpm -q --specfile '$specfile' --qf 'XXX$template'`;
     $rpm =~ s/^XXX//s;
     $rpm =~ s/\n$//s;
     #   determine files
     print STDOUT "\033[34m++ determining configuration files\033[0m\n";
     my @cfgfiles = split(/\n/, `$openpkg_prefix/bin/openpkg rpm -qplc $rpm`);
     print STDOUT "\033[34m++ determining documentation files\033[0m\n";
     my @docfiles = split(/\n/, `$openpkg_prefix/bin/openpkg rpm -qpld $rpm`);
     print STDOUT "\033[34m++ determining all file information\033[0m\n";
     my @allfiles = split(/\n/, `$openpkg_prefix/bin/openpkg rpm -qplv $rpm`);
     #   create package file listing
     foreach my $line (@allfiles) {
         $prefix = "";
         foreach my $docfile (@docfiles) {
             if ($line =~ m/\s+$docfile\b/s) {
                 $prefix .= "D";
                 last;
             }
         }
         foreach my $cfgfile (@cfgfiles) {
             if ($line =~ m/\s+$cfgfile\b/s) {
                 $prefix .= "C";
                 last;
             }
         }
         $prefix .= "--";
         $prefix = substr($prefix, 0, 2);
         if ($line =~ m/^d/) {
             $line =~ s/(\s+\/\S+)/\033[34m$1\033[0m/s;
         }
         print "$prefix $line\n";
     }
     return $rc;
 }
 #   command: show modifications via VCS
 sub cmd_diff ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     my $vcs = "";
     my $cmd = "";
     if (-d "CVS") {
         $vcs = "CVS";
         $cmd = "cvs diff -u3";
     }
     elsif (-d ".svn") {
         $vcs = "Subversion";
         $cmd = "svn diff";
     }
     elsif (-d "_MTN"          or -d ".mtn" or
            -d "../_MTN"       or -d "../.mtn" or
            -d "../../_MTN"    or -d "../../.mtn" or
            -d "../../../_MTN" or -d "../../../.mtn") {
         $vcs = "Monotone";
         $cmd = "mtn diff .";
     }
     elsif (-d ".git" or
            -d "../.git" or
            -d "../../.git" or
            -d "../../../.git") {
         $vcs = "Git";
         $cmd = "git diff . ";
     }
     elsif (-d ".hg" or
            -d "../.hg" or
            -d "../../.hg" or
            -d "../../../.hg") {
         $vcs = "Mercurial";
         $cmd = "hg diff ."
     }
     else {
         $vcs = "OSSP svs";
         $cmd = "svs diff";
     }
     print STDOUT "\033[34m++ modifications as known to underlying $vcs VCS\033[0m\n";
     run($cmd);
 }
 #   command: install package
 sub cmd_install ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("fnos", $lopts, @argv);
     #   run install command
     my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{_rpmfilename}'`;
     $template =~ s/\n$//s;
     my $specfile = specfile();
     my $rpm = `$openpkg_prefix/bin/openpkg rpm -q --specfile '$specfile' --qf 'XXX$template'`;
     $rpm =~ s/^XXX//s;
     $rpm =~ s/\n$//s;
     chdir("/");
     run(($lopts->{"s"} ? "sudo " : "") .
         "$openpkg_prefix/bin/openpkg rpm -Uvh"
         . ($lopts->{"f"} ? " --force" : "")
         . ($lopts->{"n"} ? " --nodeps" : "")
         . ($lopts->{"o"} ? " --oldpackage" : "")
         . " $rpm");
     return $rc;
 }
 #   command: erase package
 sub cmd_erase ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("fnas", $lopts, @argv);
     #   run erase command
     my $specfile = specfile();
     my $name = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '%{NAME}'`;
     $name =~ s/\n$//s;
     chdir("/");
     run(($lopts->{"s"} ? "sudo " : "") .
         "$openpkg_prefix/bin/openpkg rpm -e"
         . ($lopts->{"f"} ? " --force" : "")
         . ($lopts->{"n"} ? " --nodeps" : "")
         . ($lopts->{"a"} ? " --allmatches" : "")
         . " $name");
     return $rc;
 }
 #   command: lint package
 sub cmd_lint ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("vb", $lopts, @argv);
     #   run source linting commands
     my $specfile = specfile();
     my $fslfile = $specfile;
     $fslfile =~ s/([^\/]+)\.spec$/fsl.$1/s;
     my $rcfile = $specfile;
     $rcfile =~ s/([^\/]+)\.spec$/rc.$1/s;
     my $name = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '%{NAME}'`;
     $name =~ s/\n$//s;
     my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{_rpmfilename}'`;
     $template =~ s/\n$//s;
     my $rpm = `$openpkg_prefix/bin/openpkg rpm -q --specfile '$specfile' --qf 'XXX$template'`;
     $rpm =~ s/^XXX//s;
     $rpm =~ s/\n$//s;
     my $rc = 0;
     $rc += run("$openpkg_prefix/bin/openpkg lint-spec" . ($lopts->{"v"} ? " --verbose" : "") . " $specfile");
     $rc += run("$openpkg_prefix/bin/openpkg lint-fsl"  . ($lopts->{"v"} ? " --verbose" : "") . " $fslfile") if (-f $fslfile);
     $rc += run("$openpkg_prefix/bin/openpkg lint-rc"   . ($lopts->{"v"} ? " --verbose" : "") . " $rcfile")  if (-f $rcfile);
     #   optionally run binary linting command
     run("$openpkg_prefix/bin/openpkg lint-rpm" . ($lopts->{"v"} ? " --verbose" : "") . " $rpm") if (-f $rpm and not $lopts->{"b"});
     return $rc;
 }
 #   command: release package
 sub cmd_release ($@) {
     my ($gopts, @argv) = @_;
     my $rc = 0;
     #   command line argument processing
     my $lopts = {};
     @argv = getopts("nm:f", $lopts, @argv);
     #   implicit linting
     if (not $lopts->{"f"}) {
         my $rc = cmd_lint($gopts);
         if ($rc != 0 and !$lopts->{"f"}) {
             return $rc;
         }
     }
     #   sanity check environment
     my $cmd = $ENV{"OPENPKG_DEV_RELEASE"}
         || `$openpkg_prefix/bin/openpkg rpm --eval '%{openpkg_dev_release}' 2>/dev/null || true` || "";
     $cmd =~ s/\n$//s;
     if ($cmd eq "") {
         print STDERR "openpkg:$prog_name:ERROR: no \$OPENPKG_DEV_RELEASE command defined\n";
         exit(1);
     }
     #
     #   determine package information
     #
     print STDOUT "\033[34m++ determining package information\033[0m\n";
     my $info = {};
     $info->{"openpkg-prefix"} = $openpkg_prefix;
     $info->{"option-force"} = $lopts->{"f"} ? "yes" : "no";
     print STDOUT "-- determining package name/version/release\n";
     my $specfile = specfile();
     my $result = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '::%{NAME}::%{VERSION}::%{RELEASE}'`;
     $result =~ s/\n$//s;
     $result =~ s/^:://s;
     my @result = split(/::/, $result);
     $info->{"package-name"}    = $result[0];
     $info->{"package-version"} = $result[1];
     $info->{"package-release"} = $result[2];
     print STDOUT "-- determining package source and distribution location\n";
     my $defines = "--define '\%name " . $info->{"package-name"} . "'";
     $defines .= " --define '\%version " . $info->{"package-version"} . "'";
     $defines .= " --define '\%release " . $info->{"package-release"} . "'";
     my $result = `$openpkg_prefix/bin/openpkg rpm $defines --eval '%{_specdir}::%{_sourcedir}'`;
     $result =~ s/\n$//s;
     @result = split(/::/, $result);
     $info->{"spec-dir"}   = $result[0];
     $info->{"source-dir"} = $result[1];
     print STDOUT "-- determining package source and binary RPM files\n";
     my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{l_binrpmfilename}::%{_srcrpmdir}/%{l_srcrpmfilename}'`;
     $template =~ s/\n$//s;
     $result = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '::$template'`;
     $result =~ s/\n$//s;
     $result =~ s/^:://s;
     @result = split(/::/, $result);
     $info->{"binary-rpm-file"} = $result[0];
     $info->{"source-rpm-file"} = $result[1];
     $info->{"package-version-old"} = "";
     $info->{"package-release-old"} = "";
     $info->{"vcs"} = "none";
     print STDOUT "-- determining previous package version/release\n";
     my $vcs = "";
     my $diff = "";
     my $content_old = "";
     my $specdir  = $info->{"spec-dir"};
     my $specfile = $info->{"package-name"} . ".spec";
     if (-f "$specdir/$specfile") {
         open(FP, "<$specdir/$specfile");
         $content_new .= $_ while (<FP>);
         close(FP);
         if ($content_new =~ m/\n\%No(?:Source|Patch)\s+/s) {
             $info->{"source-rpm-file"} =~ s/\.src\.rpm$/.nosrc.rpm/s;
         }
         if (-d "$specdir/CVS") {
             #   package is version controlled via CVS
             $vcs = "cvs";
             $diff = `(cd $specdir && cvs diff -u3 $specfile) 2>/dev/null || true`;
         }
         elsif (-d "$specdir/.svn") {
             #   package is version controlled via Subverson (SVN)
             $vcs = "svn";
             $diff = `(cd $specdir && svn diff $specfile) 2>/dev/null || true`;
         }
         elsif (-d "$specdir/_MTN"          or -d "$specdir/.mtn" or
                -d "$specdir/../_MTN"       or -d "$specdir/../.mtn" or
                -d "$specdir/../../_MTN"    or -d "$specdir/../../.mtn" or
                -d "$specdir/../../../_MTN" or -d "$specdir/../../../.mtn") {
             #   package is version controlled via Monotone (MTN)
             $vcs = "mtn";
             $diff = `(cd $specdir && mtn diff $specfile) 2>/dev/null || true`;
             $content_old = `(cd $specdir && mtn automate get_file_of -r h: $specfile) 2>/dev/null || true`;
         }
         elsif (-d "$specdir/.git" or
                -d "$specdir/../.git" or
                -d "$specdir/../../.git" or
                -d "$specdir/../../../.git") {
             #   package is version controlled via Git
             $vcs = "git";
             $diff = `(cd $specdir && git diff $specfile) 2>/dev/null || true`;
         }
         elsif (-d "$specdir/.hg" or
                -d "$specdir/../.hg" or
                -d "$specdir/../../.hg" or
                -d "$specdir/../../../.hg") {
             #   package is version controlled via Mercurial (Hg)
             $vcs = "hg";
             $diff = `(cd $specdir && hg diff $specfile) 2>/dev/null || true`;
         }
         elsif (-f "$specdir/$specfile.orig") {
             #   package is patched via OSSP svs
             $vcs = "svs";
             $diff = `(cd $specdir && svs diff $specfile) 2>/dev/null || true`;
         }
         if ($vcs ne '') {
             $info->{"vcs"} = $vcs;
         }
         if ($content_old ne '') {
             my $define = {};
             $content_old =~ s/\n\%define[ \t]+([^ \t\n]+)[ \t]+([^ \t\n]+)/$define->{$1} = $2, ''/sge;
             $content_old =~ s/\n([^ \t\n]+):[ \t]+([^ \t\n]+)/$define->{lc($1)} = $2, ''/sge;
             sub resolve {
                 my ($define, $name) = @_;
                 my $value = $define->{$name};
                 $value = "" if (not defined $value);
                 $value =~ s/\%\{(.+?)\}/resolve($define, $1)/sge;
                 return $value;
             }
             $info->{"package-version-old"} = resolve($define, "version");
             $info->{"package-release-old"} = resolve($define, "release");
         }
         if ((   $info->{"package-version-old"} eq ''
              or $info->{"package-release-old"} eq '')
             and $diff ne ''                          ) {
             if ($info->{"package-version-old"} eq '' and $diff =~ m/\n-Version:\s+(\S+)/s) {
                 $info->{"package-version-old"} = $1;
             }
             if ($info->{"package-release-old"} eq '' and $diff =~ m/\n-Release:\s+(\S+)/s) {
                 $info->{"package-release-old"} = $1;
             }
         }
     }
     print STDOUT "-- determining commit message\n";
     $info->{"commit-message"} = ($lopts->{"m"} || "");
     if ($info->{"commit-message"} eq "") {
         if ($info->{"package-version-old"} ne $info->{"package-version"}) {
             #   new version
             $info->{"commit-message"} = "upgrading package: " .
                 $info->{"package-name"} . " " .
                 $info->{"package-version-old"} . " -> " .
                 $info->{"package-version"};
         }
         elsif (!$lopts->{"f"}) {
             print STDERR "openpkg:$prog_name:ERROR: package version not changed -- you have to manually provide a commit message\n";
             exit(1);
         }
     }
     #   run external command
     print STDOUT "\033[34m++ executing openpkg development release program\033[0m\n";
     $cmd .= " %{openpkg-prefix}";
     $cmd .= " %{spec-dir} %{source-dir} %{binary-rpm-file} %{source-rpm-file}";
     $cmd .= " %{package-name} %{package-version} %{package-release} %{package-version-old} %{package-release-old}";
     $cmd .= " %{commit-message} %{vcs}";
     $cmd .= " %{option-force}";
     $cmd =~ s/(\%\{([a-z][a-z-]+)\})/&subst($info, $1, $2)/sge;
     sub subst {
         my ($info, $text, $name) = @_;
         if (exists($info->{$name})) {
             $text = $info->{$name};
             $text =~ s/'/\\'/sg;
             $text = "'$text'";
         }
     }
     if ($lopts->{"n"}) {
         print STDOUT "-- DRY RUN:\n";
         print STDOUT "-- $cmd\n";
         $rc = 0;
     }
     else {
         $rc = system($cmd);
     }
     return $rc;
 }

OpenPKG Specs / annotate

openpkg/dev.pl@a2c6460cfb16 (annotated)

openpkg/dev.pl