File Coverage

blib/lib/win.pm

Criterion	Covered	Total	%
statement	27	75	36.0
branch	4	30	13.3
condition	2	9	22.2
subroutine	6	7	85.7
pod	0	2	0.0
total	39	123	31.7

package win;
our $VERSION = '0.03';
require Exporter;
our @ISA = qw(Exporter);

sub import {

    my $class = shift;

    ($pkg) = (caller)[0];
    $current = __PACKAGE__;

    $mods = "";

    &rerun unless (@_);

    my @list = split /,/, $_[0];
    my $found = 0;


  foreach (@list) {
         # give me everything with or without colons.
         /([\w\:]+)(.*)/;
         $pm = "Win32/$1.pm";

        # susbstitute the colons with backslashes
         $pm =~ s/\:\:/\//g;

         # give me the last part, which will be the file name, of the first regex.
         $suffix = $2;
         $suffix =~ s/\s+$//;

	 # Let's see what we find.
         foreach (@INC) {
          next unless ( -e "$_/$pm" );
            open(READ, "$_/$pm") or die "Can't read $_/$pm";
              while ($line = ) {
                  if ( $line =~ /package\s+(Win32.*?);/i) {
                  $mods .= "use $1$suffix;\n";
                  $found++;
                  last;
                  }
                  next;
               }
         last;
       }
  next;
  }

    # Now we've got to give rerun a mods variable, so what do we do if we found nothing?
    # Remember to let rerun catch any missing modules, not Win32-Die.
    my $diev = 0;
    if  ( ( ($found == 0) && ($#list == 0) ) ||
            ($found != ($#list + 1)) ) {

      $mods = "";
      foreach (@list) {
        $_ =~ s/^\s+//;
        $_ =~ s/\s+$//;
        if ($mods .= "use Win32::$_;\n") {
        $diev = 1;
        }
      }
    }
    # Must prevent Win32-Die from interferring with our error catch.
    unless ($diev) {
        $mods .= "use Win32::Die;\n";
    }

    &rerun;

}

sub rerun {

    eval qq[
        package $pkg;
        use Win32::Autoglob;
        $mods;
        package $current;
    ];
    if ($@) {

        if ($@ =~ /Can't locate/) {
           &ppmcall;
        } else {
        require Carp;
        Carp::croak("$@");
        }
    }
}

sub ppmcall {

    do {
        print "$@\n";
        print "Looks like you don't have the module you requested\n";
        print "Shall I have PPM fetch it for you? (y/n) ";
    } while ( ( $_ =  ) && ( $_ !~ /y|n/i ) );

    unless ( $_ =~ /y/i ) {

        print "Bye!\n" and exit;

    }

    use File::Which qw(which);
    unless ( defined( which('ppm') ) ) {
        print <<'EOF';

Bad news: I can't find PPM in your path.

Most likely PPM is on your system.
Search for PPM and put its location in your path. Or you can download PPM
from http://www.activestate.com. Look under their Perl section.
Exiting ...

EOF

        exit;
    }

    my (@ppmods) = $mods =~ /(Win32::[\w\:]+).*?;/g;
     foreach my $pm (@ppmods) {
        #my $pm = $_;

        $pm =~ s/::/\//g;
        $pm = "$pm" . ".pm";

        my $found = 0;
        foreach (@INC) {
            ++$found if ( -e "$_/$pm" );
        }
        unless ($found) {
            print "Please wait ...\n";
            print "Activating PPM ( ctrl-c to abort )\n";
            my $ppm_results = `ppm install $_`;
            print "$ppm_results\n";
        }
    }

    print "PPM done. Goodbye.\n" and exit;

}
1;
__END__