adjjs.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:17 2010 from adjjs.pl 2008/07/04 6.5 KB.

#!/perl -w
# NAME: agjjs.pl
# AIM: Specialised input a list from Imagemagick 'indentify', load a javascript list, and
# adjust the images size. If identify size is 800x600, put 'N', if 450x600 put 'R',
# else use the geometry given
use strict;
use warnings;
use File::Basename;
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 $outfile = "temp.$pgmname.txt";
open_log($outfile);
##prt( "$0 ... Hello, World ...\n" );
my $in_file1 = 'c:\HOMEPAGE\maroc-m.txt';
my $in_file2 = 'c:\HOMEPAGE\GA\travel\maroc\content2.js';
my $out_file = 'tempjs.js';
my @lines1 = ();
my @lines2 = ();
my $lncnt1 = 0;
my $lncnt2 = 0;
my @arr1 = ();
my @arr2 = ();
my @warnings = ();
# DEBUG
my $dbg1 = 0;   # show "Ajusted \n[$line2] to \n[$nline]
my $dbg2 = 0;   # show "Processing $nm1 ...
my $dbg3 = 0;   # show "With $j line [$line2] ...\n" ) if (($i == 0)
my $dbg4 = 0;   # show "$j line [$line2] ... stipped tail [$cma]...\n" ) if (($i == 0)
my $dbg5 = 0;   # show "Modified line $j from\n$line2 to\n$nline ...\n" )
my ($i, $j, $line1, $line2, $az1, $az2, $cma, $sz1);
my ($nm1, $dir1, @geo, $cgeo1, $cgeo2, $nline, $aline);
my ($k, $fnd, $chgcnt, $chgfiles, $wmsg);
if (load_files($in_file1, $in_file2)) {
    for ($j = 0; $j < $lncnt2; $j++) {
        $line2 = $lines2[$j];
        chomp $line2;
        $nline = trim_tail($line2);
        $lines2[$j] = $nline;
        prt( "Ajusted \n[$line2] to \n[$nline]\n" ) if ($dbg1);
    }
    $chgcnt = 0;
    for ($i = 0; $i < $lncnt1; $i++) {
        $line1 = $lines1[$i];
        @arr1 = split(/\s/,$line1);
        $az1 = scalar @arr1;
        if (($arr1[1] ne 'JPEG')||($az1 < 3)) {
            prt( "ERROR line $i: [ $line1 ]...\n" );
            mydie( "ERROR: File $in_file1 does NOT conform ... item1[ $arr1[1] ], size $az1 ...\n" );
        }
        $sz1 = $arr1[2];
        @geo = split('x',$sz1);
        if ( scalar @geo != 2 ) {
            prt( "ERROR line $i: [ $line1 ]...\n" );
            mydie( "ERROR: File $in_file1 does NOT conform ... geometry $sz1 ... (".scalar @geo.")\n" );
        }
        $cgeo1 = $sz1;
        if ($sz1 eq '800x600') {
            $cgeo1 = 'N';
        } elsif ($sz1 eq '450x600') {
            $cgeo1 = 'R';
        }
        ($nm1,$dir1) = fileparse($arr1[0]);
        prt( "Processing $nm1 ...\n" ) if ($dbg2);
        # now find the file in file 2
        $fnd = 0;   # not yet FOUND
        for ($j = 0; $j < $lncnt2; $j++) {
            $line2 = $lines2[$j];
            prt( "With $j line [$line2] ...\n" ) if (($i == 0) && $dbg3);
            $cma = '';
            if ($line2 =~ /^".+"(.+)$/) {
                $cma = $1; # remember to put this back
                $line2 = substr($line2,0,length($line2)-length($cma));
                prt( "$j line [$line2] ... stripped tail [$cma]...\n" ) if (($i == 0) && $dbg4);
            }
           if ($line2 =~ /^".*"$/) {
                $aline = strip_quotes($line2);
                @arr2 = split(/\|/,$aline);
                $az2 = scalar @arr2;
                if ($az2 > 2) {
                    if ($arr2[0] eq $nm1) {
                        # FOUND THE FILE - make possible adjustments
                        $fnd = 1;
                        $cgeo2 = $arr2[1];  # get current SIZE
                        if ($cgeo1 ne $cgeo2) {
                            # we have to CHANGE it
                            $nline = '"' . $nm1 . '|' . $cgeo1;
                            for ($k = 2; $k < $az2; $k++) {
                                $nline .= '|';
                                $nline .= $arr2[$k];
                            }
                            $nline .= '"' . $cma;
                            prt( "Modified line $j from\n$line2 to\n$nline ...\n" ) if ($dbg5);
                            $lines2[$j] = $nline;
                            $chgcnt++;
                            $wmsg = " ".($j+1);
                            $wmsg .= ' ' while (length($wmsg) < 5);
                            $wmsg .= $nm1;
                            $wmsg .= ' ' while (length($wmsg) < 20);
                            $wmsg .= ' from ' . $cgeo2;
                            $wmsg .= ' ' while (length($wmsg) < 34);
                            $wmsg .= ' to '.$cgeo1;
                            $chgfiles .= ",\n" if (length($chgfiles));
                            $chgfiles .= $wmsg;
                        }
                    }
                }
            } else {
                # could CHECK what this line is
                if ($i == 0) {
                    prt( "Skipping line $j [$line2] ...\n" );
                }
            }
        }   # for each line in file2
        if (! $fnd) {
            $wmsg = "WARNING: File $nm1 NOT FOUND in file 2!!!";
            prt( "$wmsg\n" );
            push(@warnings,$wmsg);
        }
    }   # for each line in file1
    if ($chgcnt) {
        prt( "Changed $chgcnt lines ... list is\n$chgfiles\n" );
        if (open OUTF, ">$out_file") {
            for ($j = 0; $j < $lncnt2; $j++) {
                $line2 = $lines2[$j];
                print OUTF "$line2\n";
            }
            close OUTF;
            prt( "Written adjustments to $out_file ...\n" );
        } else {
            prt( "ERROR: Can NOT create $out_file ...\n" );
        }
    }
}
if (@warnings) {
    prt( "WARNING: Got ".scalar @warnings." warning messages ...\n");
    foreach $wmsg (@warnings) {
        prt( "$wmsg\n" );
    }
}
close_log($outfile,1);
exit(0);
#################################
sub trim_tail {
   my ($ln) = shift;
   $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space
   return $ln;
}
sub strip_quotes {
   my ($ln) = shift;
   if ($ln =~ /^".*"$/) {
      $ln = substr($ln,1,length($ln)-2);
   }
   return $ln;
}
sub load_files {
    my ($inf1, $inf2) = @_;
    if (open INF, "<$inf1") {
        @lines1 = <INF>;
        close INF;
        $lncnt1 = scalar @lines1;
        if (open INF, "<$inf2") {
            @lines2 = <INF>;
            close INF;
            $lncnt2 = scalar @lines2;
            prt( "Processing $lncnt1 lines from $inf1,\nwith $lncnt2 from $inf2 ...\n" );
            return 1;
        } else {
            prt( "ERROR: Unable to open $inf2 ...\n" );
        }
    } else {
        prt( "ERROR: Unable to open $inf1 ...\n" );
    }
    return 0;
}
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional