genalt02.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional