Hopeless has asked for the wisdom of the Perl Monks concerning the following question:

Hello Everyone, I am new to PERL and programming in general and I am about to lose my mind. I have been working on this program for about 2 weeks and I still can't figure out what I am doing wrong. The main problem lies within the second WHILE loop(I think), I can't seem to figure out how to get it to reference the stuff in the rest of the script,it is supposed to take the value defined and print a color to the HTLM file depending on the length of time that has passed. It is probably something very simple that I am doing wrong, help at all will be appreciated. Sorry that this is such a mess but I really don't know what I am doing.
use Time::local; $ccdrive = $ENV{CC_DEFAULT_DRIVE}; $file = "whatever"; $upsitesynckey = "SyncState X"; $downsitesynckey = "SyncState Y"; $upsitereplicakey = "Replica for X"; $downsitereplicakey = "Replica for Y"; my @newtime; my $htmlpath='synccheck.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; 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">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(@hashkeys, $_); } while (<FILE>) { $tmp=$_; @config=split(/\t/,$tmp); $idx=0; #Combine the two arrays into a hash. Taking the long way around, h +ere. foreach(@config){ $vobhash{$hashkeys[$idx]}=$_; $idx++; } #Clear out the arrays. @config=(""); # Get a more accurate vob tag. $name=$hash{"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($hash{$upsitesynckey} +) eq "EXPORT"){ push(@replicas, $hash{$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); $idx=0; foreach $replica (@replicas) { $cmd="cleartool describe replica:$replica\@\\$vobs[$idx]"; $time=`$cmd`; $time =~ /last_export = /g; $time=substr($time, pos($time), length($time)-pos($time)); $idx++; @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); #print "$mon\n"; $x=Time::Local::timelocal(@timelocal); $y=Time::Local::timelocal(@newtime); $z=$x-$y; #print "$x $y $z\n"; my $durhours=int($z/3600); $z-=($durhours*3600); my $durmins=int($z/60); $z-=($durmins*60); my $dursecs=$z; #$rephash{$replica}=$durhours; #$rephash=("$replica"=>"$durhours","durhours"=>"$curcolor"); if ($durhours < 3) { $curcolor = "$GRN"; } if ($durhours >= 3 && $maxtime < 7 ) { $curcolor = "$YEL"; } if ($durhours > 7 ) { $curcolor = "$RED"; } if ($durhours > $maxtime) { $maxtime = $durhours; } %rephash=($replica=>"$curcolor"); #print "$rephash{$replica}\n"; if ($replica =~ /ABC/g) { push (@ABC, $replica); } if ($replica =~ /DEF/g || $replica =~ /whatever/g) { push (@DEF, $replica); } } $idx=0; $ref1 = @ABC; $ref2 = @DEF; print TFILE2 "<table width=\"75%\" border=\"1\">"; # while ($idx < @ABC || $idx < @DEF) { print TFILE2 " <tr>"; if ($idx1 <= $ref2) { #chomp($DEF[$idx]); #print TFILE2 "<font color=\"$rephash($DEF[$idx])\"><td>$vobs[ +$idx]</td>" ; print TFILE2 "<font color=\$rephash{$replica}\> <td> $rephash{ +$replica} $DEF[$idx]&nbsp</td>"; #print "%rephash{$DEF[$idx]}\n"; } if ($idx1 <= $ref1) { #chomp($ABC[$idx]); #print TFILE2 "<font color=\"$rephash($ABC[$idx])\"> <td> $vob +s[$idx] </td> "; print TFILE2 "<font color=\"$rephash($ABC[$idx])\"><td> $AB +C[$idx]&nbsp </td> "; } print TFILE2 "</tr>"; $idx++; } print TFILE2 "</table>";

Edit kudra, 2001-10-30 Changed title

