Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

Re^2: Script to update your PPM Repositories

by QM (Parson)
on Sep 28, 2005 at 21:45 UTC ( #495908=note: print w/replies, xml ) Need Help??

in reply to Re: Script to update your PPM Repositories
in thread Script to update your PPM Repositories

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 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__

Quantum Mechanics: The dreams stuff is made of

Replies are listed 'Best First'.
Re^3: Script to update your PPM Repositories
by tphyahoo (Vicar) on Jun 03, 2006 at 21:50 UTC
    I've been looking to incorporate the various changes and suggesions the monks have made into my top post, and maybe even taking out a PAUSE idea and adding this as my contribution to CPAN.

    Looking over what you did, however, I notice there's no PPM::UI when I searched cpan. Could you clarify?

      Sorry, I shouldn't have linked to it like that.

      PPM::UI is part of the ActiveState installation. On my machine, it lives in d:/Perl/site/lib/PPM/

      Here's the transcript to demonstrate:

      D:\>perl -demo Loading DB routines from version 1.28 Editor support available. Enter h or `h h' for help, or `perldoc perldebug' for more help. main::(-e:1): mo DB<1> use PPM::UI DB<2> p $INC{'PPM/'} d:/Perl/site/lib/PPM/
      However, ppm3 doesn't seem to know about PPM::UI -- at least, you can't query PPM::UI, or search it, etc. In fact, I find the search and query functionality oddly designed, as I have to know the distribution name, or work at figuring out the wildcard/logical expression to match it. Maybe I just don't know how to use it.

      So other than installing ActiveState, I don't know where to get PPM::UI from. Which means if there's an update, it's either buried in PPM, or it's part of the ActiveState install package (and then you only get the update when you update Perl).

      Quantum Mechanics: The dreams stuff is made of

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://495908]
and the sunlight beams...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (4)
As of 2018-05-25 05:55 GMT
Find Nodes?
    Voting Booth?