Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

glenn's scratchpad

by glenn (Beadle)
on Oct 17, 2008 at 15:12 UTC ( #717762=scratchpad: print w/ replies, xml ) Need Help??

sub debugLogFunctionNameLineNum { #debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3], @_); my ($callerline, $caller, @input) = @_; my $input_msg = ""; for (my $i = 0; $i < @input; $i++) { $input_msg .= "$i=>$input[$i]"; if ($i < $#input) { $input_msg .= ", "; } } my ($package, $filename, $line) = caller; unless ($caller) { $caller = $filename; } if ($caller =~ m/eval/) { $caller = "Tk call"; $callerline = "Unknown"; } else { if ($callerline =~ m/::(.+)/) { $callerline = $1; } } my $FunctionName = (caller(1))[3]; if (!$FunctionName) { $FunctionName = "Main"; } if ($FunctionName =~ m/::(.+)/) { $FunctionName = $1; } my $time = sprintf("%s %s %s", (split(" ", localtime))[1..3]); #do sprintf left align truncate until sprintf supports if ($files{log}{fileNameLen} =~ m/-\d+\.(\d+)/) { $filename = substr($filename, 0, $1); } if ($files{log}{funNameLen} =~ m/-\d+\.(\d+)/) { $FunctionName = substr($FunctionName, 0, $1); } my $header = sprintf("%*s, %*s, %*s, %*s:", $files{log}{timeLen}, +$time, $files{log}{fileNameLen}, $filename, $files{log}{funNameLen}, +$FunctionName, $files{log}{lineNumLen}, $line); #print "$header Called from [$caller] at [$callerline] with option +s [$input_msg]\n"; $writelog->down(); print $LOGFH "$header $input_msg\n"; $writelog->up(); }

sub logLine { my ($text) = @_; chomp($text); my ($package, $filename, $line) = caller; my $FunctionName = (caller(1))[3]; if (!$FunctionName) { $FunctionName = "Main"; } if ($FunctionName =~ m/::(.+)/) { $FunctionName = $1; } my $time = sprintf("%s %s %s", (split(" ", localtime))[1..3]); #do sprintf left align truncate until sprintf supports if ($files{log}{fileNameLen} =~ m/-\d+\.(\d+)/) { $filename = substr($filename, 0, $1); } if ($files{log}{funNameLen} =~ m/-\d+\.(\d+)/) { $FunctionName = substr($FunctionName, 0, $1); } my $header = sprintf("%*s, %*s, %*s, %*s:", $files{log}{timeLen}, +$time, $files{log}{fileNameLen}, $filename, $files{log}{funNameLen}, +$FunctionName, $files{log}{lineNumLen}, $line); #print "$header $text\n"; #only for testing $writelog->down(); print $LOGFH "$header $text\n"; $writelog->up();

sub EmailResults { debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3], @_); my $system = $_[0]; my @globalMessages = ("NOT Used", "Used"); $system->{reasonforfailure}->[0] =~ s/\n/<br>\n/g; $system->{health}->[0] =~ s/\n/<br>\n/g; $system->{events}->[0] =~ s/\n/<br>\n/g; my $email_msg = "Test complete on station $station_num <br>\n<br>\ +n"; $email_msg .= "Report share [<a href=\"\\\\$reportconfig{ip}\\$rep +ortconfig{sharename}\">\\\\$reportconfig{ip}\\$reportconfig{sharename +}</a>] <br>\n"; $email_msg .= "Report share username [$reportconfig{username}] pas +sword [$reportconfig{password}] <br>\n<br>\n"; $email_msg .= "Testing Details:<br>\n"; $email_msg .= "Refurbished Drive values were ".$globalMessages[$sy +stem->{refurbished}->[0]]."<br>\n"; $email_msg .= "Jumbo Frames were ".$globalMessages[$system->{jumbo +}->[0]]."<br>\n"; $email_msg .= "10G NICs were ".$globalMessages[$system->{tengignic +}->[0]]."<br>\n"; foreach my $t (@{$system->{job}->[0]->{step}}) { if ($t->{enabled}->[0] == 1) { $email_msg .= "Test: ".$t->{name}->[0]."<br>\n"; if ($t->{name}->[0] =~ m/datavalidation/) { $email_msg .= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Duration: + ".$system->{job}->[0]->{datavalidationruntime}->[0]."<br>\n"; $email_msg .= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Iteration +s: ".$system->{job}->[0]->{datavalidationiterations}->[0]." <br>\n"; } } } my $color = "red"; if ($system->{status}->[0] =~ m/success/i) { $color = "green"; } $email_msg .= "<br>\n<b>Unit: ".$system->{hardware}->[0]." -- ".$s +ystem->{serial}->[0]." -- <font color=$color>".$system->{status}->[0] +."</font> -- ".$system->{ip}->[0]."</b><br>\n"; $email_msg .= "Service Key: ".$system->{servicekey}->[0]."<br>\n"; $email_msg .= "Report folder: <a href=\"\\\\$reportconfig{ip}\\$re +portconfig{sharename}\\".$system->{serial}->[0]."\\\">System report f +older</a><br>\n"; $email_msg .= "Report file: <a href=\"\\\\$reportconfig{ip}\\$repo +rtconfig{sharename}\\$system->{serial}->[0]\\".$system->{filename}->[ +1]."\">".$system->{filename}->[1]."</a><br>\n"; if ($system->{status}->[0] !~ m/success/) { #failure $email_msg .= "<b>Reason for failure:</b> " . $system->{reason +forfailure}->[0] . "<br>\n"; $email_msg .= "<b>System Health:</b><br>\n" . $system->{health +}->[0]; $email_msg .= "<b>Eventlog:</b><br>\n" . $system->{events}->[0 +]; } else { if (exists $system->{license}->[0]->{hash}) { if ($system->{license}->[0]->{result}->[0] eq "success") { $email_msg .= "Successfully set unit with license<br>\ +n"; $email_msg .= "<br>\n"; $email_msg .= "Licensed Features:<br>\n"; $email_msg .= "<table border='1' cellpadding='5'>\n"; foreach my $tag ("CI") { foreach my $type (keys %{$system->{license}->[0]-> +{hash}->[0]->{$tag}->[0]}) { my ($color, $value) = userColorValue($tag, $ty +pe); $email_msg .= "<tr><td>$system->{license}->[0] +->{hash}->[0]->{$tag}->[0]->{$type}->[3]</td><td><font color=$color>" +.$value."</font></td></tr>\n"; #data } } my @hashorder; foreach my $tag (keys %{$system->{license}->[0]->{hash +}->[0]}) { foreach my $type (keys %{$system->{license}->[0]-> +{hash}->[0]->{$tag}->[0]}) { push (@hashorder, [$tag, $type, $system->{lice +nse}->[0]->{hash}->[0]->{$tag}->[0]->{$type}->[3]]); } } @hashorder = sort {$a->[2] cmp $b->[2]} @hashorder; foreach (@hashorder) { my ($tag, $type, undef) = @$_; if ($tag ne "COM" and $tag ne "CI") { my ($color, $value) = userColorValue($tag, $ty +pe); $email_msg .= "<tr><td>$system->{license}->[0] +->{hash}->[0]->{$tag}->[0]->{$type}->[3]</td><td><font color=$color>" +.$value."</font></td></tr>\n"; #data } } $email_msg .= "</table>\n"; } else { $email_msg .= "Failed to set unit with license <br>\n" +; } } } my $subject = "StorTest Complete for station $station_num"; my @addresses = split(",",$emailconfig{"addresses$diagmode"}); for (my $a = 0; $a < @addresses; $a++) { if ($addresses[$a] !~ m/\@/) { $addresses[$a] .= "\@".$emailconfig{domain}; } } my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localti +me(); $year += 1900; my $mytimezone = qx"wmic timezone get Description"; #(UTC-05:00) E +astern Time (US & Canada) || (GMT+05:30) Chennai, Kolkata, Mumbai, Ne +w Delhi my $timezone = "-0000"; #default no offset foreach my $line (split("\n",$mytimezone)) { if ($line =~ m/\([UG][TM][CT]([+-]\d+:\d+)\)/) { $timezone = $1; $timezone =~ s/://; last; } } logLine("TIMEZONE: $timezone"); #Create an RFC compliant time stamp my $Date = sprintf("%s, %02d %3s %04d %02d:%02d:%02d %5s",$dayofwe +ek[$wday],$mday,$monthnames[$mon],$year,$hour - $isdst,$min,$sec,$tim +ezone); my $smtp = Net::SMTP->new(Host=>$emailconfig{server}, Hello=>$emai +lconfig{domain}, Timeout=>120, Debug=>0); if (not defined $smtp) { croak "Unable to connect to mailhost [$emailconfig{server}]"; } else { $smtp->mail("NOREPLY\@$emailconfig{domain}"); $smtp->to(@addresses); #start data to server $smtp->data(); #HEADER $smtp->datasend("From: NOREPLY\@$emailconfig{domain}\n"); $smtp->datasend("To: ".join(",",@addresses)."\n"); $smtp->datasend("Reply-To: NOREPLY\@$emailconfig{domain}\n"); $smtp->datasend("Date: $Date\n"); $smtp->datasend("Subject: $subject\n"); $smtp->datasend("MIME-Version: 1.0\n"); $smtp->datasend("Content-Type: multipart/mixed; boundary= \"*B +CKTR*\"\n"); $smtp->datasend("\n"); #end content block #MSG: $smtp->datasend("--*BCKTR*\n"); $smtp->datasend("Content-Type: ".$MIMEtype{html}[0]."; charset +=UTF-8\n"); $smtp->datasend("\n"); #end content block $smtp->datasend("$email_msg"); $smtp->datasend("\n"); #ATTACHMENTS my $path = "$reportconfig{sharedriveletter}:\\$system->{serial +}->[0]\\"; for (my $f = 1; $f < @{$system->{filename}}; $f++) { if (-e "$path$system->{filename}->[$f]") { logLine("attaching file $system->{filename}->[$f]"); $smtp->datasend("--*BCKTR*\n"); $smtp->datasend("Content-Type: ". $MIMEtype{substr($sy +stem->{filename}->[$f],index($system->{filename}->[$f],".") + 1)}[0] +."; name=\"$system->{filename}->[$f]\"\n");#; charset=binary $smtp->datasend("Content-Transfer-Encoding: ". $MIMEty +pe{substr($system->{filename}->[$f],index($system->{filename}->[$f]," +.") + 1)}[1] ."\n"); $smtp->datasend("Content-Disposition: attachment; file +name=\"$system->{filename}->[$f]\"\n"); $smtp->datasend("\n"); #end content block open (ATT, "< $path$system->{filename}->[$f]"); while (my $input = <ATT>) { if ($MIMEtype{substr($system->{filename}->[$f],ind +ex($system->{filename}->[$f],".") + 1)}[1] eq "base64") { $input = encode_base64($input); } $smtp->datasend($input); } close (ATT); $smtp->datasend("\n"); #separate each file with a new +line } } if ($system->{status}->[0] =~ m/fail/i) { $files{log}{file} =~ m/([a-zA-Z0-9\-\._]+)$/; my $logfile = $1; $smtp->datasend("--*BCKTR*\n"); $smtp->datasend("Content-Type: ".$MIMEtype{log}[0]."; name +=\"$logfile\"\n"); $smtp->datasend("Content-Transfer-Encoding: ". $MIMEtype{l +og}[1] ."\n"); $smtp->datasend("Content-Disposition: attachment; filename +=\"$logfile\"\n"); $smtp->datasend("\n"); #end content block open (ATT, "< $files{log}{file}"); while (my $input = <ATT>) { $smtp->datasend($input); } close (ATT); $smtp->datasend("\n"); #separate each file with a new line } # Send the END section break $smtp->datasend("--*BCKTR*--\n\n"); #end data to server $smtp->dataend(); #close connection to server (SEND) $smtp->quit; } }
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 browsing the Monastery: (5)
As of 2014-08-22 04:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (146 votes), past polls