Generated: Mon Aug 16 14:14:20 2010 from genalt02.pl 2010/03/20 6.6 KB.
#!/perl -w # NAME: genalt02.pl # AIM: Complete re-write of genalt.pl # 2010/03/20 - geoff mclane - http://geoffair.net/mperl/ use strict; use warnings; use File::Basename; use Cwd; unshift(@INC, 'C:\GTools\perl'); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_dir = 'C:\GTools\perl'; my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 1; ### program variables my @warnings = (); my $cwd = cwd(); my $in_file = 'C:\HOMEPAGE\FG\Downloads\aircraft-2.0.0\index.html'; my $out_file = $perl_dir."\\tempout.htm"; # debug my $dbg38 = 0; # prt( "[dbg38] Got [$lck] = [$txt] [$fil]\n" ) if ($dbg38); my $dbg39 = 0; # prt( "[dbg39] Got [$lck] = [$txt] - no inverted commas! [$fil]\n" ) if ($dbg39); sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ); } } sub get_img_hash_ref_lc($$$) { my ($fank,$fil,$dbg) = @_; my %hash = (); my ($ank,$len,$i,$ch,$pc,$hr2,$txt); my ($lck); if ($fank =~ /<img\s+(.+)>$/i) { $ank = trim_all($1); $len = length($ank); $ch = ''; $hr2 = ''; for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($ank,$i,1); if ($ch =~ /\w/) { $hr2 .= $ch; # accumulate \w chars - alphanumeric, including _ } elsif (length($hr2)) { if (($ch ne '=') && ($ch =~ /\s/)) { $i++; for (; $i < $len; $i++) { $ch = substr($ank,$i,1); last if ($ch eq '='); last if !($ch =~ /\s/); } } if ($ch eq '=') { # found our equal sign $i++; # move on... for (; $i < $len; $i++) { $ch = substr($ank,$i,1); last if ($ch =~ /('|")/); last if !($ch =~ /\s/); } if (($ch eq '"')||($ch eq "'")) { $pc = $ch; $i++; # move on... $txt = ''; for (; $i < $len; $i++) { $ch = substr($ank,$i,1); last if ($ch eq $pc); $txt .= $ch; } if ($ch eq $pc) { $lck = lc($hr2); $hash{$lck} = $txt; prt( "[dbg38] Got [$lck] = [$txt] [$fil]\n" ) if ($dbg38); } else { prtw("PROBLEM: got [$hr2]. At pos $i in [$ank], from [$fank], and NO END INVERTED COMMA! ($pc) [$fil]\n"); pgm_exit(1,"") if ($dbg); } } else { if (($ch =~ /\w/) && (($hr2 =~ /name/i)||($hr2 =~ /id/i))) { # accept these WITHOUT inverted comma $txt = $ch; $i++; # MOVING ON for (; $i < $len; $i++) { $ch = substr($ank,$i,1); last if !($ch =~ /\w/); $txt .= $ch; } $lck = lc($hr2); $hash{$lck} = $txt; prt( "[dbg39] Got [$lck] = [$txt] - no inverted commas! [$fil]\n" ) if ($dbg39); } else { prtw("PROBLEM: got [$hr2]. At pos $i in [$ank], from [$fank], and NO START INVERTED COMMA! [$fil]\n"); pgm_exit(1,"") if ($dbg); } } } else { prtw("PROBLEM: got [$hr2]. At pos $i in [$ank], from [$fank], and NO EQUAL SIGN! [$fil]\n"); pgm_exit(1,"") if ($dbg); } $hr2 = ''; } } } return \%hash; } sub process_file($) { my ($fil) = @_; if (!open INF, "<$fil") { prt("ERROR: Can NOT open [$fil] file! Check name, location...\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Doing $lncnt lines, from [$fil]...\n"); my @newarr = (); my ($i,$line,$tline,$icnt,$img,$len,$ch,$head,$tail,$rh,$none,$lnn); my ($last); $icnt = 0; $none = 0; $lnn = 0; for ($i = 0; $i < $lncnt; $i++) { $line = $lines[$i]; $lnn++; $tline = trim_all($line); if ($line =~ /(.*)<img\s+(.*)/i) { $head = $1; $tail = $2; $icnt++; $last = ''; if ( $tail =~ />/ ) { push(@newarr,$line); } else { push(@newarr,$line); $i++; for (; $i < $lncnt; $i++) { $line = $lines[$i]; $lnn++; $tail .= $line; $last = $line; last if ($tail =~ />/); push(@newarr,$line); } $tline = trim_all($head."<IMG ".$tail); prt("$tline\n"); $rh = get_img_hash_ref_lc($tline,$fil,1); if (!defined ${$rh}{'alt'}) { $none++; if (defined ${$rh}{'src'}) { push(@newarr,$head.'alt="'.${$rh}{'src'}.'"'."\n"); } else { prtw("WARNING:$lnn: got <IMG, but NO 'src='!\n"); } } push(@newarr,$last) if (length($last)); } } else { push(@newarr,$line); } } prt("Got $icnt IMG tags... $none with NO 'alt' attributes...\n"); return \@newarr; } ######################################### ### MAIN ### prt( "$pgmname: in [$cwd]: Hello, World...\n" ); prt("Processing $in_file...\n"); my $ref_arr = process_file($in_file); my $new_txt = join("",@{$ref_arr}); $new_txt .= "\n"; write2file($new_txt,$out_file); pgm_exit(0,"Written [$out_file]...Normal exit(0)"); ######################################## # eof - template.pl