<?xml version="1.0" encoding="windows-1252"?>
<node id="456056" title="Script to update your PPM Repositories" created="2005-05-11 12:13:30" updated="2005-08-15 09:20:06">
<type id="120">
perlmeditation</type>
<author id="396583">
tphyahoo</author>
<data>
<field name="doctext">
I use ActiveState perl, and I like managing my modules with ppm rather than making them manually.  Problem is, for the less common modules, it's often difficult to find a repository that has them, if they're not in one of the two ppm repositories installed by default with ActiveState.
&lt;p&gt;
PPM::Repositories was supposed to improve this situation by centralizing all known ppm repositories, as the venerable [holli] explained at [A guide to installing modules for Win32].  However, ppm::repositories lists a lot of repositories that are dead or down for maintenance.  If you are unlucky enough to have a dead repository in your list of repositories, this can cause major headaches when, for instance, you try searching for a module -- it just takes forever to fail and ppm doesn't tell you it's trying to ping the repository or whatever, it just sits there all stubborn.  Annoying.
&lt;p&gt;
So, I wrote a program to hopefully take away some of the pain and make things easier to the perl on windows crowd.  It synchronizes the ppm repositories on my system with the functioning ppm repositories listed on PPM::Repositories, working as follows.  It first removes all repositories other than the two standard ones that come with ActiveState.  Then, it goes through the repositories listed on PPM::Repositories, pings them, and if they're okay, adds them to the active repository list.
&lt;p&gt;
Hope this helps someone!

&lt;readmore&gt;

&lt;code&gt;
#updateWorkingRepositories.pl
use strict;
use warnings;
use PPM::Repositories;
use Net::Ping;

remove_non_active_state_repositories();
add_repositories();

#remove all repositories, except the repositories that come installed by default with ActiveState.
sub remove_non_active_state_repositories {
	
	my @repositories;
	my $result = `ppm rep`;	
	for (split /[\r\n]/, $result) {
		#parsing lines that looks like 
		#[ 3] jenda
		my ($number, $repository) = $_ =~ /(\[[^&gt;]*\]\s)(.*)/;
		if ($repository) {
			unless ($repository =~ /activestate/i) { print `ppm rep delete $repository` unless (/activestate/i); }		
		}
	}
}

sub add_repositories {
	for ( keys %Repositories )
	{
		my $repository = $_;
		my $location = $Repositories{$_}-&gt;{location};
		my $domain = trim_domain($location);
	
		my $p = Net::Ping-&gt;new('icmp');
		if ( $p-&gt;ping($domain) ) {
			print "$repository is alive.\n";
			print `ppm repository add $repository $location` . "\n\n";
		} else {
			print "$repository is dead.\n";
		}
	}
}

#function that trims a domain
sub trim_domain {
	$_ = my $original_input = shift;
	$_ =~ s/^\s+//; #strip spaces at start of string
	$_ =~ s/\s+$//; #strip spaces at end of string
	$_ =~ s|^http://||; # strip http:// at begining
	$_ =~ s|/.*$||; # strip everything after the first /
	my $trimmed_domain = $_;
	
	unless ($trimmed_domain) {
		logMessage("trim_domain had a problem trimming $original_input");
		carp ("trim_domain had a problem trimming $original_input");
		$trimmed_domain = "$original_input couldn't be trimmed in trim_domain";
	} 
	return $trimmed_domain;	
}
&lt;/code&gt;
&lt;/readmore&gt;
&lt;readmore&gt;
&lt;p&gt;
Output : 
&lt;code&gt;
Repositories:
[1] ActiveState PPM2 Repository
[2] rto
[3] soulcage
[4] devhelp
[5] roth
[6] ActiveState Package Repository
Repositories:
[1] ActiveState PPM2 Repository
[2] soulcage
[3] devhelp
[4] roth
[5] ActiveState Package Repository
Repositories:
[1] ActiveState PPM2 Repository
[2] devhelp
[3] roth
[4] ActiveState Package Repository
Repositories:
[1] ActiveState PPM2 Repository
[2] roth
[3] ActiveState Package Repository
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
dada is dead.
smueller is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller


perlxml is dead.
crazy58 is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller
[4] crazy58


crazy is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller
[4] crazy58
[5] crazy


datetime is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller
[4] crazy58
[5] crazy
[6] datetime


soulcage58 is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller
[4] crazy58
[5] crazy
[6] datetime
[7] soulcage58


sablot is dead.
bribes is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller
[4] crazy58
[5] crazy
[6] datetime
[7] soulcage58
[8] bribes


gtk is dead.
xray is dead.
rto is alive.
Repositories:
[1] ActiveState PPM2 Repository
[2] ActiveState Package Repository
[3] smueller
[4] crazy58
[5] crazy
[6] datetime
[7] soulcage58
[8] bribes
[9] rto


spurkis is dead.
theoryS is dead.
jenda is dead.
theory58S is dead.
esoft is dead.
log4perl is dead.
theory58 is dead.
soulcage is alive.
Repositories:
[ 1] ActiveState PPM2 Repository
[ 2] ActiveState Package Repository
[ 3] smueller
[ 4] crazy58
[ 5] crazy
[ 6] datetime
[ 7] soulcage58
[ 8] bribes
[ 9] rto
[10] soulcage


savage is dead.
devhelp is alive.
Repositories:
[ 1] ActiveState PPM2 Repository
[ 2] ActiveState Package Repository
[ 3] smueller
[ 4] crazy58
[ 5] crazy
[ 6] datetime
[ 7] soulcage58
[ 8] bribes
[ 9] rto
[10] soulcage
[11] devhelp


theory is dead.
openi is dead.
roth is alive.
Repositories:
[ 1] ActiveState PPM2 Repository
[ 2] ActiveState Package Repository
[ 3] smueller
[ 4] crazy58
[ 5] crazy
[ 6] datetime
[ 7] soulcage58
[ 8] bribes
[ 9] rto
[10] soulcage
[11] devhelp
[12] roth

&lt;/code&gt;

&lt;/readmore&gt;
UPDATE: Now strict and warnings safe, thanks to QM for reminding me of that.  (Thought I always did that automatically, but I guess I slipped up.)
&lt;hr&gt;
Update 2: Now with icmp ping, thanks to eibwen and pboin. I should have done this a long time ago.
&lt;hr&gt;
UPDATE 3: If you think you may be behind a ping-restricted firewall, you may want to try holli's version of the script which modifies the above to use some kind of LWP authentication instead of ping: [id://488626].</field>
</data>
</node>
