mirror_active_cpan_modules

[email protected] ("dominix") Thu, 6 Nov 2003 19:10:38 -1000
Newsgroups	perl.scripts
Message-ID	<[email protected]>
------=_NextPart_000_0028_01C3A499.A9FB0DE0
Content-Type: multipart/alternative;
	boundary="----=_NextPart_001_0029_01C3A499.A9FB0DE0"


------=_NextPart_001_0029_01C3A499.A9FB0DE0
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

hi there,
here is a script I use to maintain a mirror of the active cpan modules.
I find it very useful, and I suspect it could interest someone(s)...  =
:-)
I suspect it needs inprovment as well ...=20

regards


Dominix
------=_NextPart_001_0029_01C3A499.A9FB0DE0
Content-Type: text/html;
	charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=3DContent-Type content=3D"text/html; =
charset=3Diso-8859-1">
<META content=3D"MSHTML 6.00.2800.1264" name=3DGENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=3D#ffffff>
<DIV><FONT face=3DArial size=3D2>hi there,</FONT></DIV>
<DIV><FONT face=3DArial size=3D2>here is a script I use to maintain a =
mirror of the=20
active cpan modules.</FONT></DIV>
<DIV><FONT face=3DArial size=3D2>I find it very useful, and I suspect it =
could=20
interest someone(s)...&nbsp; :-)</FONT></DIV>
<DIV><FONT face=3DArial size=3D2>I suspect it needs inprovment as well =
...=20
</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>regards</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>Dominix</FONT></DIV></BODY></HTML>

------=_NextPart_001_0029_01C3A499.A9FB0DE0--

------=_NextPart_000_0028_01C3A499.A9FB0DE0
Content-Type: application/octet-stream;
	name="mirror_active_modules.pl"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="mirror_active_modules.pl"

#!/usr/bin/perl=0A=
#=0A=
# written by Dominix <[email protected]>;=0A=
# under GPL;=0A=
# this script is supposed to take place in =0A=
# 	$CPAN::Config->{"cpan_home"} . "/sources"=0A=
# ie: =0A=
# perl -MCPAN::Config -l012e 'print =
$CPAN::Config->{"cpan_home"}."/sources"'=0A=
# so it become directly usable by cpan utility.=0A=
# well,  this is not mandatory but I recommend setting =0A=
# $CPAN::Config->{"scan_cache} to "never" =0A=
# or $CPAN::Config->{'index_expire'} to '999'=0A=
# as long as you intend to manage manualy your .cpan cache=0A=
use strict;=0A=
use warnings;=0A=
use LWP::Simple;=0A=
use Compress::Zlib;=0A=
use File::Basename;=0A=
use File::Path;=0A=
use File::Find ();=0A=
use vars qw/*name *dir *prune/;=0A=
use CPAN::Config;=0A=
=0A=
my $basearg =3D scalar($#ARGV) =3D=3D -1 ? =
${$CPAN::Config->{urllist}}[0] : $ARGV[0];=0A=
=0A=
die "usage $0 URL(that indicate a CPAN root miror)" if $basearg eq "";=0A=
=0A=
my ($proto,$filler,$host,$relative)=3Dsplit("/",$basearg,4);=0A=
die "bad URL: @ARGV" if ( $filler ne "" || $host eq "");=0A=
=0A=
my @list;=0A=
#my @toremove;=0A=
my $realf;=0A=
my ($Fld1,$Fld2,$Fld3) ;=0A=
my %seen ;=0A=
my @realfiles;=0A=
my $base;=0A=
=0A=
*name   =3D *File::Find::name;=0A=
*dir    =3D *File::Find::dir;=0A=
*prune  =3D *File::Find::prune;=0A=
=0A=
my $file=3D'modules/02packages.details.txt.gz';=0A=
$relative =3D "" if not defined $relative ;=0A=
$relative =3D $relative eq "" ? "" : $relative . "/";=0A=
my $url =3D $proto . "//" . $host . "/" . $relative ;=0A=
=0A=
print "fetching from $url\n" . $file;=0A=
=0A=
$|=3D1;=0A=
my $httpresponse =3D mirror($url . $file ,$file);=0A=
die "Couldn't get it! $httpresponse" unless defined $httpresponse;=0A=
print " HTTP response: $httpresponse\n";=0A=
=0A=
my $gz =3D gzopen($file, "rb")=0A=
                    or die "ARRG Cannot open $file: $gzerrno\n" ;=0A=
while ($gz->gzreadline($_) > 0) {=0A=
	#awk=0A=
	($Fld1,$Fld2,$Fld3) =3D split(' ', $_, 9999);=0A=
	if (/[gz|zip]$/) {=0A=
	   #uniq=0A=
	   push(@list, 'authors/id/' . $Fld3) unless $seen{$Fld3}++;=0A=
	}=0A=
}=0A=
die "Error reading from $file: $gzerrno" . ($gzerrno+0) . "\n"=0A=
                   if $gzerrno !=3D Z_STREAM_END ;=0A=
#$gz->gzclose() or die "what happen with that gzclose ? $! ";=0A=
$gz->gzclose();=0A=
$file=3D"modules/03modlist.data.gz";=0A=
print $file," HTTP response:";=0A=
$httpresponse =3D mirror($url . $file ,$file);=0A=
print $httpresponse . "\n";=0A=
$file=3D"authors/01mailrc.txt.gz";=0A=
print $file," HTTP response:";=0A=
$httpresponse =3D mirror($url . $file ,$file);=0A=
print $httpresponse . "\n";=0A=
=0A=
foreach (@list) { =0A=
	if (! -e $_) {=0A=
		$base =3D dirname($_);=0A=
		if (! -d $base) { mkpath $base };	=0A=
		print $_," HTTP response:";=0A=
		$httpresponse =3D mirror($url . $_ ,$_);=0A=
		print $httpresponse;=0A=
		$httpresponse =3D mirror($url . $base . "/CHECKSUMS" ,$base . =
"/CHECKSUMS" );=0A=
		print " CHECKSUMS $httpresponse\n";=0A=
	}=0A=
} =0A=
=0A=
=0A=
# now , cleanup the old version, if exists ...=0A=
=0A=
sub wanted {=0A=
	my ($dev,$ino,$mode,$nlink,$uid,$gid);=0A=
=0A=
	(($dev,$ino,$mode,$nlink,$uid,$gid) =3D lstat($_)) &&=0A=
	-f _ &&=0A=
	push @realfiles,$name if $name=3D~ /(gz|zip)$/;=0A=
}=0A=
# Traverse desired filesystems=0A=
File::Find::find({wanted =3D> \&wanted}, 'authors/id');=0A=
=0A=
#%seen =3D ();=0A=
@seen{@list} =3D ();=0A=
=0A=
foreach $realf (@realfiles) {=0A=
#       push(@toremove, $realf) unless exists $seen{$realf};=0A=
	print "cleanup of " . $realf . "\n" unless exists $seen{$realf};=0A=
	unlink $realf unless exists $seen{$realf};=0A=
}=0A=

------=_NextPart_000_0028_01C3A499.A9FB0DE0--