1 |
Author: cab |
2 |
Date: 2005-05-15 12:02:54 +0200 (Sun, 15 May 2005) |
3 |
New Revision: 25 |
4 |
|
5 |
Modified: |
6 |
trunk/bin/g-cpan.pl |
7 |
trunk/extra-docs/Changes |
8 |
Log: |
9 |
- corrected indentation and typos in exit_usage() |
10 |
- colorized exit_usage (feel like portage) |
11 |
- rearranged code (categorizing sub - easier to find what we're looking for) |
12 |
- added some comments here and there (again ;p) |
13 |
|
14 |
|
15 |
Modified: trunk/bin/g-cpan.pl |
16 |
=================================================================== |
17 |
--- trunk/bin/g-cpan.pl 2005-05-12 18:05:56 UTC (rev 24) |
18 |
+++ trunk/bin/g-cpan.pl 2005-05-15 10:02:54 UTC (rev 25) |
19 |
@@ -11,6 +11,7 @@ |
20 |
use File::Spec; |
21 |
use File::Path; |
22 |
use File::Basename; |
23 |
+use Term::ANSIColor; |
24 |
|
25 |
use constant MAKE_CONF => '/etc/make.conf'; |
26 |
use constant PATH_PKG_DEV_PERL => '/var/db/pkg/dev-perl'; |
27 |
@@ -45,6 +46,9 @@ |
28 |
my $prog = basename($0); |
29 |
|
30 |
# Do we need to generate a config ? |
31 |
+# FIXME cab |
32 |
+# When calling g-cpan, if the user has no conf, g-cpan will generate one as first step. |
33 |
+# This is not necessary if we're asking for --help and generate way too much output. |
34 |
eval 'use CPAN::Config;'; |
35 |
my $needs_cpan_stub = $@ ? 1 : 0; |
36 |
|
37 |
@@ -198,7 +202,6 @@ |
38 |
# Now we export our overlay directory into the session's env vars |
39 |
$ENV{PORTDIR_OVERLAY} = $tmp_overlay_dir; |
40 |
|
41 |
-# sub main.. well, sort of ;p |
42 |
# Take care of List requests. This should return all the ebuilds managed by g-cpan |
43 |
if ($list) { |
44 |
printbig "Generating list of modules managed by g-cpan"; |
45 |
@@ -231,23 +234,10 @@ |
46 |
|
47 |
exit; |
48 |
|
49 |
-########## |
50 |
-# subs ! # |
51 |
-########## |
52 |
+############## |
53 |
+# Big subs ! # |
54 |
+############## |
55 |
|
56 |
-# jrray printing functions |
57 |
-sub printbig { |
58 |
-# FIXME Sniper |
59 |
-# 72 hard coded is bad |
60 |
- print '*' x 72, "\n"; |
61 |
- print '*', "\n"; |
62 |
- print '*', "\n"; |
63 |
- print '* ', @_; |
64 |
- print '*', "\n"; |
65 |
- print '*', "\n"; |
66 |
- print '*' x 72, "\n"; |
67 |
-} |
68 |
- |
69 |
sub ebuild_exists { |
70 |
my ($dir) = $_[0]; |
71 |
|
72 |
@@ -355,15 +345,6 @@ |
73 |
# if we are here, $found if undef, what to do ? |
74 |
} |
75 |
|
76 |
-sub module_check { |
77 |
- |
78 |
-# module_check evaluates whether a module can be loaded from @INC. |
79 |
-# This allows us to assure that if a module has been manually installed, we know about it. |
80 |
- my $check = shift; |
81 |
- eval "use $check;"; |
82 |
- return $@ ? 0 : 1; |
83 |
-} |
84 |
- |
85 |
sub portage_dir { |
86 |
my $obj = shift; |
87 |
my $file = $obj->cpan_file; |
88 |
@@ -667,19 +648,6 @@ |
89 |
|
90 |
} |
91 |
|
92 |
-# TODO Sniper |
93 |
-# maybee put this in END {} block |
94 |
-sub clean_up { |
95 |
- |
96 |
- #Probably don't need to do this, but for sanity's sake, we reset this var |
97 |
- # $ENV{'PORTDIR_OVERLAY'} = $OVERLAYS[0]; |
98 |
- |
99 |
- if ($needs_cpan_stub) { unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm" } |
100 |
- |
101 |
- #Clean out the /tmp tree we were using |
102 |
- rmtree( ["$tmp_overlay_dir"] ) if ( !$OVERLAYS[0] ); |
103 |
-} |
104 |
- |
105 |
sub emerge_module { |
106 |
my @flags; |
107 |
push @flags, "-p" if $pretend > 0; |
108 |
@@ -758,17 +726,6 @@ |
109 |
return ( $conf{DISTDIR}, $conf{PORTDIR}, @OVERLAYS ); |
110 |
} |
111 |
|
112 |
-sub clean_vars { |
113 |
- |
114 |
- # In order to parse strange but allowed constructions, |
115 |
- # (i.e. DISTDIR=${PORTDIR}/disfiles), we are cycling some times |
116 |
- # (3 should be enough) on DISTDIR and PORTDIR_OVERLAY settings, |
117 |
- # using a nice regexp (thx Sniper - sniper@×××××××××.net) |
118 |
- my ( $toclean, %conf ) = @_; |
119 |
- foreach my $i ( 1 .. 3 ) { $toclean =~ s/\$\{ ( [^}]+ ) \}/$conf{$1}/egx } |
120 |
- return ($toclean); |
121 |
-} |
122 |
- |
123 |
sub cpan_stub { |
124 |
my $cpan_cfg_dir = File::Spec->catfile($ENV{HOME}, CPAN_CFG_DIR); |
125 |
my $cpan_cfg_file = File::Spec->catfile($cpan_cfg_dir, CPAN_CFG_NAME); |
126 |
@@ -844,8 +801,43 @@ |
127 |
close CPANCONF; |
128 |
} |
129 |
|
130 |
-# Simple useful sub. returns md5 hexdigest of the given argument |
131 |
+################ |
132 |
+# Display subs # |
133 |
+################ |
134 |
+ |
135 |
+# jrray printing functions |
136 |
+sub printbig { |
137 |
+# FIXME cab |
138 |
+# Rewrite using colors ! |
139 |
+# FIXME Sniper |
140 |
+# 72 hard coded is bad |
141 |
+ print '*' x 72, "\n"; |
142 |
+ print '*', "\n"; |
143 |
+ print '*', "\n"; |
144 |
+ print '* ', @_; |
145 |
+ print '*', "\n"; |
146 |
+ print '*', "\n"; |
147 |
+ print '*' x 72, "\n"; |
148 |
+} |
149 |
+ |
150 |
+################################################# |
151 |
+# NAME : fatal |
152 |
+# AUTHOR: David "Sniper" Rigaudiere |
153 |
+# OBJECT: die like with pattern format |
154 |
+# |
155 |
+# IN: 0 scalar pattern sprintf format |
156 |
+# x LIST variables filling blank in pattern |
157 |
+################################################# |
158 |
+sub fatal { die sprintf(shift, @_) } |
159 |
+ |
160 |
+ |
161 |
+############## |
162 |
+# Tools subs # |
163 |
+############## |
164 |
+ |
165 |
+# cab - Simple useful sub. returns md5 hexdigest of the given argument. |
166 |
# awaits a file name. |
167 |
+# FIXME cab : add a test (if -f $file) ? |
168 |
sub file_md5sum { |
169 |
my ($file) = @_;; |
170 |
print "Computing MD5 Sum of $file\n" if $verbose; |
171 |
@@ -859,7 +851,29 @@ |
172 |
return $md5digest; |
173 |
} |
174 |
|
175 |
-# Takes care of system's sanity |
176 |
+# In order to parse strange but allowed constructions, |
177 |
+# (i.e. DISTDIR=${PORTDIR}/disfiles), we are cycling some times |
178 |
+# (3 should be enough) on DISTDIR and PORTDIR_OVERLAY settings, |
179 |
+# using a nice regexp (thx Sniper - sniper@×××××××××.net) |
180 |
+sub clean_vars { |
181 |
+ my ( $toclean, %conf ) = @_; |
182 |
+ foreach my $i ( 1 .. 3 ) { $toclean =~ s/\$\{ ( [^}]+ ) \}/$conf{$1}/egx } |
183 |
+ return ($toclean); |
184 |
+} |
185 |
+ |
186 |
+# mcummings - module_check evaluates whether a module can be loaded from @INC. |
187 |
+# This allows us to assure that if a module has been manually installed, we know about it. |
188 |
+sub module_check { |
189 |
+ my $check = shift; |
190 |
+ eval "use $check;"; |
191 |
+ return $@ ? 0 : 1; |
192 |
+} |
193 |
+ |
194 |
+############### |
195 |
+# Ending subs # |
196 |
+############### |
197 |
+ |
198 |
+# cab - Takes care of system's sanity |
199 |
# should try to see if it can be merged with clean_up() |
200 |
sub clean_the_mess { |
201 |
if ($verbose) { |
202 |
@@ -872,43 +886,59 @@ |
203 |
} |
204 |
} |
205 |
|
206 |
-################################################# |
207 |
-# NAME : fatal |
208 |
-# AUTHOR: David "Sniper" Rigaudiere |
209 |
-# OBJECT: die like with pattern format |
210 |
-# |
211 |
-# IN: 0 scalar pattern sprintf format |
212 |
-# x LIST variables filling blank in pattern |
213 |
-################################################# |
214 |
-sub fatal { die sprintf(shift, @_) } |
215 |
+# TODO Sniper |
216 |
+# maybee put this in END {} block |
217 |
+sub clean_up { |
218 |
|
219 |
+ #Probably don't need to do this, but for sanity's sake, we reset this var |
220 |
+ # $ENV{'PORTDIR_OVERLAY'} = $OVERLAYS[0]; |
221 |
|
222 |
+ if ($needs_cpan_stub) { unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm" } |
223 |
+ |
224 |
+ #Clean out the /tmp tree we were using |
225 |
+ rmtree( ["$tmp_overlay_dir"] ) if ( !$OVERLAYS[0] ); |
226 |
+} |
227 |
+ |
228 |
+# cab - nice help message ! ;) |
229 |
sub exit_usage { |
230 |
+ my $green = color("bold green"); |
231 |
+ my $white = color ("bold white"); |
232 |
+ my $cyan = color("bold cyan"); |
233 |
+ my $reset = color("reset"); |
234 |
+ |
235 |
print <<"USAGE"; |
236 |
-Usage : $prog <Switch(es)> Module Name(s) |
237 |
+${white}Usage : ${cyan}$prog ${green}<Switch(es)> ${cyan}Module Name(s)${reset} |
238 |
|
239 |
---ask,-a Ask before installing |
240 |
+${green}--ask,-a${reset} |
241 |
+ Ask before installing |
242 |
|
243 |
---install,-i Try to generate ebuild for the given module name |
244 |
- and, if successful, emerge it. Important : installation |
245 |
- requires exact CPAN Module Name. |
246 |
+${green}--install,-i${reset} |
247 |
+ Try to generate ebuild for the given module name |
248 |
+ and, if successful, emerge it. Important : installation |
249 |
+ requires exact CPAN Module Name. |
250 |
|
251 |
---list,-l This command generates a list of the Perl modules and ebuilds |
252 |
- handled by $prog. |
253 |
+${green}--list,-l${reset} |
254 |
+ This command generates a list of the Perl modules and ebuilds |
255 |
+ handled by $prog. |
256 |
|
257 |
---noclean,-n Don't clean up temporary areas after running install or upgrade. |
258 |
+${green}--noclean,-n${reset} |
259 |
+ Don't clean up temporary areas after running install or upgrade. |
260 |
|
261 |
---pretend,-u Pretend (show actions, but don't emerge). This still generates |
262 |
- new ebuilds. |
263 |
+${green}--pretend,-p${reset} |
264 |
+ Pretend (show actions, but don't emerge). This still generates |
265 |
+ new ebuilds. |
266 |
|
267 |
---search,-s Search CPAN for the given expression (similar to |
268 |
- the "m /EXPR/" from the CPAN Shell). Searches are |
269 |
- case insensitive. |
270 |
+${green}--search,-s${reset} |
271 |
+ Search CPAN for the given expression (similar to |
272 |
+ the "m /EXPR/" from the CPAN Shell). Searches are |
273 |
+ case insensitive. |
274 |
|
275 |
---upgrade,-u Try to list and upgrade all Perl modules managed by $prog. |
276 |
- It generate up-to-date ebuilds, then emerge then. |
277 |
+${green}--upgrade,-u${reset} |
278 |
+ Try to list and upgrade all Perl modules managed by $prog. |
279 |
+ It generate up-to-date ebuilds, then emerge then. |
280 |
|
281 |
---verbose,-v Enable (some) verbose output. |
282 |
+${green}--verbose,-v${reset} |
283 |
+ Enable (some) verbose output. |
284 |
|
285 |
USAGE |
286 |
|
287 |
|
288 |
Modified: trunk/extra-docs/Changes |
289 |
=================================================================== |
290 |
--- trunk/extra-docs/Changes 2005-05-12 18:05:56 UTC (rev 24) |
291 |
+++ trunk/extra-docs/Changes 2005-05-15 10:02:54 UTC (rev 25) |
292 |
@@ -1,3 +1,10 @@ |
293 |
+15/05/2005 - Wonderful colored world, by cab ;) |
294 |
+ |
295 |
+- corrected indentation and typos in exit_usage() |
296 |
+- colorized exit_usage (feel like portage) |
297 |
+- rearranged code (categorizing sub - easier to find what we're looking for) |
298 |
+- added some comments here and there (again ;p) |
299 |
+ |
300 |
11/05/2005 - mcummings makes weird changes |
301 |
|
302 |
- cleaned up calls to merge, added -p,-a,-n,-u flags to respective portions |
303 |
|
304 |
|
305 |
-- |
306 |
gentoo-perl@g.o mailing list |