Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

by DaveRoberts (Novice)
on Jan 21, 2002 at 16:41 UTC ( #140376=sourcecode: print w/replies, xml ) Need Help??
Category: Win32 Stuff
Author/Contact Info
Description: This script is used to install and update a number of perl packages using the Perl Package Manager (PPM). The perl packages to be managed, and their repositaries, are defined within the script. When executed the script will report on the status of packages, and attempt to install any that are missing. If any packages have already been installed using the PPM a check will be made and these updated if a later revision is available. Packages not installed by PPM will not be upgraded. The script is useful for ensuring several perl installations have a base set of modules installed.
use Win32;
use PPM;
use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1,
    SplitMultis => 1,  AllowLoad => 1,
use Win32::Service;

use constant TRUE     => 1;
use constant FALSE     => 0;

my ($me)   = $0;
$me   =~ s/.*(\\|\/)([a-zA-Z0-9\.]+)$/$2/;
my ($banner) = <<"EOT";





print $banner;

my $ASppm   = "";
my $ASppmpl = "";

my $ROTHppm = "";
my %modules = (
  "Win32::Perms"        =>  $ROTHppm,
  "Win32::GUI"          =>  $ASppm, 
  "Win32::daemon"       =>  $ROTHppm,
  "Win32::AdminMisc"    =>  $ROTHppm,
  "Win32::TieRegistry"  =>  $ASppm,
  "Win32::Process"      =>  $ASppm,
  "Win32::Console"      =>  $ASppm,
  "Win32::NetResource"  =>  $ASppm,
  "Win32::FileSecurity" =>  $ASppm,
  "Win32::EventLog::Message" => $ROTHppm,
  "Getopt::Long"        =>  $ASppm,
  "LWP::UserAgent"      =>  $ASppm,
  "HTTP::Request"       =>  $ASppm,
  "HTTP::Response"      =>  $ASppm,
  "HTTP::Cookies"       =>  $ASppm,
  "HTTP::Headers"       =>  $ASppm,
  "Time::HiRes"         =>  $ASppm,
  "Time::Local"         =>  $ASppm,
  "Net::SMTP"           =>  $ASppm,
  "DB_File"             =>  $ASppm,
  "Win32::Perms"        =>  $ROTHppm,
  "GD"                  =>  $ASppm,
  "GD::Graph"           =>  $ASppmpl . "GDGraph.ppd",
  "Mail-Sendmail"       =>  $ASppmpl,

foreach my $module (keys %modules) {
  my $package = $module;
  $package =~ s/::/-/g;
  my $location = $modules{$module};
  $location = Win32::ExpandEnvironmentStrings($location);
  printf "Module %-25s ",$module;

  my $code = "use $module;";
  eval "$code" ;
  if ( $@ ) {
    print "- to install\n";
    # Try to install....
    if ( $location =~ m/:([\\\/].).*\.ppd$/ ) {                      #
+ If $location identifiles a ppd file
      if(PPM::InstallPackage(package => "$location")) {  
        #use this form for installation
        print  "\t - installed OK\n";
        printf "\t - install failed (%s)\n",$PPM::PPMERR;
        printf "                                        \tLocation %s\
+n", $location;
    }else{                                               # otherwise u
+se this
      if(PPM::InstallPackage(package => "$package",
        location => "$location")) {
        print  "\t - installed OK\n";
        printf "\t - install failed (%s)\n",$PPM::PPMERR;
        printf "                                        \tLocation %s\
+n", $location;
    print "- installed - ";
    my $status = PPM::VerifyPackage(package => $package, upgrade => 0,
+ force => 0);
    if (defined $status) {
      if ($status eq "0") {
        print "module is up to date.\n";
      } else {
        my $status = PPM::VerifyPackage(package => $package,
          upgrade => 1, force => 0);
        if ( $status == 0 ) {
          print "upgraded ok\n";
          print "failed to upgrade\n";
      # Couldn't find a PPD to compare it with.
      print "$PPM::PPMERR\n";
      print "   (Location: $location)\n" 
        if ( $PPM::PPMERR =~ /Could not locate a PPD file/);

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://140376]
[Corion]: choroba: No, I don't remember that story, but yes, it matches my experience ;))
[ambrus]: Hopefull the object isn't kept alive, the events are processed immediately, but you'd have to read a lot of source code to be sure about that.
[Corion]: ambrus: I think both of AnyEvent and Prima are pretty tight in their memory management because they both are cooperative multitasking and (I think) both use the Perl memory management for managing things
[Corion]: ambrus: And for Windows, I don't think that Prima knows if there still are messages queued for an object (in the Windows message loop). Finding that out would take lots of effort for little gain
[ambrus]: And even if this works, I'm still not sure you can't get double timeouts from a Timer.
[ambrus]: Corion: well Prima::Object says something like that the cleanup method will send an onDestory message and that you can't get more messages after cleanup, or something.
[Corion]: ambrus: Yeah - I don't think the deep source dive will be necessary if things are implemented as simple as they could be :)) And hopefully I won't need (more) timely object destruction. I can update the screen at 60Hz and hopefully even do HTTP ...
[Corion]: ... transfers in the background. Now that I think about it, this maybe even means that I can run the OpenGL filters on Youtube input :)
[ambrus]: Corion: I mentioned that the unix event loop of Prima always wakes up at least once every 0.2 seconds. Have you found out whether the win32 event loop of Prima does that too?
[Corion]: ambrus: Hmm - I would assume that the onDestroy message is sent from the destructor and doesn't go through the messageloop, but maybe it is sent when a window gets destroyed but all components are still alive...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2016-12-09 10:25 GMT
Find Nodes?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:

    Results (150 votes). Check out past polls.