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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 137 - (show annotations) (download) (as text)
Fri Jan 5 18:43:32 2007 UTC (7 years, 11 months ago) by mcummings
File MIME type: text/x-perl
File size: 10100 byte(s)
Bug 160137, strip_ends cleanup on env imports.


1 package Gentoo::Portage;
2
3 use 5.008007;
4 use strict;
5 use warnings;
6 use Shell qw(ebuild emerge);
7 #use Memoize;
8 #memoize('getAvailableVersions');
9 use Cwd qw(getcwd abs_path cwd);
10 use File::Find ();
11 use Shell::EnvImporter;
12
13
14 # Set the variable $File::Find::dont_use_nlink if you're using AFS,
15 # since AFS cheats.
16
17 # for the convenience of &wanted calls, including -eval statements:
18 use vars qw/*name *dir *prune/;
19 *name = *File::Find::name;
20 *dir = *File::Find::dir;
21 *prune = *File::Find::prune;
22
23 my @store_found_dirs;
24 my @store_found_ebuilds;
25 sub wanted;
26
27 # These libraries were influenced and largely written by
28 # Christian Hartmann <ian@gentoo.org> originally. All of the good
29 # parts are ian's - the rest is mcummings messing around.
30
31 require Exporter;
32
33 our @ISA = qw(Exporter Gentoo);
34
35 our @EXPORT =
36 qw( getAvailableEbuilds getAvailableVersions generate_digest emerge_ebuild );
37
38 our $VERSION = '0.01';
39
40
41 #IMPORT VARIABLES
42 foreach my $file ( "/etc/make.globals", "/etc/make.conf", "$ENV{HOME}/.gcpanrc" ) {
43 if ( -f $file) {
44 my $importer = Shell::EnvImporter->new(
45 file => $file,
46 shell => 'bash',
47 auto_run => 1,
48 auto_import => 1,
49 import_added => 1,
50 import_modified => 1,
51 );
52 $importer->shellobj->envcmd('set');
53 $importer->run();
54 $importer->env_import();
55 }
56
57 }
58
59 # Description:
60 # @listOfEbuilds = getAvailableEbuilds($PORTDIR, category/packagename);
61 sub getAvailableEbuilds {
62 my $self = shift;
63 my $portdir = shift;
64 my $catPackage = shift;
65 @{$self->{packagelist}} = ();
66 if ( -e $portdir . "/" . $catPackage ) {
67
68 # - get list of ebuilds >
69 my $startdir = &cwd;
70 chdir( $portdir . "/" . $catPackage );
71 @store_found_ebuilds = [];
72 File::Find::find( { wanted => \&wanted_ebuilds }, "." );
73 chdir($startdir);
74 foreach (@store_found_ebuilds) {
75 $_ =~ s{^\./}{}xms;
76 if ( $_ =~ m/(.+)\.ebuild$/ ) {
77 next if ( $_ eq "skel.ebuild" );
78 push( @{ $self->{packagelist} }, $_ );
79 }
80 else {
81 if ( -d $portdir . "/" . $catPackage . "/" . $_ ) {
82 $_ =~ s{^\./}{}xms;
83 my $startdir = &cwd;
84 chdir( $portdir . "/" . $catPackage . "/" . $_ );
85 @store_found_ebuilds = [];
86 File::Find::find( { wanted => \&wanted_ebuilds }, "." );
87 chdir($startdir);
88 foreach (@store_found_ebuilds) {
89 if ( $_ =~ m/(.+)\.ebuild$/ ) {
90 next if ( $_ eq "skel.ebuild" );
91 push( @{ $self->{packagelist} }, $_ );
92 }
93 }
94 }
95 }
96 }
97 }
98 else {
99 if ( -d $portdir ) {
100 if ( $self->{debug} ) {
101 warn(
102 "\n" . $portdir . "/" . $catPackage . " DOESN'T EXIST\n" );
103 }
104 }
105 else {
106 die("\nPORTDIR hasn't been defined!\n\n");
107 }
108 }
109
110 }
111
112 # Description:
113 # Returns version of an ebuild. (Without -rX string etc.)
114 # $version = getEbuildVersionSpecial("foo-1.23-r1.ebuild");
115 sub getEbuildVersionSpecial {
116 my $ebuildVersion = shift;
117 $ebuildVersion = substr( $ebuildVersion, 0, length($ebuildVersion) - 7 );
118 $ebuildVersion =~
119 s/^([a-zA-Z0-9\-_\/\+]*)-([0-9\.]+[a-zA-Z]?)([\-r|\-rc|_alpha|_beta|_pre|_p]?)/$2$3/;
120
121 return $ebuildVersion;
122 }
123
124 sub getAvailableVersions {
125 my $self = shift;
126 my $portdir = shift;
127 my $find_ebuild = shift;
128 my %excludeDirs = (
129 "." => 1,
130 ".." => 1,
131 "metadata" => 1,
132 "licenses" => 1,
133 "eclass" => 1,
134 "distfiles" => 1,
135 "virtual" => 1,
136 "profiles" => 1
137 );
138
139 if ($find_ebuild) {
140 return if ( defined($self->{portage}{ lc($find_ebuild) }{'found'} ));
141 }
142 foreach my $tc ( @{ $self->{portage_categories} } ) {
143 next if ( !-d "$portdir/$tc" );
144 @store_found_dirs = [];
145
146 # Where we started
147 my $startdir = &cwd;
148
149 # chdir to our target dir
150 chdir( $portdir . "/" . $tc );
151
152 # Traverse desired filesystems
153 File::Find::find( { wanted => \&wanted_dirs }, "." );
154
155 # Return to where we started
156 chdir($startdir);
157 foreach my $tp ( sort @store_found_dirs ) {
158 $tp =~ s{^\./}{}xms;
159
160 # - not excluded and $_ is a dir?
161 if ( !$excludeDirs{$tp} && -d $portdir . "/" . $tc . "/" . $tp ) {
162 if ($find_ebuild) {
163 next
164 unless ( lc($find_ebuild) eq lc($tp) );
165 }
166 getAvailableEbuilds( $self, $portdir, $tc . "/" . $tp );
167
168 my @arr = @{ $self->{packagelist}};
169 foreach ( @{ $self->{packagelist} } ) {
170 my @tmp_availableVersions = ();
171 push( @tmp_availableVersions, getEbuildVersionSpecial($_) );
172
173 # - get highest version >
174 if ( $#tmp_availableVersions > -1 ) {
175 $self->{'portage'}{ lc($tp) }{'version'} =
176 ( sort(@tmp_availableVersions) )
177 [$#tmp_availableVersions];
178
179 # - get rid of -rX >
180 $self->{'portage'}{ lc($tp) }{'version'} =~
181 s/([a-zA-Z0-9\-_\/]+)-r[0-9+]/$1/;
182 $self->{'portage'}{ lc($tp) }{'version'} =~
183 s/([a-zA-Z0-9\-_\/]+)-rc[0-9+]/$1/;
184 $self->{'portage'}{ lc($tp) }{'version'} =~
185 s/([a-zA-Z0-9\-_\/]+)_p[0-9+]/$1/;
186 $self->{'portage'}{ lc($tp) }{'version'} =~
187 s/([a-zA-Z0-9\-_\/]+)_pre[0-9+]/$1/;
188
189 # - get rid of other stuff we don't want >
190 $self->{'portage'}{ lc($tp) }{'version'} =~
191 s/([a-zA-Z0-9\-_\/]+)_alpha[0-9+]?/$1/;
192 $self->{'portage'}{ lc($tp) }{'version'} =~
193 s/([a-zA-Z0-9\-_\/]+)_beta[0-9+]?/$1/;
194 $self->{'portage'}{ lc($tp) }{'version'} =~
195 s/[a-zA-Z]+$//;
196
197 if ( $tc eq "perl-core"
198 and ( keys %{ $self->{'portage_bases'} } ) )
199 {
200
201 # We have a perl-core module - can we satisfy it with a virtual/perl-?
202 foreach my $portage_root (
203 keys %{ $self->{'portage_bases'} } )
204 {
205 if ( -d $portage_root ) {
206 if ( -d "$portage_root/virtual/perl-$tp" ) {
207 $self->{'portage'}{ lc($tp) }
208 {'name'} = "perl-$tp";
209 $self->{'portage'}{ lc($tp) }
210 {'category'} = "virtual";
211 last;
212 }
213 }
214 }
215
216 }
217 else {
218 $self->{'portage'}{ lc($tp) }{'name'} =
219 $tp;
220 $self->{'portage'}{ lc($tp) }{'category'} =
221 $tc;
222 }
223 if ($find_ebuild) {
224 if ( defined($self->{'portage'}{ lc($tp) }{'name'}) )
225 {
226 $self->{portage}{ lc($tp) }{'found'} = 1;
227 last;
228 }
229 }
230 }
231 }
232 }
233 }
234 }
235 return ($self);
236 }
237
238 sub generate_digest {
239 my $self = shift;
240
241 # Full path to the ebuild file in question
242 my $ebuild = shift;
243 ebuild( $ebuild, "digest" );
244 }
245
246 sub emerge_ebuild {
247 my $self = shift;
248 my @call = @_;
249
250 # emerge forks and returns, which confuses this process. So
251 # we call it the old fashioned way :(
252 system( "emerge", @call );
253 }
254
255 sub wanted_dirs {
256 my ( $dev, $ino, $mode, $nlink, $uid, $gid );
257 ( ( $dev, $ino, $mode, $nlink, $uid, $gid ) = lstat($_) )
258 && -d _
259 && ( $name !~ m|/files| )
260 && ( $name !~ m|/CVS| )
261 && push @store_found_dirs, $name;
262 }
263
264 sub wanted_ebuilds {
265 /\.ebuild\z/s
266 && push @store_found_ebuilds, $name;
267 }
268
269 sub DESTROY {
270 my ($self) = @_;
271 return if $self->{DESTROY}{__PACKAGE__}++;
272 }
273
274 1;
275
276 =pod
277
278 =head1 NAME
279
280 Gentoo::Portage - perl access to portage information and commands
281
282 =head1 SYNOPSIS
283
284 use Gentoo;
285 my $obj = Gentoo->new();
286 $obj->getAvailableEbuilds($portdir,'category');
287 $obj->getAvailableVersions($portdir);
288
289 =head1 DESCRIPTION
290
291 The C<Gentoo::Portage> class provides access to portage tools and tree
292 information.
293
294 =head1 METHODS
295
296 =over 4
297
298 =item $obj->getAvailableEbuilds($portdir, $package);
299
300 Providing the PORTDIR you want to invesitage, and either the name of the
301 category or the category/package you are interested, this will populate an
302 array in $obj->{packagelist} of the available ebuilds.
303
304 =item $obj->getAvailableVersions($portdir,[$ebuildname])
305
306 Given the portage directory and the name of a package (optional), check
307 portage to see if the ebuild exists and which versions are available.
308
309 =item $obj->getEbuildVersionSpecial($ebuild)
310
311 Given the full name of an ebuild (foo-1.3.4-rc5.ebuild), this function will
312 return the actual version of the ebuild after stripping out the portage
313 related syntax.
314
315 =item $obj->generate_digest($path_to_ebuild)
316
317 Given the full path to an ebuild, generate a digest via C<ebuild PKG digest>
318
319 =item $obj->emerge_ebuild($pkg, @flags)
320
321 Given the name of a package and any optional flags, emerge the package with
322 portage.
323
324 =cut

  ViewVC Help
Powered by ViewVC 1.1.20