/[gentoo-perl]/g-cpan/trunk/lib/Gentoo/Ebuild.pm
Gentoo

Contents of /g-cpan/trunk/lib/Gentoo/Ebuild.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 53 - (show annotations) (download) (as text)
Wed May 10 16:13:42 2006 UTC (8 years, 7 months ago) by mcummings
File MIME type: text/x-perl
File size: 4729 byte(s)
Prepping
1 package Gentoo::Ebuild;
2
3 use 5.008007;
4 use strict;
5 use warnings;
6
7 use DirHandle;
8
9 # These libraries were influenced and largely written by
10 # Christian Hartmann <ian@gentoo.org> originally. All of the good
11 # parts are ian's - the rest is mcummings messing around.
12
13 require Exporter;
14
15 our @ISA = qw(Exporter Gentoo);
16
17 our @EXPORT = qw( getAvailableEbuilds getAvailableVersions );
18
19 our $VERSION = '0.01';
20
21 # Description:
22 # @listOfEbuilds = getAvailableEbuilds($PORTDIR, category/packagename);
23 sub getAvailableEbuilds
24 {
25 my $self = shift;
26 my $catPackage = shift;
27 my @packagelist = ();
28
29 if (-e $self->{portdir} . "/" . $catPackage)
30 {
31
32 # - get list of ebuilds >
33 my $_cat_handle = new DirHandle($self->{portdir} . "/" . $catPackage);
34 while (defined($_ = $_cat_handle->read))
35 {
36 if ($_ =~ m/(.+)\.ebuild$/)
37 {
38 next if ($_ eq "skel.ebuild");
39 push(@{$self->{packagelist}}, $_);
40 }
41 else
42 {
43 if (-d $self->{portdir} . "/" . $catPackage . "/" . $_)
44 {
45 my $_ebuild_dh = new DirHandle($self->{portdir} . "/" . $catPackage . "/" . $_);
46 while (defined($_ = $_ebuild_dh->read))
47 {
48 if ($_ =~ m/(.+)\.ebuild$/)
49 {
50 next if ($_ eq "skel.ebuild");
51 push(@{$self->{packagelist}}, $_);
52 }
53 }
54 }
55 }
56 }
57 }
58 else
59 {
60 if (-d $self->{portdir})
61 {
62 die("\n" . $self->{portdir} . "/" . $catPackage . " DOESNT EXIST\n");
63 }
64 else
65 {
66 die("\nPORTDIR hasn't been defined!\n\n");
67 }
68 }
69
70 }
71
72 # Description:
73 # Returns version of an ebuild. (Without -rX string etc.)
74 # $version = getEbuildVersionSpecial("foo-1.23-r1.ebuild");
75 sub getEbuildVersionSpecial
76 {
77 my $ebuildVersion = shift;
78 $ebuildVersion = substr($ebuildVersion, 0, length($ebuildVersion) - 7);
79 $ebuildVersion =~ s/^([a-zA-Z0-9\-_\/\+]*)-([0-9\.]+[a-zA-Z]?)([\-r|\-rc|_alpha|_beta|_pre|_p]?)/$2$3/;
80
81 return $ebuildVersion;
82 }
83
84 sub getAvailableVersions
85 {
86 my $self = shift;
87 my %excludeDirs = (
88 "." => 1,
89 ".." => 1,
90 "metadata" => 1,
91 "licenses" => 1,
92 "eclass" => 1,
93 "distfiles" => 1,
94 "virtual" => 1,
95 "profiles" => 1
96 );
97 my @matches = ();
98 my $dhp;
99 my $tc;
100 my $tp;
101
102 foreach $tc (@{$self->{portage_categories}})
103 {
104 $dhp = new DirHandle($self->{portdir} . "/" . $tc);
105 while (defined($tp = $dhp->read))
106 {
107
108 # - not excluded and $_ is a dir?
109 if (!$excludeDirs{$tp} && -d $self->{portdir} . "/" . $tc . "/" . $tp)
110 {
111 getAvailableEbuilds($self, $tc . "/" . $tp);
112 foreach (@{$self->{packagelist}})
113 {
114 my @tmp_availableVersions = ();
115 push(@tmp_availableVersions, getEbuildVersionSpecial($_));
116
117 # - get highest version >
118 if ($#tmp_availableVersions > -1)
119 {
120 $self->{modules}{'portage_lc_realversion'}{lc($tp)} = (sort(@tmp_availableVersions))[$#tmp_availableVersions];
121 $self->{modules}{'portage_lc'}{lc($tp)} = $self->{modules}{'portage_lc_realversion'}{lc($tp)};
122
123 # - get rid of -rX >
124 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/([a-zA-Z0-9\-_\/]+)-r[0-9+]/$1/;
125 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/([a-zA-Z0-9\-_\/]+)-rc[0-9+]/$1/;
126 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/([a-zA-Z0-9\-_\/]+)_p[0-9+]/$1/;
127 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/([a-zA-Z0-9\-_\/]+)_pre[0-9+]/$1/;
128
129 # - get rid of other stuff we don't want >
130 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/([a-zA-Z0-9\-_\/]+)_alpha[0-9+]?/$1/;
131 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/([a-zA-Z0-9\-_\/]+)_beta[0-9+]?/$1/;
132 $self->{modules}{'portage_lc'}{lc($tp)} =~ s/[a-zA-Z]+$//;
133
134 $self->{modules}{'portage'}{lc($tp)}{'name'} = $tp;
135 $self->{modules}{'portage'}{lc($tp)}{'category'} = $tc;
136 }
137 }
138 }
139 }
140 undef $dhp;
141 }
142 }
143
144 sub DESTROY
145 {
146 my ($self) = @_;
147 return if $self->{DESTROY}{__PACKAGE__}++;
148 }
149
150 1;

  ViewVC Help
Powered by ViewVC 1.1.20