http://qs321.pair.com?node_id=717762
Public ScratchpadDownload, Select Code To D/L
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();
}

[download]

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();

[download]

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;
    }
}

[download]