Gentoo Archives: gentoo-perl

From: antoine.raillon@××××××.net
To: gentoo-perl@l.g.o
Subject: [gentoo-perl] r7 - / code docs
Date: Thu, 12 May 2005 21:57:12
Message-Id: 20050512215617.B47D88280EE@gredin.dragou.net
1 Author: cab
2 Date: 2005-05-11 01:08:12 +0200 (Wed, 11 May 2005)
3 New Revision: 7
4
5 Added:
6 TODO
7 Modified:
8 Changes
9 code/g-cpan.pl
10 docs/svn-mini-howto.txt
11 Log:
12 Modifications, imported old changes, todo file
13
14
15 Modified: Changes
16 ===================================================================
17 --- Changes 2005-05-10 22:15:06 UTC (rev 6)
18 +++ Changes 2005-05-10 23:08:12 UTC (rev 7)
19 @@ -1,10 +1,13 @@
20 -10/05/2005 - cab made again some changes to g-cpan.. :)
21 +10/05/2005 - cab strikes g-cpan again.. :)
22
23 - added comments here and there..
24 - modified the cpan-config-needed if() test
25 - modified switches interpretations
26 - added -l,--list switch (nothing behind for now)
27 - added a new sub : clean_the_mess, that should take care of system's sanity
28 +- changed my $arches
29 +- subbed the MD5 sum calculation
30 +- updated exit_usage()
31
32 07/05/2005 - cab first strike !
33
34 @@ -17,7 +20,7 @@
35 instead of 3 times qx() : performance boost guaranteed. Sets up default before
36 overwriting them if needed and can replace variables like ${PORTDIR} if ever
37 they are used in make.conf : quality improvement guaranteed. :p
38 - thx to Sniper for the s// regexp !
39 + thx to Sniper (sniper@×××××××××.net) for the s// regexp !
40
41 - Added a bit more explicative Usage message.. in fact a whole sub.
42 Available with -h or --help switch but will also appear if user
43
44 Added: TODO
45 ===================================================================
46 --- TODO 2005-05-10 22:15:06 UTC (rev 6)
47 +++ TODO 2005-05-10 23:08:12 UTC (rev 7)
48 @@ -0,0 +1,7 @@
49 +- Heavy testing !
50 +- Some work on the overlays - possibility to use ~/.cpan
51 +- clean_the_mess / clean_up to improve/merge
52 +- big portions of upgrade_module and install_module are the same code
53 +- check for multiple emerge
54 +- Add verbosity messages
55 +- Clean the code.. which prog doesn't need this ? :p
56
57 Modified: code/g-cpan.pl
58 ===================================================================
59 --- code/g-cpan.pl 2005-05-10 22:15:06 UTC (rev 6)
60 +++ code/g-cpan.pl 2005-05-10 23:08:12 UTC (rev 7)
61 @@ -19,15 +19,18 @@
62 my $needs_cpan_stub = $@ ? 1 : 0;
63
64 # Test Replacement - ((A&B)or(C&B)) should be the same as ((A or C) and B)
65 -if (( ($needs_cpan_stub) || ( $> > 0 ) ) && ( !-f "$ENV{HOME}/.cpan/CPAN/MyConfig.pm" ) ) {
66 - # In case match comes from the UID test
67 +if ( ( ($needs_cpan_stub) || ( $> > 0 ) )
68 + && ( !-f "$ENV{HOME}/.cpan/CPAN/MyConfig.pm" ) )
69 +{
70 +
71 + # In case match comes from the UID test
72 $needs_cpan_stub = 1;
73 -
74 - # Generate a fake config for CPAN
75 +
76 + # Generate a fake config for CPAN
77 cpan_stub();
78 }
79 else {
80 - $needs_cpan_stub = 0;
81 + $needs_cpan_stub = 0;
82 }
83
84 use CPAN;
85 @@ -49,7 +52,7 @@
86 ###############################
87
88 # Init all options
89 -my ( $verbose, $search, $install, $upgrade, $list ) = (0,0,0,0,0);
90 +my ( $verbose, $search, $install, $upgrade, $list ) = ( 0, 0, 0, 0, 0 );
91
92 #Get & Parse them
93 GetOptions(
94 @@ -57,24 +60,24 @@
95 'search|s' => \$search,
96 'install|i' => \$install,
97 'upgrade|u' => \$upgrade,
98 - 'list|l' => \$list,
99 + 'list|l' => \$list,
100 'help|h' => sub { exit_usage(); }
101 )
102 or exit_usage();
103
104 # Output error if more than one switch is activated
105 -if ($search + $list + $install + $upgrade > 1) {
106 - print "You can't combine search, list, install or upgrade with each other. Pick up one !\n\n";
107 - exit_usage();
108 +if ( $search + $list + $install + $upgrade > 1 ) {
109 + print
110 +"You can't combine search, list, install or upgrade with each other. Pick up one !\n\n";
111 + exit_usage();
112 }
113
114 # Output error if no arguments
115 -if ( !( defined( $ARGV[0] ) ) and (!($upgrade) or !($list)) ) {
116 +if ( !( defined( $ARGV[0] ) ) and ( !($upgrade) or !($list) ) ) {
117 print "Not even one module name or expression given !\n\n";
118 exit_usage();
119 }
120
121 -
122 ##########
123 # main() #
124 ##########
125 @@ -83,21 +86,22 @@
126 # CPAN Shell to do the job, thus making it impossible to have a clean output..
127 if ($search) {
128 foreach my $expr (@ARGV) {
129 -
130 +
131 # Assume they gave us module-name instead of module::name
132 - if ( $expr !~ m|::| ) {
133 + # which is bad, because CPAN can't convert it ;p
134 + if ( $expr !~ m|::| ) {
135 $expr =~ s/-/::/g;
136 - }
137 + }
138 print "Searching for $expr on CPAN\n\n";
139 CPAN::Shell->m("/$expr/");
140 }
141 -
142 - clean_the_mess();
143 +
144 + clean_the_mess();
145 exit;
146 }
147
148 # Take care of List requests. This should return all the ebuilds managed by g-cpan
149 -if ( $list ) {
150 +if ($list) {
151 print "List function not implemented yet.\n";
152 exit_usage();
153 }
154 @@ -110,7 +114,7 @@
155 if ( $ENV{TMPDIR} ) { $tmp_overlay_dir = "$ENV{TMPDIR}/perl-modules_$$" }
156 else { $tmp_overlay_dir = "/tmp/perl-modules_$$" }
157
158 -my @ebuild_list;
159 +my @ebuild_list; #this array needs to be seriously observed.
160
161 # Set up global paths
162 # my $TMP_DEV_PERL_DIR = '/var/db/pkg/dev-perl';
163 @@ -141,11 +145,18 @@
164 }
165 }
166
167 -my $arches =
168 - join( ' ', map { chomp; $_ } `cat $PORTAGE_DIR/profiles/arch.list` );
169 +# Grab the whole available arches list, to include them later in ebuilds
170 +my $arches = do {
171 + if ($verbose) {
172 + print "Grabbing arch list\n";
173 + }
174 + open my $tmp, "$PORTAGE_DIR/profiles/arch.list"
175 + or die "Unable to open '$PORTAGE_DIR/profiles/arch.list' : $!";
176 + join " ", map { chomp; $_ } <$tmp>;
177 + }
178
179 -#this should never find the dir, but just to be safe
180 -unless ( -d $tmp_overlay_dir ) {
181 + #this should never find the dir, but just to be safe
182 + unless ( -d $tmp_overlay_dir ) {
183 mkpath( [$tmp_overlay_dir], 1, 0755 )
184 or die "Couldn't create '$tmp_overlay_dir': $|";
185 }
186 @@ -170,6 +181,7 @@
187 install_module($_) for (@ARGV);
188 emerge_module($_) for (@ARGV);
189 }
190 +
191 if ($upgrade) {
192 if (@ARGV) {
193 upgrade_module($_) for (@ARGV);
194 @@ -182,7 +194,9 @@
195 }
196
197 }
198 +
199 if ( $install or $upgrade ) { clean_up() }
200 +
201 exit;
202
203 ##########
204 @@ -467,14 +481,8 @@
205 my $localfile = $pack->{localfile};
206 ( my $base = $file ) =~ s/.*\/(.*)/$1/;
207
208 - my $md5digest;
209 - open( DIGIFILE, $localfile ) or die "Can't open '$file': $!";
210 - binmode(DIGIFILE);
211 - $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
212 - close(DIGIFILE);
213 + my $md5string = sprintf "MD5 %s %s %d", file_md5sum($localfile), $base, -s $localfile;
214
215 - my $md5string = sprintf "MD5 %s %s %d", $md5digest, $base, -s $localfile;
216 -
217 # make ebuilds for all the prereqs
218 my $prereq_pm = $pack->prereq_pm;
219 if ($add_mb) { $prereq_pm->{'Module::Build'} = "0" }
220 @@ -554,13 +562,8 @@
221 my $localfile = $pack->{localfile};
222 ( my $base = $file ) =~ s/.*\/(.*)/$1/;
223
224 - my $md5digest;
225 - open( DIGIFILE, $localfile ) or die "Can't open '$file': $!";
226 - binmode(DIGIFILE);
227 - $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
228 - close(DIGIFILE);
229
230 - my $md5string = sprintf "MD5 %s %s %d", $md5digest, $base, -s $localfile;
231 + my $md5string = sprintf "MD5 %s %s %d", file_md5sum($localfile), $base, -s $localfile;
232
233 # make ebuilds for all the prereqs
234 my $prereq_pm = $pack->prereq_pm;
235 @@ -793,30 +796,54 @@
236
237 }
238
239 +# Simple useful sub. returns md5 hexdigest of the given argument
240 +# awaits a file name.
241 +sub file_md5sum {
242 +
243 + my $file = $_[0];
244 +
245 + if ($verbose) {
246 + print "Computing MD5 Sum of $file\n";
247 + }
248 +
249 + open(DIGIFILE, $file ) or die "Can't open '$file': $!";
250 + my $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
251 + close(DIGIFILE);
252 +
253 + return $md5digest;
254 +}
255 +
256 # Takes care of system's sanity
257 # should try to see if it can be merged with clean_up()
258 sub clean_the_mess {
259 - if ($verbose) {
260 - print "Now cleaning up the system of all the junk we put in !\n";
261 - }
262 - if ($needs_cpan_stub) {
263 - unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm";
264 - #add something here to take care of the .cpan dir, if not empty
265 - }
266 + if ($verbose) {
267 + print "Now cleaning up the system of all the junk we put in !\n";
268 + }
269 + if ($needs_cpan_stub) {
270 + unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm";
271 +
272 + #add something here to take care of the .cpan dir, if not empty
273 + }
274 }
275
276 sub exit_usage {
277 print <<"USAGE";
278 -Usage : $0 [-i|--install] [-s|--search] [-v|--verbose] Module Name(s)
279 +Usage : $0 <Switch(es)> Module Name(s)
280
281 --install,-i Try to generate ebuild for the given module name
282 and, if successful, emerge it. Important : installation
283 requires exact CPAN Module Name.
284 +
285 +--list,-l This command generates a list of the Perl modules and ebuilds
286 + handled by $0.
287
288 --search,-s Search CPAN for the given expression (similar to
289 the "m /EXPR/" from the CPAN Shell). Searches are
290 case insensitive.
291
292 +--upgrade,-u Try to list and upgrade all Perl modules managed by $0.
293 + It generate up-to-date ebuilds, then emerge then.
294 +
295 --verbose,-v Enable (some) verbose output.
296
297 USAGE
298
299 Modified: docs/svn-mini-howto.txt
300 ===================================================================
301 --- docs/svn-mini-howto.txt 2005-05-10 22:15:06 UTC (rev 6)
302 +++ docs/svn-mini-howto.txt 2005-05-10 23:08:12 UTC (rev 7)
303 @@ -9,6 +9,7 @@
304
305 don't forget to use svn update often, at least each time you want to work on the code ;p
306
307 +and of course SVN is web browsable : http://gredin.net/svn/gcpan/
308 +
309 --
310 cab
311 -
312
313
314 --
315 gentoo-perl@g.o mailing list