Skip to content
Newer
Older
100755 73 lines (60 sloc) 2.02 KB
af05d93 @mlschroe - start support for arch linux, code mostly written by Nikolay Rysev …
mlschroe authored Mar 30, 2012
1 #!/usr/bin/perl -w
2
3 # Archlinux support, based on the GSoC work of Nikolay Rysev <mad.f3ka@gmail.com>
4
5 BEGIN {
6 unshift @INC, ($::ENV{"BUILD_DIR"} || "/usr/lib/build");
7 }
8
9 use strict;
10 use Archive::Tar;
11 use Build::Arch;
12 use Digest::MD5;
13 use File::Path;
6538da7 @mlschroe - finished support for arch linux, sample config included
mlschroe authored Apr 2, 2012
14 use Getopt::Long;
15
16 Getopt::Long::Configure("no_ignore_case");
af05d93 @mlschroe - start support for arch linux, code mostly written by Nikolay Rysev …
mlschroe authored Mar 30, 2012
17
18 my $cachedir = "/var/cache/build";
19
20 sub getrepodb {
21 my ($url, $reponame, $dir) = @_;
22 File::Path::mkpath($dir);
23 system($INC[0]."/download", $dir, "$url$reponame.db");
24 }
25
26 sub getreponame {
27 my ($url) = @_;
28 return $1 if "/$url/" =~ /.*\/([^\/]+)\/os\//;
29 return undef;
30 }
31
32 sub printpkginfo {
33 my ($d, $repourl) = @_;
34 my $id = $d->{'name'} . "." . $d->{'arch'} . "-" . $d->{'buildtime'} . "/0/0";
35 my $pkgurl = $repourl . $d->{'filename'};
36 my $selfprovides = $d->{'name'};
37 $selfprovides .= "=$d->{'version'}" if defined $d->{'version'};
38 push @{$d->{'provides'}}, $selfprovides unless @{$d->{'provides'} || []} && $d->{'provides'}->[-1] eq $selfprovides;
39 print "F:$id: $pkgurl\n";
40 print "P:$id: " . join(' ', @{$d->{'provides'}}) . "\n" if $d->{'provides'};
41 print "R:$id: " . join(' ', @{$d->{'requires'}}) . "\n" if $d->{'requires'};
42 print "I:$id: $d->{name}-$d->{'version'} $d->{'buildtime'}\n";
43 }
44
6538da7 @mlschroe - finished support for arch linux, sample config included
mlschroe authored Apr 2, 2012
45 GetOptions("cachedir=s" => \$cachedir) or exit(1);
46
47
af05d93 @mlschroe - start support for arch linux, code mostly written by Nikolay Rysev …
mlschroe authored Mar 30, 2012
48 for my $url (@ARGV) {
49 die("Not an Archlinux repo") unless $url =~ /^(ht|f)tp:\/\/([^\/]*)\/?/;
50 my $reponame = getreponame($url);
6538da7 @mlschroe - finished support for arch linux, sample config included
mlschroe authored Apr 2, 2012
51 my $repoid = Digest::MD5::md5_hex("arch\@$url");
af05d93 @mlschroe - start support for arch linux, code mostly written by Nikolay Rysev …
mlschroe authored Mar 30, 2012
52 my $dir = "$cachedir/$repoid";
6538da7 @mlschroe - finished support for arch linux, sample config included
mlschroe authored Apr 2, 2012
53 $url .= '/' unless $url =~ /\/$/;
af05d93 @mlschroe - start support for arch linux, code mostly written by Nikolay Rysev …
mlschroe authored Mar 30, 2012
54 getrepodb($url, $reponame, $dir);
55
56 my $repodb = Archive::Tar->iter("$dir/$reponame.db", 1);
57 my $e;
58 my $lastfn = '';
59 my $d;
60 while ($e = $repodb->()) {
61 next unless $e->type() == Archive::Tar::Constant::FILE;
62 my $fn = $e->name();
6538da7 @mlschroe - finished support for arch linux, sample config included
mlschroe authored Apr 2, 2012
63 next unless $fn =~ s/\/(?:depends|desc|files)$//s;
af05d93 @mlschroe - start support for arch linux, code mostly written by Nikolay Rysev …
mlschroe authored Mar 30, 2012
64 if ($lastfn ne $fn) {
65 printpkginfo($d, $url) if $d->{'name'};
66 $d = {};
67 $lastfn = $fn;
68 }
69 Build::Arch::parserepodata($d, $e->get_content());
70 }
71 printpkginfo($d, $url) if $d->{'name'};
72 }
Something went wrong with that request. Please try again.