X-Git-Url: http://git.grml.org/?a=blobdiff_plain;f=usr_bin%2Fwwwis;fp=usr_bin%2Fwwwis;h=0000000000000000000000000000000000000000;hb=c08b156abb0b2b1b1335cb1ada0c08758553238b;hp=ac2e52c2b8b7183db9ea4927959f72fbdb67c56c;hpb=b0c3e5ff760f99d6ff7721852bc1a0d73c5ea201;p=grml-scripts.git diff --git a/usr_bin/wwwis b/usr_bin/wwwis deleted file mode 100755 index ac2e52c..0000000 --- a/usr_bin/wwwis +++ /dev/null @@ -1,1176 +0,0 @@ -#!/usr/bin/perl -w -# -# wwwis: adds HEIGHT= and WIDTH= to images referenced in specified HTML file. -# -# for documentation - changelog and latest version -# see http://www.bloodyeck.com/wwwis/ -# -# this program by (and copyright) Alex Knowles, Alex@bloodyEck.com -# based on original code and idea by Andrew Tong, werdna@ugcs.caltech.edu -# -# You may distribute this code under the GNU public license -# -# THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT WARRANTY OF ANY KIND. -# -# RCS $Id: wwwis,v 2.43 2004/12/02 18:32:13 ark Exp $ - -use strict; -use File::Copy; -use Socket; -# if you do not have these system libraries make sure you comment them out -# and have the options UsePerlCp, searchURLS, TryServer ALL SET TO NO - -if( ! $\ ){ - # this stops the error Use of uninitialized value at .../File/Copy.pm line 84 - # print "Out rec sep not defined?? someone help me with this\n"; - $\=''; -} - -# this array specifies what options are available what the default -# value is and also what type it is, files are checked to see if they -# exist and the only possible values for choice are given. -# you should only need to change the third column -my(@options)= - ('searchURLS', 'bool', 'Yes', - 'DocumentRoot', 'file', '/usr/local/etc/httpd/htdocs', - 'UserDir', 'string', 'html', - 'MakeBackup', 'bool', 'Yes', - 'BackupExtension', 'string', '~', - 'OverwriteBackup', 'choice', 'Yes', 3, 'Yes','No','Ask', - 'ChangeIfThere', 'choice', 'Yes', 4, 'Yes','No','Ask','Clever', - 'Skip1x1', 'bool', 'Yes', - 'SkipThreshold', 'integer', '0', # 0 disables this option - 'DoChmodChown', 'bool', 'No', - 'UpcaseTags', 'choice', 'No', 4, 'Yes','No','Upper','Lower', - 'UpcaseNewTags', 'bool', 'No', - 'TryServer', 'bool', 'Yes', - 'QuoteNums', 'choice', 'No', 4, 'Yes','No','Single','Double', - 'Munge%', 'bool', 'Yes', - 'NeedAlt', 'bool', 'Yes', - 'SkipCGI', 'bool', 'Yes', - 'UseNewGifsize', 'bool', 'No', - 'UseHash', 'bool', 'Yes', - 'Base', 'string', '', - 'InFilter', 'string', '', - 'OutFilter', 'string', '', - 'Quiet', 'bool', 'No', - 'Script', 'string', '', - 'Proxy', 'string', '', - 'SkipFilter', 'string', '', - 'IgnoreLinks', 'bool', 'Yes', - 'UsePerlCp', 'bool', 'Yes', - ); - -##################################################################### -######### YOU SHOULD NOT HAVE TO CHANGE ANYTHING BELOW HERE ######### -##################################################################### - - -my($Base, $SkipCGI, $InFilter, $MakeBackup, $SearchURLS, $OverwriteBackup, - $Proxy, $UseHash, $OutFilter, $UpcaseTags, $UpcaseNewTags, - $UseNewGifsize, $debug, - $Script, $UserDir, $TryServer, $DoChmodChown,$ChangeIfThere, $IgnoreLinks, - $NeedAlt,$MungePer, $QuoteNums, $DocumentRoot,$BackupExtension, $Quiet, - $UsePerlCp, $Skip1x1, $SkipThreshold, $SkipFilter ); - -my( %hashx, %hashy ); - -# O.K. now we have defined the options go and get them and set the global vars -my(@optionval)=&GetConfigFile(@options); -&SetGlobals(); - -$|=1; # make it so that I can fit lots of info on one line... - -############################################################################ -# Main routine. processes all files specified on command line, skipping -# any file for which a .bak file exists. -############################################################################ -while (@ARGV) { - my($FILE)=shift; - if( $FILE =~ /^-/ ){ - &proc_arg($FILE); - next; - } - - print "$FILE -- "; - - if( -s $FILE && -T $FILE ){ - if ( -e "$FILE$BackupExtension"){ - if( &isfalse($OverwriteBackup) ){ - print "Skipping -- found $FILE$BackupExtension\n"; - next; - } elsif ( $OverwriteBackup =~ /ASK/i ){ - print "overwite $FILE$BackupExtension [Yn]\n"; - $_=; - if( /n/i ){ - print " - Skipping\n"; - next; - } - } - } - if ( -l $FILE and &istrue($IgnoreLinks) ){ - print "Skipping -- this file is a symbolic link\n"; - next; - } - print "Processing...\n"; - &convert($FILE); - } else { - print "Skipping -- Doesn't look like a text file to me!\n"; - next; - } -} - -# SetGlobals: -# This converts the optionval array into global variables -# this is cos I don't know how to store pointers to variables in arrys (sorry) -sub SetGlobals -{ - my($i)=0; - - $SearchURLS = $optionval[$i++]; - $DocumentRoot = $optionval[$i++]; - $UserDir = $optionval[$i++]; - $MakeBackup = $optionval[$i++]; - $BackupExtension = $optionval[$i++]; - $OverwriteBackup = $optionval[$i++]; - $ChangeIfThere = $optionval[$i++]; - $Skip1x1 = $optionval[$i++]; - $SkipThreshold = $optionval[$i++]; - $DoChmodChown = $optionval[$i++]; - $UpcaseTags = $optionval[$i++]; - $UpcaseNewTags = $optionval[$i++]; - $TryServer = $optionval[$i++]; - $QuoteNums = $optionval[$i++]; - $MungePer = $optionval[$i++]; - $NeedAlt = $optionval[$i++]; - $SkipCGI = $optionval[$i++]; - $UseNewGifsize = $optionval[$i++]; - $UseHash = $optionval[$i++]; - $Base = $optionval[$i++]; - $InFilter = $optionval[$i++]; - $OutFilter = $optionval[$i++]; - $Quiet = $optionval[$i++]; - $Script = $optionval[$i++]; - $Proxy = $optionval[$i++]; - $SkipFilter = $optionval[$i++]; - $IgnoreLinks = $optionval[$i++]; - $UsePerlCp = $optionval[$i++]; - - # do a quick check just to see we got everything - $i--; - if( $i!=$#optionval ){ - print "Internal Error: number of options is not equal to globals!\n"; - print "Please Email alex\@ed.ac.uk for help\n"; - exit; - } -} - -########################################################################### -# Subroutine does all the actual HTML parsing --- grabs image URLs and tells -# other routines to open the images and get their size -########################################################################### -sub convert { - my($file) = @_; - my($ox,$oy,$nx,$ny); - my($changed,$type,$tag,$five,$user,$original,@original); - my($widthtag,$heighttag); - my($HTMLbase,$i); - my(@PATH,$REL,$rel); - - my($ino, $mode, $uid, $gid, $ngid, $nuid ); - - $changed=0; # did we change this file - $original=""; # the string containing the whole file - - $widthtag=&istrue($UpcaseNewTags)?"WIDTH":"width"; - $heighttag=&istrue($UpcaseNewTags)?"HEIGHT":"height"; - - - if( !open(ORIGINAL, $InFilter =~ /\S+/ ? "$InFilter $file|" : "<$file") ){ - print "Couldn't open $file\n"; - return; - } - while () { - $original .= $_; - } - close (ORIGINAL); - @PATH = split(/[\\\/]/, $file); # \\ for NT (brian_helterline@om.cv.hp.com) - pop(@PATH); - $REL = join("/", @PATH); - - # print out the header to the columns - printf(" %s %-34s %-9s %-9s\n",'Type','File',' Old',' New') if (isfalse($Quiet)); - - @original=split(//i){ #" - # we found an IMG or FIGURE tag! this is really important - - # initialise some of my flags - if( !defined($1) || !defined($2) || !defined($4) ){ - print " Couldn't find tagtype or images source for tag number $i!\n"; - return; - } - $tag=$1; # The whole HTML tag (with attributes) - $type=$2; # this is either IMG or FIGURE - $five=$4; # we put the SRC in a variable called five for historic reasons - $five=&strip_quotes($five); - $ox=0; $oy=0; # old X & Y values (Was Width & Height) - $nx=0; $ny=0; # the new values - - printf(" %3s %-34s ",substr($type,0,3),$five) if (isfalse($Quiet)); - - if(&istrue($SkipCGI) && - $five =~ /(\.(cgi|pl)$|\/cgi-bin\/|\/cgi\/)/ ){ - print "\"$file\": Skipping CGI program\n" if (isfalse($Quiet)); - next; - } - if( $SkipFilter && $five =~/$SkipFilter/i ){ - print "\"$file\": SkipFilter matched\n" if (isfalse($Quiet)); - next; - } - - if( $tag =~ /(width|height)\s*=\s*[\"\']?\d+%/i ){ #" - # we found a % sign near width or height - if( ! &istrue($MungePer) ){ - print "\"$file\": Found % Skipping\n"; - next; - } - } else { - $ox=$2 if( $tag =~ /\s*width\s*=\s*(\"|\')?(\d+)\s*/i ); #" - $oy=$2 if( $tag =~ /\s*height\s*=\s*(\"|\')?(\d+)\s*/i ); #" - } - - printf("(%3d,%3d) ",$ox,$oy) if (isfalse($Quiet)); - - if( $ox && $oy && &isfalse($ChangeIfThere) ){ - print "Already There\n"; - next; - } - - if( defined($HTMLbase) && $HTMLbase =~ /\S+/ ){ - print "\nUsing HTMLbase to turn:$five\n" if $debug; - $five=&ARKjoinURL($HTMLbase,$five); - print "Into :$five\n" if $debug; - } - - if ($five =~ /^http:\/\/.*/) { - if (&istrue($SearchURLS)) { - ($nx,$ny) = &URLsize($five); - } - } elsif ($five =~ /^\/\~.*/) { - @PATH = split(/\//, $five); - shift(@PATH); $user = shift(@PATH) ; $rel = join ("/", @PATH); - $user =~ s/^\~//; - $user=(getpwnam( $user ))[7]; - print "User dir is $user/$UserDir/$rel\n" if $debug; - ($nx,$ny) = &imgsize("$user/$UserDir/$rel",$five); - } elsif ($five =~ /^\/.*/) { - ($nx,$ny) = &imgsize("$DocumentRoot$five",$five); - } else { - if ($REL eq '') { - ($nx,$ny) = &imgsize("$five",$five); - } else { - ($nx,$ny) = &imgsize("$REL/$five",$five); - } - } - - if( $nx==0 && $ny==0 ){ - print "\"$file\": No Values : $!\n"; - next; - } - - printf( "(%3d,%3d) ", $nx,$ny) if (isfalse($Quiet)); - - if(&istrue($Skip1x1) && - $nx==1 && $ny==1){ - print "Skipping 1x1 image\n" if (isfalse($Quiet)); - next; - } - - if (&istrue($SkipThreshold) && $nx<=$SkipThreshold && - $ny<=$SkipThreshold){ - print "Skipping $nx"."x$ny image (\$SkipThreshold=$SkipThreshold)\n" if - (isfalse($Quiet)); - next; - } - - if( $nx && $ny && &do_change($ox,$oy,$nx,$ny)){ - $changed=1; # mark the page as changed - $original[$i]=&replce_attrib($original[$i],$heighttag,$ny); - $original[$i]=&replce_attrib($original[$i],$widthtag,$nx); - if( $ox==0 && $oy==0 ){ - print "Added tags " if (isfalse($Quiet)); - } else { - print "Updated " if (isfalse($Quiet)); - } - } - - print "Needs Alt" if(&istrue($NeedAlt) && $tag !~ /ALT\s*=\s*\S+/i ); - - print "\n" if (isfalse($Quiet)); - } - } - - if( !($changed)) { - print " No need to write \"$file\": nothing changed\n"; - return; - } - - if( ! &isfalse($MakeBackup) ){ - # maybe I should move the rest of this stuff into a separate function? - if( &istrue($DoChmodChown) ){ - # find out about this file - ($ino,$mode,$uid,$gid) = (stat($file))[1,2,4,5]; - if ($ino == 0 || !rename($file, "$file$BackupExtension")) { - if( $ino == 0 ){ - print "Couldn't stat \"$file\" for permissions & ownership: $!\n"; - } else { - print "couldn't rename \"$file\" for backup: $!\n"; - } - return; - } - } else { - if( &istrue( $UsePerlCp ) ){ - copy( $file, "$file$BackupExtension" ); - } else { - # system( "cp $file $file$BackupExtension" ); - # we could have added the -p flag e.g. cp -p .... - # use copy cos this keeps the permissions the same! - system( "cp -p $file $file$BackupExtension" ); - } - } - } - - $file="output.html" if $debug; - - if(open(CONVERTED, $OutFilter =~ /\S+/ ? "|$OutFilter $file" : ">$file") ){ - print CONVERTED join("<", @original); - close(CONVERTED); - - if( &istrue($DoChmodChown) ){ - # now change the ownership & permissions - chmod $mode, $file || print "Warning: Couldn't chmod $file\n"; - # It seems that chown doesn't necessarily indicate any errors - chown $uid, $gid, $file || print "Warning: Couldn't chown $file\n"; - - ($nuid,$ngid) = (stat($file))[4,5]; - if ($nuid != $uid || - $ngid != $gid ){ - print "Warning: $file now has different group or owner\n"; - } - } - # if we defined a script to run the make it so.... - system("$Script $file") if( $Script =~ /\S+/ ); - } else { - print "Either: could not backup or could not write to $file!\n"; - } -} - -# replaces the $attrib's value to $val in $line -# if $attrib is not present it is inserted at the start of the tag -sub replce_attrib -{ - my($line,$attrib,$val)=@_; - my( $start, $oldval ); - - # argument checking - if(!defined($line ) || - !defined($attrib) || - !defined($val)){ - print "Error: dodgy arguments to replace_attrib!\n"; - return $line if(defined($line)); # have no effect if we can - exit; - } - - $attrib =~ tr/[A-Z]/[a-z]/ if($UpcaseTags=~/lower/i); - - if( !(&isfalse($QuoteNums)) ){ - if( $QuoteNums =~ /single/i ){ - $val = "\'" . $val . "\'"; - } else { - $val = "\"" . $val . "\""; - } - } - - if( $line =~ /(\s+$attrib\s*=\s*)([\'\"]?\d+%?[\'\"]?)[^\000]*>/i ){ #" - $start=$1; - $oldval=$2; - $line =~ s/$start$oldval/$start$val/; - } else { - $line =~ s/(\S+\s+)/$1$attrib=$val /; - } - return $line; -} - -sub ask_for_change{ - my($ret)=1; - print "Change [Yn]?"; - $_=; - if( /n/i ){ - $ret=0; - } - return $ret; -} - -sub do_change{ - my($oldwidth, $oldheight, $newwidth, $newheight) = @_; - my($wrat); - my($hrat); - - return 0 if (!defined($oldwidth) || - !defined($oldheight) || - !defined($newwidth) || - !defined($newheight) || - !($newwidth) || - !($newheight) || - ($oldwidth ==$newwidth && - $newheight==$oldheight)); - - return 1 if(!($oldwidth) && !($oldheight) ); - - if( &isfalse($ChangeIfThere) ){ - return 0; - } elsif( $ChangeIfThere =~ /clever/i ){ - if( $oldwidth ){ - eval { $wrat= $newwidth / $oldwidth }; warn $@ if $@; - if( $wrat < 1.0 ){ - eval {$wrat = 1/ $wrat }; warn $@ if $@; - } - } else { - $wrat=1.5; - } - if( $oldheight ){ - eval { $hrat= $newheight / $oldheight }; warn $@ if $@; - if( $hrat < 1.0 ){ - eval {$hrat = 1/ $hrat }; warn $@ if $@; - } - } else { - $hrat=1.5; - } - if((int($wrat) == $wrat) && - (int($hrat) == $hrat) ){ - return 0; - } else { - return &ask_for_change(); - } - } elsif($ChangeIfThere =~ /ask/i){ - return &ask_for_change(); - } - return 1; -} - -# looking at the filename really sucks I should be using the first 4 bytes -# of the image. If I ever do it these are the numbers.... (from chris@w3.org) -# PNG 89 50 4e 47 -# MNG 8a 4d 4e 47 -# GIF 47 49 46 38 -# JPG ff d8 ff e0 -# XBM 23 64 65 66 -sub imgsize { - my($file)= shift @_; - my($ref)=@_ ? shift @_ : ""; - my($x,$y)=(0,0); - - # first check the hash table (if we use one) - # then try and open the file - # then try the server if we know of one - if(&istrue($UseHash) && - $hashx{$file} && - $hashy{$file} ){ - print "Hash " if $debug; - $x=$hashx{$file}; - $y=$hashy{$file}; - } elsif( defined($file) && open(STRM, "<$file") ){ - binmode( STRM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED - if ($file =~ /\.jpg$/i || $file =~ /\.jpeg$/i) { - ($x,$y) = &jpegsize(\*STRM); - } elsif($file =~ /\.gif$/i) { - ($x,$y) = &gifsize(\*STRM); - } elsif($file =~ /\.xbm$/i) { - ($x,$y) = &xbmsize(\*STRM); - } elsif($file =~ /\.[pm]ng$/i) { - ($x,$y) = &pngsize(\*STRM); - } else { - print "$file is not gif, xbm, jpeg, png or mng (or has stupid name)"; - } - close(STRM); - - if(&istrue($UseHash) && $x && $y){ - $hashx{$file}=$x; - $hashy{$file}=$y; - } - - } else { - # we couldn't open the file maybe we want to try the server? - - if(&istrue($TryServer) && - defined($ref) && - $ref =~ /\S+/ && - $Base =~ /\S+/ ){ - $ref= &ARKjoinURL( $Base, $ref ); - print "Trying server for $ref\n" if $debug; - - ($x,$y)=&URLsize($ref); - } - } - - return ($x,$y); -} - -########################################################################### -# Subroutine gets the size of the specified GIF -########################################################################### -sub gifsize -{ - my($GIF) = @_; - if( &istrue($UseNewGifsize) ){ - return &NEWgifsize($GIF); - } else { - return &OLDgifsize($GIF); - } -} - - -sub OLDgifsize { - my($GIF) = @_; - my($type,$a,$b,$c,$d,$s)=(0,0,0,0,0,0); - - if(defined( $GIF ) && - read($GIF, $type, 6) && - $type =~ /GIF8[7,9]a/ && - read($GIF, $s, 4) == 4 ){ - ($a,$b,$c,$d)=unpack("C"x4,$s); - return ($b<<8|$a,$d<<8|$c); - } - return (0,0); -} - -# part of NEWgifsize -sub gif_blockskip { - my ($GIF, $skip, $type) = @_; - my ($s)=0; - my ($dummy)=''; - - read ($GIF, $dummy, $skip); # Skip header (if any) - while (1) { - if (eof ($GIF)) { - warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n"; - return ""; - } - read($GIF, $s, 1); # Block size - last if ord($s) == 0; # Block terminator - read ($GIF, $dummy, ord($s)); # Skip data - } -} - -# this code by "Daniel V. Klein" -sub NEWgifsize { - my($GIF) = @_; - my($cmapsize, $a, $b, $c, $d, $e)=0; - my($type,$s)=(0,0); - my($x,$y)=(0,0); - my($dummy)=''; - - return($x,$y) if(!defined $GIF); - - read($GIF, $type, 6); - if($type !~ /GIF8[7,9]a/ || read($GIF, $s, 7) != 7 ){ - warn "Invalid/Corrupted GIF (bad header)\n"; - return($x,$y); - } - ($e)=unpack("x4 C",$s); - if ($e & 0x80) { - $cmapsize = 3 * 2**(($e & 0x07) + 1); - if (!read($GIF, $dummy, $cmapsize)) { - warn "Invalid/Corrupted GIF (global color map too small?)\n"; - return($x,$y); - } - } - FINDIMAGE: - while (1) { - if (eof ($GIF)) { - warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n"; - return($x,$y); - } - read($GIF, $s, 1); - ($e) = unpack("C", $s); - if ($e == 0x2c) { # Image Descriptor (GIF87a, GIF89a 20.c.i) - if (read($GIF, $s, 8) != 8) { - warn "Invalid/Corrupted GIF (missing image header?)\n"; - return($x,$y); - } - ($a,$b,$c,$d)=unpack("x4 C4",$s); - $x=$b<<8|$a; - $y=$d<<8|$c; - return($x,$y); - } - if ($type eq "GIF89a") { - if ($e == 0x21) { # Extension Introducer (GIF89a 23.c.i) - read($GIF, $s, 1); - ($e) = unpack("C", $s); - if ($e == 0xF9) { # Graphic Control Extension (GIF89a 23.c.ii) - read($GIF, $dummy, 6); # Skip it - next FINDIMAGE; # Look again for Image Descriptor - } elsif ($e == 0xFE) { # Comment Extension (GIF89a 24.c.ii) - &gif_blockskip ($GIF, 0, "Comment"); - next FINDIMAGE; # Look again for Image Descriptor - } elsif ($e == 0x01) { # Plain Text Label (GIF89a 25.c.ii) - &gif_blockskip ($GIF, 12, "text data"); - next FINDIMAGE; # Look again for Image Descriptor - } elsif ($e == 0xFF) { # Application Extension Label (GIF89a 26.c.ii) - &gif_blockskip ($GIF, 11, "application data"); - next FINDIMAGE; # Look again for Image Descriptor - } else { - printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e; - return($x,$y); - } - } - else { - printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e; - return($x,$y); - } - } - else { - warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n"; - return($x,$y); - } - } -} - -sub xbmsize { - my($XBM) = @_; - my($input)=""; - - if( defined( $XBM ) ){ - $input .= <$XBM>; - $input .= <$XBM>; - $input .= <$XBM>; - $_ = $input; - if( /.define\s+\S+\s+(\d+)\s*\n.define\s+\S+\s+(\d+)\s*\n/i ){ - return ($1,$2); - } - } - return (0,0); -} - -# pngsize : gets the width & height (in pixels) of a png file -# cor this program is on the cutting edge of technology! (pity it's blunt!) -# GRR 970619: fixed bytesex assumption -sub pngsize { - my($PNG) = @_; - my($head) = ""; -# my($x,$y); - my($a, $b, $c, $d, $e, $f, $g, $h)=0; - - if(defined($PNG) && - read( $PNG, $head, 8 ) == 8 && - ( $head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" || - $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" ) && - read($PNG, $head, 4) == 4 && - read($PNG, $head, 4) == 4 && - ($head eq "MHDR" || - $head eq "IHDR") && - read($PNG, $head, 8) == 8 ){ -# ($x,$y)=unpack("I"x2,$head); # doesn't work on little-endian machines -# return ($x,$y); - ($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head); - return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h); - } - return (0,0); -} - -# jpegsize : gets the width and height (in pixels) of a jpeg file -# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995 -# modified slightly by alex@ed.ac.uk -sub jpegsize { - my($JPEG) = @_; - my($done)=0; - my($c1,$c2,$ch,$s,$length, $dummy)=(0,0,0,0,0,0); - my($a,$b,$c,$d); - - if(defined($JPEG) && - read($JPEG, $c1, 1) && - read($JPEG, $c2, 1) && - ord($c1) == 0xFF && - ord($c2) == 0xD8 ){ - while (ord($ch) != 0xDA && !$done) { - # Find next marker (JPEG markers begin with 0xFF) - # This can hang the program!! - while (ord($ch) != 0xFF) { return(0,0) unless read($JPEG, $ch, 1); } - # JPEG markers can be padded with unlimited 0xFF's - while (ord($ch) == 0xFF) { return(0,0) unless read($JPEG, $ch, 1); } - # Now, $ch contains the value of the marker. - if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) { - return(0,0) unless read ($JPEG, $dummy, 3); - return(0,0) unless read($JPEG, $s, 4); - ($a,$b,$c,$d)=unpack("C"x4,$s); - return ($c<<8|$d, $a<<8|$b ); - } else { - # We **MUST** skip variables, since FF's within variable names are - # NOT valid JPEG markers - return(0,0) unless read ($JPEG, $s, 2); - ($c1, $c2) = unpack("C"x2,$s); - $length = $c1<<8|$c2; - last if (!defined($length) || $length < 2); - read($JPEG, $dummy, $length-2); - } - } - } - return (0,0); -} - -# this is untested contributed code From: Jan Paul Schmidt -# if you have problems with the jpegsize above - try this one! -sub jpegsize2 -{ - my($JPEG) = @_; - my( $i, $w, $y, $h, $j, $b ) = (0,0,0,0,0,0); - - read $JPEG, $b, 4; - $j = unpack "N", $b; - - if ($j == 0xffd8ffe0) { - do { - read $JPEG, $b, 2; - seek $JPEG, unpack("n", $b) - 2, 1; - read $JPEG, $b, 2; - $j = unpack "n", $b; - if ($j >= 0xffc0 and $j <= 0xffc3) { - seek $JPEG, 3, 1; - - read $JPEG, $b, 2; - $h = unpack "n", $b; - - read $JPEG, $b, 2; - $w = unpack "n", $b; - goto done; # last; - } - } while not eof($JPEG); - done: - } - return ($w, $h ); -} - -########################################################################### -# Subroutine grabs a gif from another server, and gets its size -########################################################################### - - -sub URLsize { - my($five) = @_; - my($dummy, $server, $url); - my($c1, $c2, $c3, $c4)=(0,0,0,0); - - my( $x,$y) = (0,0); - - print "URLsize: $five\n" if $debug; - - # first check the hash table (if we're using one) - if(&istrue($UseHash) && - $hashx{$five} && - $hashy{$five} ){ - print "Hash " if $debug; - - $x=$hashx{$five}; - $y=$hashy{$five}; - return($x,$y); - } - - if( $Proxy =~ /\S+/ ){ - ($dummy, $dummy, $server, $url) = split(/\//, $Proxy, 4); - $url=$five; - } else { - ($dummy, $dummy, $server, $url) = split(/\//, $five, 4); - $url= '/' . $url; - } - - my($them,$port) = split(/:/, $server); - my( $iaddr, $paddr, $proto ); - - $port = 80 unless $port; - $them = 'localhost' unless $them; - - print "\nThey are $them on port $port\n" if $debug;# && $Proxy; - print "url is $url\n" if $debug; - - $_=$url; - if( /gif/i || /jpeg/i || /jpg/i || /xbm/i || /png/i ){ - - $iaddr= inet_aton( $them ); - $paddr= sockaddr_in( $port, $iaddr ); - $proto=getprotobyname('tcp'); - - # Make the socket filehandle. - - if(socket(STRM, PF_INET, SOCK_STREAM, $proto) && - connect(STRM,$paddr) ){ - # Set socket to be command buffered. - select(STRM); $| = 1; select(STDOUT); - - print "Getting $url\n" if $debug; - - my $str=("GET $url HTTP/1.1\n". - #"User-Agent: Mozilla/4.08 [en] (WWWIS)\n". - #"Accept: */*\n". - "Connection: close\n". - "Host: $them\n\n"); - - print "$str" if $debug; - - print STRM $str; - - # we're looking for \n\r\n\r - while ((ord($c1) != 10) || (ord($c2) != 13) || (ord ($c3) != 10) || - (ord($c4) != 13)) { - $c4 = $c3; - $c3 = $c2; - $c2 = $c1; - read(STRM, $c1, 1); - print "$c1" if $debug; - } - print "\n" if $debug; - - if ($url =~ /\.jpg$/i || $url =~ /\.jpeg$/i) { - ($x,$y) = &jpegsize(\*STRM); - } elsif($url =~ /\.gif$/i) { - ($x,$y) = &gifsize(\*STRM); - } elsif($url =~ /\.xbm$/i) { - ($x,$y) = &xbmsize(\*STRM); - } elsif($url =~ /\.png$/i) { - ($x,$y) = &pngsize(\*STRM); - } else { - print "$url is not gif, jpeg, xbm or png (or has stupid name)"; - } - - close ( STRM ); - } else { - # there was a problem - print "ERROR: $!"; - } - } else { - print "$url is not gif, xbm or jpeg (or has stupid name)"; - } - if(&istrue($UseHash) && $x && $y){ - $hashx{$five}=$x; - $hashy{$five}=$y; - } - return ($x,$y); -} - -sub istrue -{ - my( $val)=@_; - return (defined($val) && ($val =~ /^y(es)?/i || $val =~ /true/i )); -} - -sub isfalse -{ - my( $val)=@_; - return (defined($val) && ($val =~ /^no?/i || $val =~ /false/i )); -} - -sub strip_quotes{ - my($name)=@_; - - $_=$name; # now to gte rid of quotes if they were there - if( /\"([^\"]*)\"/ ){ return $1; } #" - elsif( /\'([^\']*)\'/ ){ return $1; } - return $name; -} - -# this doesn't cope with \-ed " which it should!!! -# I also didn't cope with javascript stuff like onChange (whoops) -# this is why it is unsupported. -sub changecase{ - my($text)=@_; - my( @line )=(); - my( $ostr, $str, $j )=("","",0); - - $text=~/^([^>]*)>/; - return $text if( !defined($1)); - $ostr=$str=$1; - - @line=split(/\"/, $str); #" - - for( $j=0 ; $j <= $#line ; $j+=2 ){ - if( $UpcaseTags =~ /lower/i ){ - $line[$j] =~ tr/[A-Z]/[a-z]/; - } else { - $line[$j] =~ tr/[a-z]/[A-Z]/; - } - } - if( $str =~ /\"$/ ){ #" - $str=join( "\"", @line , ""); - } else { - $str=join( "\"", @line ); - } - $text=~ s/^$ostr/$str/; - - return $text; -} - -# joins together two URLS to make one url -# e.g. http://www/ + fish.html = http://www/fish.html -# e.g. http://www/index.html + fish.html = http://www/fish.html -# e.g. http://www/s/index.html + /fish.html = http://www/fish.html -sub ARKjoinURL -{ - my($base,$url)=@_; - - # if url has a double // in it then it is fine thank you! - return $url if( $url =~ /\/\// ); - - # strip down base url to make sure that it doesn't have a .html at the end - $base=~s/[^\/]*$//; - - if( $url =~ /^\// ){ - # strip off leading directories - $base =~ s/(\/\/[^\/]*)\/.*$/$1/; - } - - return ($base . $url); -} - -# File: wwwis-options.pl -*- Perl -*- -# Created by: Alex Knowles (alex@ed.ac.uk) Sat Nov 2 16:41:12 1996 -# Last Modified: Time-stamp: <03 Nov 96 1549 Alex Knowles> -# RCS $Id: wwwis,v 2.43 2004/12/02 18:32:13 ark Exp $ -############################################################################ -# There now follows some routines to get the configuration file -############################################################################ - -# NextOption: -# give me the start of the next option (as options can take up a -# different number of array elements) -sub NextOption -{ - my($i) = @_; - - $_=$options[$i+1]; - if( /string/i || /integer/i || /file/i || /bool/i ){ - $i+=3; - } elsif( /choice/i ){ - $i+=4+$options[$i+3]; - }else { - print "unknown option type! $_\n"; - exit 2; - } - return $i; -} - -# ShowOptions: now I use -usage it's much better - -# CheckOption: -# Check if $val (arg2) is valid for option which starts at options[$i (arg1)] -# returns either 0 (failure) or 1 (success) -sub CheckOption -{ - my($i,$val) = @_; - my($k); - - return 0 unless $i && $val; - - $_=$options[$i+1]; - if( /string/i ){ - # can't think of a check for this - }elsif( /integer/i ){ - if( $val !~ /^\d+$/ ){ - print "$val is not an integer!\n"; - return 0; - } - } elsif( /file/i ){ - if( ! (-e ($val) ) ){ - print "can't find file $val for $options[$i]\n"; - return 0; - } - }elsif( /bool/i ){ - if( $val !~ /^(y(es)?|no?)$/i ){ - print "$val is neither Yes nor No\n"; - return 0; - } - }elsif( /choice/i ){ - for( $k=0 ; $k < $options[$i+3] ; $k++ ){ - if( $val =~ /^$options[$i+4+$k]$/i ){ - return 1; - } - } - print "$val is not a valid value for $options[$i]\n"; - return 0; - }else { - print "unknown option type! $_\n"; - exit 2; - } - return 1; -} - -# GetConfigFile: -# Read user's configuration file, if such exists. If WWWIMAGESIZERC is -# set in user's environment, then read the file referenced, otherwise -# try for $HOME/.wwwimagesizerc -sub GetConfigFile -{ - my( @options )= @_; - my( @optionval )=(); - # my(*CONFIG); - my($filename)=""; - my(@files)=(); - my($i,$j,$line); - - #first go through options array and puyt the default values into optionval - $i=0; - $j=0; - while( $i < $#options ){ - $optionval[$j]=$options[$i+2]; - $i=&NextOption($i); - $j++; - } - - push(@files,$ENV{'WWWISRC'}) if $ENV{'WWWISRC'}; - push(@files,$ENV{'WWWIMAGESIZERC'}) if $ENV{'WWWIMAGESIZERC'}; - push(@files,("$ENV{'HOME'}/.wwwisrc", - "$ENV{'HOME'}/.wwwimagesizerc",)) if $ENV{'HOME'}; - - foreach $i (@files){ - if( defined($i) && -f $i ){ - $filename=$i; - last; - } - } - - if(defined($filename) && - -f $filename && - open(CONFIG,"< $filename") ){ - while (){ - # skip lines with a hash on them - s/#.*$//; - next if /^\s*$/; - - $line=$_; - if( $line =~ /^(\S+)(\s+|\s*:\s*)(.+)$/ ){ - if( !(&proc_option($1,$3)) ){ - print "Invalid .wwwisrc line: $line"; - } - } - } - close CONFIG; - } else { - if( -f $filename ){ - print "Unable to read config file `$filename': $!\n"; - } - } - return @optionval; -} - -sub proc_option -{ - my($opt,$value)=@_; - my($i,$j,$proced)=(0,0,0); - - return 0 unless $opt && $value; - - while( !$proced && $i < $#options ){ - if( $options[$i] =~ /$opt/i ){ - $proced=1; - if( &CheckOption($i,$value) ){ - $optionval[$j]=$value; - } else { - printf("Invalid .wwwisrc value \"%s\" for option \"%s\"\n", - $value,$options[$i]); - } - } - - $i=&NextOption($i); # move onto the next option - $j++; - } - return $proced; -} - -sub proc_arg -{ - my($arg)= @_; - - return if !defined($arg); - - if( $arg =~ /^-+v(ersion)?$/i ){ - my($version)='$Revision: 2.43 $ '; - my($progname)=$0; - $progname =~ s/.*\///; # we only want the name - $version =~ s/[^\d\.]//g; # we only care about numbers and full stops - print "$progname: $version\n"; - } elsif( $arg =~ /^-+u(sage)?$/i || - $arg =~ /^-+h(elp)?$/i ){ - &usage(); - } elsif( $arg =~ /^-+d(ebug)$/i ){ - $debug=1; - } elsif( $arg =~ /-+im(a)?g(e)?size/i ){ - my($x,$y)=&imgsize(shift @ARGV); - print "WIDTH=$x HEIGHT=$y\n"; - } else { - $arg=~s/^-+//; - if( &proc_option( $arg, shift @ARGV)){ - &SetGlobals(); - } else { - print "Unrecognized option $arg\n"; - &usage(); - exit; - } - } - -} - -sub get_values -{ - my($i)=@_; - return "" if !defined $i; - - if( $options[$i+1] =~ /file/i ){ - return (); - } elsif($options[$i+1] =~ /string|integer/i ){ - return (); - } elsif($options[$i+1] =~ /bool/i ){ - return ('Yes','No'); - } elsif($options[$i+1] =~ /choice/i ){ - my($start,$end)=(($i+4),($options[$i+3])); - return (@options[$start .. $start+$end-1]); - } else { - print "Unrecognized option type\n"; - exit 0; - } -} - -sub usage -{ - my($progname)=$0; - $progname =~ s/.*\///; # we only want the name - my($vals)=""; - - print "$progname: [-version] [-usage] [-option optionval] file.html ... \n"; - - my($fmt)=" %15s %6s %-10s %s\n"; - - printf($fmt,"Option Name","Type","Default","Values"); - printf($fmt,"-----------","----","-------","------"); - - my($i,$j)=(0,0); - - while( $i < $#options ){ - $vals=join(',', &get_values($i)); - printf($fmt,$options[$i],$options[$i+1],$optionval[$j],$vals); - - $i=&NextOption($i); - $j++; - } -} - -1;