Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

kabeldag's scratchpad

by kabeldag (Hermit)
on Jul 25, 2005 at 01:16 UTC ( #477641=scratchpad: print w/replies, xml ) Need Help??

# Traverse directories recursively using opendir() # It's as fast as you can get (I think) use strict; use warnings; use Time::HiRes; my $base_dir = "/"; my @directories; my $file_count = 0; chdir $base_dir; while($base_dir) { my @dir_contents = get_listing($base_dir); for my $sub_file (@dir_contents) { if(-d "$base_dir$sub_file" && $sub_file!~/^\.{1,2}$/) { push(@directories, "$base_dir$sub_file/"); }elsif(-f "$base_dir$sub_file") { $file_count++; } print "$base_dir$sub_file\n"; } $base_dir = shift(@directories); } my $elapsed_time = (Time::HiRes::time-$^T); print "Completed listing in: $elapsed_time seconds\n"; print "Total files: $file_count\n"; sub get_listing { my $dir = $_[0]; my @dir_contents; opendir(DIR, $dir); @dir_contents = readdir(DIR); closedir(DIR); return @dir_contents; }
----------------------------------------------------
# This is another way to traverse directories and files recursively, # but the above method (using opendir()) is my choice. # Test both of them out and see for yourself... use strict; use warnings; use IO::Dir; use Time::HiRes; my $base_dir = "/"; my $file_count = 0; my @dir_list; my %dir; while($base_dir) { %dir = get_dir_listing($base_dir); my ($key, $el) = each %dir; while($key) { if(-d "$base_dir$key" && $key!~/^\.{1,2}$/) { push(@dir_list, "$base_dir$key/"); }elsif(-f "$base_dir$key") { $file_count++; print "File: $base_dir$key\n"; } ($key, $el) = each %dir; } $base_dir = shift(@dir_list); } my $elapsed_time = (Time::HiRes::time-$^T); print "Completed listing in: $elapsed_time seconds\n"; print "Total files: $file_count\n"; sub get_dir_listing { my $base_dir = $_[0]; tie %dir, "IO::Dir", "$base_dir"; return %dir; }
----------------------------------------------------
# Just a chargen socket use strict; use warnings; use IO::Select; use IO::Socket; $|=1; $SIG{INT}=\&exit_genchars; my $time_zone_inc=10; my %sock_client_hash; my $cc=48; my $lsn = new IO::Socket::INET(Listen => 1,LocalPort => 19,Reuse=> + 1); my $sel = new IO::Select( $lsn ); my $rready; my $wready; while($lsn) { my @priority_array; ($rready,$wready) = IO::Select->select($sel, $sel, undef); if(@$rready&&!@$wready) { # Let's process the read ready socket array. As there are +no writables yet @priority_array=@$rready; }elsif(@$rready&&@$wready) { # Let's process the read ready socket array before the wri +te array # as a new socket/client has arrived @priority_array=@$rready; }else{ # Let's process the write ready socket array this time. As + no readables are ready @priority_array=@$wready; } foreach my $socket (@priority_array) { if($socket == $lsn) { new_socket($socket); }else{ # Let's actually generate those chars to the client/so +cket # that is write ready gen_chars($socket); } } } sub start_timer { my $socket = $_[0]; $sock_client_hash{$socket->fileno}{send_start_time}=time; $sock_client_hash{$socket->fileno}{bytes_recvd}=0; } sub stop_timer { my $socket = $_[0]; my $stop_time = time; my $start_time = $sock_client_hash{$socket->fileno}{send_start_tim +e}; my $elapsed_seconds = $stop_time - $start_time; my $bytes_recvd = $sock_client_hash{$socket->fileno}{bytes_recvd}; my $bps = sprintf "%.4f", $bytes_recvd / $elapsed_seconds; my ($ip,$port) = sock_attrs($socket); log_event("Transfer rate to $ip:$port was $bps bytes/second\n----- +-----> Seconds elapsed: $elapsed_seconds\n"); } sub new_socket { my $newclientsock=shift; $newclientsock = $lsn->accept; $sel->add($newclientsock); my ($ip,$peer_port)=sock_attrs($newclientsock); $sock_client_hash{$newclientsock->fileno}{ip}=$ip; $sock_client_hash{$newclientsock->fileno}{port}=$peer_port; my $fileNo=$newclientsock->fileno; log_event("New Client connected -> FileNo($fileNo) $ip:$peer_port\ +n"); start_timer($newclientsock); } sub gen_chars { my $wrs = $_[0]; if($cc==58) { $cc=65; }elsif($cc==91) { $cc=97; }elsif($cc==123) { $cc=48; } $sock_client_hash{$wrs->fileno}{bytes_recvd}++; $wrs->send(chr($cc)) or close_socket($wrs); $cc++; } sub close_socket { my $socket=$_[0]; my $sock_ip=$sock_client_hash{$socket->fileno}{ip}; my $sock_peer_port=$sock_client_hash{$socket->fileno}{port}; my $fileNo=$socket->fileno; log_event("Unable to write to -> FileNo($fileNo) $sock_ip:$sock_pe +er_port\n"); if(defined ($socket)) { stop_timer($socket); $sel->remove($socket); $socket->close; log_event("Removed socket -> FileNo($fileNo) $sock_ip:$sock_pe +er_port\n"); } } sub sock_attrs { my $socket=$_[0]; my $ip=$socket->peerhost; my $port=$socket->peerport; return $ip,$port; } sub log_event { my $msg=shift; my $gmTime=rTime(); print "$gmTime -> $msg"; } sub rTime { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time); my $militaryTime=($hour)+$time_zone_inc; my $m; my $s; if($militaryTime>24) { $militaryTime=$militaryTime-24; } $militaryTime=$hour; if(length($min)==1) { $m="0".$min; $min=$m; } if(length($sec)==1) { $s="0".$sec; $sec=$s; } my $roundedTime="$militaryTime:$min:$sec"; return $roundedTime; } sub exit_genchars { log_event("Exit called\n"); exit(0); }
----------------------------------------------------
# Restart a program when it terminates # Date : 22/01/2006 # Name : kautorestart - Auto-restart (for windows game servers +) # Author : Kabeldag # Purpose : Automatically restarts windows game servers when they t +erminate/crash/end etc .. # Not the double-back slashes and the date, heh ;) use strict; use Win32::Process; use Win32; print "\r\n"; print "Started Auto-Restart for Windows Game-Servers ...\n"; print "Created by kabeldag on 22-01-2006\n\n"; my ($server_exe_file,$server_dir,$params)=@ARGV or do_error("No arguments specified\n"); if(!$server_exe_file) { do_error("Server executable not specified"); }elsif(!$server_dir) { do_error("Server directory not specified"); }elsif(!(-e $server_dir)) { do_error("Directory of : $server_dir not found"); }elsif(!(-e "$server_dir\\$server_exe_file")) { do_error("File not found : $server_dir\\$server_exe_file"); } sub do_error() { my $err_msg=$_[0]; print "$err_msg\n"; print "Syntax: $0 server path-of-server params-for-server\n"; print "\nExample:\n\n$0 \"moh_spearhead_server.exe\" \"c:\\moh-ser +ver\\\" \"+exec server.cfg\"\n"; exit(); } sub ErrorReport{ print Win32::FormatMessage(Win32::GetLastError()); } sub print_line($) { my $line_in=$_[0]; my $time=localtime(); print "->$time -> $line_in\n"; } sub start_process() { my $processObj; print "============- [PRESS CTRL+C TO TERMINATE] -================ +=\n"; print_line("Starting new process ..."); Win32::Process::Create($processObj, "$server_dir\\$server_exe_file", "$server_exe_file $params", 0, NORMAL_PRIORITY_CLASS, "$server_dir")||die ErrorReport(); monitor_process($processObj); } sub monitor_process() { my $processObj=$_[0]; my $pid=$processObj->GetProcessID(); print_line("Process id is $pid"); print_line("Waiting on process $pid"); $processObj->Wait(INFINITE); #$processObj->Kill(1); print_line("Process $pid ended"); start_process(); } start_process();
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2020-10-30 08:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (278 votes). Check out past polls.

    Notices?