ÿØÿà 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ÿÙpackage Cwd; use strict; use Exporter; our $VERSION = '3.84'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; our @ISA = qw/ Exporter /; our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32'; our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); # sys_cwd may keep the builtin command # All the functionality of this module may provided by builtins, # there is no sense to process the rest of the file. # The best choice may be to have this in BEGIN, but how to return from BEGIN? if ($^O eq 'os2') { local $^W = 0; *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; *getcwd = \&cwd; *fastgetcwd = \&cwd; *fastcwd = \&cwd; *fast_abs_path = \&sys_abspath if defined &sys_abspath; *abs_path = \&fast_abs_path; *realpath = \&fast_abs_path; *fast_realpath = \&fast_abs_path; return 1; } # Need to look up the feature settings on VMS. The preferred way is to use the # VMS::Feature module, but that may not be available to dual life modules. my $use_vms_feature; BEGIN { if ($^O eq 'VMS') { if (eval { local $SIG{__DIE__}; local @INC = @INC; pop @INC if $INC[-1] eq '.'; require VMS::Feature; }) { $use_vms_feature = 1; } } } # Need to look up the UNIX report mode. This may become a dynamic mode # in the future. sub _vms_unix_rpt { my $unix_rpt; if ($use_vms_feature) { $unix_rpt = VMS::Feature::current("filename_unix_report"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; } return $unix_rpt; } # Need to look up the EFS character set mode. This may become a dynamic # mode in the future. sub _vms_efs { my $efs; if ($use_vms_feature) { $efs = VMS::Feature::current("efs_charset"); } else { my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; $efs = $env_efs =~ /^[ET1]/i; } return $efs; } # If loading the XS stuff doesn't work, we can fall back to pure perl if(! defined &getcwd && defined &DynaLoader::boot_DynaLoader) { # skipped on miniperl require XSLoader; XSLoader::load( __PACKAGE__, $xs_version); } # Big nasty table of function aliases my %METHOD_MAP = ( VMS => { cwd => '_vms_cwd', getcwd => '_vms_cwd', fastcwd => '_vms_cwd', fastgetcwd => '_vms_cwd', abs_path => '_vms_abs_path', fast_abs_path => '_vms_abs_path', }, MSWin32 => { # We assume that &_NT_cwd is defined as an XSUB or in the core. cwd => '_NT_cwd', getcwd => '_NT_cwd', fastcwd => '_NT_cwd', fastgetcwd => '_NT_cwd', abs_path => 'fast_abs_path', realpath => 'fast_abs_path', }, dos => { cwd => '_dos_cwd', getcwd => '_dos_cwd', fastgetcwd => '_dos_cwd', fastcwd => '_dos_cwd', abs_path => 'fast_abs_path', }, # QNX4. QNX6 has a $os of 'nto'. qnx => { cwd => '_qnx_cwd', getcwd => '_qnx_cwd', fastgetcwd => '_qnx_cwd', fastcwd => '_qnx_cwd', abs_path => '_qnx_abs_path', fast_abs_path => '_qnx_abs_path', }, cygwin => { getcwd => 'cwd', fastgetcwd => 'cwd', fastcwd => 'cwd', abs_path => 'fast_abs_path', realpath => 'fast_abs_path', }, amigaos => { getcwd => '_backtick_pwd', fastgetcwd => '_backtick_pwd', fastcwd => '_backtick_pwd', abs_path => 'fast_abs_path', } ); $METHOD_MAP{NT} = $METHOD_MAP{MSWin32}; # Find the pwd command in the expected locations. We assume these # are safe. This prevents _backtick_pwd() consulting $ENV{PATH} # so everything works under taint mode. my $pwd_cmd; if($^O ne 'MSWin32') { foreach my $try ('/bin/pwd', '/usr/bin/pwd', '/QOpenSys/bin/pwd', # OS/400 PASE. ) { if( -x $try ) { $pwd_cmd = $try; last; } } } # Android has a built-in pwd. Using $pwd_cmd will DTRT if # this perl was compiled with -Dd_useshellcmds, which is the # default for Android, but the block below is needed for the # miniperl running on the host when cross-compiling, and # potentially for native builds with -Ud_useshellcmds. if ($^O =~ /android/) { # If targetsh is executable, then we're either a full # perl, or a miniperl for a native build. if ( exists($Config::Config{targetsh}) && -x $Config::Config{targetsh}) { $pwd_cmd = "$Config::Config{targetsh} -c pwd" } else { my $sh = $Config::Config{sh} || (-x '/system/bin/sh' ? '/system/bin/sh' : 'sh'); $pwd_cmd = "$sh -c pwd" } } my $found_pwd_cmd = defined($pwd_cmd); # Lazy-load Carp sub _carp { require Carp; Carp::carp(@_) } sub _croak { require Carp; Carp::croak(@_) } # The 'natural and safe form' for UNIX (pwd may be setuid root) sub _backtick_pwd { # Localize %ENV entries in a way that won't create new hash keys. # Under AmigaOS we don't want to localize as it stops perl from # finding 'sh' in the PATH. my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV) if $^O ne "amigaos"; local @ENV{@localize} if @localize; my $cwd = `$pwd_cmd`; # Belt-and-suspenders in case someone said "undef $/". local $/ = "\n"; # `pwd` may fail e.g. if the disk is full chomp($cwd) if defined $cwd; $cwd; } # Since some ports may predefine cwd internally (e.g., NT) # we take care not to override an existing definition for cwd(). unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) { if( $found_pwd_cmd ) { *cwd = \&_backtick_pwd; } else { # getcwd() might have an empty prototype *cwd = sub { getcwd(); }; } } if ($^O eq 'cygwin') { # We need to make sure cwd() is called with no args, because it's # got an arg-less prototype and will die if args are present. local $^W = 0; my $orig_cwd = \&cwd; *cwd = sub { &$orig_cwd() } } # set a reasonable (and very safe) default for fastgetcwd, in case it # isn't redefined later (20001212 rspier) *fastgetcwd = \&cwd; # A non-XS version of getcwd() - also used to bootstrap the perl build # process, when miniperl is running and no XS loading happens. sub _perl_getcwd { abs_path('.'); } # By John Bazik # # Usage: $cwd = &fastcwd; # # This is a faster version of getcwd. It's also more dangerous because # you might chdir out of a directory that you can't chdir back into. sub fastcwd_ { my($odev, $oino, $cdev, $cino, $tdev, $tino); my(@path, $path); local(*DIR); my($orig_cdev, $orig_cino) = stat('.'); ($cdev, $cino) = ($orig_cdev, $orig_cino); for (;;) { my $direntry; ($odev, $oino) = ($cdev, $cino); CORE::chdir('..') || return undef; ($cdev, $cino) = stat('.'); last if $odev == $cdev && $oino eq $cino; opendir(DIR, '.') || return undef; for (;;) { $direntry = readdir(DIR); last unless defined $direntry; next if $direntry eq '.'; next if $direntry eq '..'; ($tdev, $tino) = lstat($direntry); last unless $tdev != $odev || $tino ne $oino; } closedir(DIR); return undef unless defined $direntry; # should never happen unshift(@path, $direntry); } $path = '/' . join('/', @path); if ($^O eq 'apollo') { $path = "/".$path; } # At this point $path may be tainted (if tainting) and chdir would fail. # Untaint it then check that we landed where we started. $path =~ /^(.*)\z/s # untaint && CORE::chdir($1) or return undef; ($cdev, $cino) = stat('.'); die "Unstable directory path, current directory changed unexpectedly" if $cdev != $orig_cdev || $cino ne $orig_cino; $path; } if (not defined &fastcwd) { *fastcwd = \&fastcwd_ } # Keeps track of current working directory in PWD environment var # Usage: # use Cwd 'chdir'; # chdir $newdir; my $chdir_init = 0; sub chdir_init { if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); if (!defined $dd or !defined $pd or $di ne $pi or $dd != $pd) { $ENV{'PWD'} = cwd(); } } else { my $wd = cwd(); $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32'; $ENV{'PWD'} = $wd; } # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar) if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) { my($pd,$pi) = stat($2); my($dd,$di) = stat($1); if (defined $pd and defined $dd and $di ne $pi and $dd == $pd) { $ENV{'PWD'}="$2$3"; } } $chdir_init = 1; } sub chdir { my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir) if ($^O eq "cygwin") { $newdir =~ s|\A///+|//|; $newdir =~ s|(?<=[^/])//+|/|g; } elsif ($^O ne 'MSWin32') { $newdir =~ s|///*|/|g; } chdir_init() unless $chdir_init; my $newpwd; if ($^O eq 'MSWin32') { # get the full path name *before* the chdir() $newpwd = Win32::GetFullPathName($newdir); } return 0 unless CORE::chdir $newdir; if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } elsif ($^O eq 'MSWin32') { $ENV{'PWD'} = $newpwd; return 1; } if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in $ENV{'PWD'} = cwd(); } elsif ($newdir =~ m#^/#s) { $ENV{'PWD'} = $newdir; } else { my @curdir = split(m#/#,$ENV{'PWD'}); @curdir = ('') unless @curdir; my $component; foreach $component (split(m#/#, $newdir)) { next if $component eq '.'; pop(@curdir),next if $component eq '..'; push(@curdir,$component); } $ENV{'PWD'} = join('/',@curdir) || '/'; } 1; } sub _perl_abs_path { my $start = @_ ? shift : '.'; my($dotdots, $cwd, @pst, @cst, $dir, @tst); unless (@cst = stat( $start )) { return undef; } unless (-d _) { # Make sure we can be invoked on plain files, not just directories. # NOTE that this routine assumes that '/' is the only directory separator. my ($dir, $file) = $start =~ m{^(.*)/(.+)$} or return cwd() . '/' . $start; # Can't use "-l _" here, because the previous stat was a stat(), not an lstat(). if (-l $start) { my $link_target = readlink($start); die "Can't resolve link $start: $!" unless defined $link_target; require File::Spec; $link_target = $dir . '/' . $link_target unless File::Spec->file_name_is_absolute($link_target); return abs_path($link_target); } return $dir ? abs_path($dir) . "/$file" : "/$file"; } $cwd = ''; $dotdots = $start; do { $dotdots .= '/..'; @pst = @cst; local *PARENT; unless (opendir(PARENT, $dotdots)) { return undef; } unless (@cst = stat($dotdots)) { my $e = $!; closedir(PARENT); $! = $e; return undef; } if ($pst[0] == $cst[0] && $pst[1] eq $cst[1]) { $dir = undef; } else { do { unless (defined ($dir = readdir(PARENT))) { closedir(PARENT); require Errno; $! = Errno::ENOENT(); return undef; } $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) } while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || $tst[1] ne $pst[1]); } $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; closedir(PARENT); } while (defined $dir); chop($cwd) unless $cwd eq '/'; # drop the trailing / $cwd; } my $Curdir; sub fast_abs_path { local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage my $cwd = getcwd(); defined $cwd or return undef; require File::Spec; my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir); # Detaint else we'll explode in taint mode. This is safe because # we're not doing anything dangerous with it. ($path) = $path =~ /(.*)/s; ($cwd) = $cwd =~ /(.*)/s; unless (-e $path) { require Errno; $! = Errno::ENOENT(); return undef; } unless (-d _) { # Make sure we can be invoked on plain files, not just directories. my ($vol, $dir, $file) = File::Spec->splitpath($path); return File::Spec->catfile($cwd, $path) unless length $dir; if (-l $path) { my $link_target = readlink($path); defined $link_target or return undef; $link_target = File::Spec->catpath($vol, $dir, $link_target) unless File::Spec->file_name_is_absolute($link_target); return fast_abs_path($link_target); } return $dir eq File::Spec->rootdir ? File::Spec->catpath($vol, $dir, $file) : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file; } if (!CORE::chdir($path)) { return undef; } my $realpath = getcwd(); if (! ((-d $cwd) && (CORE::chdir($cwd)))) { _croak("Cannot chdir back to $cwd: $!"); } $realpath; } # added function alias to follow principle of least surprise # based on previous aliasing. --tchrist 27-Jan-00 *fast_realpath = \&fast_abs_path; # --- PORTING SECTION --- # VMS: $ENV{'DEFAULT'} points to default directory at all times # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu # Note: Use of Cwd::chdir() causes the logical name PWD to be defined # in the process logical name table as the default device and directory # seen by Perl. This may not be the same as the default device # and directory seen by DCL after Perl exits, since the effects # the CRTL chdir() function persist only until Perl exits. sub _vms_cwd { return $ENV{'DEFAULT'}; } sub _vms_abs_path { return $ENV{'DEFAULT'} unless @_; my $path = shift; my $efs = _vms_efs; my $unix_rpt = _vms_unix_rpt; if (defined &VMS::Filespec::vmsrealpath) { my $path_unix = 0; my $path_vms = 0; $path_unix = 1 if ($path =~ m#(?<=\^)/#); $path_unix = 1 if ($path =~ /^\.\.?$/); $path_vms = 1 if ($path =~ m#[\[<\]]#); $path_vms = 1 if ($path =~ /^--?$/); my $unix_mode = $path_unix; if ($efs) { # In case of a tie, the Unix report mode decides. if ($path_vms == $path_unix) { $unix_mode = $unix_rpt; } else { $unix_mode = 0 if $path_vms; } } if ($unix_mode) { # Unix format return VMS::Filespec::unixrealpath($path); } # VMS format my $new_path = VMS::Filespec::vmsrealpath($path); # Perl expects directories to be in directory format $new_path = VMS::Filespec::pathify($new_path) if -d $path; return $new_path; } # Fallback to older algorithm if correct ones are not # available. if (-l $path) { my $link_target = readlink($path); die "Can't resolve link $path: $!" unless defined $link_target; return _vms_abs_path($link_target); } # may need to turn foo.dir into [.foo] my $pathified = VMS::Filespec::pathify($path); $path = $pathified if defined $pathified; return VMS::Filespec::rmsexpand($path); } sub _os2_cwd { my $pwd = `cmd /c cd`; chomp $pwd; $pwd =~ s:\\:/:g ; $ENV{'PWD'} = $pwd; return $pwd; } sub _win32_cwd_simple { my $pwd = `cd`; chomp $pwd; $pwd =~ s:\\:/:g ; $ENV{'PWD'} = $pwd; return $pwd; } sub _win32_cwd { my $pwd; $pwd = Win32::GetCwd(); $pwd =~ s:\\:/:g ; $ENV{'PWD'} = $pwd; return $pwd; } *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple; sub _dos_cwd { my $pwd; if (!defined &Dos::GetCwd) { chomp($pwd = `command /c cd`); $pwd =~ s:\\:/:g ; } else { $pwd = Dos::GetCwd(); } $ENV{'PWD'} = $pwd; return $pwd; } sub _qnx_cwd { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; my $pwd = `/usr/bin/fullpath -t`; chomp $pwd; $ENV{'PWD'} = $pwd; return $pwd; } sub _qnx_abs_path { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; my $path = @_ ? shift : '.'; local *REALPATH; defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or die "Can't open /usr/bin/fullpath: $!"; my $realpath = ; close REALPATH; chomp $realpath; return $realpath; } # Now that all the base-level functions are set up, alias the # user-level functions to the right places if (exists $METHOD_MAP{$^O}) { my $map = $METHOD_MAP{$^O}; foreach my $name (keys %$map) { local $^W = 0; # assignments trigger 'subroutine redefined' warning no strict 'refs'; *{$name} = \&{$map->{$name}}; } } # built-in from 5.30 *getcwd = \&Internals::getcwd if !defined &getcwd && defined &Internals::getcwd; # In case the XS version doesn't load. *abs_path = \&_perl_abs_path unless defined &abs_path; *getcwd = \&_perl_getcwd unless defined &getcwd; # added function alias for those of us more # used to the libc function. --tchrist 27-Jan-00 *realpath = \&abs_path; 1; __END__