3 # wwwis: adds HEIGHT= and WIDTH= to images referenced in specified HTML file.
5 # for documentation - changelog and latest version
6 # see http://www.bloodyeck.com/wwwis/
8 # this program by (and copyright) Alex Knowles, Alex@bloodyEck.com
9 # based on original code and idea by Andrew Tong, werdna@ugcs.caltech.edu
11 # You may distribute this code under the GNU public license
13 # THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT WARRANTY OF ANY KIND.
15 # RCS $Id: wwwis,v 2.43 2004/12/02 18:32:13 ark Exp $
20 # if you do not have these system libraries make sure you comment them out
21 # and have the options UsePerlCp, searchURLS, TryServer ALL SET TO NO
24 # this stops the error Use of uninitialized value at .../File/Copy.pm line 84
25 # print "Out rec sep not defined?? someone help me with this\n";
29 # this array specifies what options are available what the default
30 # value is and also what type it is, files are checked to see if they
31 # exist and the only possible values for choice are given.
32 # you should only need to change the third column
34 ('searchURLS', 'bool', 'Yes',
35 'DocumentRoot', 'file', '/usr/local/etc/httpd/htdocs',
36 'UserDir', 'string', 'html',
37 'MakeBackup', 'bool', 'Yes',
38 'BackupExtension', 'string', '~',
39 'OverwriteBackup', 'choice', 'Yes', 3, 'Yes','No','Ask',
40 'ChangeIfThere', 'choice', 'Yes', 4, 'Yes','No','Ask','Clever',
41 'Skip1x1', 'bool', 'Yes',
42 'SkipThreshold', 'integer', '0', # 0 disables this option
43 'DoChmodChown', 'bool', 'No',
44 'UpcaseTags', 'choice', 'No', 4, 'Yes','No','Upper','Lower',
45 'UpcaseNewTags', 'bool', 'No',
46 'TryServer', 'bool', 'Yes',
47 'QuoteNums', 'choice', 'No', 4, 'Yes','No','Single','Double',
48 'Munge%', 'bool', 'Yes',
49 'NeedAlt', 'bool', 'Yes',
50 'SkipCGI', 'bool', 'Yes',
51 'UseNewGifsize', 'bool', 'No',
52 'UseHash', 'bool', 'Yes',
54 'InFilter', 'string', '',
55 'OutFilter', 'string', '',
56 'Quiet', 'bool', 'No',
57 'Script', 'string', '',
58 'Proxy', 'string', '',
59 'SkipFilter', 'string', '',
60 'IgnoreLinks', 'bool', 'Yes',
61 'UsePerlCp', 'bool', 'Yes',
64 #####################################################################
65 ######### YOU SHOULD NOT HAVE TO CHANGE ANYTHING BELOW HERE #########
66 #####################################################################
69 my($Base, $SkipCGI, $InFilter, $MakeBackup, $SearchURLS, $OverwriteBackup,
70 $Proxy, $UseHash, $OutFilter, $UpcaseTags, $UpcaseNewTags,
71 $UseNewGifsize, $debug,
72 $Script, $UserDir, $TryServer, $DoChmodChown,$ChangeIfThere, $IgnoreLinks,
73 $NeedAlt,$MungePer, $QuoteNums, $DocumentRoot,$BackupExtension, $Quiet,
74 $UsePerlCp, $Skip1x1, $SkipThreshold, $SkipFilter );
78 # O.K. now we have defined the options go and get them and set the global vars
79 my(@optionval)=&GetConfigFile(@options);
82 $|=1; # make it so that I can fit lots of info on one line...
84 ############################################################################
85 # Main routine. processes all files specified on command line, skipping
86 # any file for which a .bak file exists.
87 ############################################################################
97 if( -s $FILE && -T $FILE ){
98 if ( -e "$FILE$BackupExtension"){
99 if( &isfalse($OverwriteBackup) ){
100 print "Skipping -- found $FILE$BackupExtension\n";
102 } elsif ( $OverwriteBackup =~ /ASK/i ){
103 print "overwite $FILE$BackupExtension [Yn]\n";
106 print " - Skipping\n";
111 if ( -l $FILE and &istrue($IgnoreLinks) ){
112 print "Skipping -- this file is a symbolic link\n";
115 print "Processing...\n";
118 print "Skipping -- Doesn't look like a text file to me!\n";
124 # This converts the optionval array into global variables
125 # this is cos I don't know how to store pointers to variables in arrys (sorry)
130 $SearchURLS = $optionval[$i++];
131 $DocumentRoot = $optionval[$i++];
132 $UserDir = $optionval[$i++];
133 $MakeBackup = $optionval[$i++];
134 $BackupExtension = $optionval[$i++];
135 $OverwriteBackup = $optionval[$i++];
136 $ChangeIfThere = $optionval[$i++];
137 $Skip1x1 = $optionval[$i++];
138 $SkipThreshold = $optionval[$i++];
139 $DoChmodChown = $optionval[$i++];
140 $UpcaseTags = $optionval[$i++];
141 $UpcaseNewTags = $optionval[$i++];
142 $TryServer = $optionval[$i++];
143 $QuoteNums = $optionval[$i++];
144 $MungePer = $optionval[$i++];
145 $NeedAlt = $optionval[$i++];
146 $SkipCGI = $optionval[$i++];
147 $UseNewGifsize = $optionval[$i++];
148 $UseHash = $optionval[$i++];
149 $Base = $optionval[$i++];
150 $InFilter = $optionval[$i++];
151 $OutFilter = $optionval[$i++];
152 $Quiet = $optionval[$i++];
153 $Script = $optionval[$i++];
154 $Proxy = $optionval[$i++];
155 $SkipFilter = $optionval[$i++];
156 $IgnoreLinks = $optionval[$i++];
157 $UsePerlCp = $optionval[$i++];
159 # do a quick check just to see we got everything
161 if( $i!=$#optionval ){
162 print "Internal Error: number of options is not equal to globals!\n";
163 print "Please Email alex\@ed.ac.uk for help\n";
168 ###########################################################################
169 # Subroutine does all the actual HTML parsing --- grabs image URLs and tells
170 # other routines to open the images and get their size
171 ###########################################################################
175 my($changed,$type,$tag,$five,$user,$original,@original);
176 my($widthtag,$heighttag);
180 my($ino, $mode, $uid, $gid, $ngid, $nuid );
182 $changed=0; # did we change this file
183 $original=""; # the string containing the whole file
185 $widthtag=&istrue($UpcaseNewTags)?"WIDTH":"width";
186 $heighttag=&istrue($UpcaseNewTags)?"HEIGHT":"height";
189 if( !open(ORIGINAL, $InFilter =~ /\S+/ ? "$InFilter $file|" : "<$file") ){
190 print "Couldn't open $file\n";
197 @PATH = split(/[\\\/]/, $file); # \\ for NT (brian_helterline@om.cv.hp.com)
199 $REL = join("/", @PATH);
201 # print out the header to the columns
202 printf(" %s %-34s %-9s %-9s\n",'Type','File',' Old',' New') if (isfalse($Quiet));
204 @original=split(/</, $original);
205 for ($i=0; $i <= $#original; $i++) {
206 # make the tags upper case if that's is what the user wants
207 if( &istrue( $UpcaseTags) && $original[$i] !~ /^!--/ ){
208 $original[$i]=&changecase($original[$i]);
211 if ($original[$i] =~ /^BASE\s+HREF\s*=\s*(\"[^\"]+\"|\'[^\']+\'|\S+)/i){ #"
212 # we found a BASE tag this is quite important to us!
213 $HTMLbase=&strip_quotes($1);
214 print " BASE $HTMLbase\n" if (isfalse($Quiet));
215 } elsif ($original[$i] =~
216 /^((IMG|FIGURE|INPUT)\s+([^\000]*\s+)?SRC\s*=\s*(\"[^\"]+\"|\'[^\']+\'|\S+)[^\000]*)>/i){ #"
217 # we found an IMG or FIGURE tag! this is really important
219 # initialise some of my flags
220 if( !defined($1) || !defined($2) || !defined($4) ){
221 print " Couldn't find tagtype or images source for tag number $i!\n";
224 $tag=$1; # The whole HTML tag (with attributes)
225 $type=$2; # this is either IMG or FIGURE
226 $five=$4; # we put the SRC in a variable called five for historic reasons
227 $five=&strip_quotes($five);
228 $ox=0; $oy=0; # old X & Y values (Was Width & Height)
229 $nx=0; $ny=0; # the new values
231 printf(" %3s %-34s ",substr($type,0,3),$five) if (isfalse($Quiet));
233 if(&istrue($SkipCGI) &&
234 $five =~ /(\.(cgi|pl)$|\/cgi-bin\/|\/cgi\/)/ ){
235 print "\"$file\": Skipping CGI program\n" if (isfalse($Quiet));
238 if( $SkipFilter && $five =~/$SkipFilter/i ){
239 print "\"$file\": SkipFilter matched\n" if (isfalse($Quiet));
243 if( $tag =~ /(width|height)\s*=\s*[\"\']?\d+%/i ){ #"
244 # we found a % sign near width or height
245 if( ! &istrue($MungePer) ){
246 print "\"$file\": Found % Skipping\n";
250 $ox=$2 if( $tag =~ /\s*width\s*=\s*(\"|\')?(\d+)\s*/i ); #"
251 $oy=$2 if( $tag =~ /\s*height\s*=\s*(\"|\')?(\d+)\s*/i ); #"
254 printf("(%3d,%3d) ",$ox,$oy) if (isfalse($Quiet));
256 if( $ox && $oy && &isfalse($ChangeIfThere) ){
257 print "Already There\n";
261 if( defined($HTMLbase) && $HTMLbase =~ /\S+/ ){
262 print "\nUsing HTMLbase to turn:$five\n" if $debug;
263 $five=&ARKjoinURL($HTMLbase,$five);
264 print "Into :$five\n" if $debug;
267 if ($five =~ /^http:\/\/.*/) {
268 if (&istrue($SearchURLS)) {
269 ($nx,$ny) = &URLsize($five);
271 } elsif ($five =~ /^\/\~.*/) {
272 @PATH = split(/\//, $five);
273 shift(@PATH); $user = shift(@PATH) ; $rel = join ("/", @PATH);
275 $user=(getpwnam( $user ))[7];
276 print "User dir is $user/$UserDir/$rel\n" if $debug;
277 ($nx,$ny) = &imgsize("$user/$UserDir/$rel",$five);
278 } elsif ($five =~ /^\/.*/) {
279 ($nx,$ny) = &imgsize("$DocumentRoot$five",$five);
282 ($nx,$ny) = &imgsize("$five",$five);
284 ($nx,$ny) = &imgsize("$REL/$five",$five);
288 if( $nx==0 && $ny==0 ){
289 print "\"$file\": No Values : $!\n";
293 printf( "(%3d,%3d) ", $nx,$ny) if (isfalse($Quiet));
295 if(&istrue($Skip1x1) &&
297 print "Skipping 1x1 image\n" if (isfalse($Quiet));
301 if (&istrue($SkipThreshold) && $nx<=$SkipThreshold &&
302 $ny<=$SkipThreshold){
303 print "Skipping $nx"."x$ny image (\$SkipThreshold=$SkipThreshold)\n" if
308 if( $nx && $ny && &do_change($ox,$oy,$nx,$ny)){
309 $changed=1; # mark the page as changed
310 $original[$i]=&replce_attrib($original[$i],$heighttag,$ny);
311 $original[$i]=&replce_attrib($original[$i],$widthtag,$nx);
312 if( $ox==0 && $oy==0 ){
313 print "Added tags " if (isfalse($Quiet));
315 print "Updated " if (isfalse($Quiet));
319 print "Needs Alt" if(&istrue($NeedAlt) && $tag !~ /ALT\s*=\s*\S+/i );
321 print "\n" if (isfalse($Quiet));
326 print " No need to write \"$file\": nothing changed\n";
330 if( ! &isfalse($MakeBackup) ){
331 # maybe I should move the rest of this stuff into a separate function?
332 if( &istrue($DoChmodChown) ){
333 # find out about this file
334 ($ino,$mode,$uid,$gid) = (stat($file))[1,2,4,5];
335 if ($ino == 0 || !rename($file, "$file$BackupExtension")) {
337 print "Couldn't stat \"$file\" for permissions & ownership: $!\n";
339 print "couldn't rename \"$file\" for backup: $!\n";
344 if( &istrue( $UsePerlCp ) ){
345 copy( $file, "$file$BackupExtension" );
347 # system( "cp $file $file$BackupExtension" );
348 # we could have added the -p flag e.g. cp -p ....
349 # use copy cos this keeps the permissions the same!
350 system( "cp -p $file $file$BackupExtension" );
355 $file="output.html" if $debug;
357 if(open(CONVERTED, $OutFilter =~ /\S+/ ? "|$OutFilter $file" : ">$file") ){
358 print CONVERTED join("<", @original);
361 if( &istrue($DoChmodChown) ){
362 # now change the ownership & permissions
363 chmod $mode, $file || print "Warning: Couldn't chmod $file\n";
364 # It seems that chown doesn't necessarily indicate any errors
365 chown $uid, $gid, $file || print "Warning: Couldn't chown $file\n";
367 ($nuid,$ngid) = (stat($file))[4,5];
370 print "Warning: $file now has different group or owner\n";
373 # if we defined a script to run the make it so....
374 system("$Script $file") if( $Script =~ /\S+/ );
376 print "Either: could not backup or could not write to $file!\n";
380 # replaces the $attrib's value to $val in $line
381 # if $attrib is not present it is inserted at the start of the tag
384 my($line,$attrib,$val)=@_;
385 my( $start, $oldval );
388 if(!defined($line ) ||
391 print "Error: dodgy arguments to replace_attrib!\n";
392 return $line if(defined($line)); # have no effect if we can
396 $attrib =~ tr/[A-Z]/[a-z]/ if($UpcaseTags=~/lower/i);
398 if( !(&isfalse($QuoteNums)) ){
399 if( $QuoteNums =~ /single/i ){
400 $val = "\'" . $val . "\'";
402 $val = "\"" . $val . "\"";
406 if( $line =~ /(\s+$attrib\s*=\s*)([\'\"]?\d+%?[\'\"]?)[^\000]*>/i ){ #"
409 $line =~ s/$start$oldval/$start$val/;
411 $line =~ s/(\S+\s+)/$1$attrib=$val /;
418 print "Change [Yn]?";
427 my($oldwidth, $oldheight, $newwidth, $newheight) = @_;
431 return 0 if (!defined($oldwidth) ||
432 !defined($oldheight) ||
433 !defined($newwidth) ||
434 !defined($newheight) ||
437 ($oldwidth ==$newwidth &&
438 $newheight==$oldheight));
440 return 1 if(!($oldwidth) && !($oldheight) );
442 if( &isfalse($ChangeIfThere) ){
444 } elsif( $ChangeIfThere =~ /clever/i ){
446 eval { $wrat= $newwidth / $oldwidth }; warn $@ if $@;
448 eval {$wrat = 1/ $wrat }; warn $@ if $@;
454 eval { $hrat= $newheight / $oldheight }; warn $@ if $@;
456 eval {$hrat = 1/ $hrat }; warn $@ if $@;
461 if((int($wrat) == $wrat) &&
462 (int($hrat) == $hrat) ){
465 return &ask_for_change();
467 } elsif($ChangeIfThere =~ /ask/i){
468 return &ask_for_change();
473 # looking at the filename really sucks I should be using the first 4 bytes
474 # of the image. If I ever do it these are the numbers.... (from chris@w3.org)
482 my($ref)=@_ ? shift @_ : "";
485 # first check the hash table (if we use one)
486 # then try and open the file
487 # then try the server if we know of one
488 if(&istrue($UseHash) &&
491 print "Hash " if $debug;
494 } elsif( defined($file) && open(STRM, "<$file") ){
495 binmode( STRM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED
496 if ($file =~ /\.jpg$/i || $file =~ /\.jpeg$/i) {
497 ($x,$y) = &jpegsize(\*STRM);
498 } elsif($file =~ /\.gif$/i) {
499 ($x,$y) = &gifsize(\*STRM);
500 } elsif($file =~ /\.xbm$/i) {
501 ($x,$y) = &xbmsize(\*STRM);
502 } elsif($file =~ /\.[pm]ng$/i) {
503 ($x,$y) = &pngsize(\*STRM);
505 print "$file is not gif, xbm, jpeg, png or mng (or has stupid name)";
509 if(&istrue($UseHash) && $x && $y){
515 # we couldn't open the file maybe we want to try the server?
517 if(&istrue($TryServer) &&
521 $ref= &ARKjoinURL( $Base, $ref );
522 print "Trying server for $ref\n" if $debug;
524 ($x,$y)=&URLsize($ref);
531 ###########################################################################
532 # Subroutine gets the size of the specified GIF
533 ###########################################################################
537 if( &istrue($UseNewGifsize) ){
538 return &NEWgifsize($GIF);
540 return &OLDgifsize($GIF);
547 my($type,$a,$b,$c,$d,$s)=(0,0,0,0,0,0);
549 if(defined( $GIF ) &&
550 read($GIF, $type, 6) &&
551 $type =~ /GIF8[7,9]a/ &&
552 read($GIF, $s, 4) == 4 ){
553 ($a,$b,$c,$d)=unpack("C"x4,$s);
554 return ($b<<8|$a,$d<<8|$c);
561 my ($GIF, $skip, $type) = @_;
565 read ($GIF, $dummy, $skip); # Skip header (if any)
568 warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
571 read($GIF, $s, 1); # Block size
572 last if ord($s) == 0; # Block terminator
573 read ($GIF, $dummy, ord($s)); # Skip data
577 # this code by "Daniel V. Klein" <dvk@lonewolf.com>
580 my($cmapsize, $a, $b, $c, $d, $e)=0;
585 return($x,$y) if(!defined $GIF);
587 read($GIF, $type, 6);
588 if($type !~ /GIF8[7,9]a/ || read($GIF, $s, 7) != 7 ){
589 warn "Invalid/Corrupted GIF (bad header)\n";
592 ($e)=unpack("x4 C",$s);
594 $cmapsize = 3 * 2**(($e & 0x07) + 1);
595 if (!read($GIF, $dummy, $cmapsize)) {
596 warn "Invalid/Corrupted GIF (global color map too small?)\n";
603 warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
607 ($e) = unpack("C", $s);
608 if ($e == 0x2c) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
609 if (read($GIF, $s, 8) != 8) {
610 warn "Invalid/Corrupted GIF (missing image header?)\n";
613 ($a,$b,$c,$d)=unpack("x4 C4",$s);
618 if ($type eq "GIF89a") {
619 if ($e == 0x21) { # Extension Introducer (GIF89a 23.c.i)
621 ($e) = unpack("C", $s);
622 if ($e == 0xF9) { # Graphic Control Extension (GIF89a 23.c.ii)
623 read($GIF, $dummy, 6); # Skip it
624 next FINDIMAGE; # Look again for Image Descriptor
625 } elsif ($e == 0xFE) { # Comment Extension (GIF89a 24.c.ii)
626 &gif_blockskip ($GIF, 0, "Comment");
627 next FINDIMAGE; # Look again for Image Descriptor
628 } elsif ($e == 0x01) { # Plain Text Label (GIF89a 25.c.ii)
629 &gif_blockskip ($GIF, 12, "text data");
630 next FINDIMAGE; # Look again for Image Descriptor
631 } elsif ($e == 0xFF) { # Application Extension Label (GIF89a 26.c.ii)
632 &gif_blockskip ($GIF, 11, "application data");
633 next FINDIMAGE; # Look again for Image Descriptor
635 printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
640 printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
645 warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
655 if( defined( $XBM ) ){
660 if( /.define\s+\S+\s+(\d+)\s*\n.define\s+\S+\s+(\d+)\s*\n/i ){
667 # pngsize : gets the width & height (in pixels) of a png file
668 # cor this program is on the cutting edge of technology! (pity it's blunt!)
669 # GRR 970619: fixed bytesex assumption
674 my($a, $b, $c, $d, $e, $f, $g, $h)=0;
677 read( $PNG, $head, 8 ) == 8 &&
678 ( $head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
679 $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" ) &&
680 read($PNG, $head, 4) == 4 &&
681 read($PNG, $head, 4) == 4 &&
684 read($PNG, $head, 8) == 8 ){
685 # ($x,$y)=unpack("I"x2,$head); # doesn't work on little-endian machines
687 ($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head);
688 return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
693 # jpegsize : gets the width and height (in pixels) of a jpeg file
694 # Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
695 # modified slightly by alex@ed.ac.uk
699 my($c1,$c2,$ch,$s,$length, $dummy)=(0,0,0,0,0,0);
703 read($JPEG, $c1, 1) &&
704 read($JPEG, $c2, 1) &&
707 while (ord($ch) != 0xDA && !$done) {
708 # Find next marker (JPEG markers begin with 0xFF)
709 # This can hang the program!!
710 while (ord($ch) != 0xFF) { return(0,0) unless read($JPEG, $ch, 1); }
711 # JPEG markers can be padded with unlimited 0xFF's
712 while (ord($ch) == 0xFF) { return(0,0) unless read($JPEG, $ch, 1); }
713 # Now, $ch contains the value of the marker.
714 if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
715 return(0,0) unless read ($JPEG, $dummy, 3);
716 return(0,0) unless read($JPEG, $s, 4);
717 ($a,$b,$c,$d)=unpack("C"x4,$s);
718 return ($c<<8|$d, $a<<8|$b );
720 # We **MUST** skip variables, since FF's within variable names are
721 # NOT valid JPEG markers
722 return(0,0) unless read ($JPEG, $s, 2);
723 ($c1, $c2) = unpack("C"x2,$s);
724 $length = $c1<<8|$c2;
725 last if (!defined($length) || $length < 2);
726 read($JPEG, $dummy, $length-2);
733 # this is untested contributed code From: Jan Paul Schmidt <jps@fundament.org>
734 # if you have problems with the jpegsize above - try this one!
738 my( $i, $w, $y, $h, $j, $b ) = (0,0,0,0,0,0);
743 if ($j == 0xffd8ffe0) {
746 seek $JPEG, unpack("n", $b) - 2, 1;
749 if ($j >= 0xffc0 and $j <= 0xffc3) {
759 } while not eof($JPEG);
765 ###########################################################################
766 # Subroutine grabs a gif from another server, and gets its size
767 ###########################################################################
772 my($dummy, $server, $url);
773 my($c1, $c2, $c3, $c4)=(0,0,0,0);
777 print "URLsize: $five\n" if $debug;
779 # first check the hash table (if we're using one)
780 if(&istrue($UseHash) &&
783 print "Hash " if $debug;
790 if( $Proxy =~ /\S+/ ){
791 ($dummy, $dummy, $server, $url) = split(/\//, $Proxy, 4);
794 ($dummy, $dummy, $server, $url) = split(/\//, $five, 4);
798 my($them,$port) = split(/:/, $server);
799 my( $iaddr, $paddr, $proto );
801 $port = 80 unless $port;
802 $them = 'localhost' unless $them;
804 print "\nThey are $them on port $port\n" if $debug;# && $Proxy;
805 print "url is $url\n" if $debug;
808 if( /gif/i || /jpeg/i || /jpg/i || /xbm/i || /png/i ){
810 $iaddr= inet_aton( $them );
811 $paddr= sockaddr_in( $port, $iaddr );
812 $proto=getprotobyname('tcp');
814 # Make the socket filehandle.
816 if(socket(STRM, PF_INET, SOCK_STREAM, $proto) &&
817 connect(STRM,$paddr) ){
818 # Set socket to be command buffered.
819 select(STRM); $| = 1; select(STDOUT);
821 print "Getting $url\n" if $debug;
823 my $str=("GET $url HTTP/1.1\n".
824 #"User-Agent: Mozilla/4.08 [en] (WWWIS)\n".
826 "Connection: close\n".
829 print "$str" if $debug;
833 # we're looking for \n\r\n\r
834 while ((ord($c1) != 10) || (ord($c2) != 13) || (ord ($c3) != 10) ||
840 print "$c1" if $debug;
842 print "\n" if $debug;
844 if ($url =~ /\.jpg$/i || $url =~ /\.jpeg$/i) {
845 ($x,$y) = &jpegsize(\*STRM);
846 } elsif($url =~ /\.gif$/i) {
847 ($x,$y) = &gifsize(\*STRM);
848 } elsif($url =~ /\.xbm$/i) {
849 ($x,$y) = &xbmsize(\*STRM);
850 } elsif($url =~ /\.png$/i) {
851 ($x,$y) = &pngsize(\*STRM);
853 print "$url is not gif, jpeg, xbm or png (or has stupid name)";
858 # there was a problem
862 print "$url is not gif, xbm or jpeg (or has stupid name)";
864 if(&istrue($UseHash) && $x && $y){
874 return (defined($val) && ($val =~ /^y(es)?/i || $val =~ /true/i ));
880 return (defined($val) && ($val =~ /^no?/i || $val =~ /false/i ));
886 $_=$name; # now to gte rid of quotes if they were there
887 if( /\"([^\"]*)\"/ ){ return $1; } #"
888 elsif( /\'([^\']*)\'/ ){ return $1; }
892 # this doesn't cope with \-ed " which it should!!!
893 # I also didn't cope with javascript stuff like onChange (whoops)
894 # this is why it is unsupported.
898 my( $ostr, $str, $j )=("","",0);
901 return $text if( !defined($1));
904 @line=split(/\"/, $str); #"
906 for( $j=0 ; $j <= $#line ; $j+=2 ){
907 if( $UpcaseTags =~ /lower/i ){
908 $line[$j] =~ tr/[A-Z]/[a-z]/;
910 $line[$j] =~ tr/[a-z]/[A-Z]/;
913 if( $str =~ /\"$/ ){ #"
914 $str=join( "\"", @line , "");
916 $str=join( "\"", @line );
918 $text=~ s/^$ostr/$str/;
923 # joins together two URLS to make one url
924 # e.g. http://www/ + fish.html = http://www/fish.html
925 # e.g. http://www/index.html + fish.html = http://www/fish.html
926 # e.g. http://www/s/index.html + /fish.html = http://www/fish.html
931 # if url has a double // in it then it is fine thank you!
932 return $url if( $url =~ /\/\// );
934 # strip down base url to make sure that it doesn't have a .html at the end
938 # strip off leading directories
939 $base =~ s/(\/\/[^\/]*)\/.*$/$1/;
942 return ($base . $url);
945 # File: wwwis-options.pl -*- Perl -*-
946 # Created by: Alex Knowles (alex@ed.ac.uk) Sat Nov 2 16:41:12 1996
947 # Last Modified: Time-stamp: <03 Nov 96 1549 Alex Knowles>
948 # RCS $Id: wwwis,v 2.43 2004/12/02 18:32:13 ark Exp $
949 ############################################################################
950 # There now follows some routines to get the configuration file
951 ############################################################################
954 # give me the start of the next option (as options can take up a
955 # different number of array elements)
961 if( /string/i || /integer/i || /file/i || /bool/i ){
963 } elsif( /choice/i ){
964 $i+=4+$options[$i+3];
966 print "unknown option type! $_\n";
972 # ShowOptions: now I use -usage it's much better
975 # Check if $val (arg2) is valid for option which starts at options[$i (arg1)]
976 # returns either 0 (failure) or 1 (success)
982 return 0 unless $i && $val;
986 # can't think of a check for this
987 }elsif( /integer/i ){
988 if( $val !~ /^\d+$/ ){
989 print "$val is not an integer!\n";
993 if( ! (-e ($val) ) ){
994 print "can't find file $val for $options[$i]\n";
998 if( $val !~ /^(y(es)?|no?)$/i ){
999 print "$val is neither Yes nor No\n";
1002 }elsif( /choice/i ){
1003 for( $k=0 ; $k < $options[$i+3] ; $k++ ){
1004 if( $val =~ /^$options[$i+4+$k]$/i ){
1008 print "$val is not a valid value for $options[$i]\n";
1011 print "unknown option type! $_\n";
1018 # Read user's configuration file, if such exists. If WWWIMAGESIZERC is
1019 # set in user's environment, then read the file referenced, otherwise
1020 # try for $HOME/.wwwimagesizerc
1024 my( @optionval )=();
1030 #first go through options array and puyt the default values into optionval
1033 while( $i < $#options ){
1034 $optionval[$j]=$options[$i+2];
1039 push(@files,$ENV{'WWWISRC'}) if $ENV{'WWWISRC'};
1040 push(@files,$ENV{'WWWIMAGESIZERC'}) if $ENV{'WWWIMAGESIZERC'};
1041 push(@files,("$ENV{'HOME'}/.wwwisrc",
1042 "$ENV{'HOME'}/.wwwimagesizerc",)) if $ENV{'HOME'};
1044 foreach $i (@files){
1045 if( defined($i) && -f $i ){
1051 if(defined($filename) &&
1053 open(CONFIG,"< $filename") ){
1055 # skip lines with a hash on them
1060 if( $line =~ /^(\S+)(\s+|\s*:\s*)(.+)$/ ){
1061 if( !(&proc_option($1,$3)) ){
1062 print "Invalid .wwwisrc line: $line";
1069 print "Unable to read config file `$filename': $!\n";
1078 my($i,$j,$proced)=(0,0,0);
1080 return 0 unless $opt && $value;
1082 while( !$proced && $i < $#options ){
1083 if( $options[$i] =~ /$opt/i ){
1085 if( &CheckOption($i,$value) ){
1086 $optionval[$j]=$value;
1088 printf("Invalid .wwwisrc value \"%s\" for option \"%s\"\n",
1089 $value,$options[$i]);
1093 $i=&NextOption($i); # move onto the next option
1103 return if !defined($arg);
1105 if( $arg =~ /^-+v(ersion)?$/i ){
1106 my($version)='$Revision: 2.43 $ ';
1108 $progname =~ s/.*\///; # we only want the name
1109 $version =~ s/[^\d\.]//g; # we only care about numbers and full stops
1110 print "$progname: $version\n";
1111 } elsif( $arg =~ /^-+u(sage)?$/i ||
1112 $arg =~ /^-+h(elp)?$/i ){
1114 } elsif( $arg =~ /^-+d(ebug)$/i ){
1116 } elsif( $arg =~ /-+im(a)?g(e)?size/i ){
1117 my($x,$y)=&imgsize(shift @ARGV);
1118 print "WIDTH=$x HEIGHT=$y\n";
1121 if( &proc_option( $arg, shift @ARGV)){
1124 print "Unrecognized option $arg\n";
1135 return "" if !defined $i;
1137 if( $options[$i+1] =~ /file/i ){
1139 } elsif($options[$i+1] =~ /string|integer/i ){
1141 } elsif($options[$i+1] =~ /bool/i ){
1142 return ('Yes','No');
1143 } elsif($options[$i+1] =~ /choice/i ){
1144 my($start,$end)=(($i+4),($options[$i+3]));
1145 return (@options[$start .. $start+$end-1]);
1147 print "Unrecognized option type\n";
1155 $progname =~ s/.*\///; # we only want the name
1158 print "$progname: [-version] [-usage] [-option optionval] file.html ... \n";
1160 my($fmt)=" %15s %6s %-10s %s\n";
1162 printf($fmt,"Option Name","Type","Default","Values");
1163 printf($fmt,"-----------","----","-------","------");
1167 while( $i < $#options ){
1168 $vals=join(',', &get_values($i));
1169 printf($fmt,$options[$i],$options[$i+1],$optionval[$j],$vals);