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 ' '; } 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