Greetings all,
Quick question, Does active perl 5.6.x have any support for threads,
ithreads or fork built into the binary downloaded from Activestate? . I have
the new Perl Programming book which has a couple of examples, some work (I
think) some dont. Sorry to re-hash this question. The documentation is a
bit confusing in this area. like...
"On some platforms such as Windows where the fork() system call is not
available, Perl can be built to emulate fork() at the interpreter level.
While the emulation is designed to be as compatible as possible with the
real fork() at the level of the Perl program, there are certain important
differences that stem from the fact that all the pseudo child ``processes''
created this way live in the same real process as far as the operating
system is concerned."
Reason is I am trying to go to the next step with my Perl/Tk program (below)
so I can perform other functions without waiting on other functions to
finish.
#!perl.exe
##################################################################
##### Mollensoft Perl/Tk Ping Commander
##################################################################
#
# The Purpose of this Program is to provide a working
# example of the Graphic utiltiy found using Perl and Tk,
# coupled with a commonly used networking function PING.
# Displays Good Examples of menus, Dialog Box, Scrolling,
# List Box, opening files, reading data from files,
# acting on that data, etc.
# I wrote this program because I could not find any
# good programming examples perl/tk that show an actual
# functioning programming using Perl/Tk.
#
#
# This program is for learning and understanding Perl
# and is free (Just Like Perl) so do what you want with it!
#
# Creation: 19 May 2001
# Last Edit: 20 May 2001
#
# courtesy BigAL Mollenkopf- www.mollensoft.com
# [EMAIL PROTECTED]
#
##################################################################
use Tk;
use Tk::Text;
use Net::Ping;
use Tk::Toplevel;
use Tk::Pane;
use Tk::DialogBox;
my $main = new MainWindow;
$main->title("Perl/Tk Ping Commander");
$menubar = $main->Frame(-relief=>"raised",-borderwidth=>2);
$filebutton = $menubar->Menubutton(-text=>"Ping",-underline => 0);
$filemenu = $filebutton->Menu();
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command =>
\&start_ping,-label => "Start Pinging",-underline => 0);
$filemenu->separator;
$filemenu->command(-label => "Exit",-command =>
\&exit_choice,-underline => 1);
$configbutton = $menubar->Menubutton(-text=>"Configure",-underline
=> 0);
$configmenu = $configbutton->Menu();
$configbutton->configure(-menu=>$configmenu);
$configmenu->command(-command => \&cfg_vars,-label =>
"Configure Intervals",-underline => 0);
$configmenu->separator;
$configmenu->command(-command => \&edit_list,-label =>
"Add/Edit Host List",-underline => 0);
$helpbutton = $menubar->Menubutton(-text=>"Help",-underline => 0);
$helpmenu = $helpbutton->Menu();
$helpmenu->command(-command => \&about_choice,-label => "About
Perl/Tk Ping Commander", -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$helpmenu->command(-command => \&show_help,-label =>
"Help", -underline => 0); # A in About
$filebutton->pack(-side=>"left");
$configbutton->pack(-side=>"left");
$helpbutton->pack(-side=>"right");
$menubar->pack(-side=>"top", -fill=>"x");
$status =
$main->Label(-text=>"Ready...",-relief=>sunken,-borderwidth=>2,-anchor=>"w")
;
$status->pack(-side=>"bottom", -fill=>"x");
$box = $main->Listbox(-relief => 'sunken',-width => 70,-height =>
10)->pack(-side =>'left');
$scroll = $main->Scrollbar(-command => ['yview', $box]);
$scroll->pack(-side => 'right', -fill => 'y');
$box->configure(-yscrollcommand => ['set', $scroll]);
$box->pack(-side => 'left', -fill => 'both', -expand => 'yes');
MainLoop;
sub exit_choice {
$dialog=$main->DialogBox(-title => "Really Quit Perl Ping
CMDR?", -buttons => ["OK","Cancel"]);
$result = $dialog->Show;
if ($result eq "OK") {exit;}
if ($result eq "Cancel") {;}
}
sub start_ping {
open(INPUT, "hostdbase.txt");
@data = <INPUT>;
close(INPUT);
open(OUTFILE, ">outfile.txt");
$Date = localtime();
print OUTFILE "<< Starting New Ping Session >>\n";
foreach $host (@data){
chop $host;
if ($host ne "" && $host ne "\n"){
$p = Net::Ping->new(icmp);
if ($p->ping($host)) {print OUTFILE "<+>On $Date Host $host is
alive\n";}
else {print OUTFILE "<->On $Date Host $host is Not
reachable\n";}
}
else {print OUTFILE "Skipped Entry...No Hostname Or Ip
Entered\n";}
}
$p->close();
close(OUTFILE);
open(INFILE, "outfile.txt");
@inz = <INFILE>;
close(INFILE);
$windowz = @inz;
#$text1->insert('end',"@inz");
$status->configure(-text=>"Pinging Complete...");
foreach (@inz) {
chomp $_;
$box->insert('end', $_);
}
}
sub cfg_vars {
my $cv=MainWindow->new;
$cv->title("Ping Commander Configuration");
$label7 = $cv->Label(-text => "This Feature Is not Enabled
Yet",-font => "times 14",-foreground => "red");
$label7->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$label5 = $cv->Label(-text => "Current Ping Interval \n Time In
Seconds",-font => "Verdana 7",-foreground => "Dark Red");
$label5->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$cvtext1 = $cv ->Text ('-width'=> 5, '-height'=>1)->pack();
$label4 = $cv->Label(-text => "Current Number of times\n to repeat
ping",-font => "Verdana 7",-foreground => "Dark Red");
$label4->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$cvtext2 = $cv ->Text ('-width'=> 5, '-height'=>1)->pack();
open(INPUT, "cfgvars.txt");
@data = <INPUT>;
close(INPUT);
$cvtext1->insert('end',"$data[0]");
$cvtext2->insert('end',"$data[1]");
$cv->Button(-text => 'Quit',-command => [$cv =>
'destroy'])->pack(-side=>left);
$cv->Button(-text => 'Save', -command =>
sub{save_cfgvars($cvtext1,$cvtext2)})->pack(-side=>right);
}
sub save_cfgvars {
my ($cvtext1, $cvtext2) = @_;
my $cvdata1 = $cvtext1 ->Contents();
my $cvdata2 = $cvtext2 ->Contents();
chop $cvdata1;
chop $cvdata2;
open (OUTFILE, ">cfgvars.txt")|| die ("Cannot Open Hosts/IP
Database File");
print OUTFILE "$cvdata1$cvdata2";
close(OUTFILE);
$status->configure(-text=>"Configuration Variables... updated");
}
sub edit_list {
my $mp=MainWindow->new;
$mp->title("Edit/Add Hosts or IP Addresses");
$label4 = $mp->Label(-text => "This program will ping any four hosts
you wish. \n Enter the hostnames or Ip addresses into the four text
boxes",-font => "Verdana 7",-foreground => "Dark Red");
$label4->pack(-side=>"top", -expand=>1,-padx=>2, -pady=>2);
$xwtext1 = $mp ->Text ('-width'=> 30,
'-height'=>1)->pack(-padx=>2, -pady=>2);
$xwtext2 = $mp ->Text ('-width'=> 30,
'-height'=>1)->pack(-padx=>2, -pady=>2);
$xwtext3 = $mp ->Text ('-width'=> 30,
'-height'=>1)->pack(-padx=>2, -pady=>2);
$xwtext4 = $mp ->Text ('-width'=> 30,
'-height'=>1)->pack(-padx=>2, -pady=>2);
open(INPUT, "hostdbase.txt");
@data = <INPUT>;
close(INPUT);
$xwtext1->insert('end',"$data[0]");
$xwtext2->insert('end',"$data[1]");
$xwtext3->insert('end',"$data[2]");
$xwtext4->insert('end',"$data[3]");
$label9 = $mp->Label(-text => "Clicking the \"Save\" button saves
new values. \nClicking \"Quit\"with out clicking the \"Save\" \nbutton keeps
the current IP/Hosts intact.",-font => "Verdana 7",-foreground => "Dark
Red");
$label9->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$mp->Button(-text => 'Quit',-command => [$mp =>
'destroy'])->pack(-side=>left,-padx=>25, -pady=>25);
$mp->Button(-text => 'Save', -command =>
sub{save_hostsfile($xwtext1,$xwtext2, $xwtext3,
$xwtext4)})->pack(-side=>right,-padx=>25, -pady=>25);
}
sub save_hostsfile {
my ($xwtext1, $xwtext2, $xwtext3, $xwtext4) = @_;
my $text1 = $xwtext1 ->Contents();
my $text2 = $xwtext2 ->Contents();
my $text3 = $xwtext3 ->Contents();
my $text4 = $xwtext4 ->Contents();
chop $text1;
chop $text2;
chop $text3;
chop $text4;
open (HOSTS, ">hostdbase.txt")|| die ("Cannot Open Hosts/IP
Database File");
print HOSTS "$text1$text2$text3$text4";
close(HOSTS);
$status->configure(-text=>"Ping Host List... updated");
}
sub about_choice {
my $xw=MainWindow->new;
$xw->title("About Perl/Tk Ping Commander");
$label = $xw->Label(-text => "The Perl/Tk Ping Commander",-font =>
"Verdana",-foreground => "Dark Red");
$label2 = $xw->Label(-text => "Courtesy",-font => "Arial
12",-foreground => "Black");
$label3 = $xw->Label(-text => "Mollensoft Software\n
www.mollensoft.com",-font => "Arial 10",-foreground => "Dark Green");
$label->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$label2->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$label3->pack(-side=>"top", -expand=>1,-padx=>10, -pady=>10);
$xw->Button(-text => 'Exit',-command => [$xw => 'destroy'])->pack;
$status->configure(-text=>"about Perl/Tk Ping Commander");
}
sub show_help{
my $main = new MainWindow;
$main->title("Perl/Tk Ping Commander Help");
$main->Button(-text => 'Exit',-command => [$main =>
'destroy'])->pack(-side=>"bottom");
my $box = $main->Listbox(-relief => 'sunken',-width => -1,-height =>
5,-setgrid => 'yes');
$help[0] = "Welcome to the Perl Ping Commander Help File." ;
$help[1] = "The Purpose of this Program is to provide a working" ;
$help[2] = "example of Perl/Tk coupled with a common networking" ;
$help[3] = "task. This program is of course free Just Like Perl!"
;
$help[4] = "To Start..." ;
$help[5] = "1. click the \"configure\" menu box and select the
\"add/edit hosts\" menu." ;
$help[6] = "2. The Top of the form shows the four Ip/hosts that are
currently setup" ;
$help[7] = " to be pinged. If you want to change them you type
the new values in the " ;
$help[8] = " four boxes below." ;
$help[9] = "3. You may now begin the Pinging procedure by clicking
\"Ping\" selection, then \"Start Pinging\"";
$help[10] = " You should then see the ping responses show up in
the Center Window." ;
$help[11] = "" ;
foreach (@help) {
$box->insert('end', $_);
}
my $scroll = $main->Scrollbar(-command => ['yview', $box]);
$box->configure(-yscrollcommand => ['set', $scroll]);
$box->pack(-side => 'left', -fill => 'both', -expand => 'yes');
$scroll->pack(-side => 'right', -fill => 'y');
}
_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
http://listserv.ActiveState.com/mailman/listinfo/perl-win32-users
