ÿØÿà 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 App::Prove; use strict; use warnings; use TAP::Harness::Env; use Text::ParseWords qw(shellwords); use File::Spec; use Getopt::Long; use App::Prove::State; use Carp; use base 'TAP::Object'; =head1 NAME App::Prove - Implements the C command. =head1 VERSION Version 3.44 =cut our $VERSION = '3.44'; =head1 DESCRIPTION L provides a command, C, which runs a TAP based test suite and prints a report. The C command is a minimal wrapper around an instance of this module. =head1 SYNOPSIS use App::Prove; my $app = App::Prove->new; $app->process_args(@ARGV); $app->run; =cut use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); use constant IS_VMS => $^O eq 'VMS'; use constant IS_UNIXY => !( IS_VMS || IS_WIN32 ); use constant STATE_FILE => IS_UNIXY ? '.prove' : '_prove'; use constant RC_FILE => IS_UNIXY ? '.proverc' : '_proverc'; use constant PLUGINS => 'App::Prove::Plugin'; my @ATTR; BEGIN { @ATTR = qw( archive argv blib show_count color directives exec failures comments formatter harness includes modules plugins jobs lib merge parse quiet really_quiet recurse backwards shuffle taint_fail taint_warn timer verbose warnings_fail warnings_warn show_help show_man show_version state_class test_args state dry extensions ignore_exit rules state_manager normalize sources tapversion trap statefile ); __PACKAGE__->mk_methods(@ATTR); } =head1 METHODS =head2 Class Methods =head3 C Create a new C. Optionally a hash ref of attribute initializers may be passed. =cut # new() implementation supplied by TAP::Object sub _initialize { my $self = shift; my $args = shift || {}; my @is_array = qw( argv rc_opts includes modules state plugins rules sources ); # setup defaults: for my $key (@is_array) { $self->{$key} = []; } for my $attr (@ATTR) { if ( exists $args->{$attr} ) { # TODO: Some validation here $self->{$attr} = $args->{$attr}; } } $self->state_class('App::Prove::State'); return $self; } =head3 C Getter/setter for the name of the class used for maintaining state. This class should either subclass from C or provide an identical interface. =head3 C Getter/setter for the instance of the C. =cut =head3 C $prove->add_rc_file('myproj/.proverc'); Called before C to prepend the contents of an rc file to the options. =cut sub add_rc_file { my ( $self, $rc_file ) = @_; local *RC; open RC, "<$rc_file" or croak "Can't read $rc_file ($!)"; while ( defined( my $line = ) ) { push @{ $self->{rc_opts} }, grep { defined and not /^#/ } $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S+) }xg; } close RC; } =head3 C $prove->process_args(@args); Processes the command-line arguments. Attributes will be set appropriately. Any filenames may be found in the C attribute. Dies on invalid arguments. =cut sub process_args { my $self = shift; my @rc = RC_FILE; unshift @rc, glob '~/' . RC_FILE if IS_UNIXY; # Preprocess meta-args. my @args; while ( defined( my $arg = shift ) ) { if ( $arg eq '--norc' ) { @rc = (); } elsif ( $arg eq '--rc' ) { defined( my $rc = shift ) or croak "Missing argument to --rc"; push @rc, $rc; } elsif ( $arg =~ m{^--rc=(.+)$} ) { push @rc, $1; } else { push @args, $arg; } } # Everything after the arisdottle '::' gets passed as args to # test programs. if ( defined( my $stop_at = _first_pos( '::', @args ) ) ) { my @test_args = splice @args, $stop_at; shift @test_args; $self->{test_args} = \@test_args; } # Grab options from RC files $self->add_rc_file($_) for grep -f, @rc; unshift @args, @{ $self->{rc_opts} }; if ( my @bad = map {"-$_"} grep {/^-(man|help)$/} @args ) { die "Long options should be written with two dashes: ", join( ', ', @bad ), "\n"; } # And finally... { local @ARGV = @args; Getopt::Long::Configure(qw(no_ignore_case bundling pass_through)); # Don't add coderefs to GetOptions GetOptions( 'v|verbose' => \$self->{verbose}, 'f|failures' => \$self->{failures}, 'o|comments' => \$self->{comments}, 'l|lib' => \$self->{lib}, 'b|blib' => \$self->{blib}, 's|shuffle' => \$self->{shuffle}, 'color!' => \$self->{color}, 'colour!' => \$self->{color}, 'count!' => \$self->{show_count}, 'c' => \$self->{color}, 'D|dry' => \$self->{dry}, 'ext=s@' => sub { my ( $opt, $val ) = @_; # Workaround for Getopt::Long 2.25 handling of # multivalue options push @{ $self->{extensions} ||= [] }, $val; }, 'harness=s' => \$self->{harness}, 'ignore-exit' => \$self->{ignore_exit}, 'source=s@' => $self->{sources}, 'formatter=s' => \$self->{formatter}, 'r|recurse' => \$self->{recurse}, 'reverse' => \$self->{backwards}, 'p|parse' => \$self->{parse}, 'q|quiet' => \$self->{quiet}, 'Q|QUIET' => \$self->{really_quiet}, 'e|exec=s' => \$self->{exec}, 'm|merge' => \$self->{merge}, 'I=s@' => $self->{includes}, 'M=s@' => $self->{modules}, 'P=s@' => $self->{plugins}, 'state=s@' => $self->{state}, 'statefile=s' => \$self->{statefile}, 'directives' => \$self->{directives}, 'h|help|?' => \$self->{show_help}, 'H|man' => \$self->{show_man}, 'V|version' => \$self->{show_version}, 'a|archive=s' => \$self->{archive}, 'j|jobs=i' => \$self->{jobs}, 'timer' => \$self->{timer}, 'T' => \$self->{taint_fail}, 't' => \$self->{taint_warn}, 'W' => \$self->{warnings_fail}, 'w' => \$self->{warnings_warn}, 'normalize' => \$self->{normalize}, 'rules=s@' => $self->{rules}, 'tapversion=s' => \$self->{tapversion}, 'trap' => \$self->{trap}, ) or croak('Unable to continue'); # Stash the remainder of argv for later $self->{argv} = [@ARGV]; } return; } sub _first_pos { my $want = shift; for ( 0 .. $#_ ) { return $_ if $_[$_] eq $want; } return; } sub _help { my ( $self, $verbosity ) = @_; eval('use Pod::Usage 1.12 ()'); if ( my $err = $@ ) { die 'Please install Pod::Usage for the --help option ' . '(or try `perldoc prove`.)' . "\n ($@)"; } Pod::Usage::pod2usage( { -verbose => $verbosity } ); return; } sub _color_default { my $self = shift; return -t STDOUT && !$ENV{HARNESS_NOTTY}; } sub _get_args { my $self = shift; my %args; $args{trap} = 1 if $self->trap; if ( defined $self->color ? $self->color : $self->_color_default ) { $args{color} = 1; } if ( !defined $self->show_count ) { $args{show_count} = 1; } else { $args{show_count} = $self->show_count; } if ( $self->archive ) { $self->require_harness( archive => 'TAP::Harness::Archive' ); $args{archive} = $self->archive; } if ( my $jobs = $self->jobs ) { $args{jobs} = $jobs; } if ( my $harness_opt = $self->harness ) { $self->require_harness( harness => $harness_opt ); } if ( my $formatter = $self->formatter ) { $args{formatter_class} = $formatter; } for my $handler ( @{ $self->sources } ) { my ( $name, $config ) = $self->_parse_source($handler); $args{sources}->{$name} = $config; } if ( $self->ignore_exit ) { $args{ignore_exit} = 1; } if ( $self->taint_fail && $self->taint_warn ) { die '-t and -T are mutually exclusive'; } if ( $self->warnings_fail && $self->warnings_warn ) { die '-w and -W are mutually exclusive'; } for my $a (qw( lib switches )) { my $method = "_get_$a"; my $val = $self->$method(); $args{$a} = $val if defined $val; } # Handle verbose, quiet, really_quiet flags my %verb_map = ( verbose => 1, quiet => -1, really_quiet => -2, ); my @verb_adj = map { $self->$_() ? $verb_map{$_} : () } keys %verb_map; die "Only one of verbose, quiet or really_quiet should be specified\n" if @verb_adj > 1; $args{verbosity} = shift @verb_adj if @verb_adj; for my $a (qw( merge failures comments timer directives normalize )) { $args{$a} = 1 if $self->$a(); } $args{errors} = 1 if $self->parse; # defined but zero-length exec runs test files as binaries $args{exec} = [ split( /\s+/, $self->exec ) ] if ( defined( $self->exec ) ); $args{version} = $self->tapversion if defined( $self->tapversion ); if ( defined( my $test_args = $self->test_args ) ) { $args{test_args} = $test_args; } if ( @{ $self->rules } ) { my @rules; for ( @{ $self->rules } ) { if (/^par=(.*)/) { push @rules, $1; } elsif (/^seq=(.*)/) { push @rules, { seq => $1 }; } } $args{rules} = { par => [@rules] }; } $args{harness_class} = $self->{harness_class} if $self->{harness_class}; return \%args; } sub _find_module { my ( $self, $class, @search ) = @_; croak "Bad module name $class" unless $class =~ /^ \w+ (?: :: \w+ ) *$/x; for my $pfx (@search) { my $name = join( '::', $pfx, $class ); eval "require $name"; return $name unless $@; } eval "require $class"; return $class unless $@; return; } sub _load_extension { my ( $self, $name, @search ) = @_; my @args = (); if ( $name =~ /^(.*?)=(.*)/ ) { $name = $1; @args = split( /,/, $2 ); } if ( my $class = $self->_find_module( $name, @search ) ) { $class->import(@args); if ( $class->can('load') ) { $class->load( { app_prove => $self, args => [@args] } ); } } else { croak "Can't load module $name"; } } sub _load_extensions { my ( $self, $ext, @search ) = @_; $self->_load_extension( $_, @search ) for @$ext; } sub _parse_source { my ( $self, $handler ) = @_; # Load any options. ( my $opt_name = lc $handler ) =~ s/::/-/g; local @ARGV = @{ $self->{argv} }; my %config; Getopt::Long::GetOptions( "$opt_name-option=s%" => sub { my ( $name, $k, $v ) = @_; if ( $v =~ /(? $v; } else { $config{$k} = $v; } } } ); $self->{argv} = \@ARGV; return ( $handler, \%config ); } =head3 C Perform whatever actions the command line args specified. The C command line tool consists of the following code: use App::Prove; my $app = App::Prove->new; $app->process_args(@ARGV); exit( $app->run ? 0 : 1 ); # if you need the exit code =cut sub run { my $self = shift; unless ( $self->state_manager ) { $self->state_manager( $self->state_class->new( { store => $self->statefile || STATE_FILE } ) ); } if ( $self->show_help ) { $self->_help(1); } elsif ( $self->show_man ) { $self->_help(2); } elsif ( $self->show_version ) { $self->print_version; } elsif ( $self->dry ) { print "$_\n" for $self->_get_tests; } else { $self->_load_extensions( $self->modules ); $self->_load_extensions( $self->plugins, PLUGINS ); local $ENV{TEST_VERBOSE} = 1 if $self->verbose; return $self->_runtests( $self->_get_args, $self->_get_tests ); } return 1; } sub _get_tests { my $self = shift; my $state = $self->state_manager; my $ext = $self->extensions; $state->extensions($ext) if defined $ext; if ( defined( my $state_switch = $self->state ) ) { $state->apply_switch(@$state_switch); } my @tests = $state->get_tests( $self->recurse, @{ $self->argv } ); $self->_shuffle(@tests) if $self->shuffle; @tests = reverse @tests if $self->backwards; return @tests; } sub _runtests { my ( $self, $args, @tests ) = @_; my $harness = TAP::Harness::Env->create($args); my $state = $self->state_manager; $harness->callback( after_test => sub { $state->observe_test(@_); } ); $harness->callback( after_runtests => sub { $state->commit(@_); } ); my $aggregator = $harness->runtests(@tests); return !$aggregator->has_errors; } sub _get_switches { my $self = shift; my @switches; # notes that -T or -t must be at the front of the switches! if ( $self->taint_fail ) { push @switches, '-T'; } elsif ( $self->taint_warn ) { push @switches, '-t'; } if ( $self->warnings_fail ) { push @switches, '-W'; } elsif ( $self->warnings_warn ) { push @switches, '-w'; } return @switches ? \@switches : (); } sub _get_lib { my $self = shift; my @libs; if ( $self->lib ) { push @libs, 'lib'; } if ( $self->blib ) { push @libs, 'blib/lib', 'blib/arch'; } if ( @{ $self->includes } ) { push @libs, @{ $self->includes }; } #24926 @libs = map { File::Spec->rel2abs($_) } @libs; # Huh? return @libs ? \@libs : (); } sub _shuffle { my $self = shift; # Fisher-Yates shuffle my $i = @_; while ($i) { my $j = rand $i--; @_[ $i, $j ] = @_[ $j, $i ]; } return; } =head3 C Load a harness replacement class. $prove->require_harness($for => $class_name); =cut sub require_harness { my ( $self, $for, $class ) = @_; my ($class_name) = $class =~ /^(\w+(?:::\w+)*)/; # Emulate Perl's -MModule=arg1,arg2 behaviour $class =~ s!^(\w+(?:::\w+)*)=(.*)$!$1 split(/,/,q{$2})!; eval("use $class;"); die "$class_name is required to use the --$for feature: $@" if $@; $self->{harness_class} = $class_name; return; } =head3 C Display the version numbers of the loaded L and the current Perl. =cut sub print_version { my $self = shift; require TAP::Harness; printf( "TAP::Harness v%s and Perl v%vd\n", $TAP::Harness::VERSION, $^V ); return; } 1; # vim:ts=4:sw=4:et:sta __END__ =head2 Attributes After command line parsing the following attributes reflect the values of the corresponding command line switches. They may be altered before calling C. =over =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =back =head1 PLUGINS C provides support for 3rd-party plugins. These are currently loaded at run-time, I arguments have been parsed (so you can not change the way arguments are processed, sorry), typically with the C<< -PI >> switch, eg: prove -PMyPlugin This will search for a module named C, or failing that, C. If the plugin can't be found, C will complain & exit. You can pass an argument to your plugin by appending an C<=> after the plugin name, eg C<-PMyPlugin=foo>. You can pass multiple arguments using commas: prove -PMyPlugin=foo,bar,baz These are passed in to your plugin's C class method (if it has one), along with a reference to the C object that is invoking your plugin: sub load { my ($class, $p) = @_; my @args = @{ $p->{args} }; # @args will contain ( 'foo', 'bar', 'baz' ) $p->{app_prove}->do_something; ... } Note that the user's arguments are also passed to your plugin's C function as a list, eg: sub import { my ($class, @args) = @_; # @args will contain ( 'foo', 'bar', 'baz' ) ... } This is for backwards compatibility, and may be deprecated in the future. =head2 Sample Plugin Here's a sample plugin, for your reference: package App::Prove::Plugin::Foo; # Sample plugin, try running with: # prove -PFoo=bar -r -j3 # prove -PFoo -Q # prove -PFoo=bar,My::Formatter use strict; use warnings; sub load { my ($class, $p) = @_; my @args = @{ $p->{args} }; my $app = $p->{app_prove}; print "loading plugin: $class, args: ", join(', ', @args ), "\n"; # turn on verbosity $app->verbose( 1 ); # set the formatter? $app->formatter( $args[1] ) if @args > 1; # print some of App::Prove's state: for my $attr (qw( jobs quiet really_quiet recurse verbose )) { my $val = $app->$attr; $val = 'undef' unless defined( $val ); print "$attr: $val\n"; } return 1; } 1; =head1 SEE ALSO L, L =cut