Replies are listed 'Best First'.
(Ovid) Re: Desperatly seeking the wisdom of the Monks
by Ovid (Cardinal) on Oct 26, 2001 at 20:14 UTC

    Hopeless, yes, the code is a mess, but the situation is not as hopeless as your nick would imply. Before we can help you, we need to know what you are looking for. A quick check shows that your code compiles cleanly, so it's not an obvious syntax error. What we need to know is:

    • What sort of input is your script using? (a small sample, please)
    • What output do you want?
    • What output are you actually getting?

    Without clear information like that, most of the advice that we can offer is a shot in the dark. However, there are two pieces of advice that I can give right now. First, use strict. All competent Perl programmers will tell you that for a program of significant size, you should almost always be be using strict. Strict will allow you to catch a lot of the typos and other problems which might plague your code (and it did, when I used it for your program.

    Second, turn on warnings. If you are using a shebang line, add a -w to the shebang line:

    #!/usr/bin/perl -w

    If you are using Perl version 5.6 or better (I think that's when it was introduced), you can add "use warnings; to your code.

    Just turning on warnings in your code produced some interesting information:

    C:\temp>perl -wc Name "main::ccdrive" used only once: possible typo at lin +e 4. Name "main::name" used only once: possible typo at line 6 +8. Name "main::rephash" used only once: possible typo at lin +e 158. syntax OK

    As for the command line switches, -w enables warnings and -c tells Perl to compile the program without running it. This is a quick check to see if the program can even attempt to run.

    The first warning refers to this line:

    $ccdrive = $ENV{CC_DEFAULT_DRIVE};

    Since that variable is not used anywhere else in the program, I wonder if this is part of a feature you have not yet implemented?

    The second warning refers to this:


    Later, you have the following statement twice: push(@vobs, $vobname);. Since $vobname is not initialized anywhere, perhaps the initial assignment should have been to $vobname instead?

    The third warning is what may be causing your issue. It refers to the following line:

    print TFILE2 "<font color=\"$rephash($ABC[$idx])\"><td> $ABC[$idx] +&nbsp </td> ";

    Even though you've already declared a %rephash, it's not going to get recognized here because you need curly braces instead of parentheses. Also, &nbsp; needs a semicolon at the end. Here's a revision of that line:

    print TFILE2 "<font color=\"$rephash{$ABC[$idx]}\"><td> $ABC[$idx] +&nbsp; </td>";

    In a similar, previous line, you have an error that's not reported:

    print TFILE2 "<font color=\$rephash{$replica}\> <td> $rephash{$rep +lica} $DEF[$idx]&nbsp</td>";

    The problem there is that you put a backslash directly in front of the dollar sign. When you do that in a string, it tells Perl that you really wanted to print a dollar sign and didn't want the following variable interpolated. The following line is what you intended:

    print TFILE2 "<font color=\"$rephash{$replica}\"> <td> $rephash{$r +eplica} $DEF[$idx]&nbsp;</td>";

    Hope this helps.


    Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

Re: Desperatly seeking the wisdom of the Monks
by Albannach (Monsignor) on Oct 26, 2001 at 20:11 UTC
    Not Hopeless, but definitely "needs work". For starters, you will want to use strict; and use warnings; (or -w depending on the age of your Perl). This and some careful thinking of where you use your variables (and where you don't) should go a long way to clearing up your confusion.

    A quick look did reveal that you never assign to $idx1 so that part of your last loop probably isn't doing what you think it is. That loop also refers to $replica which is the loop variable from the previous foreach and also not likely what you want as it will always just be the last element in @replicas. You also use $rephash(stuff) in that loop when you need to use {} as you have declared it as a hash. Again, you need to step back a bit and figure out just what you are doing with all these variables.

    There are lots of other things that could be done to make this more Perlish, but you need to get your logic straight first.

    I'd like to be able to assign to an luser

Oh my, code overload
by cfreak (Chaplain) on Oct 26, 2001 at 20:14 UTC
    I think I'd have to pour over this code awhile to figure out exactly what it is that's going wrong. I did notice one thing though.
    open (FILE, "$file") || die "Can't open $file"; $tmp=<FILE>; foreach(split(/\t/,$tmp)){ push(@hashkeys, $_); } while (<FILE>) { $tmp=$_;

    The problem here is that you've slurpped the file into $tmp. So it can't read it again in your while loop unless you add the like:


    That will start reading again at the beginning of FILE. That should allow you to loop through the contents of the file using while.

    That said I think you are making this problem much harder than it should be. I do have a couple of questions though: You said that you were trying to change the colors of the page based on the amount of time that had passed. Time since what? Since the page was last accessed? Since it was updated?

    Either way it sounds like you could benefit from HTML::Template (availiable from CPAN). Here's a short example that would change the background color based on the time of day:

    #!/usr/bin/perl use strict; # Should always use this use HTML::Template; # Loads the HTML::Template module my $template = HTML::Template->new(filename=>"htmlbackground.tmpl"); my $hour = (localtime)[3]; my $bgcolor; if($hour < 12) { $bgcolor = "#00ff00"; # Green for the morning } elsif($hour == 12) { $bgcolor = "#0000ff"; # blue for noon } else { $bgcolor = "#ff0000"; # red for afternoon } # Set the template's variables to the varibles in the script $template->param(bgcolor=>$bgcolor); #Print the template out print "Content-type:text/html\n\n"; print $template->output(); exit;

    Then in a separate HTML file called htmlbackground.tmpl:

    <html><body bgcolor="<tmpl_var name=bgcolor>"> Hey I can change the background!</body></html>

    When you call the script it substitutes <tmpl_var name=bgcolor> for the background color variable based on the time of day. If you would prefer to save it as a static file simply open a new file and print the template's contents to it rather than to STDOUT (which in this case is the webserver).

    Hope that helps

      No, that's wrong. "Slurp mode" is only in effect when $/ has been localized or otherwise set to an undefined value. A filehandle READLINE in scalar context only reads a single line. seek is unnecessary, and is, in fact, probably counterproductive.

      It looks to me like the OP has a tab-delimited flatfile. The first line probably lists the headers. The code grabs the field names from the first line with the first read to use as hash keys. Then it loops through the rest of the lines -- the actual data. It's not the most beautiful idiom, but it's valid code, if this is actually the poster's intent.

        Yeah, that sounds like what I am trying to do
      I am comparing sync times for files that are replicated in different locations, I compare the time of the last import/export to the system clock and based on the result the name of the replica returns Green < 3(hours), Yellow (3-7 hours) or Red(greater than 7 hours). It will do this if I take out the second while loop but then I can't separate the 2 different sites($ABC & $DEF) and print them in nice orderly columns that are pleasing to the eye. I hope that helps clear up some things
Re: Desperatly seeking the wisdom of the Monks
by earthboundmisfit (Chaplain) on Oct 26, 2001 at 21:05 UTC
    Let's take one piece of your code and rewrite it a bit:
    open (FILE, "$file") || die "Can't open $file"; $tmp=<FILE>; foreach(split(/\t/,$tmp)){ push(@hashkeys, $_); }
    This takes only the first line of the file. I think what you want is:
    my @hashkeys; open (FILE, "$file") || die "Can't open $file"; my @lines=<FILE>; foreach my $line (@lines){ my @fields = (split(/\t/,$line){ push(@hashkeys, $fields[0]); # or perhaps it's some ot +her # field you want? }
    This isn't meant as a definitive answer but merely a small illustrative example to help you sort out exactly what you want to do