note QM I've taken this and made it more complicated :( I'm interested in suggestions for improvements! <p> It will now keep "local" repositories in the list if they are alive, even if they aren't in the [mod://PPM::Repositories] list or one of ActiveState's. <p> It preserves the order of "local" repositories. (Those added from [mod://PPM::Repositories] are still added in <code>key</code> order.) <p> Since this script would generally be run only occasionally, it also gets the latest [mod://PPM::Repositories], in case that list has been updated. I could only mangle^Wmanage this automatically by first removing the old module, and then installing it again. If this somehow fails to reinstall, the script won't load. (I could fix this, but I've run out of time today. Besides, it winds up being something of a circular dependency.) This can be avoided by calling it with some arbitrary argument. <p><p> <code>add</code>s and <code>delete</code>s now only happen if necessary (according to the <code>IN_LOCAL_LIST</code> key in the script-generated <code>%repositories</code> hash). <p> I also found that <code>exec</code> in Windoze caused the prompt to wait for user input, such that it never appeared to finish. Switching to <code>system</code> with appropriate control logic fixed it. <p> I'm sure someone will want option processing, etc., but I'm not inclined to add that today ;) <p> <b>Update:</b> Thanks to [randyk], used [mod://PPM::UI] instead of <code>ppm rep describe $name</code>. <readmore> <code> #!/your/perl/here # based on script found at 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__ </code> </readmore> <div class="pmsig"><div class="pmsig-294463"> <p>-QM<br /> --<br /> Quantum Mechanics: The dreams stuff is made of </div></div> 456056 469988