Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
This isn't very pretty:

Edit by tye to "hide" duplicate code

use Time::local; my $view = "cmtools_view"; my $ccdrive = $ENV{CC_DEFAULT_DRIVE}; my $file = "$ccdrive\\$view\\swf\\vobadmin\\vob_manager_.txt"; my $upsitesynckey = "SyncState ERLH"; my $downsitesynckey = "SyncState SCR"; my $upsitereplicakey = "Replica for ERLH"; my $downsitereplicakey = "Replica for SCR"; my @newtime; my $htmlpath='synccheck1.htm'; my $logfile='synccheck.log'; my $maxtime; my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5, Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11); #Define some colors... my $GRN="#00FF00"; my $YEL="#FFFF00"; my $RED="#FF0000"; my $GRY="#808080"; my $curcolor=$GRN; my %rephash; my $x; my $y; my @erlh; my @scr; open(TFILE2,">$htmlpath") || die "Can't open $htmlpath"; # Print the html header section. print TFILE2 <<WEB_PAGE; <html> <head> <meta http-equiv="Content-Language" content="en-us"> <meta http-equiv="Content-Type" content="text/html; charset=windows-12 +52"> <title>SyncCheck</title> </head> <body background="PrairieWind.bmp" bgcolor="#000000" text="#FFFFFF" li +nk="#FFFF00" vlink="#FFFF00"> <p>&nbsp;</p> <p align="center"><font face="Americana" size="5">Clearcase Sync Check + Summary</font></p> <p align="center"><font face="Americana" size="5"></font></p> <p align="left">&nbsp;</p> WEB_PAGE # Handle the "Last Update" my $time=localtime(time); print TFILE2 "<p align=\"center\"><font face=\"Americana\" size=\"4\"> +Last update: $time</font></p><br>\n"; open (FILE, "$file") || die "Can't open $file"; $tmp=<FILE>; foreach(split(/\t/,$tmp)){ push(@vobhashkeys, $_); } while (<FILE>) { $tmp=$_; @vobconfig=split(/\t/,$tmp); $idx=0; #Combine the two arrays into a hash. Taking the long way around, h +ere. foreach(@vobconfig){ $vobhash{$vobhashkeys[$idx]}=$_; $idx++; } #Clear out the arrays. @vobconfig=(""); # Get a more accurate vob tag. $vobname=$vobhash{"VOB-Tag"}; #If the syncstate of a site has an X or "EXPORT", Add its replica +to the list. if(uc($vobhash{$upsitesynckey}) eq "X" || uc($vobhash{$upsitesynck +ey}) eq "EXPORT"){ push(@replicas, $vobhash{$upsitereplicakey}); push +(@vobs, $vobname); } if(uc($vobhash{$downsitesynckey}) eq "X" || uc($vobhash{$downsites +ynckey}) eq "EXPORT"){ push(@replicas, $vobhash{$downsitereplicakey}) +; push(@vobs, $vobname); } %vobhash = (""); } close (FILE); foreach $replica (@replicas) { if ($replica =~ /scr/g || $replica =~ /princeton/g) { push (@scr, $replica); #print TFILE2 "<td><font color=\"$curcolor \">$replica</td>"; #print TFILE2 "<td><font color=\"$curcolor \">$durhours</td>"; } if ($replica =~ /erlh/g) { push (@erlh, $replica); #print TFILE2 "<td><font color=\"$curcolor\"> $replica &nb +sp; </td>"; #print TFILE2 "<td><font color=\"$curcolor\"> $durhours &nbsp +; </td>"; } } $idx=0; foreach $replica (@scr || @erlh) { $cmd="cleartool describe replica:$replica\@\\$vobs[$idx]"; $time=`$cmd`; $time =~ /last_export = /g; $time=substr($time, pos($time), length($time)-pos($time)); @timelocal = localtime(time); $day=substr($time, 0, 2); $mon=substr($time, 3, 3); $year="20".substr($time, 7, 2); $hour=substr($time, 10, 2); $min=substr($time, 13, 2); $sec=substr($time, 16, 2); # Convert the month abbreviation to a number (0-11). Use separate +variable. $mon = $month{$mon}; @newtime=($sec, $min, $hour, $day, $mon, $year, undef, undef, unde +f); $x=Time::Local::timelocal(@timelocal); $y=Time::Local::timelocal(@newtime); $z=$x-$y; my $durhours=int($z/3600); $z-=($durhours*3600); my $durmins=int($z/60); $z-=($durmins*60); my $dursecs=$z; if ($durhours < 3) { $curcolor = "$GRN"; } if ($durhours >= 3 && $durhours < 7 ) { $curcolor = "$YEL"; } if ($durhours > 7 ) { $curcolor = "$RED"; } if ($durhours > $maxtime) { $maxtime = $durhours; } if ($maxtime < 3) { $currentstatus = "OK"; } if ($maxtime >= 3 && $maxtime < 7 ) { $currentstatus = "WARN"; } if ($maxtime > 7 ) { $currentstatus = "ERROR"; } $idx++; } $idxa=0; print TFILE2 "<table width=\"75%\" border=\"1\">"; while ($idx > @scr || $idx > @erlh) { print TFILE2 " <tr>"; print TFILE2 "<td><font color=\"$curcolor \">$scr[$idx]</td>"; print TFILE2 "<td><font color=\"$curcolor \">$durhours</td>"; print TFILE2 "<td><font color=\"$curcolor\"> $erlh[$idx]</td>"; print TFILE2 "<td><font color=\"$curcolor\"> $durhours</td>"; print TFILE2 "</tr>"; print TFILE2 "</tr>"; $idxa++; } print TFILE2 "</table>"; &loghandler ($currentstatus); print "$currentstatus\n"; sub loghandler{ #Updates the log file with the current status. Adds hi +story line to page. my @logs; #Array to hold log entries my @currenttime; my $entryidx; #Index to the correct log entry. my $currentstatus=$_[0]; #Define some colors... my $GRN="#00FF00"; my $YEL="#FFFF00"; my $RED="#FF0000"; my $GRY="#808080"; my $curcolor=$GRN; # Get the log file open(LOGFILE,"$logfile") || die "Can't get $logfile"; $tmp=<LOGFILE>; #Ignore the first line. while(<LOGFILE>){ $tmp=$_; chomp($tmp); push(@logs, $tmp); } close(LOGFILE); # Calculate which entry to change and do it. @currenttime=localtime(time); $entryidx=($currenttime[2]*4)+int($currenttime[1]/15); $logs[$entryidx]=$currentstatus; #Add the timeline to the webpage. print TFILE2 "<p align=\"center\"><font color=\"#FFFF00\">History</p>< +font color=\"#FFFFFF\">\n"; print TFILE2 "<p align=\"center\"><pre>12A 1A 2A 3A 4A 5A 6A 7A + 8A 9A 10A 11A 12P 1P 2P 3P 4P 5P 6P 7P 8P 9P 10P 11P <br> +"; print TFILE2 "<p align=\"center\"><pre>| ' | ' | ' | ' | ' | ' | ' | ' + | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' | ' <br> +"; print TFILE2 "<p align=\"center\"><pre><font color=\"$curcolor\">"; #Re-generate the log file and add entries to the time line. open(LOGFILE,">$logfile") || die "Can't create $logfile"; print LOGFILE "$rgyerror errors in Clearcase registry. \n"; $x=0; foreach $entry (@logs) { if($x > $entryidx){ #RE-Define some colors... $GRN="#00A000"; $YEL="#A0A000"; $RED="#A00000"; $GRY="#808080"; } print LOGFILE "$entry\n"; if($entry eq "OK" && $curcolor ne $GRN){ print TFILE2 "<font color +=\"$GRN\">"; $curcolor=$GRN;} if($entry eq "WARN" && $curcolor ne $YEL){ print TFILE2 "<font col +or=\"$YEL\">"; $curcolor=$YEL;} if($entry eq "ERROR" && $curcolor ne $RED){ print TFILE2 "<font co +lor=\"$RED\">"; $curcolor=$RED;} if($entry eq "UNAVAILABLE" && $curcolor ne $GRY){ print TFILE2 "<f +ont color=\"$GRY\">"; $curcolor=$GRY;} print TFILE2 "*"; $x++; } close(LOGFILE); #Finally add the pointer to the current entry print TFILE2 "<p align=\"center\"><pre><font color=\"#FFFFFF\">"; for(0..$entryidx-1){print TFILE2 " ";} print TFILE2 "^ <br>"; print "Time: $currenttime[2]: $currenttime[1] Entry: $entryidx\n" ; } #End of Sub

In reply to Re: Re: Re: Re: A little help please by Hopeless
in thread What is a multidimensional array and how do I use one by Hopeless

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    [Eily]: :P, the search box is on the top left, or you can use Super Search
    [Corion]: jthebarg: There is the switch keyword if you want that, but maybe a dispatch table is closer.
    [Corion]: If by "case" you meant "case-insensitive ", see fc, uc and lc and perlop on the /i flag ;)
    Corion waves to virtualsue
    [virtualsue]: I have made a post for the first time in ... years
    [marto]: hey virtualsue!

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (15)
    As of 2017-09-26 13:41 GMT
    Find Nodes?
      Voting Booth?
      During the recent solar eclipse, I:

      Results (295 votes). Check out past polls.