#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) = $_ =~ /(\[[^>]*\]\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{$_}->{location};
		my $domain = trim_domain($location);
	
		my $p = Net::Ping->new('icmp');
		if ( $p->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;	
}

##</code><code>##

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