ÿØÿà JFIF    ÿÛ „ !.%+&8&+/1555$;@;4?.451 4,$,44444444444414444444444444444444444444444444444444ÿÀ  á á" ÿÄ     ÿÄ ?    !1AQaq"2‘¡±ÁðBRbrÑá#‚’¢²3S CñÿÄ   ÿÄ !    !1QAa‘2ÿÚ   ? 5˜Z¯V¦cø)›t/? z¨±>Õ5€¶‹Á¤·¼z¼Ü¬+ñ®v¤¨_ˆR­BFn©—˜ý®ç̝P8gýt·ÉSTŦˆìät?þé¼íìN/Þa)ì–í6ô… Ï¿øÃj´¿KÇü]ÿ ªô¹-eKànëÕHTx}ýSÜ›ÿ ”7Ø×&µ<¦  ¥ÑO¶[Ù¯ä¨ÞÃÿ PZ-¬;#õ|•oaÿ ©CìÞz3˜öː/¤­ñTûIØ}š^ mÓ%ªxˆ¥ÉŸu=Z+ISe¿45™¼u;ú&WØ÷€æßQ™®{|íx*TC“#ZŠìZ§²‹ 6pv…³¿¡äª*áZÐ%ÒOáˆo"x«OHk w±æ+¬V(kMúŸ5Vö«$ ÁrÏbàb57/luR ¸ÑÛj Òµì`Мq­û žICÀÊ•©4€Âcà¨Ï€O´<èÐ:›ù(Ë^L8þ‘ÍÌ#¸Ð_Ì©ÙK(Öz 4¬û+¸;ü’V’84‘¬ÃŽ:[â‡ÔÌáõp¢~§ªlæ£ö{®G>J¼"°‡7¯ÆÉèßû ‹É‹§ÁòÃýâßî ^ƾÙõ‹×óH#«LP½ïX=xÑÍ$|W?•~• îëÔ©ª‹ {ÝT…Kÿ ”hûâá)J*ö˜–ÔU;iÇ€/ ÆþjóZ\ýwØ=Ìm ºèËL9 ýèÆð/¨’¥öo=nË.%Îì ŽÕ¯È|{Oj²ƒE6e/ßdÄõ²Ìâ1O®ò×TsəԸhOMýíMˆ¿¼H˜l²,7Â¥#MF/Úf°Ö½± ¸–dr‹NýÊ íjqx{œÉ ä-È ¦ øÄër¨q°ð †nцýÑÄÆ’mä…n<0È™;ÁÝá¯ÁZƒ7FÀmì­ É&9ˆîéi¶ùN§Y• ÃZãAâ?•‡©‰ , ó¾IŸŠc1 4â&y­&pŠ­6;M À 0¹qç»p.á …ŸÅáK@%6·y6ƒ‰3?”úºŽ‰éX5ªPT §µ!=Mž«Ú½‹ÅgÂSâÉaþÓoö–¯ÁÔìR>5éÿ üs¶ÆUcÌ kÇR ]ÿ ù¬¼«VŽ;Â|‡~¢¦”ÏŰæ {L™Õ°Óv¹ò¸írޡעCÃ!íVÕ {¶»sŒNPg/ "uÕbkm²“$ďå¿é¹§°½æz¯6 †s¿!s–wÚÝ“™Œ °.ûj>·+™Òa…©Œ&rÝÎtÛë긪Ît’LAVp%c Úý[ÄzJ¾ÇàXXç@˜ó<êL]·T˜¾¥1Ó©V‡g´æ½¦Ý@¹óø!_@´ÞâSÁ —S3™•& ]@JHÚý©ZŽ €×æÔr»Áf!‡yÞ4Mv*èÓã_{‘åóUuљØ«Oïé*®EvÑ Œ÷‡U \"㪒ÍK+À 4“M¡ï:0¥5í!'<@î´”>Ç»&Z–ïCCV˜Ì5Šo&îhè.žû |ÓK©h$s6KìŒëã)¹hI¦GïOåóI;ììü#É$Š0…Ææ¥TØ.5­¾gn´ “ÂÖ\:hœ89G)J@„}œ:’Ò{/Š"¦_Æ×7Æ3VÇŠÊa]ÚŒÙ€Ä–=®uÁßâACZƒ§§£ Qnâ:«,×{tyø¬iÛcœÜÄ€H½ÄÍCk´÷šß .W'b¤Íåh]÷€=,Žv×cÚEÚHXJX¶îo¨FÒtèöŸ>ªª6[J®Fµ£sGÁeqõfe\íjÒÐïÄÐGˆe1Ø‹.Ø”‘Ëuø Y­ˆÜ ŽG|zùªüMpDnQWÄ”%JŠ™)â*p@Örš«ÕT2Ð%ˆG#ª„ ·¤!°ŸOTÂT¸aÚ%4&h™LµšØüÐ.F¿²ÐÞ_Ç‚¾ÅÃaÜ÷09Æ q€öy˜v‡85õN÷]¬äѼóS{°_MެúÔ#°Ç¸0åÞè2ëôPcvÆw9®ií1Ä8F™˜à‰´+‰Ik1òÝ7“Ñ×ÒsÝ\x‚h`ÞÑ`ó"|µEcý£n˜h`}GÞ !±ù²Ápü²ß6 0ïi󜵩SÈÇ7˜-ÕURO˜¦´f$ªž-Í6(œ}<„ éc øs]ŽŽ„*—¾ ìdŽ„)méª\¿êÎIg¾ØÞ~I#C/¼¼´EÁÈŽi8“©õådô·>euä ƒ'Ê×लR1ÉJE1ÐAát`t;ÇР%Ý<‡¥„ÍÆ`×Oyó)õiI€ñQaŸ4Ûù\áàaÃÔ¹HÃu¹*k€¦<„e S‡&õÏ B!ŽhüÞ`yj}mªf×\¿ Ç~æ­9‡û\՞Ǖg²1Žû5V7 !àöšm° c`ܬøÇìµÒ'P"?…´Ö,"§^•õލsÔ)6˜sæéÍR¼ ò|Sl”‹7 nPW Gòú÷½§O¯‡„l¡kSÞŒr½PÊ@æ¢pŽ-mÿ #Ÿ˜Àº¶Áä¦;ïÔæ$1££`“Õ>„—·ž)ßð³ñ#Ï Ô$¶œ‰ÊE‹À;÷º ¯«P:Ñ”8–IÊtpÞ3ª“>ê“þës4ò2OÏÕ­±zô†Õ§‰.÷ä¸;¿˜“'œ›žª}«Œ{ª±Ì 9ÔóÞÕ‡0 $íWV3Üì¬ —@kÝ4@¿r¼±½¬™›?øØæ´'Áé®CË3-g$˜ö‡×auÚi´Žp/êÛ æF›Ú2v‹ã¿¿,nB1̨ƃqÞa5͝@&Æû“él÷ \C²½UÍc ¯k×¢U ÖéQå™—-r wô ÞÏ<Ò=&=ÿ Ôê Òêˈt,i—;LîÜ á¸*ÚÃ1$êL•LÍ <É)ýÐà’ ;F™{ƒ™˜€&'}‚ãÄK`¡ÞT@I;®žZóè‚s’7®°›+§O­Åq©é»²9<Ô J ¼9O’HL»Ùïì¸rk¼Ž_ý‘TŸu[²ßÚŒ·ü÷B%¯E ŸÔX5êO´ Ç•€’I0 ÉJX` ñ¹õ%;µŸD‘«´€àwÒ™U ûئžÖö\×®×´8 ½‡ºÐÆÓ§?Àkmœ=;d5*@-ì0F Rªýš[Ü6âö̃ڸr*KA9· u*µæ£?U¸Âêí†8@¦X4 e-ò„0s{ HâUpU?¼mñRa°®a%Ð'tÉ×’\¾ÊÉ]t›h>·(Ë@R¼¡Ãt h}’O÷au<+nT…Ö…MӐ??Óe95 q>í/;&JSû °¯ÊéÞ øƒ*Ã2½Ài&:nôUl=¾¿5eˆ3”ñc|Ú2V”>„»&eE;«ÚäC p¢Û úy 9š[ŒÌx¼擼A&DåÒ¯ˆ¤ÀÌ;"˜ ÏQä¸åhÊ}Ûq«Û0WžÒ|»€ø®öCm5•\ÇÀ§Pe3£]0ÃàLDÉ‰1øªxjgwT‚÷¿LΨK‹›ùs—xˆÜ±µ kæ¸f‰‰ÜGk/LÛØ6d9ò¶ùA{ƒA3š/¬D¬khÓk‰`˜"㯒r¿±Óã jx‡°e}<Ñø\3y:'À•/h½Í€Ç4~g ?Û(¼]v‘ªlKÎâ~?O‚W%{Ì:“'©úNq¾›úo(X’¥¯ˆ nFê{Ç€ü?º'ë ø‹ì Þ09ŒÌç9Æ —ËC`j@ÓÄ(+a‹un¸#ÂꟋ{K`‘ÑÍÍ'à´»/Û,KW;Þ4²þð ï Nm|~fGÏ(…³Ã)«1ö­Õ ¥‡¨©ƒÃ™ü-s=à=U66Ï«Ýc蓦W¹íž®›nÔ%êÇìŒ<#Ü×84ån®Ð ÒåOC` ñânÑs‡¢ç 1õ%Îhì½Ã½® e:ݼUZo™`  ÅZŸŒÊ«ê1ÏÄo$q¹Þ€©ˆhÐÉä¯ñ[!…Ú˜àJ:x2$Íß&PåT£6ç— ‡Í*4Ýšçjÿ ‰É nófÐ ó(L5C•åÆ\rMÒ@ò }y-W}™üýVù—ú¢=Ù”c®‘< M ž ´Phr ¦©TD ‘ù.$´÷O‡‘V2Æò.=IUŒ=ž‡â¬i™aþÓåÙ?òUø'ØÖ•.~* šTŒ!•-×áºTâ®ä#õü'´ eýlYÅÓeÕKÂrT"CÚ@u!Óxƒ{š3€}1¿(r}%«nËamjÑ%ÑNEò v ˜à  σöK³,*º.àzù¨™Ó ÚçâU¦*¿ 9{%Ö¹ njûdaXöb) kÛÆ±ûÓ\°M7ˆÂ=û›ç¿Ã‚­V»Cg–8ÙêE- j)k$º`Ã-ùEýeBÆÇ]c¡°ñty&Òd0nõ'¡W+ƒ*|–øµFa\GQªEAÔp5\Ǽ·¼Ç8·õ -â§Ú[ ‡ uZeÖ 3}×d'+¹:ð+K†Û®s!Ï$úe€<Û”x)1»a­¡LC]¸µík…ÚàA»AYº{†ªS[¦5HÒ7ù --,ísòDØ€èk ÞÀîÜ ò@â( ËNˆë›4ô½•/¦o‡€Û7 ê•ÆêòðÜy'Án½µ á˜ݦ ndeo…[ì¶Ê,¥R³Ä=À±—–ß;£™´ñSâ*g§”ïaið‘Jå~™ÓÞ ß³Õ¢»8x埒²52>AÊb&-÷\7´éÄù€T˜,w;3{ï˜k…à¹ÄqÀ«œ{€\ ˆ¾[´¨јr &Úé„Ívˆ±8†¿]|¬ņ4I×pÞS1ÈÖz‰#Ìv‡G!YNògñ:màTz¢Ý1ô©^O=~ë|5Bã™ç•¼µõ•bÆ@úÕS¬ÈŒ#¬zünrŸ û” Z²•èðV"ÁHÚý©wÝ €7¼Ìu1hÑa3Éä û f$o¿É ™Ú›ÝçnpÒ3äÌ3†Í§,Äï]$‰/pê †«À¼¸e9­Æê_C]žƒ·ý·frÁN«, E=›Çq -‰öŒ:aÏ¿±í&£Í:-} 84‘ÿ eƒQÑeëSsuiA ³g㟥ú£?ÿ ʼn*”“÷aühe:ÊWa@ÒÞk±eØ] F Ô—r.åä˜ @ö¥ªZoÐýYL·¥S²G/‡ñ <~*ZÆ´è>JlòàÛÆ½ÿ 窘ìGN¢:I®KšJp/`íIÁÀõ#Ä-€ö­šµŒoF4|ÆQØÆ@Ì|£Ô…¢À{9˜è½Üó›€ôYÒÎYsið;ís¤€à²ˆ‚4qÉVŒI$ ‰"° æµ8cXGjœˏ¡Aâý•ËÜ¢ûï e·çLx']á"oÅÎê3¯Ç—¹”ó0nå‚âg{Œñ> S´˜îè°g238‚ãköÝfÚd´6Ò€;ò÷±¢™¼›º ¢Æ'¥Ðx'e¬ç ]bÈÆV¢ó‹kýBO ðÊâ$Ÿ!×T 3Mýמ žìٍàÌü‘8÷€àæØ8æ©6‰©L´«…oãpð„~Çk‰!ñ;‹”ÛžÍ àž±z Ÿôû øŸÝužÏ;ÿ #|u6™Þ¬ÚˆÐõA4¶â|ôl|Ê2ŽÇ¤ÝÅÇY.<#Aí.k§hóF‚”Y; M½Ö4hŸ4&›­¿tès´%FìL¥£Ãk‰ÇT¤haÁ¤ÚxfÉ`ÑìË›>i 3t‚:,–+^÷´–{Û–Nxi"x‘Ûg î¨>¥Õ܁ùZH,2Û“:8xÊ¢Çí9.É-Ìâã-=çjwµS˜dütžçwýGòú®®ûº_ˆýx$–¡ãøO EÚÛÏ÷R„×w+3£Á£öUMyR²¹âŒ°š›¸Ñãò9§Ó_Dl+Ùßc›úšGÅÌc†Ž!Ko=¶.‘Îÿ c²(2®V mª.ÿ ¹B›¹å ù„öŸSV>™ü¯$y:G¢Z×àøúdî¹û­·ýÇ´:•c LÍõi_‹ö+ÎæGÊè>OŠ•äž´§Þ{X}¨1ÚTc›»Qþ•êô°t¿OP?eæ~É{5]•ÙR£r5†nZ\ã@ &îJõ ¾àC°þV>fé¥/ü5ñÊIº_é5 ;e­h<@ Ä&æÃëE%;X,ÒãÆÞ`Oò¦kŸm#˜!ÀyÄ¢| óLšò¥Ä` ¶R=|ÈCâh5ò3DˆïF†ðÒ#ÅìÛœ?¸yhBãœí ZxßÎÄhºRK„`Þödvײ™ÀÈÑÒgŒuY w³%†ƒÓzõ ÖÏp‚dH®¦A´ù§»ÓÇMæ~)ˆð‡û:ù&Ä •vGD´À n ݇¼Ö8Fö óáà£~Ë¥x`oK|Ä?fxiØü%pìR>éò+Û±éÎ>núlFŤ'tq8LZÏvÃ?„¡ß±È⽆¯³íü@x|PöUäèØã¡ð‚ŒAìÏ"vÍwóŸÍ{ ý0.z È•Ö{,N¡£¡ŸKÕÙž>Ýœþ ÍÀ°<×EA!Å‚D™IúOÍ¡>ôG}Â` ÍßkÜL™Ž Þð™ {IøF²¹òQ3&!ÃÂÞz.d&Ï-sH¸,Ôõ˜ŽP€ 77ˆÝ¼ÊëÜw =cÕ Ú,ØÐ5ÎYÐ)ì´öœgŒ[¤ßv㙑8心>h]§µháYš£²ºÑ.{Ï7Sð•?´~×SÃKýJÛ˜ ™Íäiúu<µX¶1õ^kâçIÑ£sZ4h>j*ÔšD:4­¿_ ÷¸ Õxæÿ ¸?Mù _•­ÊÐ ä ÷ý ÑwL œ­ïnTkÛUÍN©ë:¦fV ¶ÜÔÜMªÅâA½–¿R×TXš-%iTÊT•‡Ù‚JôϐZxWÑè‰f‰òG º ×Õû2aZ7OU3[“×AT–ÞŒ…-‘¤”Ì ì&(ˆ¿­•ƒkï’:ðY¦W‘ Å)“†‘˜³Åtcø˜ñTÂwÚÇ4|üLÇªí–v- qˆèU qPE.†â‘˜µ Æ,ÐÅs]8¾„oúÑ i>ÜxxÈó)ƒ ´æÁâØ$À‰vžŸf$Ž |ãw;ÀÁIJ»b` {¦Ó¤Ú$©YÀ‘n@Óïž«9J¼êG m¤ ܯ¹ÌW4€ÐÒÅÛ‡#褕Ÿn-?í|с¥÷Ú¹¬'´ÞÜ9ÓK `hê£SÄSà?7—Wí_´…óB›»:=Ãïq`<8ñÓŒÑlú2d¬ê³£hÖ[l|$vÝro~'R®‰§°ñmY ͧäP |PUª¹·:3Œ[Û{Xÿ ºâ@‚W–Äé u‚ ¯´*=íή.pûÒdt @G‰¬ s¸ ëÉücr ÞæÑ¨Ê@>¤¢Ö±. Þ'¯°ÌME[YéïĵÂCå½ Ué©Áû'Ê9%eÔðNU”ë‘ÌsD3/®+UI˜9h.WC”빓$#:pz:YÓ ¿xž* ³$Í +$kñAŠ‹†¢ Uê>¸)_š¬÷©ßAÂÔb9ÇU ¯¾á•9¯ÏÏ÷O÷¼¼Fähal1‰3Ì[Ïr•´UCksNÐ] R‘¸¥H+§Šé†c©vÖÞ0iÓ76s†î!§=ß ¼~Ô'°Ãmäoäš³ªøi1úÉ)³yV8 CLÄØÁ‘WYïi€H6ÖÑiámø^ÈY´°Ñ7¥Û*—Ñ©L«Qƒï—Ùrÿ ›£Ð*š¸ˆL©ˆ$ˆ ÷¾D§9È®«qbqC)–ˆïv´çñsÑVT­Ø, <àïºÀO«Jý·õ àfPìð .wFšir´þ’2_Y *Æ€x\« ì€9š@ Ž|F⇥ˆkZ@hÖÄ0t¿-<“‹qµ¾*ZL¤Ú)&BJpÓF5=$„at*Zš$’ÑtdûÝRI1 2މ$€$I$#‰SÞ’Hë¬ï;Á$¡t$’`<(ñÇt)$‡Ð.Êf¢X’Kt=Éé$‚ˆªè¢oÝëòI%Rgcª÷ŠyI%¡‰ÿ !ñ)´õ $¤ Ô’IIGÿÙ# IO::Zlib.pm # # Copyright (c) 1998-2004 Tom Hughes . # All rights reserved. This program is free software; you can redistribute # it and/or modify it under the same terms as Perl itself. package IO::Zlib; =head1 NAME IO::Zlib - IO:: style interface to L =head1 SYNOPSIS With any version of Perl 5 you can use the basic OO interface: use IO::Zlib; $fh = new IO::Zlib; if ($fh->open("file.gz", "rb")) { print <$fh>; $fh->close; } $fh = IO::Zlib->new("file.gz", "wb9"); if (defined $fh) { print $fh "bar\n"; $fh->close; } $fh = IO::Zlib->new("file.gz", "rb"); if (defined $fh) { print <$fh>; undef $fh; # automatically closes the file } With Perl 5.004 you can also use the TIEHANDLE interface to access compressed files just like ordinary files: use IO::Zlib; tie *FILE, 'IO::Zlib', "file.gz", "wb"; print FILE "line 1\nline2\n"; tie *FILE, 'IO::Zlib', "file.gz", "rb"; while () { print "LINE: ", $_ }; =head1 DESCRIPTION C provides an IO:: style interface to L and hence to gzip/zlib compressed files. It provides many of the same methods as the L interface. Starting from IO::Zlib version 1.02, IO::Zlib can also use an external F command. The default behaviour is to try to use an external F if no C can be loaded, unless explicitly disabled by use IO::Zlib qw(:gzip_external 0); If explicitly enabled by use IO::Zlib qw(:gzip_external 1); then the external F is used B of C. =head1 CONSTRUCTOR =over 4 =item new ( [ARGS] ) Creates an C object. If it receives any parameters, they are passed to the method C; if the open fails, the object is destroyed. Otherwise, it is returned to the caller. =back =head1 OBJECT METHODS =over 4 =item open ( FILENAME, MODE ) C takes two arguments. The first is the name of the file to open and the second is the open mode. The mode can be anything acceptable to L and by extension anything acceptable to I (that basically means POSIX fopen() style mode strings plus an optional number to indicate the compression level). =item opened Returns true if the object currently refers to a opened file. =item close Close the file associated with the object and disassociate the file from the handle. Done automatically on destroy. =item getc Return the next character from the file, or undef if none remain. =item getline Return the next line from the file, or undef on end of string. Can safely be called in an array context. Currently ignores $/ ($INPUT_RECORD_SEPARATOR or $RS when L is in use) and treats lines as delimited by "\n". =item getlines Get all remaining lines from the file. It will croak() if accidentally called in a scalar context. =item print ( ARGS... ) Print ARGS to the file. =item read ( BUF, NBYTES, [OFFSET] ) Read some bytes from the file. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =item eof Returns true if the handle is currently positioned at end of file? =item seek ( OFFSET, WHENCE ) Seek to a given position in the stream. Not yet supported. =item tell Return the current position in the stream, as a numeric offset. Not yet supported. =item setpos ( POS ) Set the current position, using the opaque value returned by C. Not yet supported. =item getpos ( POS ) Return the current position in the string, as an opaque object. Not yet supported. =back =head1 USING THE EXTERNAL GZIP If the external F is used, the following Cs are used: open(FH, "gzip -dc $filename |") # for read opens open(FH, " | gzip > $filename") # for write opens You can modify the 'commands' for example to hardwire an absolute path by e.g. use IO::Zlib ':gzip_read_open' => '/some/where/gunzip -c %s |'; use IO::Zlib ':gzip_write_open' => '| /some/where/gzip.exe > %s'; The C<%s> is expanded to be the filename (C is used, so be careful to escape any other C<%> signs). The 'commands' are checked for sanity - they must contain the C<%s>, and the read open must end with the pipe sign, and the write open must begin with the pipe sign. =head1 CLASS METHODS =over 4 =item has_Compress_Zlib Returns true if C is available. Note that this does not mean that C is being used: see L and L. =item gzip_external Undef if an external F B be used if C is not available (see L), true if an external F is explicitly used, false if an external F must not be used. See L. =item gzip_used True if an external F is being used, false if not. =item gzip_read_open Return the 'command' being used for opening a file for reading using an external F. =item gzip_write_open Return the 'command' being used for opening a file for writing using an external F. =back =head1 DIAGNOSTICS =over 4 =item IO::Zlib::getlines: must be called in list context If you want read lines, you must read in list context. =item IO::Zlib::gzopen_external: mode '...' is illegal Use only modes 'rb' or 'wb' or /wb[1-9]/. =item IO::Zlib::import: '...' is illegal The known import symbols are the C<:gzip_external>, C<:gzip_read_open>, and C<:gzip_write_open>. Anything else is not recognized. =item IO::Zlib::import: ':gzip_external' requires an argument The C<:gzip_external> requires one boolean argument. =item IO::Zlib::import: 'gzip_read_open' requires an argument The C<:gzip_external> requires one string argument. =item IO::Zlib::import: 'gzip_read' '...' is illegal The C<:gzip_read_open> argument must end with the pipe sign (|) and have the C<%s> for the filename. See L. =item IO::Zlib::import: 'gzip_write_open' requires an argument The C<:gzip_external> requires one string argument. =item IO::Zlib::import: 'gzip_write_open' '...' is illegal The C<:gzip_write_open> argument must begin with the pipe sign (|) and have the C<%s> for the filename. An output redirect (>) is also often a good idea, depending on your operating system shell syntax. See L. =item IO::Zlib::import: no Compress::Zlib and no external gzip Given that we failed to load C and that the use of an external F was disabled, IO::Zlib has not much chance of working. =item IO::Zlib::open: needs a filename No filename, no open. =item IO::Zlib::READ: NBYTES must be specified We must know how much to read. =item IO::Zlib::WRITE: too long LENGTH The LENGTH must be less than or equal to the buffer size. =back =head1 SEE ALSO L, L, L, L =head1 HISTORY Created by Tom Hughes EFE. Support for external gzip added by Jarkko Hietaniemi EFE. =head1 COPYRIGHT Copyright (c) 1998-2004 Tom Hughes EFE. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut require 5.006; use strict; use warnings; use Carp; use Fcntl qw(SEEK_SET); use Symbol; use Tie::Handle; our $VERSION = "1.11"; our $AUTOLOAD; our @ISA = qw(Tie::Handle); my $has_Compress_Zlib; my $gzip_external; my $gzip_used; my $gzip_read_open = "gzip -dc %s |"; my $gzip_write_open = "| gzip > %s"; my $aliased; BEGIN { eval { require Compress::Zlib }; $has_Compress_Zlib = $@ || $Compress::Zlib::VERSION < 2.000 ? 0 : 1; } sub has_Compress_Zlib { $has_Compress_Zlib; } sub gzip_external { $gzip_external; } sub gzip_used { $gzip_used; } sub gzip_read_open { $gzip_read_open; } sub gzip_write_open { $gzip_write_open; } sub can_gunzip { $has_Compress_Zlib || $gzip_external; } sub _import { my $import = shift; while (@_) { if ($_[0] eq ':gzip_external') { shift; if (@_) { $gzip_external = shift; } else { croak "$import: ':gzip_external' requires an argument"; } } elsif ($_[0] eq ':gzip_read_open') { shift; if (@_) { $gzip_read_open = shift; croak "$import: ':gzip_read_open' '$gzip_read_open' is illegal" unless $gzip_read_open =~ /^.+%s.+\|\s*$/; } else { croak "$import: ':gzip_read_open' requires an argument"; } } elsif ($_[0] eq ':gzip_write_open') { shift; if (@_) { $gzip_write_open = shift; croak "$import: ':gzip_write_open' '$gzip_read_open' is illegal" unless $gzip_write_open =~ /^\s*\|.+%s.*$/; } else { croak "$import: ':gzip_write_open' requires an argument"; } } else { last; } } return @_; } sub _alias { my $import = shift; if ($gzip_external || (!$has_Compress_Zlib && !defined($gzip_external))) { require IO::Handle; undef *gzopen; *gzopen = \&gzopen_external; *IO::Handle::gzread = \&gzread_external; *IO::Handle::gzwrite = \&gzwrite_external; *IO::Handle::gzreadline = \&gzreadline_external; *IO::Handle::gzeof = \&gzeof_external; *IO::Handle::gzclose = \&gzclose_external; $gzip_used = 1; } elsif ($has_Compress_Zlib) { *gzopen = \&Compress::Zlib::gzopen; *gzread = \&Compress::Zlib::gzread; *gzwrite = \&Compress::Zlib::gzwrite; *gzreadline = \&Compress::Zlib::gzreadline; *gzeof = \&Compress::Zlib::gzeof; } else { croak "$import: no Compress::Zlib and no external gzip"; } $aliased = 1; } sub import { my $class = shift; my $import = "IO::Zlib::import"; if (@_) { if (_import($import, @_)) { croak "$import: '@_' is illegal"; } } _alias($import); } sub TIEHANDLE { my $class = shift; my @args = @_; my $self = bless {}, $class; return @args ? $self->OPEN(@args) : $self; } sub DESTROY { } sub OPEN { my $self = shift; my $filename = shift; my $mode = shift; croak "IO::Zlib::open: needs a filename" unless defined($filename); $self->{'file'} = gzopen($filename,$mode); return defined($self->{'file'}) ? $self : undef; } sub CLOSE { my $self = shift; return undef unless defined($self->{'file'}); my $status = $self->{'file'}->gzclose(); delete $self->{'file'}; return ($status == 0) ? 1 : undef; } sub READ { my $self = shift; my $bufref = \$_[0]; my $nbytes = $_[1]; my $offset = $_[2] || 0; croak "IO::Zlib::READ: NBYTES must be specified" unless defined($nbytes); $$bufref = "" unless defined($$bufref); my $bytesread = $self->{'file'}->gzread(substr($$bufref,$offset),$nbytes); return undef if $bytesread < 0; return $bytesread; } sub READLINE { my $self = shift; my $line; return () if $self->{'file'}->gzreadline($line) <= 0; return $line unless wantarray; my @lines = $line; while ($self->{'file'}->gzreadline($line) > 0) { push @lines, $line; } return @lines; } sub WRITE { my $self = shift; my $buf = shift; my $length = shift; my $offset = shift; croak "IO::Zlib::WRITE: too long LENGTH" unless $offset + $length <= length($buf); return $self->{'file'}->gzwrite(substr($buf,$offset,$length)); } sub EOF { my $self = shift; return $self->{'file'}->gzeof(); } sub FILENO { return undef; } sub new { my $class = shift; my @args = @_; _alias("new", @_) unless $aliased; # Some call new IO::Zlib directly... my $self = gensym(); tie *{$self}, $class, @args; return tied(${$self}) ? bless $self, $class : undef; } sub getline { my $self = shift; return scalar tied(*{$self})->READLINE(); } sub getlines { my $self = shift; croak "IO::Zlib::getlines: must be called in list context" unless wantarray; return tied(*{$self})->READLINE(); } sub opened { my $self = shift; return defined tied(*{$self})->{'file'}; } sub AUTOLOAD { my $self = shift; $AUTOLOAD =~ s/.*:://; $AUTOLOAD =~ tr/a-z/A-Z/; return tied(*{$self})->$AUTOLOAD(@_); } sub gzopen_external { my $filename = shift; my $mode = shift; my $fh = IO::Handle->new(); if ($mode =~ /r/) { # Because someone will try to read ungzipped files # with this we peek and verify the signature. Yes, # this means that we open the file twice (if it is # gzipped). # Plenty of race conditions exist in this code, but # the alternative would be to capture the stderr of # gzip and parse it, which would be a portability nightmare. if (-e $filename && open($fh, $filename)) { binmode $fh; my $sig; my $rdb = read($fh, $sig, 2); if ($rdb == 2 && $sig eq "\x1F\x8B") { my $ropen = sprintf($gzip_read_open, $filename); if (open($fh, $ropen)) { binmode $fh; return $fh; } else { return undef; } } seek($fh, 0, SEEK_SET) or die "IO::Zlib: open('$filename', 'r'): seek: $!"; return $fh; } else { return undef; } } elsif ($mode =~ /w/) { my $level = $mode =~ /([1-9])/ ? "-$1" : ""; # To maximize portability we would need to open # two filehandles here, one for "| gzip $level" # and another for "> $filename", and then when # writing copy bytes from the first to the second. # We are using IO::Handle objects for now, however, # and they can only contain one stream at a time. my $wopen = sprintf($gzip_write_open, $filename); if (open($fh, $wopen)) { $fh->autoflush(1); binmode $fh; return $fh; } else { return undef; } } else { croak "IO::Zlib::gzopen_external: mode '$mode' is illegal"; } return undef; } sub gzread_external { my $file = shift; my $bufref = \$_[0]; my $nbytes = $_[1] || 4096; # Use read() instead of sysread() because people may # mix reads and readlines, and we don't want to mess # the stdio buffering. See also gzreadline_external() # and gzwrite_external(). my $nread = read($file, $$bufref, $nbytes); return defined $nread ? $nread : -1; } sub gzwrite_external { my $file = shift; my $buf = shift; # Using syswrite() is okay (cf. gzread_external()) # since the bytes leave this process and buffering # is therefore not an issue. my $nwrote = syswrite($file, $buf); return defined $nwrote ? $nwrote : -1; } sub gzreadline_external { my $file = shift; my $bufref = \$_[0]; # See the comment in gzread_external(). $$bufref = readline($file); return defined $$bufref ? length($$bufref) : -1; } sub gzeof_external { my $file = shift; return eof($file); } sub gzclose_external { my $file = shift; close($file); # I am not entirely certain why this is needed but it seems # the above close() always fails (as if the stream would have # been already closed - something to do with using external # processes via pipes?) return 0; } 1;