Build/Arch.pm

   1 package Build::Arch;
   2
   3 use strict;
   4 use Digest::MD5;
   5
   6 eval { require Archive::Tar; };
   7 *Archive::Tar::new = sub {die("Archive::Tar is not available\n")} unless defined &Archive::Tar::new;
   8
   9
  10 # Archlinux support, based on the GSoC work of Nikolay Rysev <mad.f3ka@gmail.com>
  11
  12 # parse a PKGBUILD file
  13
  14 sub quote {
  15   my ($str) = @_;
  16   $str =~ s/([ \t\"\'])/sprintf("%%%02X", ord($1))/ge;
  17   return $str;
  18 }
  19
  20 sub unquotesplit {
  21   my ($str) = @_;
  22   $str =~ s/%/%25/g;
  23   $str =~ s/^[ \t]+//;
  24   while ($str =~ /([\"\'])/) {
  25     my $q = $1;
  26     $str =~ s/$q(.*?)$q/quote($1)/e;
  27   }
  28   my @args = split(/[ \t]+/, $str);
  29   for (@args) {
  30     s/%([a-fA-F0-9]{2})/chr(hex($1))/ge
  31   }
  32   return @args;
  33 }
  34
  35 sub parse {
  36   my ($config, $pkgbuild) = @_;
  37   my $ret;
  38   local *PKG;
  39   if (!open(PKG, '<', $pkgbuild)) {
  40     $ret->{'error'} = "$pkgbuild: $!";
  41     return $ret;
  42   }
  43   my %vars;
  44   while (<PKG>) {
  45     chomp;
  46     next if /^\s*$/;
  47     next if /^\s*#/;
  48     last unless /^([a-zA-Z0-9_]*)=(\(?)(.*?)$/;
  49     my $var = $1;
  50     my $val = $3;
  51     if ($2) {
  52       while ($val !~ s/\)\s*$//s) {
  53         my $nextline = <PKG>;
  54         last unless defined $nextline;
  55         chomp $nextline;
  56         $val .= ' ' . $nextline;
  57       }
  58     }
  59     $vars{$var} = [ unquotesplit($val) ];
  60   }
  61   close PKG;
  62   $ret->{'name'} = $vars{'pkgname'}->[0] if $vars{'pkgname'};
  63   $ret->{'version'} = $vars{'pkgver'}->[0] if $vars{'pkgver'};
  64   $ret->{'deps'} = $vars{'makedepends'} || [];
  65   return $ret;
  66 }
  67
  68 sub islzma {
  69   my ($fn) = @_;
  70   local *F;
  71   return 0 unless open(F, '<', $fn);
  72   my $h;
  73   return 0 unless read(F, $h, 5) == 5;
  74   close F;
  75   return $h eq "\3757zXZ";
  76 }
  77
  78 sub lzmadec {
  79   my ($fn) = @_;
  80   my $nh;
  81   my $pid = open($nh, '-|');
  82   return undef unless defined $pid;
  83   if (!$pid) {
  84     $SIG{'PIPE'} = 'DEFAULT';
  85     exec('xzdec', '-dc', $fn);
  86     die("xzdec: $!\n");
  87   }
  88   return $nh;
  89 }
  90
  91 sub query {
  92   my ($handle, %opts) = @_;
  93   if (ref($handle)) {
  94     die("arch pkg query not implemented for file handles\n");
  95   }
  96   if ($handle =~ /\.xz$/ || islzma($handle)) {
  97     $handle = lzmadec($handle);
  98   }
  99   my $tar = Archive::Tar->new;
 100   my @read = $tar->read($handle, 1, {'filter' => '^\.PKGINFO$', 'limit' => 1});
 101   die("$handle: not an arch package file\n") unless @read ==  1;
 102   my $pkginfo = $read[0]->get_content;
 103   die("$handle: not an arch package file\n") unless $pkginfo;
 104   my %vars;
 105   for my $l (split('\n', $pkginfo)) {
 106     next unless $l =~ /^(.*?) = (.*)$/;
 107     push @{$vars{$1}}, $2;
 108   }
 109   my $ret = {};
 110   $ret->{'name'} = $vars{'pkgname'}->[0] if $vars{'pkgname'};
 111   $ret->{'hdrmd5'} = Digest::MD5::md5_hex($pkginfo);
 112   $ret->{'provides'} = $vars{'provides'} || [];
 113   $ret->{'requires'} = $vars{'depend'} || [];
 114   if ($vars{'pkgname'}) {
 115     my $selfprovides = $vars{'pkgname'}->[0];
 116     $selfprovides .= "=$vars{'pkgver'}->[0]" if $vars{'pkgver'};
 117     push @{$ret->{'provides'}}, $selfprovides unless @{$ret->{'provides'} || []} && $ret->{'provides'}->[-1] eq $selfprovides;
 118   }
 119   if ($opts{'evra'}) {
 120     if ($vars{'pkgver'}) {
 121       my $evr = $vars{'pkgver'}->[0];
 122       if ($evr =~ /^([0-9]+):(.*)$/) {
 123         $ret->{'epoch'} = $1;
 124         $evr = $2;
 125       }
 126       $ret->{'version'} = $evr;
 127       if ($evr =~ /^(.*)-(.*?)$/) {
 128         $ret->{'version'} = $1;
 129         $ret->{'release'} = $2;
 130       }
 131     }
 132     $ret->{'arch'} = $vars{'arch'}->[0] if $vars{'arch'};
 133   }
 134   if ($opts{'description'}) {
 135     $ret->{'description'} = $vars{'pkgdesc'}->[0] if $vars{'pkgdesc'};
 136   }
 137   # arch packages don't seem to have a source :(
 138   # fake it so that the package isn't confused with a src package
 139   $ret->{'source'} = $ret->{'name'} if defined $ret->{'name'};
 140   return $ret;
 141 }
 142
 143 sub queryhdrmd5 {
 144   my ($handle) = @_;
 145   if (ref($handle)) {
 146     die("arch pkg query not implemented for file handles\n");
 147   }
 148   if ($handle =~ /\.xz$/ || islzma($handle)) {
 149     $handle = lzmadec($handle);
 150   }
 151   my $tar = Archive::Tar->new;
 152   my @read = $tar->read($handle, 1, {'filter' => '^\.PKGINFO$', 'limit' => 1});
 153   die("$handle: not an arch package file\n") unless @read ==  1;
 154   my $pkginfo = $read[0]->get_content;
 155   die("$handle: not an arch package file\n") unless $pkginfo;
 156   return Digest::MD5::md5_hex($pkginfo);
 157 }
 158
 159 sub parserepodata {
 160   my ($d, $data) = @_;
 161   $d ||= {};
 162   $data =~ s/^\n+//s;
 163   my @parts = split(/\n\n+/s, $data);
 164   for my $part (@parts) {
 165     my @p = split("\n", $part);
 166     my $p = shift @p;
 167     if ($p eq '%NAME%') {
 168       $d->{'name'} = $p[0];
 169     } elsif ($p eq '%VERSION%') {
 170       $d->{'version'} = $p[0];
 171     } elsif ($p eq '%ARCH%') {
 172       $d->{'arch'} = $p[0];
 173     } elsif ($p eq '%BUILDDATE%') {
 174       $d->{'buildtime'} = $p[0];
 175     } elsif ($p eq '%FILENAME%') {
 176       $d->{'filename'} = $p[0];
 177     } elsif ($p eq '%PROVIDES%') {
 178       push @{$d->{'provides'}}, @p;
 179     } elsif ($p eq '%DEPENDS%') {
 180       push @{$d->{'requires'}}, @p;
 181     }
 182   }
 183   return $d;
 184 }
 185
 186 1;