imgalt02.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:42 2010 from imgalt02.pl 2006/11/27 24.2 KB.

#!/Perl
# imgalt02.pl - 2006.11.24 - geoff mclane (geoffmclane.com)
# AIM: To extract the <img alt="..." atribute of each image,
# in all (both) English and French version ...
# Read a JetPhoto, fix each entry in the 
# studio.plist XML file ... each has to be inserted as 
# <key>Description</key>
# <string>English description ... French Description</string>
# and save the new studio.plist file ...
# =====================================================================
use strict;
require 'logfile.pl' or die "ERROR: Can NOT load logfile.pl ...\n";
require 'htmltools.pl' or die "ERROR: Can NOT load htmltools.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
# user variable
my $def_folder = 'C:\HOMEPAGE\P26\travel'; 
# Default JetPhoto configuration XML file ...
my $def_studio = 'C:\Documents and Settings\Geoff McLane.PRO-1\My Documents\My Photo Albums\Photo Album 2006-11-24.album\studio.data\studio.plist';
# Image descriptions to come from HTML files
my $def_input1 = $def_folder . '\tunisia.htm';
my $def_input2 = $def_folder . '\tunisfr2.htm';
# Output, until sure it works ...
my $def_output = 'temp.studio.pfile.txt';
my $mincomp   = 3;   # to match, must match more than this
my $addtr = 0;
my $dosubs = 0; # modify in3 file, changing the alt text, and write out3
my @trtable = ();
my @tlines = ();
my @langarr = ();
# debug
my $dbg1 = 0; # show length after adjustments
my $dbg2 = 0; # show 'other' tags
my $dbg3 = 0; # show collections phase
my $dbg4 = 0; # show sub collection phase especially 'src' and 'alt'
my $dbg4a = 0; # show all tags, attribs and values
my $dbg5 = 0; # show the text collection
my $dbg6 = 0; # show substitution
my $dbgshw = 0;   # output while processing, sorting attibute list ...
my $dbgrpt = 0; # show the EXPECTED repeat items ...
my $dbgist = 0; # show is_same_tag in details ..
my $dbgtags = 0; # show tags as found 
my $dbgnalt = 0; # show the NEW combined alt string as stored
my $dbgcalt = 0; # show the NEW @combalt list
my $dbg10 = 0;
# program variables
my $line = '';
my @lines = ();
my @frlines = ();
my @xml_lines = ();
my $cnt = 0;
my $txt = '';
my $ccnt = 0;
my $newtxt = '';
my @attlist = ();
my @altlist = ();
my @combalt = ();
my @newxml = ();
my $in_file1 = $def_input1;
my $in_file2 = $def_input2;
my $in_studio = $def_studio;
my $out_file = $def_output;
my $htm_head = <<"EOF";
<html>
<head>
<title>Alt List</title>
</head>
<body>
<table border="2">
EOF
my $htm_tail = <<"EOF";
</table>
</body>
</html>
EOF
## $in_file = pop @ARGV if (@ARGV);
## $out_file = pop @ARGV if (@ARGV);
prt( "Got input from [$in_file1], and [$in_file2],\nXML in [$in_studio], out to [$out_file] ...\n" );
if ( ! -f $in_file1) {
   mydie("OOPS: Can NOT locate [$in_file1] ...\n");
}
if ( ! -f $in_studio) {
   mydie("OOPS: Can NOT locate [$in_studio] ...\n");
}
if ( ! -f $in_file2) {
   mydie("OOPS: Can NOT locate [$in_file2] ...\n");
}
###if ($addtr) {
###   load_existing_table($tr_file);
###}
sub load_htm_file {
   my ($file, $num) = @_;
   open IF, "<$file" or mydie("OOPS: Can NOT open [$file] ...\n");
   @lines = <IF>;   # slurp it all in
   close IF;
   $cnt = scalar @lines;
   prt("Processing $cnt lines from [$file] ...\n");
   $txt = join("\n", @lines);
   $ccnt = length($txt);
   prt("Or $ccnt characters from [$file] ...\n");
   extract_img_alts( $txt, $file );
   prt( "Done [$file] ...\n\n" );
}
sub is_same_tag {
   my ($tg1, $tg2) = @_;
   my @arr = ();
   if ($tg1 eq $tg2) {
      return 1;
   }
   prt( "Comparing [$tg1] with [$tg2] ...\n" ) if ($dbgist);
   if ($tg1 =~ /^<\//) {
      $tg1 = substr($tg1, 2);
   } else {
      $tg1 = substr($tg1, 1);
   }
   if ($tg2 =~ /^<\//) {
      $tg2 = substr($tg2, 2);
   } else {
      $tg2 = substr($tg2, 1);
   }
   prt( "Modified [$tg1] with [$tg2] ...\n" ) if ($dbgist);
   if ($tg1 eq $tg2) {
      return 1;
   }
   if ($tg1 =~ /\s/) {
      @arr = split(/\s/, $tg1);
      $tg1 = $arr[0];
   } else {
      $tg1 = substr($tg1,0, length($tg1) - 1);
   }
   if ($tg2 =~ /\s/) {
      @arr = split(/\s/, $tg2);
      $tg2 = $arr[0];
   } else {
      $tg2 = substr($tg2,0, length($tg2) - 1);
   }
   prt( "2nd Mod [$tg1] with [$tg2] ...\n" ) if ($dbgist);
   if ($tg1 eq $tg2) {
      return 1;
   }
   return 0;
}
sub extract_img_names {
   my ($tx, $fi) = @_;
   my $tl = length($tx);
   my ($i, $ch, $tag, $val, $ptag, $ptag2, $popt, $lnnum, $tc);
   $val = '';
   $ptag = '';
   $popt = '';
   $ptag2 = '';
   my @tags = ();
   $lnnum = 0;
   my $indict = 0;
   my $haditms = 0;
   my $keytg = 0;
   my $inarray = 0;
   my $nxtisfile = 0;
   my $nxtisdesc = 0;
   my $filename = '';
   my $description = '';
   my $newdesc = '';
   my $haddesc = 0;
   foreach $tx (@xml_lines) {
      $lnnum++;
      $tl = length($tx);
      for ($i = 0; $i < $tl; $i++) {
         $ch = substr($tx,$i,1);
         if ($ch eq '<') {
            $tag = get_tag( substr($tx,$i) );
            if ($tag =~ /^<\//) {
               if ($tag eq '</dict>') {
                  if ($inarray) {
                     if ($haddesc) {
                        prt( "Had desc [$newdesc]\n" ) if ($dbg10);
                        $haddesc = 0;
                     } else {
                        if (length($newdesc)) {
                           prt( "INSERT DESC [$newdesc]\n" );
                           push(@newxml, "        <key>Description</key>\n"); # add <key> line
                           push(@newxml, "        <string>$newdesc</string>\n");
                        } else {
                           prt( "WARNING NO DESCRIPTION for [$filename]\n" );
                        }
                     }
                  }
                  $indict = 0;
                  $keytg = 0;
               } elsif ($tag eq '</array>') {
                  $inarray = 0;
               }
               if (@tags) {
                  $popt = pop @tags;
               } else {
                  $popt = '<NONE!>';
               }
               $tc = scalar @tags;
               if ( is_same_tag( $tag, $popt ) ) {
                  prt( "ln=$lnnum:$i: close $popt [$val] $tag ok ($tc) [$inarray:$indict:$keytg]\n" ) if ($dbgtags);
               } else {
                  if (is_same_tag( $ptag, $popt )) {
                     prt( "ln=$lnnum:$i: close $popt [$val] $tag PREVIOUS ok ($tc) [$inarray:$indict:$keytg]\n" );
                  } else {
                     prt( "ln=$lnnum:$i: close $popt [$val] $tag [$ptag] DIFFERENT? ($tc) [$inarray:$indict:$keytg]\n" );
                  }
               }
               if ($nxtisdesc) {
                  prt("Got OLD description [$val]\n" );
                  if (length($newdesc)) {
                     $tx = "        $popt$newdesc$tag\n";
                  }
                  $nxtisdesc = 0;
                  $haddesc = 1;
               }
               if ($nxtisfile) {
                  $filename = $val;
                  $newdesc = get_comb_desc($filename);
                  if (length($newdesc)) {
                     prt("Got file name [$val] with NEW desc\n" );
                  } else {
                     prt("WARNING: FAILED description for file [$val]!\n" );
                  }
                  $nxtisfile = 0;
               } 
               if (($tag eq '</key>') && $inarray && $indict && $keytg) {
                  if ($val =~ /^File$/i) {
                     $nxtisfile = 1;
                  } elsif ($val =~ /^Description$/i) {
                     $nxtisdesc = 1;
                  }
               } 
               if ($tag eq '</string>') {
                  $keytg = 0;   # end string = used <key> tag
               }
            } else {
               $ptag2 = $ptag; # keep the PREVIOUS
               $ptag = $tag;
               if ($tag eq '<dict>') {
                  $indict = 1;
               } elsif ($tag eq '<key>') {
                  $keytg = 1;
               } elsif ($tag eq '<array>') {
                  $inarray = 1;
               }
               push(@tags, $tag);
               $tc = scalar @tags;
               prt( "ln=$lnnum:$i: tag=$tag [$val] ($tc) [$inarray:$indict:$keytg]\n" ) if ($dbgtags);
            }
            $i += (length($tag) - 1) if (length($tag));
            $val = '';
         } else {
            if ($ch =~ /\s/) {
               $val .= ' ';
            } else {
               $val .= $ch;
            }
         }
      }
      push(@newxml, $tx); # add this line to the NEW xml file
   }
   if(@tags) {
      $tl = scalar @tags;
      $val = join(' ', @tags);
      if ($tl == 1) {
         prt( "One remaining in \@tags ...[$val]...as there should be for XML ...\n" );
      } else {
         prt( "WARNING: Remaining $tl in \@tags ...[$val] ...\n" );
      }
   }
   $tl = scalar @newxml;
   prt( "Got $tl lines for NEW XML ...\n" );
}
sub load_xml_file {
   my ($file) = @_;
   open IF, "<$file" or mydie("OOPS: Can NOT open [$file] ...\n");
   @xml_lines = <IF>;   # slurp it all in
   close IF;
   $cnt = scalar @xml_lines;
   prt("Processing $cnt lines from -\n[$file] ...\n");
   $txt = join("\n", @xml_lines);
   $ccnt = length($txt);
   prt("Or $ccnt characters ...\n");
   extract_img_names( $txt, $file );
   prt( "Done [$file] ...\n\n" );
}
load_htm_file( $in_file1 );
load_htm_file( $in_file2 );
prt( "\nShow of attribute list collected ...\n" );
show_att_list();
show_alt_list();
load_xml_file($in_studio);
write_new_xml($out_file);
#$ccnt = length($newtxt);
#write_out_file($newtxt, $out_file);
#system($out_file);
close_log($outfile,1);
exit(0);
# ###############################################
# all subs below
# ##############
sub do_substitution {
   my $lc = scalar @langarr;
   my ($i, $img, $eng, $fr, $j, $c, $d, $imtag, $im2);
   my $frhtm = join('', @frlines);
   my $tl = length($frhtm);
   prt( "Attempting $lc substitutions ... in $tl htm chars...\n" );
   my $fnd = 0;
   my $newfr = ''; # accumulate into here
   for ($i = 0; $i < $lc; $i++) {
      $img = $langarr[$i][0];
      $eng = $langarr[$i][1];
      $fr  = $langarr[$i][2];
      $imtag = '';
      $d = '';
      $fnd = 0;
      $newfr = '';
      $tl = length($frhtm);
      prt( "\nText length now $tl characters ...\n" ) if ($dbg6);
      for ($j = 0; $j < $tl; $j++) {
         $c = substr($frhtm,$j,1);
         if ($d eq '<') {
            if ($c eq "\n") {
               if (substr($imtag,-1) =~ /\s/) {
                  $c = '';
               } else {
                  $c = ' ';
               }
            }
            $imtag .= $c;
            if ($c eq '>') {
               $d = $c;
               if ($imtag =~ /^<img.+/) {
                  $imtag = trimall($imtag);
                  if ($imtag =~ /src=['"](.+?)['"]/i) {
                     $im2 = $1;
                     if ($im2 eq $img) {
                        if ($imtag =~ /alt=['"](.+?)['"]/i) {
                           substr($imtag, index($imtag,$1),length($1),$fr);
                           prt( "Change [$1] to [$fr] ..\n" ) if ($dbg6);
                           prt( "$imtag\n" ) if ($dbg6);
                           $fnd = 1;
                        }
                        $newfr .= $imtag; # add in this block
                        last;
                     }
                  }
               }
               $newfr .= $imtag; # add in this block
            }
         } elsif ($c eq '<') {
            $imtag = $c;
            $d = $c;
         } else {
            $newfr .= $c;
         }
      }
      ##############################################################
      if (!$fnd) {
         prt( "Did not find [$img] ...\n" );
      } else {
         $j++ if ($j < $tl);
         $newfr .= substr($frhtm, $j) if ($j < $tl); # use the NEW text
         $frhtm = $newfr;
      }
   }
   return $frhtm;
}
sub get_table_block {
   my ($tn) = shift; # table number
   my $lc = scalar @tlines;
   my ($l, $i, $c, $tg, $d, $ln, $ll);
   my $tbl = '';
   my $tc = 0;
   my $in_tbl = 0;
   $d = '';
   for ($l = 0; $l < $lc; $l++) {
      $ln = $tlines[$l]; # entract a line
      $ln = trimall($ln); # clean it up
      $ll = length($ln);
      if ($ll && $in_tbl && (length($tbl))) {
         $c = substr($tbl,-1);
         if ( !(($c =~ /\s/)||($c eq '>')) ) {
            $tbl .= ' ';
         }
      }
      for ($i = 0; $i < $ll; $i++) {
         $c = substr($ln,$i,1);
         $tbl .= $c if ($in_tbl);
         if ($d eq '<') {
            $tg .= $c;
            if ($c eq '>') {
               # got a tag
               if ($tg =~ /<table.*?>/i) {
                  $tc++;
                  if ($tn == $tc) {
                     $in_tbl = 1;
                  }
               } elsif ($tg =~ /<\/table>/i) {
                  if ($in_tbl) {
                     $tbl = substr($tbl, 0, length($tbl) - length($tg));
                  }
                  $in_tbl = 0;
               }
               $d = '';
            }
         } elsif ($c eq '<') {
            $tg = $c;
            $d = $c;
         }
      }
   }
   return $tbl;
}
sub load_existing_table {
   my ($fil) = shift;
   my $ln = '';
   my $rows = 0;
   my $cols = 0;
   my $in_row = 0;
   my $in_td = 0;
   my $img = '';
   my $eng = '';
   my $fr = '';
   if ( ! -f $fil) {
      mydie( "ERROR: Unable to locate exisitng [$fil] file ... $! ...\n" );
   }
   open INF, "<$fil" or mydie( "ERROR: Unable to OPEN exisitng [$fil] file ... $! ...\n" );
   @tlines = <INF>;
   close INF;
   prt( "Got " . scalar @tlines . " lines from file [$fil] ...\n" );
   my $tt = get_table_block(1);
   ##prt( "Table block = [$tt]\n" );
   #$tt = tag2newline($tt, 'caption');
   #$tt = tag2newline($tt, 'tr');
   #$tt = tag2newline($tt, 'th');
   #$tt = tag2newline($tt, 'td');
   #$tt = trimblanklines($tt);
   #prt( "\nTable block 2 = \n[$tt]\n" );
   $tt = alltags2newline($tt);
   ##prt( "\nTable block 3 = \n[$tt]\n" );
   @tlines = split("\n",$tt);
   prt( "Got " . scalar @tlines . " table lines ...\n" );
   foreach $ln (@tlines) {
      $ln = trimall($ln);
      if ($ln =~ /<tr.*>/i) {
         $rows++;
         $in_row = 1;
         $cols = 0;
      } elsif ($ln =~ /<th.*>/i) {
         # ignore these
         $cols = 0;
      } elsif ($ln =~ /<caption.*>/i) {
         # ignore
         $cols = 0;
      } elsif ($ln =~ /<td.*>/i) {
         $cols++;
         $in_td = 1;
      } elsif ($ln =~ /<\/caption>/i) {
         # ignore this
         $cols = 0;
      } elsif ($ln =~ /<\/th>/i) {
         # ignore
         $cols = 0;
      } elsif ($ln =~ /<\/tr>/i) {
         $in_row = 0;
         $cols = 0;
      } elsif ($ln =~ /<\/td>/i) {
         $in_td = 0;
      } else {
         # should be a text entry
         if ($in_td) {
            if ($cols == 1) {
               $img = $ln;
               prt( "img=[$ln]\n" ) if ($dbg5);
            } elsif ($cols == 2) {
               $eng = $ln;
               prt( "eng=[$ln]\n" ) if ($dbg5);
            } elsif ($cols == 3) {
               $fr = $ln;
               prt( "fr=[$ln]\n" ) if ($dbg5);
               push(@langarr, [$img, $eng, $fr]);
            }
         }
      }
   }
}
sub alltags2newline {
   my ($tx) = shift;
   my $tl = length($tx);
   my ($i, $c, $d);
   my $nt = '';
   $d = '';
   for ($i = 0; $i < $tl; $i++) {
      $c = substr($tx,$i,1);
      if ($c eq '<') {
         if (length($nt) && (substr($nt,-1) ne "\n")) {
            $nt .= "\n";
         }
      } 
      if (($d eq '>')&&($c ne "\n")) {
         if (length($nt) && (substr($nt,-1) ne "\n")) {
            $nt .= "\n";
         }
      }
      $nt .= $c;
      $d = $c;
   }
   return $nt;
}
sub short_text {
   my ($tx, $len) = @_;
   my $ln = length($tx);
   my $ntx = $tx;
   if ($ln > ($len + 3)) {
      my $hl = int( $len / 2 );
      $ntx = substr($tx,0,$hl);
      $ntx .= '...';
      $hl = $len - $hl;
      $ntx .= substr($tx, $ln - $hl);
   }
   return $ntx;
}
##   $tl = scalar @newxml;
sub write_new_xml { # ($out_file);
   my ($fil) = shift;
   open OF, ">$fil" or mydie("ERROR: Can NOT create [$fil] ... $! ...\n");
   foreach my $ln (@newxml) {
      print OF $ln;
   }
   close OF;
   system($fil);
}
sub write_out_file {
   my ($tx, $fil) = @_;
   open OF, ">$fil" or mydie("YEEK! Can NOT create [$fil] ...\n");
   print OF $tx;
   close OF;
   prt("Written " . length($tx) . " characters to [$fil]...\n");
}
sub get_tag {
   my ($t) = shift;
   my $m = length($t);
   my ($j, $c);
   my $tg = '';
   for ($j = 0; $j < $m; $j++) {
      $c = substr($t,$j,1);
      if ($c eq '<') {
         $tg = $c;
         $j++;
         for ( ; $j < $m; $j++) {
            $c = substr($t,$j,1);
            $tg .= $c;
            if ($c eq '>') {
               last;
            }
         }
         last;
      }
   }
   return $tg;
}
sub get_att_hash {
   my ($tg, $fil) = @_;
   $tg =~ s/\n/ /gm;
   $tg =~ s/\r/ /gm;
   my $ml = length($tg);
   my ($i, $c, $d);
   my $tag = '';
   my $att = '';
   my $val = '';
   my %h = ();
   for ($i = 0; $i < $ml; $i++) {
      $c = substr($tg,$i,1);
      if ($c eq '<') {
         $i++;
         for ( ; $i < $ml; $i++) {
            $c = substr($tg,$i,1);
            if (($c =~ /\s/)||($c eq '>')) {
               last;
            }
            $tag .= $c;
         }
         # got the tag, now the attributes, if any
         prt( "tag=[$tag] src=[$fil]\n" ) if ($dbg4);
         while (($c =~ /\s/)&&(($i + 1) < $ml)) {
            while (($c =~ /\s/)&&(($i + 1) < $ml)) {
               $i++;
               $c = substr($tg,$i,1);
            }
            $att = '';
            $val = '';
            if ( !($c =~ /\s/) && ($c ne '>')) {
               $att = $c; # start attribute
               $i++;
               for ( ; $i < $ml; $i++) {
                  $c = substr($tg,$i,1);
                  if ($c eq '=') {
                     last;
                  }
                  $att .= $c;
               }
               if (($c eq '=')&&(($i + 1) < $ml)) {
                  $i++;
                  $d = substr($tg,$i,1);
                  if (($d eq '"')||($d eq "'")) {
                     $val = $d; # keep the inverted comma
                  } else {
                     $val = $d; # keep first item
                     $d = ' ';
                  }
                  $i++;
                  for ( ; $i < $ml; $i++) {
                     $c = substr($tg,$i,1);
                     if ($c eq '>') {
                        last;
                     } elsif ($c eq $d) {
                        if ($c ne ' ') {
                           $val .= $c;
                           if (($i + 1) < $ml) {
                              $i++;
                              $c = substr($tg,$i,1);
                           }
                        }
                        last;
                     }
                     $val .= $c;
                  }
               }
               if (length($att) && length($val)) {
                  # for img tag, am interested most in 
                  # the src=[filename] and alt=[Description]
                  if (($att eq 'src')||($att eq 'alt')) {
                     prt( "att=[$att] value=[$val] c=[$c]\n" ) if ($dbg4);
                  } else {
                     prt( "att=[$att] value=[$val] c=[$c]\n" ) if ($dbg4a);
                  }
                  if (defined $h{$att}) {
                     prt("Duplicate attribute!!! [$att] val1=[" . $h{$att} . "] adding [$val] ...\n" );
                     if ($h{$att} ne $val) {
                        $h{$att} .= '|' . $val;
                     }
                  } else {
                     $h{$att} = $val;
                  }
               } else {
                  prt( "Warning: failed to get att=[$att] value=[$val] c=[$c]\n" );
               }
            }
         } # end while 
         #############################
         push(@attlist, [$tag, \%h, $fil]);   # tag, hash of attributes, and source
      }
   }
}
sub trim_tail {
   my ($ln) = shift;
   while ($ln =~ /\s$/m) {
      $ln = substr($ln,0, length($ln) - 1);
   }
   return $ln;
}
sub strip_quotes {
   my ($tx) = shift;
   $tx =~ s/^('|")//;
   $tx =~ s/('|")$//;
   return $tx;
}
sub strip_tail_dots {
   my ($tx) = shift;
   my $len = length($tx);
   while($len && ($tx =~ /\s$/)) {
      $len--;
      $tx = substr($tx, 0, $len);
   }
   while($len && ($tx =~ /\.$/)) {
      $len--;
      $tx = substr($tx, 0, $len);
   }
   while($len && ($tx =~ /\s$/)) {
      $len--;
      $tx = substr($tx, 0, $len);
   }
   return $tx;
}
sub show_comb_alt {
   ## push(@combalt, [$src1, $nalt, $fil2]);
   my ($i, $at, $src, $dsc);
   $at = scalar @combalt;
   for ($i = 0; $i < $at; $i++) {
      $src = $combalt[$i][0];
      $dsc = $combalt[$i][1];
      prt( "[$src][$dsc]\n" );
   }
}
sub lead_chars_equal {
   my ($f1, $f2) = @_;
   my $l1 = length($f1);
   my $l2 = length($f2);
   my $ml = $l1;
   $ml = $l2 if ($l2 < $l1);
   my ($i, $c1, $c2);
   for ($i = 0; $i < $ml; $i++) {
      $c1 = substr($f1,$i,1);
      $c2 = substr($f2,$i,1);
      if (($c1 =~ /\w/)&&($c2 =~ /\w/)) {
         if ( !($c1 eq $c2) ) {
            return 0;
         }
      } else {
         # first non-alpha character
         last;
      }
   }
   if ($i > $mincomp) {
      return $i;
   }
   return 0;
}
sub get_comb_desc {
   my ($fil) = shift;
   ## push(@combalt, [$src1, $nalt, $fil2]);
   my ($i, $at, $src, $dsc, $nm);
   $dsc = '';
   $at = scalar @combalt;
   for ($i = 0; $i < $at; $i++) {
      $src = $combalt[$i][0];
      if ($src =~ /\//) {
         my @arr = split('/', $src);
         $nm = $arr[-1];
      } else {
         $nm = $src;
      }
      if ($nm eq $fil) {
         $dsc = $combalt[$i][1];
         last;
      } elsif (lead_chars_equal($nm, $fil)) {
         $dsc = $combalt[$i][1];
         last;
      }
   }
   return $dsc;
}
sub show_alt_list {
   # push(@altlist, [$src, $alt, $sf]);
   my $ac = scalar @altlist;
   prt( "Got $ac entries in \@altlist ...\n" );
   my ($i, $j, $src1, $alt1, $sf1, $src2, $alt2, $sf2, $nalt, $dn, $fnd, $fil2);
   my @done = ();
   for ($i = 0; $i < $ac; $i++) {
      $src1 = $altlist[$i][0];
      $alt1 = $altlist[$i][1];
      $sf1  = $altlist[$i][2];
      $fnd = 0;
      foreach $dn (@done) {
         if ($dn eq $src1) {
            $fnd = 1;
            last;
         }
      }
      if ($fnd) {
         prt( "REPEAT src=$src1 [$sf1]\n" ) if ($dbgrpt);
      } else {
         for ($j = 0; $j < $ac; $j++) {
            if ($j != $i) {
               $src2 = $altlist[$j][0];
               $alt2 = $altlist[$j][1];
               $sf2  = $altlist[$j][2];
               if ($src1 eq $src2) {
                  push(@done, $src1);
                  last;
               }
            }
         }
         if ($j < $ac) {
            $nalt = strip_tail_dots($alt1) . ' ... ' . strip_tail_dots($alt2);
            $fil2 = $sf1 . ' ' . $sf2;
            push(@combalt, [$src1, $nalt, $fil2]);
            prt( "$nalt ..\n" ) if ($dbgnalt);
         } else {
            prt( "WARNING: did not find $src1 ???\n" );
         }
      }
   }
   $ac = scalar @combalt;
   prt( "Got $ac entries in \@combalt ...\n" );
   show_comb_alt() if ($dbgcalt);
}
sub show_att_list {
   my $ac = scalar @attlist;
   prt( "Got $ac entries in \@attlist ...\n" );
   my ($i, $src, $alt);
   for ($i = 0; $i < $ac; $i++) {
      my $tg = $attlist[$i][0];
      my %th = $attlist[$i][1];
      my $sf = $attlist[$i][2];
      prt( "TAG=[$tg] src=[$sf]\n" ) if ($dbgshw);
      ##foreach my $k (keys(%th)) {
      ##   my $v = $th{$k};
      ##   prt( "k=[$k] v=[$v]\n" );
      ##}
      $src = '';
      $alt = '';
      foreach my $k (keys(%{$attlist[$i][1]})) {
         my $v = ${$attlist[$i][1]}{$k};
         prt( "k=[$k] v=[$v]\n" ) if ($dbgshw);
         if ($k =~ /^src$/i) {
            $src = strip_quotes($v);
         } elsif ($k =~ /^alt$/) {
            $alt = strip_quotes($v);
         }
      }
      if (length($src) && length($alt)) {
         push(@altlist, [$src, $alt, $sf]);
      } else {
         prt( "WARNING: Failed to find src and alt ...\n" );
      }
   }
}
sub get_fr {
   my ($ig) = shift;
   my ($img, $eng, $fr, $i);
   my $icnt = scalar @langarr;
   for ($i = 0; $i < $icnt; $i++) {
      $img = $langarr[$i][0];
      $eng = $langarr[$i][1];
      $fr = $langarr[$i][2];
      if ($img eq $ig) {
         return $fr;
      }
   }
   return '&nbsp;';
}
sub out_alt_list {
   my ($fil) = shift;
   my $ct = scalar @altlist;
   if ($ct) {
      my ($i, $sr, $at, $msg);
      prt( "Outputting $ct alt list entries to $fil ...\n" );
      open OTF, ">$fil" or mydie( "ERROR: Unable to open $fil file ... $! \n" );
      print OTF $htm_head;
      for ($i = 0; $i < $ct; $i++) {
         $sr = $altlist[$i][0];
         $at = $altlist[$i][1];
         $msg = "<tr>\n";
         $msg .= "<td>\n";
         ##$msg .= $sr;
         $msg .= '<img src="' . $def_folder . '/' . $sr . '" width="60" height="40">';
         $msg .= "</td>\n";
         $msg .= "<td>\n";
         $msg .= $at;
         $msg .= "</td>\n";
         $msg .= "<td>\n";
         $msg .= get_fr($sr);
         $msg .= "</td>\n";
         $msg .= "</tr>\n";
         print OTF $msg;
      }
      print OTF $htm_tail;
      close OTF;
      ###system($fil);
   } else {
      prt( "WARNING: Did not find any src/alt sets ...\n" );
   }
}
sub extract_img_alts {
   my ($tx, $fil) = @_;
   my $tl = length($tx);
   my ($i);
   my $ch = '';
   my $nt = '';
   my $tag = '';
   my $att = '';
   my $tgl = '';
   my $intd = 0;
   my $ntag = '';
   for ($i = 0; $i < $tl; $i++) {
      $ch = substr($tx,$i,1);
      if ($ch eq '<') {
         $tag = get_tag( substr($tx,$i) );
         $i += (length($tag) - 1) if (length($tag));
         $tgl = $tag;
         $tgl =~ s/\n/ /g;
         $tgl =~ s/\r/ /g;
         if ($tgl =~ /<img(.*)>/im) {
            $att = $1;
            prt( "IMG tag [$tag]...\n" ) if ($dbg3);
            get_att_hash($tag, $fil);
         } elsif ((length($tag) > 4)&&(substr($tag,0,4) eq '<!--')) {
            prt( "Got comment ...\n" ) if ($dbg2);
         } else {
            prt( "other tag [$tag] ...\n" ) if ($dbg2);
         }
         $nt .= $tag;
      } else {
         $nt .= $ch;
      }
   }
   $tl = length($nt);
   prt("Now returning $tl characters ...\n") if $dbg1;
   return $nt;
}
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;
}
# format of XML
my $rawxml = <<"EOF";
    </dict>
    <key>Items</key>
    <array>
      <dict>
        <key>ID</key>
        <string>1</string>
        <key>File</key>
        <string>tunis001.jpg</string>
        <key>Size</key>
        <string>39371</string>
        <key>Modified</key>
        <string>2006-10-19 14:08:45</string>
        <key>Created</key>
        <string>2006-10-19 14:46:05</string>
        <key>Archived</key>
        <string>2006-11-24 12:46:26</string>
        <key>Width</key>
        <string>512</string>
        <key>Height</key>
        <string>384</string>
        <key>CameraMaker</key>
        <string></string>
        <key>CameraModel</key>
        <string></string>
        <key>CaptureDate</key>
        <string>2006-10-19 14:08:45</string>
        <key>Aperture</key>
        <string></string>
        <key>FocalLength</key>
        <string></string>
        <key>FocusDistance</key>
        <string></string>
        <key>ShutterSpeed</key>
        <string></string>
        <key>Flash</key>
        <string></string>
        <key>ISOSpeed</key>
        <string></string>
        <key>CPU</key>
        <string></string>
        <key>Description</key>
        <string>view of the main pool at Hotel Melia Palm Azur, Djerba Island, southern Tunisia  ...</string>
      </dict>
      <dict>
        <key>ID</key>
        <string>2</string>
        <key>File</key>
        <string>tunis002.jpg</string>
      IFF there is no decription then there will be NO
      <key>Description</key> entry at all
EOF
# eof - imgalt02.pl - 20061124

index -|- top

checked by tidy  Valid HTML 4.01 Transitional