Generated: Tue Feb 2 17:54:58 2010 from tidycmp.pl 2006/09/24 6 KB.
#!/Perl # tidycmp.pl # AIM: To DOWNLOAD the accessibility table from the web site # http://www.aprompt.ca/Tidy/accessibilitychecks.html # and compare its contents to Tidy's accesscases.txt use strict; use warnings; use LWP::Simple; require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file and some other utility subs require "htmltools.pl" or die "Missing htmltools.pl ...\n"; my $download = 0; # log file stuff my ($LF); my $outfile = 'temp'.$0.'.txt'; my $outfil1 = 'temp1'.$0.'.htm'; # program variables my $site = 'http://www.aprompt.ca/Tidy/'; my $URL = $site . 'accessibilitychecks.html'; my $in_file = 'F:\Gtools\tidyproj\accesscases.txt'; my $in_folder = 'F:/Gtools/tidyproj/tidycvs6/test/accessTest/'; my $out_folder = 'tmp5'; # and output FOLDER my @tests = (); my $text = ''; my $tcnt = 0; my @arr = (); my $dtext = ''; my $line = ''; my @lines = (); my $tln = ''; my $tlcnt = 0; my @mdarr = (); my @hrefs = (); my $thrftxt = ''; my $lhrftxt = 0; my $thrffil = ''; open_log($outfile); prt( "$0 ... Hello, World...\n" ); if ($download) { prt("Fetching text from $URL ...\n"); $text = get("$URL"); $tcnt = length($text); prt( "Got $tcnt characters from URL $URL ...\n"); @arr = split("\r", $text); $dtext = join( "\r\n", @arr ); ##write2file($dtext,$outfil1); } else { open INF, "<$outfil1" or mydie( "ERROR: Unable to open [$outfil1] ... $1\n" ); @arr = <INF>; # slurp it all close INF; } prt("Openning the compare file [$in_file] ...\n"); open INF, "<$in_file" or mydie( "ERROR: Unable to open [$in_file] ... $1\n" ); my @tmp = <INF>; # slurp it all close INF; prt( "Got ".scalar @tmp." from $in_file ... putting into a mutlti-dimensional ...\n" ); foreach $line (@tmp) { $tln = trimall($line); if (length($tln)) { push(@lines, $tln); my @ts = split(" ",$tln); if (scalar @ts == 3) { push(@mdarr, [ $ts[0], $ts[1], $ts[2], 0 ]); } else { prt( "WARNING: [$tln] did not split correctly ...\n" ); } } } $tlcnt = scalar @mdarr; prt( "Got $tlcnt (".(scalar @lines).") from $in_file ...\n" ); for (my $i3 = 0; $i3 < $tlcnt; $i3++) { my $msg = $mdarr[$i3][0] . ' ' . $mdarr[$i3][1] . ' ' . $mdarr[$i3][2]; ###prt( "$msg\n" ); } ###my $etext = htmlexpand($text); ###my $ctext = htmlcleanall($etext); ##open WOF, ">$outfil1" or mydie("ERROR: Unable to open $outfil1 - $!\n"); my $lcnt = scalar @arr; prt( "Processing $lcnt lines ...\n" ); # expect # Error number [13.2.1.3] - Priority 2 # or # Warning number [7.4.1.1] - Priority 2 # Warning number [1.1.1.2] - Priority 1 # All images require text equivalents but "alt" text must also meet ... # # Testfile 1.1.1.f2: suspicious "alt" text (filename) # View testfile source = link # Testfile = link my $cnt = 0; my $we = ''; my $test = ''; my $lev = 0; my $href = ''; my $href2 = ''; my $flip = 0; foreach $line (@arr) { ## print WOF $line."\n"; $tln = trimall($line); $tln = removetag($tln, 'b'); $tln = removetag($tln, 'br'); ##if ($line =~ /(Error|Warning)\s+\[(\d+\.\d+\.\d+\.\d+)\]\s+-\s+Priority\s+(\d{1})/) { ##if ($tln =~ /(Error|Warning)\s+number\s+/i) { ##if ($tln =~ /(Error|Warning)\s+number\s+\[(.*)\]/i) { if ($tln =~ /(Error|Warning)\s+number\s+\[(.*)\].+Priority\s+(\d+)/i) { $cnt++; $we = $1; $test = $2; $lev = $3; ##prt( "[$2] $tln\n" ); ##prt( "$cnt [$we] [$test] [$lev]\n" ); push(@tests, [$test, $lev, $we]); $flip = 0; } elsif ($tln =~ /href=["'](\S+)["']./i ) { if ($cnt) { my $hrf = $1; if ($flip) { if ($flip == 1) { $href = $site . $hrf; $thrftxt = get($href); $lhrftxt = length($thrftxt); if ($lhrftxt) { $thrffil = $test; $thrffil =~ s/\./-/g; $thrffil = $out_folder . '/' . $thrffil . '.html'; $thrftxt =~ s/\r/\r\n/gm; write2file( $thrftxt, $thrffil ); prt( "Test HREF=\"$href\" length $lhrftxt ... written [$thrffil]\n" ); } else { prt( "Test HREF=\"$href\" length is ZERO - CHECK ME! ...\n" ); } } else { prt( "CHECK ME HREF=\"$hrf\"\n" ); } } else { $href2 = $hrf; prt( "View HREF=\"$href2\"\n" ); } $flip++; } } } my $tcnt = scalar @tests; prt( "Got $tcnt test sets ...\n" ); ##close WOF; my $fnd = 0; for (my $i = 0; $i < $tcnt; $i++) { $we = $tests[$i][2]; $test = $tests[$i][0]; $lev = $tests[$i][1]; $fnd = test_in_lines($test); my ($tf, $tff); #foreach $line (@lines) { # $tln = trimall($line); # if ($tln =~ /\s$test\s/) { # $fnd = 1; # last; # } #} $tf = $test; $tf =~ s/\./-/g; $tff = $in_folder . $tf . ".html"; if ($fnd) { $tln = $lines[$fnd-1]; ###my $tf = $mdarr[$fnd-1][0]; my $tc = $mdarr[$fnd-1][1]; ###my $tff = $in_folder . "\\" . $tf . ".html"; if (-f $tff) { prt( "[$test] [$lev] [$tln] [$tc] ok\n" ); } else { prt( "[$test] [$lev] [$tln] [$tc] missing [$tff]?\n" ); } } else { if (-f $tff) { prt( "NOT FOUND [$test] [$lev] BUT found [$tff]\n" ); } else { prt( "NOT FOUND [$test] [$lev]\n" ); } } } ##system($outfil1); close_log($outfile,1); exit(0); ### file test level ### push(@mdarr, [ $ts[0], $ts[1], $ts[2], 0 ]); sub test_in_lines { my ($tst) = shift; my $f = 0; my $ct = 0; my $ln = ''; ###prt( "Finding [$tst] ...\n" ); for (my $i2 = 0; $i2 < $tlcnt; $i2++) { $ct++; ##my $ts = $mdarr[$i2][1]; ##prt( "Compare with [$ts] ...\n" ); if ($mdarr[$i2][1] eq $tst) { $f = $ct; last; } } return $f; } sub test_in_lines_ok { my ($tst) = shift; my $f = 0; my $ct = 0; my $ln = ''; foreach $ln (@lines) { $ct++; $ln = trimall($ln); if ($ln =~ /\s$tst\s/) { $f = $ct; last; } } return $f; } sub trimall { my ($ln) = shift; chomp $ln; $ln =~ s/\r$//; $ln =~ s/\t/ /g; while ($ln =~ /\s\s/) { $ln =~ s/\s\s/ /g; } while ($ln =~ /^\s/) { $ln = substr($ln,1); } while ($ln =~ /\s$/) { $ln = substr($ln,0, length($ln) - 1); } return $ln; } # eof - tidycmp.pl