Initial Commit

database/perl/vendor/lib/Win32/GuiTest/Cmd.pm

@@ -0,0 +1,453 @@
+# $Id: Cmd.pm,v 1.1 2007/10/23 12:18:37 pkaluski Exp $
+=head1 NAME
+
+Win32::GuiTest::Cmd - Perl Batch File Enhancer. Part of Win32::GuiTest.
+
+=head1 SYNOPSIS
+
+  use Win32::GuiTest::Cmd ':ASK';
+
+  Pause("Press ENTER to start the setup...");
+
+  setup_network() 
+    if YesOrNo("Setup networking component?");
+
+  $address = AskForIt("What's your new ip address?", 
+    "122.122.122.122");
+
+  $dir = AskForDir("Where should I put the new files?", 
+    "c:\\temp");
+
+  copy_files($dir) if $dir;
+
+  $exe = AskForExe("Where is your net setup program?", 
+    "/foo/bar.exe");
+
+  system($exe) if YesOrNo("Want me to run the net setup?");
+
+
+=head1 DESCRIPTION
+
+Instead of writing batch files (although on NT they are almost
+usable), I've resorted more and more to writing Perl scripts for
+common sysadmin/build/test chores. This module makes that kind of
+thing easier.
+
+Other modules I've found useful for that kind of work:
+
+C<use Win32::NetAdmin;>
+
+C<use Win32::NetResource;>
+
+C<use Win32::ODBC;>
+
+C<use Socket;>
+
+C<use Sys::Hostname;>
+
+C<use File::Path  'mkpath';>
+
+C<use Getopt::Std 'getopts';>
+
+=cut
+
+package Win32::GuiTest::Cmd;
+
+require Exporter;
+
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+use ExtUtils::MakeMaker;
+use Cwd;
+use File::Basename;
+
+use strict;
+use warnings;
+
+
+@ISA = qw(Exporter);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = ();
+
+%EXPORT_TAGS=(
+    CPL => [ qw(
+        Accessibility AppWizard Console DateTime Display Exchange FindFast
+        Internet Joystick Modem Mouse Multimedia Network Odbc Pcmcia Ports Ras
+        Regional Server System Telephony Ups Users
+    )],
+    ASK => [ qw(
+        Pause YesOrDie YesOrNo AskForIt IsExe AskForExe AskForDir AskAndRun
+    )],
+    REG => [ qw(
+        RegisterCom UnregisterCom AddToRegistry
+    )],
+    MISC => [ qw(
+        WhichExe TempFileName
+    )],
+);
+
+@EXPORT_OK= ();
+{ my $ref;
+    foreach $ref (  values(%EXPORT_TAGS)  ) {
+        push( @EXPORT_OK, @$ref );
+    }
+}
+$EXPORT_TAGS{ALL}= \@EXPORT_OK;
+
+# Preloaded methods go here.
+
+=head1 FUNCTIONS
+
+
+=head2 Console
+
+Console interaction functions heavily based on the command-line installer for 
+the libwin32 distribution written by Gurusamy Sarathy.
+
+=over 4
+
+=item Pause([$message])
+
+Shows a message and waits until the user presses ENTER.
+
+=cut
+
+sub Pause {
+    my $msj = shift;
+    print "$msj" if $msj; 
+    scalar(<STDIN>); # hang around in case they ran it from Explorer
+}
+
+=item YesOrDie([$message])
+
+Asks for a [y/n] response using the message you specify. The program
+dies if you answer 'n'.
+
+=cut
+
+sub YesOrDie {
+    my $m = shift || "Proceed?";
+    print "$m [y] ";
+    die "Bailing out\n" if scalar(<STDIN>) !~ /^\s*(y|$)/i;
+}
+
+=item YesOrNo([$msg])
+
+Asks for a [y/n] response using the message you specify. Returns 1 if
+you type 'y' or 0 otherwise.
+
+=cut
+
+sub YesOrNo {
+    my $m = shift || "Which?";
+    print "$m [y] ";
+    return 1 if scalar(<STDIN>) =~ /^\s*(y|$)/i;
+}
+
+=item AskForIt([$question],[$def_value])
+
+Asks the user to input a value and returns it. If you omit $question
+a default question will be used. If you omit $def_value, false will be used
+as default return value.
+
+=cut
+
+sub AskForIt {
+    my $m = shift || "Enter value";
+    my $def = shift;
+    $def = "" unless defined $def;
+    print "$m \[$def\] ";
+    my $v = <STDIN>;
+    chomp $v;
+    return ($v =~ /^\s*$/ ? $def : $v);
+}
+
+=item IsExe($filename)
+
+Checks if a file is executable.
+
+=cut
+
+sub IsExe {
+    my $exe = shift;
+    return $exe	if -x $exe && ! -d _;
+}
+
+=item AskForExe([$question],[$def_exe])
+
+Just like AskForIt, but returns false if the value 
+is not an executable file.
+
+=cut
+
+sub AskForExe {
+    my $exe = AskForIt(@_); 
+    return $exe if -x $exe && ! -d _;
+    warn "$exe is not executable\n";
+    return "";
+}
+
+=item AskForDir([$question],[$def_dir])
+
+Just like AskForIt, but returns false if the value 
+is not a directory.
+
+=cut
+
+sub AskForDir {
+    my $dir = AskForIt(@_); 
+    return $dir if -d $dir;
+    warn "$dir is not a directory\n";
+    return "";
+}
+
+=item AskAndRun([$question],[$def_exe])
+
+Asks for an exe file an runs it using C<system>.
+
+=cut
+
+sub AskAndRun {
+    my $exe = AskForExe(@_);
+    system($exe) if $exe; 
+}
+
+sub try_again {
+    print "Let's try this again.\n";
+    goto shift;
+}
+
+=back
+
+=head2 System Configuration
+
+Mostly allow opening Win32 Control Panel Applets programatically.
+
+=over 4
+
+=item RunCpl($applet)
+
+Opens a Control Panel Applet (.cpl) by name.
+
+ RunCpl("modem.cpl");
+
+=cut
+
+sub RunCpl {
+    my $cpl = shift;
+    system("start rundll32.exe shell32.dll,Control_RunDLL $cpl");
+}
+
+=item Modem, Network, Console, Accessibility, AppWizard, Pcmcia,
+    Regional, Joystick, Mouse, Multimedia, Odbc, Ports, Server,
+    System, Telephony, DateTime, Ups, Internet, Display, FindFast,
+    Exchange, 3ComPace
+
+Each of them opens the corresponding Control Panel Applet.
+
+=cut
+
+sub Modem         { RunCpl "modem.cpl";    }
+sub Network       { RunCpl "ncpa.cpl";     }
+sub Console       { RunCpl "console.cpl";  }
+sub Accessibility { RunCpl "access.cpl"; }
+sub AppWizard     { RunCpl "appwiz.cpl"; }
+sub Pcmcia        { RunCpl "DEVAPPS.cpl"; }
+sub Regional      { RunCpl "intl.cpl"; }
+sub Joystick      { RunCpl "joy.cpl"; }
+sub Mouse         { RunCpl "main.cpl"; }
+sub Multimedia    { RunCpl "mmsys.cpl"; }
+sub Odbc          { RunCpl "ODBCCP32.cpl"; }
+sub Ports         { RunCpl "PORTS.cpl"; }
+sub Server        { RunCpl "srvmgr.cpl"; }
+sub System        { RunCpl "sysdm.cpl"; }
+sub Telephony     { RunCpl "telephon.cpl"; }
+sub DateTime      { RunCpl "timedate.cpl"; }
+sub Ups           { RunCpl "ups.cpl"; }
+sub Internet      { RunCpl "INETCPL.cpl"; }
+sub Display       { RunCpl "DESK.cpl"; }
+
+# Propietary CPL applets
+sub FindFast      { RunCpl "FINDFAST.cpl"; }
+sub Exchange      { RunCpl "MLCFG32.cpl"; }
+#sub 3ComPace      { RunCpl "pacecfg.cpl"; }
+
+# Some useful system utilities
+
+=item Ras
+
+Installs or configures the RAS (Remote Access Service) component.
+
+=cut
+
+sub Ras     { system("start rasphone.exe"); }
+
+=item Users
+
+Runs the User/Group Manager application.
+
+=cut
+
+sub Users   { system("start musrmgr.exe"); }
+
+=back
+
+=head2 Registry
+
+Manipulate the registry.
+
+=over 4
+
+=item RegisterCom($path)
+
+Uses regsvr32.exe to register a COM server.
+
+  RegisterCom("c:\\myfiles\\mycontrol.ocx");
+
+=cut
+
+sub RegisterCom {
+    my $server = shift;
+    system("regsvr32 $server") && 
+        warn "Could not register server $server\n";
+}
+
+=item UnregisterCom($path)
+
+Uses regsvr32.exe to unregister a COM server.
+
+  UnregisterCom("c:\\myfiles\\mycontrol.ocx");
+
+=cut
+
+sub UnregisterCom {
+    my $server = shift;
+    system("regsvr32 /u $server");
+}
+
+=item AddToRegistry($regfile)
+
+Uses regedit.exe to merge a .reg file into the system registry.
+
+  AddToRegistry("c:\\myfiles\\test.reg");
+
+=cut
+
+sub AddToRegistry {
+    my $reg = shift;
+    system("regedit $reg");
+}
+
+=back
+
+=head2 Misc
+
+Sorry about that...
+
+=over 4
+
+=item WhichExe($file)
+
+Takes a command name guesses which 
+executable file gets executed if you invoke the command.
+
+    WhichExe("regedit")  -> C:\WINNT\regedit.exe
+    WhichExe("regsvr32") -> D:\bin\regsvr32.exe
+    WhichExe("ls")       -> D:\Usr\Cygnus\B19\H-i386-cygwin32\bin\ls.exe
+
+Based on original code grabbed from CPAN::FirstTime.
+
+Added support for NT file extension associations:
+
+   WhichExe("test.pl")   -> perl D:\SCRIPTS\test.pl %*
+   WhichExe("report.ps") -> D:\gstools\gsview\gsview32.exe D:\TMP\report.ps
+
+=cut
+
+#
+# Uses extensions in PATHEXT or default extensions to look for
+# posible filenames.
+#
+sub MaybeCommand {
+    my $file = shift;
+    for (split(/;/, $ENV{'PATHEXT'} || '.COM;.EXE;.BAT;.CMD')) {
+		return "${file}$_" if -e "${file}$_";
+    }
+    return;
+}
+
+sub MaybeAssoc {
+    my $abs = shift;
+    my($name,$path,$suffix) = fileparse($abs, '\..*');
+    return unless $suffix;
+    for (`assoc`) {
+	chomp;
+	if (/$suffix=(.*)/) {
+	    my $type = $1;
+	    for (`ftype`) {
+		chomp;
+		if (/$type=(.*)/) {
+		    my $cmdline = $1;
+		    my $count = ($cmdline =~ s/%1/${abs}/); 
+		    $cmdline =~ s/%\*/${abs}/ if !$count;
+		    return $cmdline;    
+		}
+	    }
+	    #warn "No ftype for $type\n";	
+	}
+    }
+    return;
+}
+
+sub WhichExe {
+    my(@path) = split /$Config::Config{'path_sep'}/, $ENV{'PATH'};
+    my $exe = shift;
+    my $path = shift || [ @path ];
+    unshift @$path, getcwd; # Don't forget to check the cwd first
+
+    #warn "in WhichExe exe[$exe] path[@$path]";
+    for (@$path) {
+    	my $abs = MM->catfile($_, $exe);
+        my $ret;
+	# Try with file associations
+	if (($ret = MaybeAssoc($abs))) {
+            return $ret;
+	}
+	# Try with command extensions
+        if (($ret = MaybeCommand($abs))) {
+            return $ret;
+	}
+    }
+}
+
+=item TempFileName
+
+Returns the full path for a temporary file that will not collide with an
+existing file.
+
+=cut
+
+sub TempFileName {
+    my $pre = "aaaaaaaa";
+    for (0..10000000) {
+       my $name = MM->catfile("$ENV{TMP}", "$pre.reg");
+       return $name unless -e $name;
+       $pre++;
+    }
+    return; 
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Ernesto Guisado E<lt>erngui@acm.orgE<gt>, E<lt>http://triumvir.orgE<gt>
+
+=cut