From ba97a989c2228e4840a0c58173b0d8f541911c69 Mon Sep 17 00:00:00 2001 From: Justin Davis Date: Sun, 5 Feb 2012 12:16:43 -0500 Subject: Start of big rewrite of pkg tweaking. The current setup is only really good for modifying PKGBUILD fields. The modification of PKGBUILD funcs is hackish. Instead, the tweaks will be written in a scripting language (like Io) where both PKGBUILD fields and function code can be easily modified. Fields should be able to be modified just like arrays, but with easier package matching going on. PKGBUILD bash functions are simply arrays of lines, but they are not as sophisticated. Instead they can only be appended to. Package files are represented as trees. Each file (PKGBUILD pkg.install) is a child of the top-level node of the tree. Each child of the file node is a section of the file (intro, body, end). Each section can also have its own intro, body, and end node. In this way each bash function is a node with its own intro, body, and end node. Prepending to a function appends to its intro node. Appending to a function appends to its end child node. The body cannot be modified. --- bin/emitpkgtree | 58 ++++++++++ bin/genpkg | 27 ++--- bin/mergepbfields | 0 bin/mkpkgbuild | 71 ------------- bin/mkpkgdata | 84 --------------- bin/mkpkgmeta | 67 ++++++++++++ bin/modpkgmeta | 0 bin/pbfields | 99 ++++++++++++++++++ bin/tweakmeta | 118 --------------------- metas/perl | 4 +- metas/perl.d/perl-dist | 244 ++++++++++++++++++++++++------------------- metas/perl.d/perl-dist-funcs | 101 ++++++++++++++++++ setup | 14 +-- templ/pbfields | 99 ------------------ templ/perl-pkg | 121 --------------------- 15 files changed, 475 insertions(+), 632 deletions(-) create mode 100755 bin/emitpkgtree create mode 100644 bin/mergepbfields delete mode 100755 bin/mkpkgbuild delete mode 100755 bin/mkpkgdata create mode 100755 bin/mkpkgmeta create mode 100644 bin/modpkgmeta create mode 100755 bin/pbfields delete mode 100755 bin/tweakmeta create mode 100755 metas/perl.d/perl-dist-funcs delete mode 100755 templ/pbfields delete mode 100755 templ/perl-pkg diff --git a/bin/emitpkgtree b/bin/emitpkgtree new file mode 100755 index 0000000..ca12c59 --- /dev/null +++ b/bin/emitpkgtree @@ -0,0 +1,58 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +my $PROG = 'flatlntree'; + +sub parsetree +{ + my($name) = @_; + my($txt, $ln, @tree) = (q{}, $., $name); + while(){ + if(/^BEGNODE (\S+)$/){ + push @tree, $txt if($txt); + push @tree, parsetree($1); + $txt = q{}; + }elsif(/^ENDNODE (\S+)$/){ + if($1 ne $name){ + print STDERR "$PROG: wrong ENDNODE:" + . qq{ '$1' at line $.} + . qq{ (in '$name' started at line $ln)\n}; + exit 101; + }else{ + last; + } + }else{ + $txt .= $_; + } + } + + push @tree, $txt if($txt); + return \@tree; +} + +sub flatten +{ + my($tree) = @_; + if(ref $tree){ + # skip name + return join q{}, map { flatten($tree->[$_]) } 1 .. $#$tree; + }else{ + return $tree; + } +} + +sub main +{ + my $top = parsetree('TOP'); + @$top = grep { ref } @$top; # only keep sub-nodes + for my $n (@$top){ + my $name = $n->[0]; + print ">>> $name\n"; + print flatten($n); + } + return 0; +} + +exit main(); diff --git a/bin/genpkg b/bin/genpkg index c88dd84..513fa9e 100755 --- a/bin/genpkg +++ b/bin/genpkg @@ -39,33 +39,20 @@ do [ -d "$pkgd/$pkg" ] || mkdir "$pkgd/$pkg" cd "$pkgd/$pkg" - echo "$pkgd/$pkg" - if METABIN="$metad" PKGVAR="$vard" mkpkgdata "$pkg" > PKGDATA + if METABIN="$metad" PKGVAR="$vard" mkpkgmeta "$pkg" then - echo PKGDATA + echo "$pkgd/$pkg" + echo "Generated PKGDATA and PKGTREE." 1>&2 else exit $? fi twk="$tweakd/$pkg" - if [ -f "$twk" -a -r "$twk" ] + if [ -f "$twk" -a -r "$twk" ] && modpkgmeta then - if ! tweakmeta < "$twk" > PKGDATA.new - then - echo "$prog: tweakmeta returned error: $?" 1>&2 - rm PKGDATA.new - exit 1 - fi - mv PKGDATA.new PKGDATA - echo "Tweaked PKGDATA with $twk." 1>&2 + echo "Modified metapackage." 1>&2 fi - if TDIR="$templd" mkpkgbuild - then - echo PKGBUILD - else - exit $? - fi - - echo + mergepbfields | emitpkgtree || exit $? done + diff --git a/bin/mergepbfields b/bin/mergepbfields new file mode 100644 index 0000000..e69de29 diff --git a/bin/mkpkgbuild b/bin/mkpkgbuild deleted file mode 100755 index 490a27a..0000000 --- a/bin/mkpkgbuild +++ /dev/null @@ -1,71 +0,0 @@ -#!/bin/sh - -prog=mkpkgbuild - -die() -{ - rc=$1; shift - echo "$prog: $*" 1>&2 - exit $rc -} - -editpb() -{ - op=$1 func=$2 - - case "$op" in - append) - regexp="^${func}[(][)]${func}()" - edin="/^ *$func() *{ -/^[ \t]*cd/ -a" ;; - *) die 1 "unknown editpb operation: $op" - esac - - txt=$(awk -v r="$regexp" 'BEGIN { FS = "\n"; RS = "" } - $1 ~ r { for (i = 2; i <= NF; i++) print $i }' PKGDATA |\ - sed 's/^/ /') - [ "$txt" ] || return 0 - - cat << END | ed -s PKGBUILD >/dev/null -$edin -$txt -. -wq -END - return $? -} - -[ -r PKGDATA ] || die 1 "PKGDATA could not be read." - -[ "$TDIR" ] || die 1 "TDIR env. var is unset." -[ -d "$TDIR" ] || die 1 "template dir ($TDIR) not found." - -tcmd=$(awk 'BEGIN { FS="\n"; RS="" } $1 == "template" { print $2 }' PKGDATA) -[ "$tcmd" ] || die 1 "PKGDATA is missing 'template' entry." - -set -- $tcmd -cmd="$TDIR/$1" -[ -f "$cmd" -a -x "$cmd" ] \ - || die 2 "template command ($1) not in template dir ($TDIR)" - -# Generate the PKGBUILD using basic pbfields script plus custom template. -"$TDIR/pbfields" < PKGDATA > PKGBUILD || die 1 "pbfields returned error ${?}." -"$TDIR"/$tcmd < PKGDATA >> PKGBUILD || die 1 "template pipeline ($tcmd) failed" - -# Prepand/append text to the package, check, or build functions. -for func in package check build -do - for op in append prepend - do - editpb $op $func \ - || die 2 "error $? when trying to $op to ${func}()" - done -done - -exit 0 diff --git a/bin/mkpkgdata b/bin/mkpkgdata deleted file mode 100755 index f330894..0000000 --- a/bin/mkpkgdata +++ /dev/null @@ -1,84 +0,0 @@ -#!/bin/sh - -prog=mkpkgdata - -lazysource() -{ - awk -v prog="$prog" ' -BEGIN { FS = "\n"; RS = ""; OFS = ORS = "\n\n" } -$1 == "pkgver" { ver = $2 } -$1 == "source" { - len = NF - 1 - for(i = 2; i <= NF; i++) sources[i - 1] = $i - next -} -1 # print everything but sources - -END { - # remember that metas emit no output when they cant match - # a package. - if(NR == 0 || !ver) exit 2 - - ORS="\n" - - # Replace any version strings in the source file with ${pkgver}. - gsub(/[.]/, "\\\\&", ver) - - print "source" - for(i = 1; i <= len; i++){ - gsub(ver, "${pkgver}", sources[i]) - print sources[i] - } - print "" -}' - return $? -} # end of lazysource() - -basicmeta() -{ - printf "pkgname\n%s\n\n" "$1" - printf "pkgrel\n%d\n\n" "${PKGREL:-1}" - printf "packager\n%s\n\n" "${PACKAGER:-Anonymous}" - - if [ "$MAINTAINER" ] - then - printf "maintainer\n%s\n\n" "$MAINTAINER" - fi -} - -case $# in -0) echo "usage: $prog [package name]" 1>&2 - exit 1 -esac - -case "$METABIN" in -'') echo "$prog: set METABIN before calling $prog" 1>&2 - exit 1 -esac - -tmp="/tmp/$prog.$$" -for flav in "$METABIN"/* -do - [ -f "$flav" -a -x "$flav" ] || continue - trap 'rm "$tmp"' 1 2 15 - PATH="$PATH:$flav.d" "$flav" "$1" > "$tmp" - metaret=$? - case "$metaret" in - 0) basicmeta "$1" - lazysource < "$tmp" - esac - - rm "$tmp" - trap '' 1 2 5 - case "$metaret" in - 0) exit 0 ;; - 1) echo "$prog: $flav encountered an error" 1>&2 - exit 1 ;; - 2) ;; # loop - *) echo "$prog: $flav returned error code $metaret" 1>&2 - exit 1 ;; - esac -done - -echo "$prog: no matching meta generator found for '$1'" 1>&2 -exit 1 diff --git a/bin/mkpkgmeta b/bin/mkpkgmeta new file mode 100755 index 0000000..2296a28 --- /dev/null +++ b/bin/mkpkgmeta @@ -0,0 +1,67 @@ +#!/bin/sh + +prog=mkpkgmeta + +err() +{ + echo "$prog: $*" 1>&2 + exit 1 +} + +basicmeta() +{ + printf "pkgname\n%s\n\n" "$pkgname" + printf "pkgrel\n%d\n\n" "${PKGREL:-1}" + printf "packager\n%s\n\n" "${PACKAGER:-Anonymous}" + + if [ "$MAINTAINER" ] + then + printf "maintainer\n%s\n\n" "$MAINTAINER" + fi + + return 0 +} + +prependmeta() +{ + if basicmeta | cat - "$1" > "$1.new" + then + mv "$1.new" "$1" + return 0 + else + rm "$1.new" + return 1 + fi +} + +case $# in +0) echo "usage: $prog [package name]" 1>&2 + exit 1 +esac + +case "$METABIN" in +'') err "set METABIN before calling $prog" +esac + +tmp="/tmp/$prog.$$" +for flav in "$METABIN"/* +do + pkgname="$1" + [ -f "$flav" -a -x "$flav" ] || continue + PATH="$PATH:$flav.d" "$flav" "$pkgname" + metaret=$? + + case "$metaret" in + 0) if prependmeta PKGDATA + then + exit 0 + else + err "failed to prepend to PKGDATA" + fi ;; + 1) err "$flav encountered an error" ;; + 2) ;; # loop + *) err "$flav returned error code $metaret" ;; + esac +done + +err "no matching meta generator found for '$1'" diff --git a/bin/modpkgmeta b/bin/modpkgmeta new file mode 100644 index 0000000..e69de29 diff --git a/bin/pbfields b/bin/pbfields new file mode 100755 index 0000000..5e7844c --- /dev/null +++ b/bin/pbfields @@ -0,0 +1,99 @@ +#!/usr/bin/awk -f + +BEGIN { + fieldstr = "pkgname pkgver pkgrel pkgdesc epoch" \ + " *arch *license *options" \ + " install changelog" \ + " *depends *makedepends *checkdepends *optdepends" \ + " *conflicts *provides" \ + " url *source *noextract *md5sums *sha512sums" + max = split(fieldstr, fields) + for(i=1; i<=max; i++) { + if(sub(/^[*]/, "", fields[i])) arrfield[fields[i]] = 1; + else strfield[fields[i]] = 1; + } + + COLS = 78; FS = "\n"; RS = "" +} + +NF < 2 { next } + +$1 == "packager" { packager = $2 } + +$1 == "maintainer" { maintainer = $2 } + +$1 ~ /depends$|conflicts|provides|source/ { quotevals() } + +$1 == "pkgdesc" { + gsub(/[$"`]/, "\\\\&", $2) + $2 = sprintf("\"%s\"", $2) +} + +$1 == "pkgverfmt" { pkgverfmt = $2 } + +strfield[$1] { output[$1] = $2 } + +arrfield[$1] { + output[$1] = wraparray(length($1) + 2) +} + +END { + if(pkgverfmt){ + output["pkgver"] = sprintf(pkgverfmt, output["pkgver"]) + } + + if(!maintainer && !packager) { packager = "Anonymous" } + if(maintainer) print "# Maintainer: " maintainer + else if(packager) print "# Packager: " packager + print "" + + OFS = "="; ORS = "\n"; + for(i=1; i<=max; i++){ + name = fields[i] + if(name in output){ + print name, output[name] + } + } +} + +function wraparray (indent) +{ + if(NF == 1) return "()" # this shouldn't happen but just in case. + + line = "" + delete lines + linecount = 0 + + i = 2 + while(i <= NF) { + linelen = length(line) + + if((indent + linelen + 1 + length($i) > COLS) && linelen > 0) { + lines[++linecount] = line + line = "" + } else { + if(linelen == 0) line = $(i++) + else line = line " " $(i++) + } + } + + if(length(line) > 0) lines[++linecount] = line + + indtxt = sprintf("%" indent "s", "") + txt = "(" lines[1] + for(i=2; i<=linecount; i++) txt = txt "\n" indtxt lines[i] + txt = txt ")" + + return txt +} + +function quotevals () +{ + for(i=2; i<=NF; i++) $i = bashquote($i) +} + +function bashquote (val) +{ + if(val ~ /[$]/) return sprintf("\"%s\"", val) + return sprintf("'%s'", val) +} diff --git a/bin/tweakmeta b/bin/tweakmeta deleted file mode 100755 index 75198a2..0000000 --- a/bin/tweakmeta +++ /dev/null @@ -1,118 +0,0 @@ -#!/usr/bin/awk -f -## -# tweakmeta -# -# First read a PKGDATA file in the current directory, loading its values. -# Next read a PKGTWEAK file from standard input. -# The PKGTWEAK file tells us how to modify the PKGDATA data. -# The modified PKGDATA is printed to standard output. -# -# Justin Davis - -BEGIN { - PROG = "tweakmeta" - if (system("test -r PKGDATA") != 0) { - print PROG ": PKGDATA file could not be read." | "cat 1>&2" - exit(errcode = 2) - } - - FS = "\n"; RS = "" - while (getline<"PKGDATA" > 0) - for (i = 2; i <= NF; i++) pushval($1, $i) - close("PKGDATA") - FS = " "; RS = "\n" -} - -{ sub(/#.*/, "") } - -$1 == "+" { pushval($2, joinfields(3)); next } - -$1 == "-" { remval($2, $3); next } - -$1 == "<" { - i = findval($2, $3) - stack[++stacklen] = pbvars[$2, i] - remelem($2, i) - next -} - -$1 == ">" { - if (stacklen < 1) - die("No values on the stack. Make sure you use '<' first.") - pushval($2, stack[stacklen--]) - next -} - -$1 == "=" { - if ($2 == "optdepends") die("cannot use '=' with optdepends.") - remall($2) - for (i=3; i<=NF; i++) pushval($2, $i) - next -} - -# ignore lines of whitespace -$1 !~ /^[ \t]*$/ { die("invalid input: " $0) } - -END { - if (errcode) exit(errcode) - - OFS = "\n" - - for (name in pbcount) { - len = pbcount[name] - if (len == 0) continue - - print name - for (i=1; i<=len; i++) print pbvars[name, i] - print "" - } -} - -function die (msg) -{ - printf "%s: error line %d: %s\n", PROG, FNR, msg | "cat 1>&2" - exit(errcode = 1) -} - -function joinfields (start, msg) -{ - msg = $(start++) - while (start <= NF) msg = msg " " $(start++) - return msg -} - -function remall (field) -{ - pbcount[field] = 0 -} - -function pushval (field, val) -{ - pbvars[field, ++pbcount[field]] = val -} - -function remval (field, prefix) -{ - remelem(field, findval(field, prefix)) -} - -function remelem (field, i, len) -{ - # TODO: error check if "i" is in bounds? - len = pbcount[field] - for (len = pbcount[field]; i < len; i++) - pbvars[field, i] = pbvars[field, i+1] - delete pbvars[field, i] - pbcount[field]-- -} - -function findval (field, prefix, i, len) -{ - len = pbcount[field] - if (len == 0) die(field " is empty!") - - for (i = 1; i <= len; i++) - if (index(pbvars[field,i], prefix) == 1) break - if (i > len) die("could not find " prefix " in " field "'s values") - return i -} diff --git a/metas/perl b/metas/perl index 23f4907..e136090 100755 --- a/metas/perl +++ b/metas/perl @@ -89,7 +89,8 @@ sub main } fetchdist($cpath); - print <<"END_META"; + open my $fh, '>', 'PKGDATA' or die "open: $!"; + print $fh <<"END_META"; url https://metacpan.org/release/$realname @@ -97,6 +98,7 @@ source http://search.cpan.org/CPAN/authors/id/$cpath END_META + close $fh; my $file = $cpath; $file =~ s{.*/}{}; system 'perl-dist' => $file; diff --git a/metas/perl.d/perl-dist b/metas/perl.d/perl-dist index 312b14a..99d187b 100755 --- a/metas/perl.d/perl-dist +++ b/metas/perl.d/perl-dist @@ -4,6 +4,7 @@ use warnings 'FATAL' => 'all'; use strict; my $PROG = 'metas/perl.d/perl-dist'; +my $FUNCPROG = 'perl-dist-funcs'; sub DBG {} if(exists $ENV{'GENDBG'}){ @@ -43,20 +44,20 @@ my %OVERRIDE = sub dist2pkg { - my ($name, $ver) = @_; + my($name, $ver) = @_; return dist_pkgname($name), dist_pkgver($ver); } # Copied from CPANPLUS::Dist::Arch sub dist_pkgname { - my ($distname) = @_; + my($distname) = @_; - return $OVERRIDE{$distname} if(exists($OVERRIDE{$distname})); + return $OVERRIDE{$distname} if(exists $OVERRIDE{$distname}); # Package names should be lowercase and consist of alphanumeric # characters only (and hyphens!)... - $distname = lc($distname); + $distname = lc $distname; $distname =~ tr/_+/--/; $distname =~ tr/-a-z0-9//cd; # Delete all other chars $distname =~ tr/-/-/s; @@ -66,7 +67,7 @@ sub dist_pkgname $distname =~ s/-\z//; die qq{Dist name '$distname' completely violates packaging standards} - if(length($distname) == 0); + if(length $distname == 0); # Don't prefix the package with perl- if it IS perl... $distname = "perl-$distname" unless($distname eq 'perl'); @@ -76,7 +77,7 @@ sub dist_pkgname sub dist_pkgver { - my ($version) = @_; + my($version) = @_; # Remove developer versions because pacman has no special logic # to handle comparing them to regular versions such as perl uses. @@ -96,7 +97,7 @@ sub dist_pkgver # Decide if the dist. is named after the module. sub _ismainmod { - my ($mod_name, $dist_name) = @_; + my($mod_name, $dist_name) = @_; $mod_name =~ tr/:/-/s; return lc($mod_name) eq lc($dist_name); @@ -106,11 +107,11 @@ sub _ismainmod # Merges the right-hand deps into the left-hand deps. sub _merge { - my ($left_deps, $right_deps) = @_; + my($left_deps, $right_deps) = @_; MERGE_LOOP: - while(my ($pkg, $ver) = each(%$right_deps)) { - if($left_deps->{$pkg}) { + while(my($pkg, $ver) = each %$right_deps){ + if($left_deps->{$pkg}){ my $leftver = version->parse($left_deps->{$pkg}); my $rightver = version->parse($ver); next MERGE_LOOP if $leftver > $rightver; @@ -125,10 +126,10 @@ sub _merge # Merge duplicate deps into $left always storing the greatest version there. sub _mergedups { - my ($left, $right) = @_; + my($left, $right) = @_; - for my $name (keys %$left) { - my $rver = delete($right->{$name}) or next; + for my $name (keys %$left){ + my $rver = delete $right->{$name} or next; my $lver = $left->{$name}; my $lvo = ($lver ? version->parse($lver) : 0); my $rvo = ($rver ? version->parse($rver) : 0); @@ -140,12 +141,12 @@ sub _mergedups sub _filterdeps(&$) { - my ($fsub, $deps) = @_; + my($fsub, $deps) = @_; my %fed; my @pkgs = keys(%$deps); for my $dname (grep { $fsub->() } @pkgs){ - my $dver = delete($deps->{$dname}); + my $dver = delete $deps->{$dname}; $fed{$dname} = $dver if(defined $dver); } @@ -163,7 +164,7 @@ sub _yankcheckers # form that the official ArchLinux perl package uses. sub _perldepver { - my ($perlver) = @_; + my($perlver) = @_; # Fix perl-style vstrings which have a leading "v". return $perlver if($perlver =~ s/\Av//); @@ -171,7 +172,7 @@ sub _perldepver # Re-apply the missing trailing zeroes. my $patch = $3; - $patch .= q{0} x (3 - length($patch)); + $patch .= q{0} x (3 - length $patch); return sprintf('%d.%d.%d', $1, $2, $patch); } @@ -179,8 +180,8 @@ sub _perldepver # Translates CPAN module dependencies into ArchLinux package dependencies. sub _reqs2deps { - my ($prereqs) = @_; - my (@mods, %pkgdeps); + my($prereqs) = @_; + my(@mods, %pkgdeps); # Filter out deps on 'perl' and any core modules that we can. while(my ($name, $ver) = each(%$prereqs)) { @@ -224,16 +225,17 @@ sub _reqs2deps sub prereqs { - my ($pkgname, $prereqs) = @_; + my($pkgname, $prereqs) = @_; # maps perl names for different dependencies to ArchLinux's names my %namemap = ('configure' => 'makedepends', - 'build' => 'makedepends', - 'test' => 'checkdepends', - 'runtime' => 'depends'); + 'build' => 'makedepends', + 'test' => 'checkdepends', + 'runtime' => 'depends', + ); my %pkgdeps; - while (my ($perl, $arch) = each(%namemap)) { + while (my($perl, $arch) = each(%namemap)) { my $reqs = $prereqs->{$perl}{'requires'}; my $deps; $deps = _reqs2deps($reqs) if($reqs); @@ -248,14 +250,16 @@ sub prereqs # ArchLinux now has a separate array for dependencies that we only # need for checking (aka "testing"). Older perl METAs do not # have this separated. Force any test modules to be checkdepends. - if(!$pkgdeps{'checkdepends'} && $pkgname !~ /\Aperl-test-/) { + if(!$pkgdeps{'checkdepends'} && $pkgname !~ /\Aperl-test-/){ my $checkdeps = {}; - _merge($checkdeps, _yankcheckers($pkgdeps{$_})) for(qw/makedepends depends/); + for(qw/makedepends depends/){ + _merge($checkdeps, _yankcheckers($pkgdeps{$_})) + } $pkgdeps{'checkdepends'} = $checkdeps; } # We at least require perl, if nothing else. - unless(grep { scalar(keys(%$_)) > 0 } values(%pkgdeps)) { + unless(grep { scalar keys %$_ > 0 } values %pkgdeps){ $pkgdeps{'depends'}{'perl'} = 0; } @@ -263,7 +267,7 @@ sub prereqs _mergedups(@pkgdeps{'depends', 'makedepends'}); # Convert all deps into arrays of strings. - for my $deptype (keys(%pkgdeps)) { + for my $deptype (keys(%pkgdeps)){ $pkgdeps{$deptype} = _stringify($pkgdeps{$deptype}); } @@ -273,13 +277,13 @@ sub prereqs #---HELPER FUNCTION--- sub _stringify { - my ($deps) = @_; + my($deps) = @_; my @depstrs; - for my $pkg (sort(keys(%$deps))) { + for my $pkg (sort keys %$deps){ my $ver = $deps->{$pkg}; my $str = ($ver eq '0' ? $pkg : "$pkg>=$ver"); - push(@depstrs, $str); + push @depstrs, $str; } return \@depstrs; @@ -287,21 +291,21 @@ sub _stringify sub _distsofmods { - my (@mods) = @_; + my(@mods) = @_; return () if(@mods == 0); @mods = _nocore(@mods); my $var = _vardir(); - open(my $fh, '<', "$var/cpanmods") - or die "$PROG: failed to open $var/cpanmods: $!"; + open my $fh, '<', "$var/cpanmods" + or die "$PROG: failed to open $var/cpanmods: $!"; my %mods = map { ($_ => 1) } @mods; my %dists; local $/ = ''; RECLOOP: - while(my $rec = <$fh>) { + while(my $rec = <$fh>){ last RECLOOP unless(keys %mods > 0); my($dist, @mvs) = split(/\n/, $rec); @@ -314,19 +318,17 @@ sub _distsofmods } my @lost = keys %mods; - if(@lost){ - for my $m (@lost){ - print STDERR "$PROG: failed to find module $m\n"; - } - exit 1; - } + return %dists unless(@lost); - return %dists; + for my $m (@lost){ + print STDERR "$PROG: failed to find module $m\n"; + } + exit 1; } sub _nocore { - my (@mods) = @_; + my(@mods) = @_; my $path = _vardir() . '/coremods'; unless(-f $path){ @@ -338,15 +340,15 @@ sub _nocore "; exit 1; } - open(my $if, '<', $path) or die "$PROG: open $path: $!"; + open my $if, '<', $path or die "$PROG: open $path: $!"; my %mods = map { ($_ => 1) } @mods; while(<$if>){ - my ($m) = split; + my($m) = split; delete $mods{$m}; } - close($if); + close $if; return keys %mods; } @@ -361,7 +363,7 @@ sub _vardir package main; use File::Basename qw(basename dirname); -use File::Spec::Functions qw(catfile catdir); +use File::Spec::Functions qw(catfile catdir rel2abs); use File::Find qw(find); use JSON::XS qw(decode_json); # for META.json @@ -371,56 +373,79 @@ use Pod::Select (); # search POD for description use Digest::MD5 (); # for md5sums & sha512sums use Digest::SHA (); +sub printdata +{ + my($pbvars) = @_; + print "options\n!emptydirs\n\n"; + printmeta($pbvars); + return; +} + +sub printfuncs +{ + my($ddir) = @_; + my $dtype = (-f "$ddir/Build.PL" ? "MB" : "MM"); + exec $FUNCPROG => $dtype + or die "$PROG: $FUNCPROG failed to execute!\n"; +} + sub main { - my $distpath = shift() or die "Usage: $PROG [path to cpan dist file]\n"; + my $distpath = shift or die "Usage: $PROG [path to cpan dist file]\n"; + $distpath = rel2abs($distpath); my $dir = dirname($distpath); my $file = basename($distpath); my $info = distinfo($file); chsrcdir(catdir($dir, 'src'), $file); - $dir = extractdist($file); + my $distdir = extractdist($file); - my $meta = loadmeta($dir); + my $meta = loadmeta($distdir); my $desc = $meta->{'abstract'}; - if(!$desc || $desc eq '~' || $desc eq 'unknown') { - $meta->{'abstract'} = distdesc($dir, $info->{'mod'}); + if(!$desc || $desc eq '~' || $desc eq 'unknown'){ + $meta->{'abstract'} = distdesc($distdir, $info->{'mod'}); } - my ($name, $ver) = Convert::dist2pkg(@{$info}{'name', 'ver'}); + my($name, $ver) = Convert::dist2pkg(@{$info}{'name', 'ver'}); my $deps = Convert::prereqs($name, $meta->{'prereqs'}); my %pbvars = ('pkgver' => $ver, 'pkgdesc' => $meta->{'abstract'}, - 'arch' => (xsdist($dir) ? ['i686', 'x86_64'] : 'any'), + 'arch' => (xsdist($distdir) ? ['i686', 'x86_64'] : 'any'), 'md5sums' => md5sums($file), 'sha512sums' => sha512sums($file), - 'distdir' => $dir, + 'distdir' => $distdir, %$deps, ); - # Since this is a perl distribution, use the perl-pkg template. - printf("template\nperl-pkg %s\n\n", (-f "$dir/Build.PL" ? "MB" : "MM")); - print("options\n!emptydirs\n\n"); + print STDERR "DBG: \$dir = $dir\n"; + chdir $dir or die "chdir: $!"; + + close STDOUT or die "close STDOUT: $!"; + open STDOUT, '>', 'PKGDATA' or die "open PKGDATA: $!"; + printdata(\%pbvars); - printmeta(\%pbvars); - return 0; + close STDOUT or die "close STDOUT: $!"; + open STDOUT, '>', 'PKGFUNC', or die "open PKGFUNC: $!"; + exit printfuncs($dir); } # Create the src/ directory and tarball symlink. Then chdir into it. sub chsrcdir { - my ($srcdir, $distfile) = @_; + my($srcdir, $distfile) = @_; - if (-e $srcdir) { - system("rm", "-fr", $srcdir) == 0 or die "failed to rm $srcdir\n"; + if(-e $srcdir){ + system 'rm' => ('-fr', $srcdir); + die "failed to rm $srcdir\n" unless($? == 0); } mkdir $srcdir or die "mkdir $srcdir: $!"; - chdir($srcdir) or die "chdir $srcdir: $!"; + chdir $srcdir or die "chdir $srcdir: $!"; unless(-f $distfile) { - symlink(catfile('..', $distfile), $distfile) or die "symlink $distfile: $!"; + symlink(catfile('..', $distfile), $distfile) + or die "symlink $distfile: $!"; } return $srcdir; @@ -428,11 +453,11 @@ sub chsrcdir sub distinfo { - my ($distfile) = @_; + my($distfile) = @_; - my @c = split(/-/, $distfile); - my $ver = pop(@c); - my $name = join(q{-}, @c); + my @c = split /-/, $distfile; + my $ver = pop @c; + my $name = join q{-}, @c; my $mod = $name; $mod =~ s/-/::/g; return { 'name' => $name, 'ver' => $ver, 'mod' => $mod }; @@ -440,53 +465,52 @@ sub distinfo sub extractdist { - my ($file) = @_; + my($file) = @_; - system("bsdtar -xf $file"); + system 'bsdtar' => ('-xf', $file); die "$PROG: bsdtar failed to extract $file\n" unless($? == 0); - opendir(my $srcdir, '.') or die "opendir: $!"; - my @dirs = grep { -d $_ && !/\A[.]/ } readdir($srcdir); - closedir($srcdir); + opendir my $srcdir, '.' or die "opendir: $!"; + my @dirs = grep { -d $_ && !/\A[.]/ } readdir $srcdir; + closedir $srcdir; - die("$PROG: many dirs (@dirs) inside the tarball $file\n") - if(@dirs > 1); - die("$PROG: no dirs found in tarball $file\n") if(@dirs == 0); + die "$PROG: many dirs (@dirs) inside the tarball $file\n" if(@dirs > 1); + die "$PROG: no dirs found in tarball $file\n" if(@dirs == 0); return $dirs[0]; } sub printmeta { - my ($pbvars) = @_; - while(my ($name, $val) = each(%$pbvars)) { - if(!defined($val) || $val eq q{}) { - warn("$PROG: warning: $name is undefined\n"); + my($pbvars) = @_; + while(my($name, $val) = each %$pbvars) { + if(!defined $val || $val eq q{}) { + warn "$PROG: warning: $name is undefined\n"; $val = q{}; } - print($name, "\n"); - print("$_\n") for (ref $val ? @$val : $val); - print("\n"); + print $name, "\n"; + print "$_\n" for (ref $val ? @$val : $val); + print "\n"; } # TODO: autodetect license type - printf("license\n%s\n\n", join("\n", qw/PerlArtistic GPL/)); + printf("license\n%s\n\n", join "\n", qw/PerlArtistic GPL/); } sub loadmeta { - my ($distdir) = @_; + my($distdir) = @_; - for my $metaext (qw/json yml/) { + for my $metaext (qw/json yml/){ my $path = "$distdir/META.$metaext"; - next unless -f $path; + next unless(-f $path); - open(my $metafh, '<', $path) or die "open: $!"; + open my $metafh, '<', $path or die "open: $!"; my $meta = do { local $/; <$metafh> }; - close($metafh); + close $metafh; $meta = ($metaext eq 'json' ? decode_json($meta) : - $metaext eq 'yml' ? YAML::XS::Load($meta) : - die "internal error: unknown \$metaext: $metaext"); + $metaext eq 'yml' ? YAML::XS::Load($meta) : + die "internal error: unknown \$metaext: $metaext"); upgrademeta($meta); return $meta; @@ -497,12 +521,13 @@ sub loadmeta sub upgrademeta { - my ($meta) = @_; + my($meta) = @_; - return if(exists($meta->{'prereqs'})); + return if(exists $meta->{'prereqs'}); my $prereqs; - $prereqs->{'configure'}{'requires'} = delete($meta->{'configure_requires'}); + $prereqs->{'configure'}{'requires'} + = delete $meta->{'configure_requires'}; $prereqs->{'build'}{'requires'} = delete($meta->{'build_requires'}); $prereqs->{'runtime'}{'requires'} = delete($meta->{'requires'}); @@ -512,9 +537,10 @@ sub upgrademeta sub xsdist { - my ($dir) = @_; + my($dir) = @_; my $isxs; - find({ 'wanted' => sub { $isxs = 1 if(/[.]xs$/) }, 'no_chdir' => 1 }, $dir); + find({ 'wanted' => sub { $isxs = 1 if(/[.]xs$/) }, 'no_chdir' => 1 }, + $dir); return $isxs; } @@ -522,13 +548,13 @@ sub xsdist sub distdesc { - my ($dir, $modname) = @_; + my($dir, $modname) = @_; return _poddesc($dir, $modname) || _readmedesc($dir, $modname); } sub _poddesc { - my ($dir, $modname) = @_; + my($dir, $modname) = @_; my $podselect = Pod::Select->new; $podselect->select('NAME'); @@ -544,18 +570,18 @@ sub _poddesc my @possible = glob("$dir/{lib/,}{$moddir/,}$modfile.{pod,pm}"); PODSEARCH: - for my $podpath (@possible) { + for my $podpath (@possible){ next PODSEARCH unless(-f $podpath); # Read the NAME section of the POD into a scalar. my $namesect = q{}; - open(my $podfile, '<', $podpath) or next PODSEARCH; - open(my $podout, '>', \$namesect) or die "open: $!"; + open my $podfile, '<', $podpath or next PODSEARCH; + open my $podout, '>', \$namesect or die "open: $!"; $podselect->parse_from_filehandle($podfile, $podout); - close($podfile); - close($podout) or die "close: $!"; + close $podfile; + close $podout or die "close: $!"; next PODSEARCH unless($namesect); @@ -573,13 +599,13 @@ sub _poddesc #---HELPER FUNCTION--- sub _readmedesc { - my ($dir, $modname) = @_; + my($dir, $modname) = @_; my $path = catfile($dir, 'README'); return undef unless(-f $path); - open(my $fh, '<', $path) or die "open: $!"; + open my $fh, '<', $path or die "open: $!"; - while (<$fh>) { + while(<$fh>){ chomp; next unless((/\ANAME/ ... /\A[A-Z]+/) && / \A \s* ${modname} [\s\-]+ (.+) \z /x); @@ -595,8 +621,10 @@ sub _readmedesc sub md5sums { return [ map { - open(my $fh, '<', $_) or die "open: $!"; + open my $fh, '<', $_ or die "open: $!"; my $md5 = Digest::MD5->new()->addfile($fh)->hexdigest; + close $fh; + $md5; } @_ ] } diff --git a/metas/perl.d/perl-dist-funcs b/metas/perl.d/perl-dist-funcs new file mode 100755 index 0000000..cc9ba19 --- /dev/null +++ b/metas/perl.d/perl-dist-funcs @@ -0,0 +1,101 @@ +#!/usr/bin/env perl + +use warnings 'FATAL' => 'all'; +use strict; + +my $PROG = 'perl-dist-funcs'; + +my %BODYFOR = + ('MM', { + 'build' => [ + q{/usr/bin/perl Makefile.PL } + . q{DESTDIR="$pkgdir" INSTALLDIRS=vendor}, + q{make}, + ], + 'check' => [ q{make test} ], + 'package' => [ q{make install} ], + }, + 'MB', { + 'build' => [ + q{/usr/bin/perl Build.PL } + . q{--destdir "$pkgdir" --installdirs vendor}, + q{./Build}, + ], + 'check' => [ q{./Build test} ], + 'package' => [ q{./Build install} ], + }); + +my %FUNC; +$FUNC{'build'}{'intro'} = <<'END_INTRO'; +cd "$_distdir" +PERL_MM_USE_DEFAULT=1 PERL_AUTOINSTALL=--skipdeps MODULEBUILDRC=/dev/null +export PERL_MM_USE_DEFAULT PERL_AUTOINSTALL MODULEBUILDRC +unset PERL_MM_OPT PERL_MB_OPT PERL5LIB +END_INTRO + +$FUNC{'check'}{'intro'} = <<'END_INTRO'; +cd "$_distdir" +PERL_MM_USE_DEFAULT=1 +export PERL_MM_USE_DEFAULT +unset PERL_MM_OPT PERL_MB_OPT PERL5LIB +END_INTRO + +$FUNC{'package'}{'intro'} = <<'END_INTRO'; +cd "$_distdir" +unset PERL_MM_OPT PERL_MB_OPT PERL5LIB +END_INTRO + +$FUNC{'package'}{'end'} = <<'END_END'; +find "$pkgdir" -name .packlist -o -name perllocal.pod -delete +END_END + +my $PBEND = <<'END_END'; +# Local Variables: +# mode: shell-script +# sh-basic-offset: 2 +# End: +# vim:set ts=2 sw=2 et: +END_END + +sub printfunc +{ + my($name, $func) = @_; + print "BEGNODE $name\n"; + for my $sect (qw/intro body end/){ + if(exists $func->{$sect}){ + my $txt = $func->{$sect}; + $txt .= "\n" unless($txt =~ /\n\z/); + print "BEGNODE $sect\n", $txt, "ENDNODE $sect\n"; + } + } + print "ENDNODE $name\n"; + return; +} + +sub printfuncs +{ + my($btype) = @_; + my $acts = $BODYFOR{$btype} or die "$PROG: unknown build type: $btype"; + + print "BEGNODE PKGBUILD\n", "BEGNODE body\n"; + for my $f (keys %FUNC){ + $FUNC{$f}{'body'} = join q{}, map { "$_\n" } @{$acts->{$f}}; + printfunc($f, $FUNC{$f}); + } + print "ENDNODE body\n"; + print "BEGNODE end\n", $PBEND, "ENDNODE end\n"; + print "ENDNODE PKGBUILD\n"; + return; +} + +sub main +{ + if(@_ == 0 || ($_[0] ne 'MM' && $_[0] ne 'MB')){ + print STDERR qq{usage: $PROG ["MM" or "MB"] > PKGFUNCS\n}; + return 1; + } + printfuncs(shift); + return 0; +} + +exit main(@ARGV); diff --git a/setup b/setup index 4c74a23..b70a293 100755 --- a/setup +++ b/setup @@ -3,9 +3,10 @@ set -e umask 022 prog=setup -binfiles=(mkpkgbuild mkpkgdata genpkg tweakmeta) -metas=(perl perl.d/ perl.d/fetchcpan perl.d/perl-dist perl.d/scrapecore) -templs=(pbfields perl-pkg) +binfiles=(genpkg mkpkgmeta modpkgmeta pbfields mergepbfields emitpkgtree) +metas=(perl perl.d/ + perl.d/fetchcpan perl.d/perl-dist perl.d/perl-dist-funcs + perl.d/scrapecore) md() { @@ -46,13 +47,6 @@ genpkg) md ~/bin do ins "metas/$m" ~/.genpkg done - - md ~/.genpkg/templ/ - for t in ${templs[@]} - do - ins "templ/$t" ~/.genpkg - done - md ~/.genpkg/var ;; tweaks) md ~/pkg/tweaks/ diff --git a/templ/pbfields b/templ/pbfields deleted file mode 100755 index 5e7844c..0000000 --- a/templ/pbfields +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/awk -f - -BEGIN { - fieldstr = "pkgname pkgver pkgrel pkgdesc epoch" \ - " *arch *license *options" \ - " install changelog" \ - " *depends *makedepends *checkdepends *optdepends" \ - " *conflicts *provides" \ - " url *source *noextract *md5sums *sha512sums" - max = split(fieldstr, fields) - for(i=1; i<=max; i++) { - if(sub(/^[*]/, "", fields[i])) arrfield[fields[i]] = 1; - else strfield[fields[i]] = 1; - } - - COLS = 78; FS = "\n"; RS = "" -} - -NF < 2 { next } - -$1 == "packager" { packager = $2 } - -$1 == "maintainer" { maintainer = $2 } - -$1 ~ /depends$|conflicts|provides|source/ { quotevals() } - -$1 == "pkgdesc" { - gsub(/[$"`]/, "\\\\&", $2) - $2 = sprintf("\"%s\"", $2) -} - -$1 == "pkgverfmt" { pkgverfmt = $2 } - -strfield[$1] { output[$1] = $2 } - -arrfield[$1] { - output[$1] = wraparray(length($1) + 2) -} - -END { - if(pkgverfmt){ - output["pkgver"] = sprintf(pkgverfmt, output["pkgver"]) - } - - if(!maintainer && !packager) { packager = "Anonymous" } - if(maintainer) print "# Maintainer: " maintainer - else if(packager) print "# Packager: " packager - print "" - - OFS = "="; ORS = "\n"; - for(i=1; i<=max; i++){ - name = fields[i] - if(name in output){ - print name, output[name] - } - } -} - -function wraparray (indent) -{ - if(NF == 1) return "()" # this shouldn't happen but just in case. - - line = "" - delete lines - linecount = 0 - - i = 2 - while(i <= NF) { - linelen = length(line) - - if((indent + linelen + 1 + length($i) > COLS) && linelen > 0) { - lines[++linecount] = line - line = "" - } else { - if(linelen == 0) line = $(i++) - else line = line " " $(i++) - } - } - - if(length(line) > 0) lines[++linecount] = line - - indtxt = sprintf("%" indent "s", "") - txt = "(" lines[1] - for(i=2; i<=linecount; i++) txt = txt "\n" indtxt lines[i] - txt = txt ")" - - return txt -} - -function quotevals () -{ - for(i=2; i<=NF; i++) $i = bashquote($i) -} - -function bashquote (val) -{ - if(val ~ /[$]/) return sprintf("\"%s\"", val) - return sprintf("'%s'", val) -} diff --git a/templ/perl-pkg b/templ/perl-pkg deleted file mode 100755 index 47cc682..0000000 --- a/templ/perl-pkg +++ /dev/null @@ -1,121 +0,0 @@ -#!/usr/bin/env perl - -use warnings 'FATAL' => 'all'; -use strict; - -my %ACTIONS_OF = - ('MM', { - 'build' => [ q{/usr/bin/perl Makefile.PL}, q{make} ], - 'check' => [ q{make test} ], - 'package' => [ q{make DESTDIR="$pkgdir" install} ] - }, - 'MB', { - 'build' => [ q{/usr/bin/perl Build.PL}, q{./Build} ], - 'check' => [ q{./Build test} ], - 'package' => [ q{./Build install} ] - }); - -my %FUNCFMTS; -$FUNCFMTS{'build'} = <<'END_FMT'; -build() -( - export PERL_MM_USE_DEFAULT=1 PERL5LIB="" \ - PERL_AUTOINSTALL=--skipdeps \ - PERL_MM_OPT="INSTALLDIRS=vendor DESTDIR='$pkgdir'" \ - PERL_MB_OPT="--installdirs vendor --destdir '$pkgdir'" \ - MODULEBUILDRC=/dev/null - - cd "$_distdir" -%s -) -END_FMT - -$FUNCFMTS{'check'} = <<'END_FMT'; -check() -( - export PERL_MM_USE_DEFAULT=1 PERL5LIB="" - cd "$_distdir" -%s -) -END_FMT - -$FUNCFMTS{'package'} = <<'END_FMT'; -package() { - cd "$_distdir" -%s - find "$pkgdir" -name .packlist -o -name perllocal.pod -delete -} -END_FMT - -my $PBEND = <<'END_END'; -# Local Variables: -# mode: shell-script -# sh-basic-offset: 2 -# End: -# vim:set ts=2 sw=2 et: -END_END - -# Convert actions array into lines of bash to insert into template. -sub bashify -{ - my (@lines) = @_; - my $txt = join qq{\n}, map { s/^/ /gm; $_ } @lines; - return $txt -} - -sub mungevars -{ - my ($vars) = @_; - $vars->{'options'} = [ '!emptydirs' ]; - - # Replace version string in 'source' entry & 'distdir' with - # $pkgver parameter. - for my $v (qw/pkgver distdir/) { - die "$0: $v is undefined" unless defined $vars->{$v}[0]; - } - my $ver = $vars->{'pkgver'}[0]; - s/\Q$ver\E/\${pkgver}/g for ($vars->{'source'}[0], $vars->{'distdir'}[0]); - - return; -} - -sub printpb -{ - my ($btype, $pbvars) = @_; - my $acts = $ACTIONS_OF{$btype} - or die "$0: unknown build type ($btype)\n"; - - my $distdir = $pbvars->{'distdir'}[0]; - print qq{_distdir="\${srcdir}/$distdir"\n}; - print "\n"; - - for my $func (qw/build check package/) { - my $funclines = $acts->{$func}; - printf $FUNCFMTS{$func}, bashify(@$funclines); - print "\n"; - } - print $PBEND; -} - -sub readvars -{ - local $/ = ""; # split records on empty lines - my (%pbvars); - while () { - my ($name, @vals) = split /\n/; - $pbvars{$name} = [ @vals ]; - } - return \%pbvars; -} - -sub main -{ - my ($type) = @_; - my $vars = readvars(); - mungevars($vars); - printpb($type, $vars); - return 0; -} - -my $type = shift or die qq{$0: please provide "MM" or "MB" as argument\n}; -exit main($type); -- cgit v1.2.3-24-g4f1b