I've taken this and made it more complicated :( I'm interested in suggestions for improvements!

It will now keep "local" repositories in the list if they are alive, even if they aren't in the PPM::Repositories list or one of ActiveState's.

It preserves the order of "local" repositories. (Those added from PPM::Repositories are still added in key order.)

Since this script would generally be run only occasionally, it also gets the latest 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.

adds and deletes now only happen if necessary (according to the IN_LOCAL_LIST key in the script-generated %repositories hash).

I also found that exec in Windoze caused the prompt to wait for user input, such that it never appeared to finish. Switching to system with appropriate control logic fixed it.

I'm sure someone will want option processing, etc., but I'm not inclined to add that today ;)

Update: Thanks to randyk, used PPM::UI instead of ppm rep describe $name. 

#!/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 r
+ep`);
    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{$n
+ame}->{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__

[download]

-QM
--
Quantum Mechanics: The dreams stuff is made of

In reply to Re^2: Script to update your PPM Repositories by QM
in thread Script to update your PPM Repositories by tphyahoo

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.