1 |
Author: mcummings |
2 |
Date: 2005-05-20 15:06:19 +0200 (Fri, 20 May 2005) |
3 |
New Revision: 35 |
4 |
|
5 |
Modified: |
6 |
trunk/bin/g-cpan.pl |
7 |
trunk/extra-docs/Changes |
8 |
Log: |
9 |
Read changes file - lots of tweaks galore. I think this is ready - tested with every scenario I could think of over here. |
10 |
|
11 |
|
12 |
|
13 |
Modified: trunk/bin/g-cpan.pl |
14 |
=================================================================== |
15 |
--- trunk/bin/g-cpan.pl 2005-05-17 16:28:47 UTC (rev 34) |
16 |
+++ trunk/bin/g-cpan.pl 2005-05-20 13:06:19 UTC (rev 35) |
17 |
@@ -1,5 +1,5 @@ |
18 |
#!/usr/bin/perl -w |
19 |
-# Copyright 1999-2004 Gentoo Foundation |
20 |
+# Copyright 1999-2005 Gentoo Foundation |
21 |
# Distributed under the terms of the GNU General Public License v2 |
22 |
# $Header: $ |
23 |
# |
24 |
@@ -15,7 +15,7 @@ |
25 |
use Digest::MD5; |
26 |
|
27 |
use constant MAKE_CONF => '/etc/make.conf'; |
28 |
-use constant PATH_PKG_DEV_PERL => '/var/db/pkg/dev-perl'; |
29 |
+use constant PATH_PKG_VAR => '/var/db/pkg/'; |
30 |
##### CPAN CONFIG ##### |
31 |
use constant CPAN_CFG_DIR => '.cpan/CPAN'; |
32 |
use constant CPAN_CFG_NAME => 'MyConfig.pm'; |
33 |
@@ -35,8 +35,8 @@ |
34 |
##### ERRORS constants (easy internationalisation ;-) ##### |
35 |
use constant ERR_FILE_NOTFOUND => "Couldn't find file '%s'"; # filename |
36 |
use constant ERR_FOLDER_NOTFOUND => "Couldn't find folder '%s'"; # foldername |
37 |
-use constant ERR_OPEN_READ => "Couldn't open (read) file'%s' : %s"; # filename, $! |
38 |
-use constant ERR_OPEN_WRITE => "Couldn't open (write) file'%s' : %s"; # filename, $! |
39 |
+use constant ERR_OPEN_READ => "Couldn't open (read) file '%s' : %s"; # filename, $! |
40 |
+use constant ERR_OPEN_WRITE => "Couldn't open (write) file '%s' : %s"; # filename, $! |
41 |
use constant ERR_FOLDER_OPEN => "Couldn't open folder '%s', %s"; # foldername, $! |
42 |
use constant ERR_FOLDER_CREATE => "Couldn't create folder '%s' : %s"; # foldername, $! |
43 |
|
44 |
@@ -73,18 +73,31 @@ |
45 |
) |
46 |
or exit_usage(); |
47 |
|
48 |
+# Set colors here so we can use them at will anywhere :) |
49 |
+my $green = color("bold green"); |
50 |
+my $white = color ("bold white"); |
51 |
+my $cyan = color("bold cyan"); |
52 |
+my $reset = color("reset"); |
53 |
+ |
54 |
# Output error if more than one switch is activated |
55 |
-if ( $search + $list + $install + $generate + $upgrade > 1 ) { |
56 |
+if ( $search + $list + $install + $generate + $upgrade + $pretend + $ask > 1 ) { |
57 |
print_err( |
58 |
-"You can't combine search, list, install or upgrade with each other. Please choose only one\n"); |
59 |
- exit_usage(); |
60 |
+"You can't combine actions with each other.\n"); |
61 |
+ print "${white}Please consult ${cyan}$prog ${green}--help${reset} or ${cyan}man $prog${reset} for more information\n\n"; |
62 |
+ exit(); |
63 |
} |
64 |
|
65 |
+if ( $search + $list + $install + $generate + $upgrade + $pretend + $ask == 0 ) { |
66 |
+ print_err("You haven't told $prog what to do. Exiting.\n"); |
67 |
+ exit(); |
68 |
+ } |
69 |
+ |
70 |
# Output error if no arguments |
71 |
-if ( !( defined( $ARGV[0] ) ) and !( defined($upgrade) or defined($list) ) ) { |
72 |
+if ( (scalar(@ARGV) == 0 ) or !(defined($upgrade) or defined($list)) ) { |
73 |
print_err ("Not even one module name or expression given !\n"); |
74 |
- exit_usage(); |
75 |
-} |
76 |
+ print "${white}Please consult ${cyan}$prog ${green}--help${reset} for more information\n\n"; |
77 |
+ exit(); |
78 |
+} |
79 |
|
80 |
###################### |
81 |
# CPAN Special Stuff # |
82 |
@@ -139,34 +152,28 @@ |
83 |
# directory and allow portage to build a package outside of its |
84 |
# normal tree. |
85 |
my $tmp_overlay_dir; |
86 |
-if ( $ENV{TMPDIR} ) { $tmp_overlay_dir = "$ENV{TMPDIR}/perl-modules_$$" } |
87 |
-else { $tmp_overlay_dir = "/tmp/perl-modules_$$" } |
88 |
|
89 |
my @ebuild_list; #this array needs to be seriously observed. |
90 |
|
91 |
# Set up global paths |
92 |
# my $TMP_DEV_PERL_DIR = '/var/db/pkg/dev-perl'; |
93 |
-my $MAKECONF = '/etc/make.conf'; |
94 |
my ( $PORTAGE_DISTDIR, $PORTAGE_DIR, @OVERLAYS ) = get_globals(); |
95 |
|
96 |
-my @OVERLAY_PERLS; |
97 |
-my @PORTAGE_DEV_PERL; |
98 |
-my @TMP_DEV_PERL_DIRS; |
99 |
+unless (scalar(@OVERLAYS) > 0) { |
100 |
+ if ( $generate or $pretend ) |
101 |
+ { print_err("The option you have chosen isn't supported without a configured overlay.\n"); |
102 |
+ exit(); |
103 |
+ } |
104 |
+ unless($ENV{TMPDIR}) { $ENV{TMPDIR} = '/tmp' } |
105 |
+ $tmp_overlay_dir = "$ENV{TMPDIR}/perl-modules_$$"; |
106 |
|
107 |
-foreach my $pdir (@perl_dirs) { |
108 |
- my $tmp_dir = File::Spec->catdir( $PORTAGE_DIR, $pdir ); |
109 |
- push @PORTAGE_DEV_PERL, $tmp_dir; |
110 |
- foreach my $odir (@OVERLAYS) { |
111 |
- my $otmp = File::Spec->catdir( $odir, $pdir ); |
112 |
- push @OVERLAY_PERLS, $otmp; |
113 |
- } |
114 |
- my $vtmp_dir = File::Spec->catdir(PATH_PKG_DEV_PERL, $pdir ); |
115 |
- push @TMP_DEV_PERL_DIRS, $vtmp_dir; |
116 |
+ # Create the tmp_overlay_dir in the even that it is a 'real' temp dir |
117 |
+ if(not -d $tmp_overlay_dir) { |
118 |
+ mkpath($tmp_overlay_dir, 1, 0755) or fatal(ERR_FOLDER_CREATE, $tmp_overlay_dir, $!); |
119 |
+ } |
120 |
+ push @OVERLAYS, $tmp_overlay_dir; |
121 |
} |
122 |
|
123 |
-# Create the ebuild in PORTDIR_OVERLAY, if it is defined and exists |
124 |
-# Part of this is to find an overlay the user running this session can actually write to |
125 |
- |
126 |
# o_reset will be used to catch if went through all of the overlay dirs successfully - |
127 |
# open to better ways :) mcummings |
128 |
my $o_reset = 1; |
129 |
@@ -183,11 +190,30 @@ |
130 |
} |
131 |
} |
132 |
if ($o_reset > 0) { |
133 |
- print_err("You don't have permission to work in any of the list overlays."); |
134 |
- print_err("Please run $prog as a user with sufficient permissions."); |
135 |
+ print_err("You don't have permission to work in any of the portage overlays."); |
136 |
+ print_err("Please run $prog as a user with sufficient permissions.\n"); |
137 |
exit(); |
138 |
} |
139 |
|
140 |
+ |
141 |
+my @OVERLAY_PERLS; |
142 |
+my @PORTAGE_DEV_PERL; |
143 |
+my @TMP_DEV_PERL_DIRS; |
144 |
+ |
145 |
+foreach my $pdir (@perl_dirs) { |
146 |
+ my $tmp_dir = File::Spec->catdir( $PORTAGE_DIR, $pdir ); |
147 |
+ push @PORTAGE_DEV_PERL, $tmp_dir; |
148 |
+ foreach my $odir (@OVERLAYS) { |
149 |
+ my $otmp = File::Spec->catdir( $odir, $pdir ); |
150 |
+ push @OVERLAY_PERLS, $otmp; |
151 |
+ } |
152 |
+ my $vtmp_dir = File::Spec->catdir(PATH_PKG_VAR, $pdir ); |
153 |
+ push @TMP_DEV_PERL_DIRS, $vtmp_dir; |
154 |
+} |
155 |
+ |
156 |
+# Create the ebuild in PORTDIR_OVERLAY, if it is defined and exists |
157 |
+# Part of this is to find an overlay the user running this session can actually write to |
158 |
+ |
159 |
# Grab the whole available arches list, to include them later in ebuilds |
160 |
print_info ("Grabbing arch list") if $verbose; |
161 |
my $arches = do { |
162 |
@@ -196,16 +222,10 @@ |
163 |
join " ", map { chomp; $_ } <$tmp>; |
164 |
}; |
165 |
|
166 |
-#this should never find the dir, but just to be safe |
167 |
-if(not -d $tmp_overlay_dir) { |
168 |
- mkpath($tmp_overlay_dir, 1, 0755) or fatal(ERR_FOLDER_CREATE, $tmp_overlay_dir, $!); |
169 |
-} |
170 |
- |
171 |
# Now we cat our dev-perl directory onto our overlay directory. |
172 |
# This is done so that portage records the appropriate path |
173 |
#i.e. dev-perl/package |
174 |
my $perldev_overlay = File::Spec->catfile( $tmp_overlay_dir, 'perl-gcpan' ); |
175 |
- |
176 |
if(not -d $perldev_overlay) { |
177 |
# create perldev overlay dir if not present |
178 |
mkpath($perldev_overlay, 1, 0755) or fatal(ERR_FOLDER_CREATE, $perldev_overlay, $!); |
179 |
@@ -214,10 +234,12 @@ |
180 |
# Now we export our overlay directory into the session's env vars |
181 |
$ENV{PORTDIR_OVERLAY} = $tmp_overlay_dir; |
182 |
|
183 |
+ |
184 |
# Take care of List requests. This should return all the ebuilds managed by g-cpan |
185 |
if ($list) { |
186 |
print_ok ("Generating list of modules managed by g-cpan"); |
187 |
my @managed = get_gcpans(); |
188 |
+ exit(); |
189 |
} |
190 |
|
191 |
if ($generate) { |
192 |
@@ -240,9 +262,7 @@ |
193 |
} |
194 |
} |
195 |
|
196 |
-if($install or $upgrade) { |
197 |
- clean_up(); |
198 |
-} |
199 |
+clean_up(); |
200 |
|
201 |
exit; |
202 |
|
203 |
@@ -385,9 +405,9 @@ |
204 |
print_ok ("Writing to $ebuild") if ($verbose); |
205 |
open EBUILD, ">$ebuild" or fatal(ERR_OPEN_WRITE, $ebuild, $!); |
206 |
print EBUILD <<"HERE"; |
207 |
- |
208 |
-# Copyright 1999-2004 Gentoo Foundation |
209 |
+# Copyright 1999-2005 Gentoo Foundation |
210 |
# Distributed under the terms of the GNU General Public License v2 |
211 |
+# This ebuild generated by $prog $VERSION |
212 |
|
213 |
inherit perl-module |
214 |
|
215 |
@@ -465,6 +485,8 @@ |
216 |
|
217 |
if ( my $exists = ebuild_exists($dir) ) { |
218 |
|
219 |
+ # Print simple found message unless verbose -verbose already got a long version |
220 |
+ print_info("Existing ebuild found for $exists\n") unless $verbose; |
221 |
# Just because an ebuild exists, doesn't mean we don't want to pass it on ;) |
222 |
push @ebuild_list, "$exists"; |
223 |
return; |
224 |
@@ -519,7 +541,7 @@ |
225 |
unless ( -f "$PORTAGE_DISTDIR/$localfile" ) { |
226 |
move("$localfile", "$PORTAGE_DISTDIR"); |
227 |
} |
228 |
- print_info("perl-gcpan/$dir created"); |
229 |
+ print_info("perl-gcpan/$dir created in $ENV{PORTDIR_OVERLAY}"); |
230 |
push @ebuild_list, "perl-gcpan/$dir"; |
231 |
} |
232 |
|
233 |
@@ -620,8 +642,9 @@ |
234 |
# FIXME Sniper |
235 |
# check return values |
236 |
if (@ebuild_list) { |
237 |
- system( "emerge", @flags, "--oneshot", "--digest", @ebuild_list ) |
238 |
- or die "Emerge failed: $!"; |
239 |
+ system( "emerge", @flags, "--oneshot", "--digest", @ebuild_list ); |
240 |
+ # Portage apparently 'returns' with a status that is being interpreted as a failure even on success :( |
241 |
+ #or die "Emerge failed: $!"; |
242 |
} else { |
243 |
print_err ("No ebuilds generated for emerge."); |
244 |
} |
245 |
@@ -638,7 +661,7 @@ |
246 |
my @OVERLAYS = (); |
247 |
|
248 |
# Opening make.conf to find real user settings |
249 |
- open CONF, "<$MAKECONF" or fatal(ERR_OPEN_READ, $MAKECONF, $!); |
250 |
+ open CONF, MAKE_CONF or fatal(ERR_OPEN_READ, MAKE_CONF, $!); |
251 |
|
252 |
# And parsing it :) |
253 |
while ( defined( my $line = <CONF> ) ) { |
254 |
@@ -689,6 +712,7 @@ |
255 |
my $count_o = @OVERLAYS; |
256 |
for ( my $i = 0 ; $i < $count_o ; $i++ ) { |
257 |
$OVERLAYS[$i] = clean_vars( $OVERLAYS[$i], %conf ); |
258 |
+ print_info("Adding $OVERLAYS[$i] to overlay list\n") if $verbose; |
259 |
} |
260 |
|
261 |
return ( $conf{DISTDIR}, $conf{PORTDIR}, @OVERLAYS ); |
262 |
@@ -778,16 +802,16 @@ |
263 |
# anyway, they expect a string and add a colored star at the beginning and the CR/LF |
264 |
# at the end of the line. oh, shiny world ;) |
265 |
sub print_ok { |
266 |
- print color("bold green"), "* ", color("reset"), @_, "\n"; |
267 |
+ print " ", color("bold green"), "* ", color("reset"), "$prog: ", @_, "\n"; |
268 |
} |
269 |
sub print_info { |
270 |
- print color("bold cyan"), "* ", color("reset"), @_, "\n"; |
271 |
+ print " ", color("bold cyan"), "* ", color("reset"), "$prog: ", @_, "\n"; |
272 |
} |
273 |
sub print_warn { |
274 |
- print color("bold yellow"), "* ", color("reset"), @_, "\n"; |
275 |
+ print " ", color("bold yellow"), "* ", color("reset"), "$prog: ", @_, "\n"; |
276 |
} |
277 |
sub print_err{ |
278 |
- print color("bold red"), "* ", color("reset"), @_, "\n"; |
279 |
+ print " ", color("bold red"), "* ", color("reset"), "$prog: ", @_, "\n"; |
280 |
} |
281 |
|
282 |
################################################# |
283 |
@@ -835,6 +859,7 @@ |
284 |
# This allows us to assure that if a module has been manually installed, we know about it. |
285 |
sub module_check { |
286 |
my $check = shift; |
287 |
+ print_info("Checking to see if $check is installed already\n") if $verbose; |
288 |
eval "use $check;"; |
289 |
return $@ ? 0 : 1; |
290 |
} |
291 |
@@ -852,17 +877,18 @@ |
292 |
#Clean out the /tmp tree we were using |
293 |
#I know this looks weird, but since clean_up is invoked on a search, where OVERLAYS isn't ever defined, |
294 |
# we first need to see if it exists, then need to remove only if it has content (the old exists vs. defined) |
295 |
- if (@OVERLAYS) { rmtree( ["$tmp_overlay_dir"] ) if ( scalar(@OVERLAYS) > 0 ) } |
296 |
+ |
297 |
+ if ( (defined($ENV{TMPDIR}) ) and ( defined($tmp_overlay_dir) && ($tmp_overlay_dir =~ m/^$ENV{TMPDIR}/) ) ) { |
298 |
+ print_info("Cleaning temporary overlay\n") if $verbose; |
299 |
+ rmtree( ["$tmp_overlay_dir"] ); |
300 |
+ } |
301 |
+ #if ($tmp_overlay_dir =~ m/^$ENV{TMPDIR}/) { rmtree( ["$tmp_overlay_dir"] ) } |
302 |
+ print_info("Removing cpan build dir") if $verbose; |
303 |
rmtree( ["$ENV{HOME}/.cpan/build"]) if ( -d "$ENV{HOME}/.cpan/build" ); |
304 |
} |
305 |
|
306 |
# cab - nice help message ! ;) |
307 |
sub exit_usage { |
308 |
- my $green = color("bold green"); |
309 |
- my $white = color ("bold white"); |
310 |
- my $cyan = color("bold cyan"); |
311 |
- my $reset = color("reset"); |
312 |
- |
313 |
print <<"USAGE"; |
314 |
${white}Usage : ${cyan}$prog ${green}<Switch(es)> ${cyan}Module Name(s)${reset} |
315 |
|
316 |
|
317 |
Modified: trunk/extra-docs/Changes |
318 |
=================================================================== |
319 |
--- trunk/extra-docs/Changes 2005-05-17 16:28:47 UTC (rev 34) |
320 |
+++ trunk/extra-docs/Changes 2005-05-20 13:06:19 UTC (rev 35) |
321 |
@@ -1,3 +1,31 @@ |
322 |
+20/05/2005 - mcummings |
323 |
+ |
324 |
+- Moved color block so I could invoke it outside the usage function |
325 |
+- Added options to the "don't combine" block. Cleaned up text since the block was getting too long to handle/read |
326 |
+- Added catch for when no options were passed :) |
327 |
+- Modified check and output for arguments without a module pass |
328 |
+- Reorganized the checking of PORTDIR_OVERLAY and tmp_dir creation. |
329 |
+ - Check to make sure we aren't attempting a non-emerge and creating a temp dir |
330 |
+ - Add tmp_dir to overlay list earlier |
331 |
+ - set ENV{TMPDIR} explicitly if there are no overlays |
332 |
+ - Bundle the creation of tmp_dir into the block of "if there are no overlays" |
333 |
+- Invoke clean up no matter what -if we are far enough to reach it, we ran something that needs it |
334 |
+- Modified clean up to only remove the tmpdir if it is from our ENV{TMPDIR} - that way we don't wipe overlays by accident |
335 |
+- Updated copyright info for generated ebuild :) Also added a line to indicate that the ebuild was generated by g-cpan and which version |
336 |
+- Added output for existing ebuilds found. This helps in the event of invoking g-cpan for an ebuild that already exists. Without this, we return to the prompt without knowing why g-cpan didn't do anything |
337 |
+- Removed die from call to emerge. Seems the way portage runs it returns an exit code that perl is interpeting as a die |
338 |
+- Removed $MAKECONF - we have a constant for this. |
339 |
+- Added verbose message for overlays during discovery phase |
340 |
+- Inform user which overlay dir is being used |
341 |
+- Corrected cat'ing of /var/db/pkg dirs to pdirs |
342 |
+- Tweaked and tested invocations. g-cpan returns proper messages now under the following conditions: |
343 |
+ * User with overlays attempts to emerge and can't |
344 |
+ * No overlays defined and user attempts generate |
345 |
+ * Confirmed multiple overlays work - g-cpan will select the first overlay that it has write access to |
346 |
+ * Emerging without any overlays |
347 |
+ * I think that's all that can be tested :) |
348 |
+ |
349 |
+ |
350 |
17/05/2005 - mcummings |
351 |
|
352 |
- Changed searching to use i() instead of m() (catch more flies with i than m ;) ) |
353 |
|
354 |
|
355 |
-- |
356 |
gentoo-perl@g.o mailing list |