#!/your/perl/here
# based on script found at http://perlmonks.org/?node_id=469988
use strict;
use warnings;
use PPM::Repositories;
use PPM::UI;
use Net::Ping;

$|++;

if ( not @ARGV )
{
	print "Updating PPM-Repositories...$/";
	print `ppm uninstall PPM-Repositories`;
	
	print `ppm install PPM-Repositories`;
	
	system("perl $0 PPM-Repositories reinstalled") == 0
	  or die qq{system: "perl $0 PPM-Repositories reinstalled" failed, $?};
}
else
{
	# predefined hash keys
	my $ORDER         = 'ORDER'; # preserve order of local rep list
	my $LOCATION      = 'LOCATION';
	my $IN_LOCAL_LIST = 'IN_LOCAL_LIST';
	
	my %repositories;
	my $sort_order = 0; # counter for sort ordering
	
	# add local repositories
	print "Getting local repository list";
	my @names = map {m/^\[[\d\ ]+\]\ (.*)\s*$/} split(/[\r\n]/, `ppm rep`);
	foreach my $name ( @names )
	{
		print ".";
		# ppm rep describe $name didn't work on XP, this does
		my $info = PPM::UI::repository_info($name);
		my $result = $info->{result};
		my $location = $result->[1];
		$repositories{$name} = {$ORDER         => $sort_order++,
			                    $LOCATION      => $location,
		                        $IN_LOCAL_LIST => 1};
	}
	print "$/$/";
	
	# get rep list from module
	print "Getting PPM::Repositories list.$/$/";
	foreach my $name (keys %Repositories)
	{
		# don't overwrite if local entry exists
		if ( not exists ($repositories{$name}))
		{
			$repositories{$name} = {$ORDER         => $sort_order++,
				                    $LOCATION      => $Repositories{$name}->{location},
		        	                $IN_LOCAL_LIST => 0};
		}
	}
	
	print "Checking repositories:$/";
	# ping all repositories 
	foreach my $name (sort order keys %repositories) 
	{
		my $domain = my $location = $repositories{$name}->{$LOCATION};
		next unless $domain =~ s|^\s*http://([^/]+)/.*$|$1|;
	
		print "$name ";
		
		if ( Net::Ping->new()->ping($domain) )
		{
			print "is alive.$/";
			# only add when needed
			if ( not $repositories{$name}->{$IN_LOCAL_LIST} )
			{
				my $backtick = `ppm rep add $name $location`;
				if ($backtick =~ /^error/i )
				{
					warn "Error adding $name ($location)$/$backtick";
				}
			}
		} 
		else 
		{
			print "is dead.$/";
			# only delete when needed
			if ( ( $repositories{$name}->{$IN_LOCAL_LIST} )
			 and ( $name !~ /activestate/i ) )
			{
				my $backtick = `ppm rep delete $name`;
				if ($backtick =~ /^error/i )
				{
					warn "Error deleting $name$/$backtick";
				}
			}
		}
	}
	
	# show updated list of active repositories
	print $/, `ppm rep`, $/;
	
	exit;
	
	# this sub needs same scope as %repositories
	sub order
	{
		$repositories{$a}->{$ORDER} <=> $repositories{$b}->{$ORDER};
	}
	
}
__END__