1 # use perl -*- Perl -*- This line used to have a : at the start
2 eval 'exec perl -w -S $0 ${1+"$@"}'
4 # clever way of calling perl on this script : stolen from weblint
7 # wwwis: adds HEIGHT= and WIDTH= to images referenced in specified HTML file.
9 # for documentation - changelog and latest version
10 # see http://www.bloodyeck.com/wwwis/
12 # this program by (and copyright) Alex Knowles, Alex@bloodyEck.com
13 # based on original code and idea by Andrew Tong, werdna@ugcs.caltech.edu
15 # You may distribute this code under the GNU public license
17 # THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT WARRANTY OF ANY KIND.
19 # RCS $Id: wwwis,v 2.43 2004/12/02 18:32:13 ark Exp $
24 # if you do not have these system libraries make sure you comment them out
25 # and have the options UsePerlCp, searchURLS, TryServer ALL SET TO NO
28 # this stops the error Use of uninitialized value at .../File/Copy.pm line 84
29 # print "Out rec sep not defined?? someone help me with this\n";
33 # this array specifies what options are available what the default
34 # value is and also what type it is, files are checked to see if they
35 # exist and the only possible values for choice are given.
36 # you should only need to change the third column
38 ('searchURLS', 'bool', 'Yes',
39 'DocumentRoot', 'file', '/usr/local/etc/httpd/htdocs',
40 'UserDir', 'string', 'html',
41 'MakeBackup', 'bool', 'Yes',
42 'BackupExtension', 'string', '~',
43 'OverwriteBackup', 'choice', 'Yes', 3, 'Yes','No','Ask',
44 'ChangeIfThere', 'choice', 'Yes', 4, 'Yes','No','Ask','Clever',
45 'Skip1x1', 'bool', 'Yes',
46 'SkipThreshold', 'integer', '0', # 0 disables this option
47 'DoChmodChown', 'bool', 'No',
48 'UpcaseTags', 'choice', 'No', 4, 'Yes','No','Upper','Lower',
49 'UpcaseNewTags', 'bool', 'No',
50 'TryServer', 'bool', 'Yes',
51 'QuoteNums', 'choice', 'No', 4, 'Yes','No','Single','Double',
52 'Munge%', 'bool', 'Yes',
53 'NeedAlt', 'bool', 'Yes',
54 'SkipCGI', 'bool', 'Yes',
55 'UseNewGifsize', 'bool', 'No',
56 'UseHash', 'bool', 'Yes',
58 'InFilter', 'string', '',
59 'OutFilter', 'string', '',
60 'Quiet', 'bool', 'No',
61 'Script', 'string', '',
62 'Proxy', 'string', '',
63 'SkipFilter', 'string', '',
64 'IgnoreLinks', 'bool', 'Yes',
65 'UsePerlCp', 'bool', 'Yes',
68 #####################################################################
69 ######### YOU SHOULD NOT HAVE TO CHANGE ANYTHING BELOW HERE #########
70 #####################################################################
73 my($Base, $SkipCGI, $InFilter, $MakeBackup, $SearchURLS, $OverwriteBackup,
74 $Proxy, $UseHash, $OutFilter, $UpcaseTags, $UpcaseNewTags,
75 $UseNewGifsize, $debug,
76 $Script, $UserDir, $TryServer, $DoChmodChown,$ChangeIfThere, $IgnoreLinks,
77 $NeedAlt,$MungePer, $QuoteNums, $DocumentRoot,$BackupExtension, $Quiet,
78 $UsePerlCp, $Skip1x1, $SkipThreshold, $SkipFilter );
82 # O.K. now we have defined the options go and get them and set the global vars
83 my(@optionval)=&GetConfigFile(@options);
86 $|=1; # make it so that I can fit lots of info on one line...
88 ############################################################################
89 # Main routine. processes all files specified on command line, skipping
90 # any file for which a .bak file exists.
91 ############################################################################
101 if( -s $FILE && -T $FILE ){
102 if ( -e "$FILE$BackupExtension"){
103 if( &isfalse($OverwriteBackup) ){
104 print "Skipping -- found $FILE$BackupExtension\n";
106 } elsif ( $OverwriteBackup =~ /ASK/i ){
107 print "overwite $FILE$BackupExtension [Yn]\n";
110 print " - Skipping\n";
115 if ( -l $FILE and &istrue($IgnoreLinks) ){
116 print "Skipping -- this file is a symbolic link\n";
119 print "Processing...\n";
122 print "Skipping -- Doesn't look like a text file to me!\n";
128 # This converts the optionval array into global variables
129 # this is cos I don't know how to store pointers to variables in arrys (sorry)
134 $SearchURLS = $optionval[$i++];
135 $DocumentRoot = $optionval[$i++];
136 $UserDir = $optionval[$i++];
137 $MakeBackup = $optionval[$i++];
138 $BackupExtension = $optionval[$i++];
139 $OverwriteBackup = $optionval[$i++];
140 $ChangeIfThere = $optionval[$i++];
141 $Skip1x1 = $optionval[$i++];
142 $SkipThreshold = $optionval[$i++];
143 $DoChmodChown = $optionval[$i++];
144 $UpcaseTags = $optionval[$i++];
145 $UpcaseNewTags = $optionval[$i++];
146 $TryServer = $optionval[$i++];
147 $QuoteNums = $optionval[$i++];
148 $MungePer = $optionval[$i++];
149 $NeedAlt = $optionval[$i++];
150 $SkipCGI = $optionval[$i++];
151 $UseNewGifsize = $optionval[$i++];
152 $UseHash = $optionval[$i++];
153 $Base = $optionval[$i++];
154 $InFilter = $optionval[$i++];
155 $OutFilter = $optionval[$i++];
156 $Quiet = $optionval[$i++];
157 $Script = $optionval[$i++];
158 $Proxy = $optionval[$i++];
159 $SkipFilter = $optionval[$i++];
160 $IgnoreLinks = $optionval[$i++];
161 $UsePerlCp = $optionval[$i++];
163 # do a quick check just to see we got everything
165 if( $i!=$#optionval ){
166 print "Internal Error: number of options is not equal to globals!\n";
167 print "Please Email alex\@ed.ac.uk for help\n";
172 ###########################################################################
173 # Subroutine does all the actual HTML parsing --- grabs image URLs and tells
174 # other routines to open the images and get their size
175 ###########################################################################
179 my($changed,$type,$tag,$five,$user,$original,@original);
180 my($widthtag,$heighttag);
184 my($ino, $mode, $uid, $gid, $ngid, $nuid );
186 $changed=0; # did we change this file
187 $original=""; # the string containing the whole file
189 $widthtag=&istrue($UpcaseNewTags)?"WIDTH":"width";
190 $heighttag=&istrue($UpcaseNewTags)?"HEIGHT":"height";
193 if( !open(ORIGINAL, $InFilter =~ /\S+/ ? "$InFilter $file|" : "<$file") ){
194 print "Couldn't open $file\n";
201 @PATH = split(/[\\\/]/, $file); # \\ for NT (brian_helterline@om.cv.hp.com)
203 $REL = join("/", @PATH);
205 # print out the header to the columns
206 printf(" %s %-34s %-9s %-9s\n",'Type','File',' Old',' New') if (isfalse($Quiet));
208 @original=split(/</, $original);
209 for ($i=0; $i <= $#original; $i++) {
210 # make the tags upper case if that's is what the user wants
211 if( &istrue( $UpcaseTags) && $original[$i] !~ /^!--/ ){
212 $original[$i]=&changecase($original[$i]);
215 if ($original[$i] =~ /^BASE\s+HREF\s*=\s*(\"[^\"]+\"|\'[^\']+\'|\S+)/i){ #"
216 # we found a BASE tag this is quite important to us!
217 $HTMLbase=&strip_quotes($1);
218 print " BASE $HTMLbase\n" if (isfalse($Quiet));
219 } elsif ($original[$i] =~
220 /^((IMG|FIGURE|INPUT)\s+([^\000]*\s+)?SRC\s*=\s*(\"[^\"]+\"|\'[^\']+\'|\S+)[^\000]*)>/i){ #"
221 # we found an IMG or FIGURE tag! this is really important
223 # initialise some of my flags
224 if( !defined($1) || !defined($2) || !defined($4) ){
225 print " Couldn't find tagtype or images source for tag number $i!\n";
228 $tag=$1; # The whole HTML tag (with attributes)
229 $type=$2; # this is either IMG or FIGURE
230 $five=$4; # we put the SRC in a variable called five for historic reasons
231 $five=&strip_quotes($five);
232 $ox=0; $oy=0; # old X & Y values (Was Width & Height)
233 $nx=0; $ny=0; # the new values
235 printf(" %3s %-34s ",substr($type,0,3),$five) if (isfalse($Quiet));
237 if(&istrue($SkipCGI) &&
238 $five =~ /(\.(cgi|pl)$|\/cgi-bin\/|\/cgi\/)/ ){
239 print "\"$file\": Skipping CGI program\n" if (isfalse($Quiet));
242 if( $SkipFilter && $five =~/$SkipFilter/i ){
243 print "\"$file\": SkipFilter matched\n" if (isfalse($Quiet));
247 if( $tag =~ /(width|height)\s*=\s*[\"\']?\d+%/i ){ #"
248 # we found a % sign near width or height
249 if( ! &istrue($MungePer) ){
250 print "\"$file\": Found % Skipping\n";
254 $ox=$2 if( $tag =~ /\s*width\s*=\s*(\"|\')?(\d+)\s*/i ); #"
255 $oy=$2 if( $tag =~ /\s*height\s*=\s*(\"|\')?(\d+)\s*/i ); #"
258 printf("(%3d,%3d) ",$ox,$oy) if (isfalse($Quiet));
260 if( $ox && $oy && &isfalse($ChangeIfThere) ){
261 print "Already There\n";
265 if( defined($HTMLbase) && $HTMLbase =~ /\S+/ ){
266 print "\nUsing HTMLbase to turn:$five\n" if $debug;
267 $five=&ARKjoinURL($HTMLbase,$five);
268 print "Into :$five\n" if $debug;
271 if ($five =~ /^http:\/\/.*/) {
272 if (&istrue($SearchURLS)) {
273 ($nx,$ny) = &URLsize($five);
275 } elsif ($five =~ /^\/\~.*/) {
276 @PATH = split(/\//, $five);
277 shift(@PATH); $user = shift(@PATH) ; $rel = join ("/", @PATH);
279 $user=(getpwnam( $user ))[7];
280 print "User dir is $user/$UserDir/$rel\n" if $debug;
281 ($nx,$ny) = &imgsize("$user/$UserDir/$rel",$five);
282 } elsif ($five =~ /^\/.*/) {
283 ($nx,$ny) = &imgsize("$DocumentRoot$five",$five);
286 ($nx,$ny) = &imgsize("$five",$five);
288 ($nx,$ny) = &imgsize("$REL/$five",$five);
292 if( $nx==0 && $ny==0 ){
293 print "\"$file\": No Values : $!\n";
297 printf( "(%3d,%3d) ", $nx,$ny) if (isfalse($Quiet));
299 if(&istrue($Skip1x1) &&
301 print "Skipping 1x1 image\n" if (isfalse($Quiet));
305 if (&istrue($SkipThreshold) && $nx<=$SkipThreshold &&
306 $ny<=$SkipThreshold){
307 print "Skipping $nx"."x$ny image (\$SkipThreshold=$SkipThreshold)\n" if
312 if( $nx && $ny && &do_change($ox,$oy,$nx,$ny)){
313 $changed=1; # mark the page as changed
314 $original[$i]=&replce_attrib($original[$i],$heighttag,$ny);
315 $original[$i]=&replce_attrib($original[$i],$widthtag,$nx);
316 if( $ox==0 && $oy==0 ){
317 print "Added tags " if (isfalse($Quiet));
319 print "Updated " if (isfalse($Quiet));
323 print "Needs Alt" if(&istrue($NeedAlt) && $tag !~ /ALT\s*=\s*\S+/i );
325 print "\n" if (isfalse($Quiet));
330 print " No need to write \"$file\": nothing changed\n";
334 if( ! &isfalse($MakeBackup) ){
335 # maybe I should move the rest of this stuff into a separate function?
336 if( &istrue($DoChmodChown) ){
337 # find out about this file
338 ($ino,$mode,$uid,$gid) = (stat($file))[1,2,4,5];
339 if ($ino == 0 || !rename($file, "$file$BackupExtension")) {
341 print "Couldn't stat \"$file\" for permissions & ownership: $!\n";
343 print "couldn't rename \"$file\" for backup: $!\n";
348 if( &istrue( $UsePerlCp ) ){
349 copy( $file, "$file$BackupExtension" );
351 # system( "cp $file $file$BackupExtension" );
352 # we could have added the -p flag e.g. cp -p ....
353 # use copy cos this keeps the permissions the same!
354 system( "cp -p $file $file$BackupExtension" );
359 $file="output.html" if $debug;
361 if(open(CONVERTED, $OutFilter =~ /\S+/ ? "|$OutFilter $file" : ">$file") ){
362 print CONVERTED join("<", @original);
365 if( &istrue($DoChmodChown) ){
366 # now change the ownership & permissions
367 chmod $mode, $file || print "Warning: Couldn't chmod $file\n";
368 # It seems that chown doesn't necessarily indicate any errors
369 chown $uid, $gid, $file || print "Warning: Couldn't chown $file\n";
371 ($nuid,$ngid) = (stat($file))[4,5];
374 print "Warning: $file now has different group or owner\n";
377 # if we defined a script to run the make it so....
378 system("$Script $file") if( $Script =~ /\S+/ );
380 print "Either: could not backup or could not write to $file!\n";
384 # replaces the $attrib's value to $val in $line
385 # if $attrib is not present it is inserted at the start of the tag
388 my($line,$attrib,$val)=@_;
389 my( $start, $oldval );
392 if(!defined($line ) ||
395 print "Error: dodgy arguments to replace_attrib!\n";
396 return $line if(defined($line)); # have no effect if we can
400 $attrib =~ tr/[A-Z]/[a-z]/ if($UpcaseTags=~/lower/i);
402 if( !(&isfalse($QuoteNums)) ){
403 if( $QuoteNums =~ /single/i ){
404 $val = "\'" . $val . "\'";
406 $val = "\"" . $val . "\"";
410 if( $line =~ /(\s+$attrib\s*=\s*)([\'\"]?\d+%?[\'\"]?)[^\000]*>/i ){ #"
413 $line =~ s/$start$oldval/$start$val/;
415 $line =~ s/(\S+\s+)/$1$attrib=$val /;
422 print "Change [Yn]?";
431 my($oldwidth, $oldheight, $newwidth, $newheight) = @_;
435 return 0 if (!defined($oldwidth) ||
436 !defined($oldheight) ||
437 !defined($newwidth) ||
438 !defined($newheight) ||
441 ($oldwidth ==$newwidth &&
442 $newheight==$oldheight));
444 return 1 if(!($oldwidth) && !($oldheight) );
446 if( &isfalse($ChangeIfThere) ){
448 } elsif( $ChangeIfThere =~ /clever/i ){
450 eval { $wrat= $newwidth / $oldwidth }; warn $@ if $@;
452 eval {$wrat = 1/ $wrat }; warn $@ if $@;
458 eval { $hrat= $newheight / $oldheight }; warn $@ if $@;
460 eval {$hrat = 1/ $hrat }; warn $@ if $@;
465 if((int($wrat) == $wrat) &&
466 (int($hrat) == $hrat) ){
469 return &ask_for_change();
471 } elsif($ChangeIfThere =~ /ask/i){
472 return &ask_for_change();
477 # looking at the filename really sucks I should be using the first 4 bytes
478 # of the image. If I ever do it these are the numbers.... (from chris@w3.org)
486 my($ref)=@_ ? shift @_ : "";
489 # first check the hash table (if we use one)
490 # then try and open the file
491 # then try the server if we know of one
492 if(&istrue($UseHash) &&
495 print "Hash " if $debug;
498 } elsif( defined($file) && open(STRM, "<$file") ){
499 binmode( STRM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED
500 if ($file =~ /\.jpg$/i || $file =~ /\.jpeg$/i) {
501 ($x,$y) = &jpegsize(\*STRM);
502 } elsif($file =~ /\.gif$/i) {
503 ($x,$y) = &gifsize(\*STRM);
504 } elsif($file =~ /\.xbm$/i) {
505 ($x,$y) = &xbmsize(\*STRM);
506 } elsif($file =~ /\.[pm]ng$/i) {
507 ($x,$y) = &pngsize(\*STRM);
509 print "$file is not gif, xbm, jpeg, png or mng (or has stupid name)";
513 if(&istrue($UseHash) && $x && $y){
519 # we couldn't open the file maybe we want to try the server?
521 if(&istrue($TryServer) &&
525 $ref= &ARKjoinURL( $Base, $ref );
526 print "Trying server for $ref\n" if $debug;
528 ($x,$y)=&URLsize($ref);
535 ###########################################################################
536 # Subroutine gets the size of the specified GIF
537 ###########################################################################
541 if( &istrue($UseNewGifsize) ){
542 return &NEWgifsize($GIF);
544 return &OLDgifsize($GIF);
551 my($type,$a,$b,$c,$d,$s)=(0,0,0,0,0,0);
553 if(defined( $GIF ) &&
554 read($GIF, $type, 6) &&
555 $type =~ /GIF8[7,9]a/ &&
556 read($GIF, $s, 4) == 4 ){
557 ($a,$b,$c,$d)=unpack("C"x4,$s);
558 return ($b<<8|$a,$d<<8|$c);
565 my ($GIF, $skip, $type) = @_;
569 read ($GIF, $dummy, $skip); # Skip header (if any)
572 warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
575 read($GIF, $s, 1); # Block size
576 last if ord($s) == 0; # Block terminator
577 read ($GIF, $dummy, ord($s)); # Skip data
581 # this code by "Daniel V. Klein" <dvk@lonewolf.com>
584 my($cmapsize, $a, $b, $c, $d, $e)=0;
589 return($x,$y) if(!defined $GIF);
591 read($GIF, $type, 6);
592 if($type !~ /GIF8[7,9]a/ || read($GIF, $s, 7) != 7 ){
593 warn "Invalid/Corrupted GIF (bad header)\n";
596 ($e)=unpack("x4 C",$s);
598 $cmapsize = 3 * 2**(($e & 0x07) + 1);
599 if (!read($GIF, $dummy, $cmapsize)) {
600 warn "Invalid/Corrupted GIF (global color map too small?)\n";
607 warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
611 ($e) = unpack("C", $s);
612 if ($e == 0x2c) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
613 if (read($GIF, $s, 8) != 8) {
614 warn "Invalid/Corrupted GIF (missing image header?)\n";
617 ($a,$b,$c,$d)=unpack("x4 C4",$s);
622 if ($type eq "GIF89a") {
623 if ($e == 0x21) { # Extension Introducer (GIF89a 23.c.i)
625 ($e) = unpack("C", $s);
626 if ($e == 0xF9) { # Graphic Control Extension (GIF89a 23.c.ii)
627 read($GIF, $dummy, 6); # Skip it
628 next FINDIMAGE; # Look again for Image Descriptor
629 } elsif ($e == 0xFE) { # Comment Extension (GIF89a 24.c.ii)
630 &gif_blockskip ($GIF, 0, "Comment");
631 next FINDIMAGE; # Look again for Image Descriptor
632 } elsif ($e == 0x01) { # Plain Text Label (GIF89a 25.c.ii)
633 &gif_blockskip ($GIF, 12, "text data");
634 next FINDIMAGE; # Look again for Image Descriptor
635 } elsif ($e == 0xFF) { # Application Extension Label (GIF89a 26.c.ii)
636 &gif_blockskip ($GIF, 11, "application data");
637 next FINDIMAGE; # Look again for Image Descriptor
639 printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
644 printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
649 warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
659 if( defined( $XBM ) ){
664 if( /.define\s+\S+\s+(\d+)\s*\n.define\s+\S+\s+(\d+)\s*\n/i ){
671 # pngsize : gets the width & height (in pixels) of a png file
672 # cor this program is on the cutting edge of technology! (pity it's blunt!)
673 # GRR 970619: fixed bytesex assumption
678 my($a, $b, $c, $d, $e, $f, $g, $h)=0;
681 read( $PNG, $head, 8 ) == 8 &&
682 ( $head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
683 $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" ) &&
684 read($PNG, $head, 4) == 4 &&
685 read($PNG, $head, 4) == 4 &&
688 read($PNG, $head, 8) == 8 ){
689 # ($x,$y)=unpack("I"x2,$head); # doesn't work on little-endian machines
691 ($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head);
692 return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
697 # jpegsize : gets the width and height (in pixels) of a jpeg file
698 # Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
699 # modified slightly by alex@ed.ac.uk
703 my($c1,$c2,$ch,$s,$length, $dummy)=(0,0,0,0,0,0);
707 read($JPEG, $c1, 1) &&
708 read($JPEG, $c2, 1) &&
711 while (ord($ch) != 0xDA && !$done) {
712 # Find next marker (JPEG markers begin with 0xFF)
713 # This can hang the program!!
714 while (ord($ch) != 0xFF) { return(0,0) unless read($JPEG, $ch, 1); }
715 # JPEG markers can be padded with unlimited 0xFF's
716 while (ord($ch) == 0xFF) { return(0,0) unless read($JPEG, $ch, 1); }
717 # Now, $ch contains the value of the marker.
718 if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
719 return(0,0) unless read ($JPEG, $dummy, 3);
720 return(0,0) unless read($JPEG, $s, 4);
721 ($a,$b,$c,$d)=unpack("C"x4,$s);
722 return ($c<<8|$d, $a<<8|$b );
724 # We **MUST** skip variables, since FF's within variable names are
725 # NOT valid JPEG markers
726 return(0,0) unless read ($JPEG, $s, 2);
727 ($c1, $c2) = unpack("C"x2,$s);
728 $length = $c1<<8|$c2;
729 last if (!defined($length) || $length < 2);
730 read($JPEG, $dummy, $length-2);
737 # this is untested contributed code From: Jan Paul Schmidt <jps@fundament.org>
738 # if you have problems with the jpegsize above - try this one!
742 my( $i, $w, $y, $h, $j, $b ) = (0,0,0,0,0,0);
747 if ($j == 0xffd8ffe0) {
750 seek $JPEG, unpack("n", $b) - 2, 1;
753 if ($j >= 0xffc0 and $j <= 0xffc3) {
763 } while not eof($JPEG);
769 ###########################################################################
770 # Subroutine grabs a gif from another server, and gets its size
771 ###########################################################################
776 my($dummy, $server, $url);
777 my($c1, $c2, $c3, $c4)=(0,0,0,0);
781 print "URLsize: $five\n" if $debug;
783 # first check the hash table (if we're using one)
784 if(&istrue($UseHash) &&
787 print "Hash " if $debug;
794 if( $Proxy =~ /\S+/ ){
795 ($dummy, $dummy, $server, $url) = split(/\//, $Proxy, 4);
798 ($dummy, $dummy, $server, $url) = split(/\//, $five, 4);
802 my($them,$port) = split(/:/, $server);
803 my( $iaddr, $paddr, $proto );
805 $port = 80 unless $port;
806 $them = 'localhost' unless $them;
808 print "\nThey are $them on port $port\n" if $debug;# && $Proxy;
809 print "url is $url\n" if $debug;
812 if( /gif/i || /jpeg/i || /jpg/i || /xbm/i || /png/i ){
814 $iaddr= inet_aton( $them );
815 $paddr= sockaddr_in( $port, $iaddr );
816 $proto=getprotobyname('tcp');
818 # Make the socket filehandle.
820 if(socket(STRM, PF_INET, SOCK_STREAM, $proto) &&
821 connect(STRM,$paddr) ){
822 # Set socket to be command buffered.
823 select(STRM); $| = 1; select(STDOUT);
825 print "Getting $url\n" if $debug;
827 my $str=("GET $url HTTP/1.1\n".
828 #"User-Agent: Mozilla/4.08 [en] (WWWIS)\n".
830 "Connection: close\n".
833 print "$str" if $debug;
837 # we're looking for \n\r\n\r
838 while ((ord($c1) != 10) || (ord($c2) != 13) || (ord ($c3) != 10) ||
844 print "$c1" if $debug;
846 print "\n" if $debug;
848 if ($url =~ /\.jpg$/i || $url =~ /\.jpeg$/i) {
849 ($x,$y) = &jpegsize(\*STRM);
850 } elsif($url =~ /\.gif$/i) {
851 ($x,$y) = &gifsize(\*STRM);
852 } elsif($url =~ /\.xbm$/i) {
853 ($x,$y) = &xbmsize(\*STRM);
854 } elsif($url =~ /\.png$/i) {
855 ($x,$y) = &pngsize(\*STRM);
857 print "$url is not gif, jpeg, xbm or png (or has stupid name)";
862 # there was a problem
866 print "$url is not gif, xbm or jpeg (or has stupid name)";
868 if(&istrue($UseHash) && $x && $y){
878 return (defined($val) && ($val =~ /^y(es)?/i || $val =~ /true/i ));
884 return (defined($val) && ($val =~ /^no?/i || $val =~ /false/i ));
890 $_=$name; # now to gte rid of quotes if they were there
891 if( /\"([^\"]*)\"/ ){ return $1; } #"
892 elsif( /\'([^\']*)\'/ ){ return $1; }
896 # this doesn't cope with \-ed " which it should!!!
897 # I also didn't cope with javascript stuff like onChange (whoops)
898 # this is why it is unsupported.
902 my( $ostr, $str, $j )=("","",0);
905 return $text if( !defined($1));
908 @line=split(/\"/, $str); #"
910 for( $j=0 ; $j <= $#line ; $j+=2 ){
911 if( $UpcaseTags =~ /lower/i ){
912 $line[$j] =~ tr/[A-Z]/[a-z]/;
914 $line[$j] =~ tr/[a-z]/[A-Z]/;
917 if( $str =~ /\"$/ ){ #"
918 $str=join( "\"", @line , "");
920 $str=join( "\"", @line );
922 $text=~ s/^$ostr/$str/;
927 # joins together two URLS to make one url
928 # e.g. http://www/ + fish.html = http://www/fish.html
929 # e.g. http://www/index.html + fish.html = http://www/fish.html
930 # e.g. http://www/s/index.html + /fish.html = http://www/fish.html
935 # if url has a double // in it then it is fine thank you!
936 return $url if( $url =~ /\/\// );
938 # strip down base url to make sure that it doesn't have a .html at the end
942 # strip off leading directories
943 $base =~ s/(\/\/[^\/]*)\/.*$/$1/;
946 return ($base . $url);
949 # File: wwwis-options.pl -*- Perl -*-
950 # Created by: Alex Knowles (alex@ed.ac.uk) Sat Nov 2 16:41:12 1996
951 # Last Modified: Time-stamp: <03 Nov 96 1549 Alex Knowles>
952 # RCS $Id: wwwis,v 2.43 2004/12/02 18:32:13 ark Exp $
953 ############################################################################
954 # There now follows some routines to get the configuration file
955 ############################################################################
958 # give me the start of the next option (as options can take up a
959 # different number of array elements)
965 if( /string/i || /integer/i || /file/i || /bool/i ){
967 } elsif( /choice/i ){
968 $i+=4+$options[$i+3];
970 print "unknown option type! $_\n";
976 # ShowOptions: now I use -usage it's much better
979 # Check if $val (arg2) is valid for option which starts at options[$i (arg1)]
980 # returns either 0 (failure) or 1 (success)
986 return 0 unless $i && $val;
990 # can't think of a check for this
991 }elsif( /integer/i ){
992 if( $val !~ /^\d+$/ ){
993 print "$val is not an integer!\n";
997 if( ! (-e ($val) ) ){
998 print "can't find file $val for $options[$i]\n";
1002 if( $val !~ /^(y(es)?|no?)$/i ){
1003 print "$val is neither Yes nor No\n";
1006 }elsif( /choice/i ){
1007 for( $k=0 ; $k < $options[$i+3] ; $k++ ){
1008 if( $val =~ /^$options[$i+4+$k]$/i ){
1012 print "$val is not a valid value for $options[$i]\n";
1015 print "unknown option type! $_\n";
1022 # Read user's configuration file, if such exists. If WWWIMAGESIZERC is
1023 # set in user's environment, then read the file referenced, otherwise
1024 # try for $HOME/.wwwimagesizerc
1028 my( @optionval )=();
1034 #first go through options array and puyt the default values into optionval
1037 while( $i < $#options ){
1038 $optionval[$j]=$options[$i+2];
1043 push(@files,$ENV{'WWWISRC'}) if $ENV{'WWWISRC'};
1044 push(@files,$ENV{'WWWIMAGESIZERC'}) if $ENV{'WWWIMAGESIZERC'};
1045 push(@files,("$ENV{'HOME'}/.wwwisrc",
1046 "$ENV{'HOME'}/.wwwimagesizerc",)) if $ENV{'HOME'};
1048 foreach $i (@files){
1049 if( defined($i) && -f $i ){
1055 if(defined($filename) &&
1057 open(CONFIG,"< $filename") ){
1059 # skip lines with a hash on them
1064 if( $line =~ /^(\S+)(\s+|\s*:\s*)(.+)$/ ){
1065 if( !(&proc_option($1,$3)) ){
1066 print "Invalid .wwwisrc line: $line";
1073 print "Unable to read config file `$filename': $!\n";
1082 my($i,$j,$proced)=(0,0,0);
1084 return 0 unless $opt && $value;
1086 while( !$proced && $i < $#options ){
1087 if( $options[$i] =~ /$opt/i ){
1089 if( &CheckOption($i,$value) ){
1090 $optionval[$j]=$value;
1092 printf("Invalid .wwwisrc value \"%s\" for option \"%s\"\n",
1093 $value,$options[$i]);
1097 $i=&NextOption($i); # move onto the next option
1107 return if !defined($arg);
1109 if( $arg =~ /^-+v(ersion)?$/i ){
1110 my($version)='$Revision: 2.43 $ ';
1112 $progname =~ s/.*\///; # we only want the name
1113 $version =~ s/[^\d\.]//g; # we only care about numbers and full stops
1114 print "$progname: $version\n";
1115 } elsif( $arg =~ /^-+u(sage)?$/i ||
1116 $arg =~ /^-+h(elp)?$/i ){
1118 } elsif( $arg =~ /^-+d(ebug)$/i ){
1120 } elsif( $arg =~ /-+im(a)?g(e)?size/i ){
1121 my($x,$y)=&imgsize(shift @ARGV);
1122 print "WIDTH=$x HEIGHT=$y\n";
1125 if( &proc_option( $arg, shift @ARGV)){
1128 print "Unrecognized option $arg\n";
1139 return "" if !defined $i;
1141 if( $options[$i+1] =~ /file/i ){
1143 } elsif($options[$i+1] =~ /string|integer/i ){
1145 } elsif($options[$i+1] =~ /bool/i ){
1146 return ('Yes','No');
1147 } elsif($options[$i+1] =~ /choice/i ){
1148 my($start,$end)=(($i+4),($options[$i+3]));
1149 return (@options[$start .. $start+$end-1]);
1151 print "Unrecognized option type\n";
1159 $progname =~ s/.*\///; # we only want the name
1162 print "$progname: [-version] [-usage] [-option optionval] file.html ... \n";
1164 my($fmt)=" %15s %6s %-10s %s\n";
1166 printf($fmt,"Option Name","Type","Default","Values");
1167 printf($fmt,"-----------","----","-------","------");
1171 while( $i < $#options ){
1172 $vals=join(',', &get_values($i));
1173 printf($fmt,$options[$i],$options[$i+1],$optionval[$j],$vals);