Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Script to update your PPM Repositories

by tphyahoo (Vicar)
on May 11, 2005 at 16:13 UTC ( #456056=perlmeditation: print w/ replies, xml ) Need Help??

I use ActiveState perl, and I like managing my modules with ppm rather than making them manually. Problem is, for the less common modules, it's often difficult to find a repository that has them, if they're not in one of the two ppm repositories installed by default with ActiveState.

PPM::Repositories was supposed to improve this situation by centralizing all known ppm repositories, as the venerable holli explained at A guide to installing modules for Win32. However, ppm::repositories lists a lot of repositories that are dead or down for maintenance. If you are unlucky enough to have a dead repository in your list of repositories, this can cause major headaches when, for instance, you try searching for a module -- it just takes forever to fail and ppm doesn't tell you it's trying to ping the repository or whatever, it just sits there all stubborn. Annoying.

So, I wrote a program to hopefully take away some of the pain and make things easier to the perl on windows crowd. It synchronizes the ppm repositories on my system with the functioning ppm repositories listed on PPM::Repositories, working as follows. It first removes all repositories other than the two standard ones that come with ActiveState. Then, it goes through the repositories listed on PPM::Repositories, pings them, and if they're okay, adds them to the active repository list.

Hope this helps someone!

#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 de +lete $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; }

Output :

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
UPDATE: Now strict and warnings safe, thanks to QM for reminding me of that. (Thought I always did that automatically, but I guess I slipped up.)
Update 2: Now with icmp ping, thanks to eibwen and pboin. I should have done this a long time ago.
UPDATE 3: If you think you may be behind a ping-restricted firewall, you may want to try holli's version of the script which modifies the above to use some kind of LWP authentication instead of ping: Re: Script to update your PPM Repositories.

Comment on Script to update your PPM Repositories
Select or Download Code
Re: Script to update your PPM Repositories
by DaWolf (Curate) on May 12, 2005 at 03:14 UTC
Re: Script to update your PPM Repositories
by ghenry (Vicar) on May 12, 2005 at 09:10 UTC

    What if the repo is very busy and your ping doesn't get through?

    Walking the road to enlightenment... I found a penguin and a camel on the way.....
    Fancy a yourname@perl.me.uk? Just ask!!!
      Then today isn't a good day to be using that repo. Run the script again tomorrow.

        Good point.

        G.

        Walking the road to enlightenment... I found a penguin and a camel on the way.....
        Fancy a yourname@perl.me.uk? Just ask!!!
Re: Script to update your PPM Repositories
by holli (Monsignor) on May 12, 2005 at 13:39 UTC
    Nice. ++ <nitpick> but you missed the closing readmore-tag. </nitpick>


    holli, /regexed monk/
Re: Script to update your PPM Repositories
by QM (Vicar) on May 13, 2005 at 22:23 UTC
    You could make it strict and warnings safe.

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

      Oops, good idea. Did that.
        I love this script, great work !
Re: Script to update your PPM Repositories
by eibwen (Friar) on Jun 26, 2005 at 02:48 UTC

    Now more efficient and no longer redundant.

    Additionally, it should be noted that Net::Ping::new() defaults to TCP, therefore any "dead" repository merely failed to reply to a TCP ping. Some "dead" domains will reply to alternative protocol pings (eg SourceForge does not reply to TCP, but does reply to ICMP).

    use strict; use warnings; use PPM::Repositories; use Net::Ping; foreach my $repository (split(/[\r\n]/, `ppm rep`)) { next unless $repository =~ s/^\[[\d\ ]+\]\ (.*)$/$1/; system("ppm rep delete $repository > NUL") unless $repository =~ / +activestate/i; } foreach my $repository (keys %Repositories) { my $domain = my $location = $Repositories{$repository}->{location} +; next unless $domain =~ s|^\s*http://([^/]+)/.*$|$1|; if (Net::Ping->new()->ping($domain)) { print "$repository is alive.\n"; system("ppm repository add $repository $location > NUL"); } else { print "$repository is dead.\n"; } } print $/, `ppm rep`;

    Output:

    dada is dead. smueller is alive. crazy58 is alive. crazy is alive. datetime is alive. soulcage58 is alive. bribes is alive. gtk is dead. rto is alive. spurkis is dead. theoryS is dead. jenda is dead. theory58S is dead. log4perl is dead. theory58 is dead. soulcage is alive. savage is dead. devhelp is alive. theory is dead. openi is dead. roth is alive. Repositories: [ 1] ActiveState Package Repository [ 2] ActiveState PPM2 Repository [ 3] smueller [ 4] crazy58 [ 5] crazy [ 6] datetime [ 7] soulcage58 [ 8] bribes [ 9] rto [10] soulcage [11] devhelp [12] roth

      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.

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

        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?

Re: Script to update your PPM Repositories
by pboin (Deacon) on Jul 07, 2005 at 17:50 UTC

    This didn't work for me -- gave me a fit. I'm running ActiveState perl on NT4SP6.

    To solve it, I ended up modifying the line that instantiates a new Net::Ping object. It now looks like this:

    my $p = Net::Ping->new('icmp');

    I also ran the script logged in as Administrator. My tips came from the following two nodes, both by tye:

    Net::Ping, the mini series

    (tye)Re: Net::Ping troubles

      incorporated that into OP script. thanks!
Re: Script to update your PPM Repositories
by holli (Monsignor) on Sep 02, 2005 at 12:06 UTC
    At work I am behind a restrictive firewall/proxy that won't let me ping outside. So I have modified your script to use LWP::UserAgent, thus checking the state of the repository via http.


    holli, /regexed monk/
Re: Script to update your PPM Repositories
by muba (Priest) on Oct 02, 2005 at 15:09 UTC
    I tried your script - and it works really well.
    Nice job and ++
Re: Script to update your PPM Repositories
by sithsasquatch (Scribe) on May 24, 2006 at 00:21 UTC
    Very helpful, thanks!
Re: Script to update your PPM Repositories
by mikasue (Friar) on Jul 11, 2006 at 01:03 UTC
    This was posted last year but I found a need for it today. I had trouble running the script as it was. I had change the ppm to ppm3 and change the word repository to rep. This is a very useful script thanks for writing it.
    #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; <b>my $result = `ppm3 rep`;</b> for (split /[\r\n]/, $result) { #parsing lines that looks like #[ 3] jenda my ($number, $repository) = $_ =~ /(\[[^>]*\]\s)(.*)/; if ($repository) { unless ($repository =~ /activestate/i) {
    print `ppm3 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 `ppm3 rep 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; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://456056]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2014-07-26 16:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (178 votes), past polls