Padre-Plugin-Git-0.12/0002755000175000017500000000000012215174457013470 5ustar kevinkevinPadre-Plugin-Git-0.12/Changes0000644000175000017500000000416112215172177014760 0ustar kevinkevinRevision history for Padre-Plugin-Git 0.12 2013-09-15 - various tweaks after running xt's - add typo found by perlbotics++ - remove an unwanted 0.11, that crepped in from an update-version script, this is also a test (BOWTIE) - turn off message echo to term [0e2335e] - tweak contents, remove core modules [cd5db46] - update POD - Update Version [30df3d8] 0.11 2012-11-29 - silly me forgot to add install share to Makrfile.PL (BOWTIE) 0.10 2012-11-29 - silly me left some test code visable (BOWTIE) 0.09 2012-11-29 - Oops Add Artistic accreditation (BOWTIE) - use 64x64 in About Dialogue (BOWTIE) - Add Local Stage Patch for dod++ (BOWTIE) - Add Local Commit Patch to complement the Stage Patch (BOWTIE) - Add Message Dialogue for commit messages, - also offer to load previous message from .git/COMMIT_EDITMSG (BOWTIE) 0.08 2012-11-25 - Unescaped left brace in regex is deprecated, passed through in regex (BOWTIE) - Add a plugin icon for use in Plugin Manager (BOWTIE) - Add blame for current file for dod++ (BOWTIE) - Add a git icon to About Dialog (BOWTIE) - Add Perl programming -> TIOBE (BOWTIE) 0.07 2012-11-03 - Fix-typo use of pbp return in sub cause a clocaking effect of menu (BOWTIE) 0.06 2012-11-01 - Add some Branching - Make Dialogue Bigger (BOWTIE) - Add auto update Changes on git commit if {{$NEXT}} exists (BOWTIE) - Update Makefile.PL with requirments (BOWTIE) 0.05 2012-09-26 - Add missing dependencies (BOWTIE) 0.04 2012-09-08 - Update to Padre-Plugin Api 2.2 (BOWTIE) - event_on_context_menu now works, short cut (BOWTIE) - switch to menu_plugins_simple all items work (BOWTIE) - git local functions, done (BOWTIE) - git remote functions, using padre-task (BOWTIE) - enable git-hub pull request with external credentials (BOWTIE) 0.03 2010-08-20 - Compatibility with new Padre (CHORNY) - chdir to file directory before commit (CHORNY) 0.02 2009-03-25 - Add necessary diff methods for file and dir (kaare) - Add inc/* and META.yml to MANIFEST (and there-for the tar-ball) (ryan52) 0.01 2009-03-13 - First version, released on an unsuspecting world. - Based on Padre-Plugin-SVK Padre-Plugin-Git-0.12/META.yml0000644000175000017500000000221512215174456014736 0ustar kevinkevin--- abstract: 'A Simple Git interface for Padre, the Perl IDE,' author: - 'Kevin Dawson ' build_requires: ExtUtils::MakeMaker: 6.59 Test::Deep: 0.11 Test::More: 0.98 Test::Requires: 0.07 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 0 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: Padre::Plugin::Git name: Padre-Plugin-Git no_index: directory: - inc - share - t - xt recommends: ExtUtils::MakeMaker: 6.76 File::Spec::Functions: 3.4 List::Util: 1.32 Test::Pod: 1.48 Test::Pod::Coverage: 1.08 requires: CPAN::Changes: 0.23 Carp: 1.32 File::Slurp: 9999.19 File::Spec: 3.4 File::Which: 1.09 Padre: 0.98 Pithub: 0.0102 Try::Tiny: 0.18 constant: 1.27 parent: 0.227 perl: 5.10.1 resources: bugtracker: https://github.com/PadreIDE/Padre-Plugin-Git/issues homepage: http://padre.perlide.org/trac/wiki/PadrePluginGit license: http://dev.perl.org/licenses/ repository: https://github.com/PadreIDE/Padre-Plugin-Git.git version: 0.12 Padre-Plugin-Git-0.12/README0000644000175000017500000000317112215164362014342 0ustar kevinkevinPadre-Plugin-Git The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it to get an idea of the module's uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Padre::Plugin::Git You can also look for information at: wiki http://padre.perlide.org/trac/wiki/PadrePluginGit RT, GitHub issues tracker (report bugs here) https://github.com/PadreIDE/Padre-Plugin-Git/issues AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Padre-Plugin-Git CPAN Ratings http://cpanratings.perl.org/d/Padre-Plugin-Git Search MetaCPAN https://metacpan.org/release/Padre-Plugin-Git LICENSE AND COPYRIGHT Copyright (C) 2013 kevin dawson This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Padre-Plugin-Git-0.12/Padre-Plugin-Git.fbp0000644000175000017500000015634012061410511017157 0ustar kevinkevin C++ 1 source_name 0 UTF-8 connect 1000 none 0 Padre::Plugin::Git . 1 1 0 0 wxBOTH 1 1 impl_virtual 0 wxID_ANY -1,-1 Padre::Plugin::Git::FBP::Output -1,-1 wxDEFAULT_DIALOG_STYLE|wxRESIZE_BORDER git output wxFILTER_NONE wxDefaultValidator bSizer1 wxVERTICAL none 5 wxALL|wxEXPAND 1 1 1 0 wxID_ANY 0 540,240 text public wxTE_MULTILINE wxFILTER_NONE wxDefaultValidator 5 wxEXPAND | wxALL 0 1 1 0 wxID_ANY m_staticline1 protected wxLI_HORIZONTAL wxFILTER_NONE wxDefaultValidator 5 wxEXPAND 0 bSizer2 wxHORIZONTAL none 5 wxEXPAND 1 0 protected 0 5 wxALL 0 1 1 1 0 wxID_CANCEL Close m_button_cancel protected wxFILTER_NONE wxDefaultValidator wxBOTH 1 1 impl_virtual 0 wxID_ANY Padre::Plugin::Git::FBP::Message wxDEFAULT_DIALOG_STYLE|wxRESIZE_BORDER Git Commit Message wxFILTER_NONE wxDefaultValidator bSizer1 wxVERTICAL none 5 wxEXPAND 0 2 wxBOTH 0 fgSizer1 wxFLEX_GROWMODE_SPECIFIED none 2 0 5 wxALL 0 1 1 0 wxID_ANY Guidance: m_staticText2 protected wxFILTER_NONE wxDefaultValidator -1 5 wxALL 0 1 1 0 wxID_ANY Please enter the commit message for your changes. Lines starting with '#' will be ignored, and an empty message aborts the commit. m_staticText1 protected wxFILTER_NONE wxDefaultValidator -1 5 wxALL 0 1 1 0 wxID_ANY File: type public wxFILTER_NONE wxDefaultValidator -1 5 wxALL 0 1 1 0 wxID_ANY commit file commit_file public wxFILTER_NONE wxDefaultValidator -1 5 wxALL|wxEXPAND 1 1 1 0 wxID_ANY 0 480,60 message public wxTE_MULTILINE wxFILTER_NONE wxDefaultValidator 5 wxEXPAND | wxALL 0 1 1 0 wxID_ANY m_staticline1 protected wxLI_HORIZONTAL wxFILTER_NONE wxDefaultValidator 5 wxALL|wxEXPAND 0 bSizer8 wxHORIZONTAL none 5 wxALL 0 1 0 1 0 wxID_ANY Show Last Commit show_last_commit protected wxFILTER_NONE wxDefaultValidator on_show_last 5 wxEXPAND 1 0 protected 0 5 wxALL 0 1 1 1 0 wxID_CANCEL Cancel m_button_cancel protected wxFILTER_NONE wxDefaultValidator 5 wxALL 0 1 1 1 0 wxID_ANY Commit button_commit protected wxFILTER_NONE wxDefaultValidator on_commit Padre-Plugin-Git-0.12/share/0002755000175000017500000000000012215174457014572 5ustar kevinkevinPadre-Plugin-Git-0.12/share/icons/0002755000175000017500000000000012215174457015705 5ustar kevinkevinPadre-Plugin-Git-0.12/share/icons/16x16/0002755000175000017500000000000012215174457016472 5ustar kevinkevinPadre-Plugin-Git-0.12/share/icons/16x16/git.png0000644000175000017500000000105312061410511017737 0ustar kevinkevin‰PNG  IHDRóÿasRGB®ÎébKGDÿÿÿ ½§“ pHYs  šœtIMEÜ :: ¡9 «IDAT8Ë}Ó»kTaðßw]‰w“˜ ’4jÚ`n,ÜFH›,ýOìíµ°µ±ÑꦱR„» AAQ‹M“Å„ ‹ý"›ç”Ã9ÃÌ9g’SjЭÆñè”u³}.BÃ÷L†=Ì¡_ÖÍ!lqùqFÚÐ`æÌ Ýê >ᚈ[¸/¥¸“!p³¬›þ¡ƒn-lb–@ú…‰²nþºÕgÌgÎoÜÀvY7ÿO¸ˆÞ,òÜ1,@„g¸œ±Ó²Ú_1u‚žÏñÛxˆÇ8—7ßÃl‘­šÊÓÖ>Ʊ…טÄÓa׊«N«È'Ηuó3ø0<+`¢…¾å‰g y¹Ó­Þá."¥$":ENØ~dàÁ)ûñýÜk%î%Îc7"–Ú«½ú¨²Ïi¸a쥔^•u³ElŒdf?"–‹¢XßYY<¤|ÉVÅ0±‰¤Vu¡¬›ƒn¥¬›ã¿0èVÓÙçëG4؈åöjïýùÄgÊ©œ>6"¤”""–Š¢XßÐy¨tÆ;_Å&#¢Ó^ímì¬,j¯öáþMT£Ãöœ:IEND®B`‚Padre-Plugin-Git-0.12/share/icons/32x32/0002755000175000017500000000000012215174457016466 5ustar kevinkevinPadre-Plugin-Git-0.12/share/icons/32x32/git.png0000644000175000017500000000242612061410511017740 0ustar kevinkevin‰PNG  IHDR szzôsRGB®ÎébKGDÿÿÿ ½§“ pHYs  šœtIMEÜ :"Í¡ö–IDATXíWß‹e~žñ˜á²0cDu”âÏøŒ½ Cb>2誢›4]h½ÙЛ54Ø‹ú¶¾¹P2¡’,+š¹°eµ"„¤‹(è짋™9¿<ÇsŽ:7‡3Ì÷þxž÷}Þ÷†|2kªßí¹ ¯å6ü7·æuÈ"3¬9xÃ:\Š,2; ^ô ÕOf‘™ â™ ‡ €ƒ~˜Û¾KYc Ζg«ó@IG‚8=˜EAœÞÛÊ p @­ËÙ*ˆ}AœÎ D_ Úx]ÆŸ^,«3I 9Ef*ˆÓj»}ÆEYdvæ‘9 ïæ ß%ÒË©-’ ’Íš0wGAfÍÀó„(ðWA›×¸ô¿,2»@ž†´H²VfßN4¸ô½¡h´ZdvüŠŠÀãðýÑ:/ˆÓ3Ö’Ü(é­*ûË"sôv-êuㇸ‹‚yŽäê6ÛEªó’vx™ ÄéaIG wÄ›ºC|ÄiŸx¦]I€¨¹À¥n<:R÷—T|P¾² ÕÇ­xj¶âÊ>8UVIâ2\«JXHpˆ Nf*$n.K{—~W¾ZáJÿÀ5· …-µš·~œ4gA!ÅEM¨·½dMœžjL7a ÄñE\®-šâtÓƒñ¥…ÑÙ»OÃjdqzXÐx5R»X\j#ŠË°Ø5ëv [s;vË4dŸõû(ÉñŽm§ â© N€¿mX«AÊÙÀ–ÌIâ’ï’-ÿì1:›ÜÁJ™$µê„Š‰µ$à3’¿ z…àhû7‰Ë¾KÖ7Çý´,(“$õ«¦ób@ÍKØZ«±¾¸ˆ®Î\JC.AfÃ)ýÚ“ÍùqºIv t_ßݽ (çvà’ƒöö˜ %q™X4£~oî†Õòà»ä¸¤w{鄨9OÚ²\»o¡eU»§W³â~™ ’S­Õ^öù†¡ç×Ð×ó²šs¾àDi㢴´cdd´^¯×áyõü¸KTž€¶SIEND®B`‚Padre-Plugin-Git-0.12/share/icons/64x64/0002755000175000017500000000000012215174457016500 5ustar kevinkevinPadre-Plugin-Git-0.12/share/icons/64x64/git.png0000644000175000017500000000545112061410511017753 0ustar kevinkevin‰PNG  IHDR@@ªiqÞsRGB®ÎébKGDÿÿÿ ½§“ pHYs  šœtIMEÜ 95±3wò ©IDATxÚÝ[]¬e~žéÙÓz!ì¬üToŒF)IKÊÎp¤-Gh`gh­Aš/¬’˜/11è‰1Þá…J5);þz´hk;³´…¤ ‚¨; ÁÎÙ33³Ýݳ³€“´§éÎÙùÞ÷{Þ÷}Þçý†˜á:L/@èX_yE«“ѽùrõõе`–ƒ™­‰˜ñUs¬[H>A`®íé} ¦œ›åzŒ™ì¼k¥8@ð ¹µ[Áõ N×Üâ®-ÿH!ºÖÍ—Õõá’„ˬ¯¤!ó‘E@èÚ©ñ·|JzH$ÉH¿æX–éMô|äï¼°dÝEðqA똘ÍØíƧx@hžäjnq§Y¦S бn$ùϤ4ü»$+’¶*ÕóӪƔ3̆înÖ@ß$Éy’gÂ’µÝ,¨O ÆdwÜnþLvlIÒ7ÖZËæÎwÛýGähðXͱnÈ{“c‚pÇ›oFkƒéù€˜ŸŸGÒ~‘¤QPD9GC§¸i҉јXÂól܈¯x#,YMÏYŸk£àBº#Ùm¨Òp8[+oŒ+‹ýáp@è$uÞ±J¤ñk—ÓàùÐ)~¦ƒW$Dø, 9Òø}½d/˜eõ 8a,Ô¦ æA 8Ùë"§kŽ}‘Yö›÷›^ð "8”¢ å’$0'C'BÇÚœ/ûc玵ó^€šc ùPÊnÔòÅ’j®6½à¯ñB Óó:Ö~§•±¥&hØ5 Z–°§àÇÆ)‘Çøбö|J€Ø­Ø õN$n.xþßBׄØq¥âuþ࿹CÀwØ »~W—B* !Z(xÕ3£Òff‡½…üã—´®w)“ RTMÒ§ ^õÝV¶;µH?4€{@fÈ Ztí¨NàˆÆ ù¤u¼eÇBHÛM/8? ¢™$·>i«çg0gÐø]èX›L/ˆ±óûIþV±Z1ç„·óžoºý$ΠºUŠ‹ùŠ¢îZÈ÷à ]Pw›Æï#øp¯ž}˜ÔßÞÖ :Ö³µÒÕó­Hhë"cÇ?"éÛíÔ*s•ƒ£õ’µ=ßGTawËGèX;eL×8’ñìùÁ{"«P®6Kb­dÍ*A£îÚte¿$iŒŠ9A-¢Jl[O¤2V͵î"yŒ”‘Ùxµßuó(3ÀÏuDï#5×¾<_N»H /8$ékYú….ªÊ<É3±¼¶61]ÔÛ[ R¢ÎÄ-Ù7Ã$ÁÔžåHn4¤s¡k*ýåбP¨T¥á0’žU΀±T+ÅBk«²d\(Aj®u3@8ë¡IÌš/¥T­¹ö3EBœ~*é+äšNZÃPŽäKuÇÚ’o¡ËFê$Þ–¬›‰½]pÁøçe”þÒD›éHß”ô#Ü/è1(†A`DP+Ù»RÔ3);·8"R„f²ùBt›Y®>q¡òØ/¸®™&¥·Dn1Ëþ¿B×ä»4:¡Süa|kØ…K¨טåàœ‘ *Ÿˆ1Ÿ~‡ðA^”$ò2¯„NqƒYÖŸê‚«ËswGСxíƒN‚ç)žª—ìÏ ï£0+8®N’ÁÈä©ËãOÝisìKž:…U6¾žyáÄzQß7(,ŠcP®Á½êÕAä¥å³ KYRcÒÊ»ˆUêÃüž´ÿA Tr½•±…€u†„Ø"z‹EòI^ßï–·ï¸&ýçÖ,èbLbt¯ ÷9áíWgtƇB€m©•¬Ïvë"C×ÆÅFèXWB¼ª§WÕT“?‚À¨…rõu ¢–û5¡ÓÁ÷0 ñ è”Á[àïÅHãp¸" é&³¼<—Œs5§¸4ŽPÊe<´Ö&Œe!Þº–Oàî••Æi»[së´î:¸¢?ùNþ¢ ‘ö¼àxèXí¿Pw¬-|’ó“ „nëŠnË÷ B2wBÄ'Ò2!æÏÉJ’v¼àÄš^ Q|_‘´MÀŠ0‰hàDS+I@˜qIÒ®ôÌÝU-žÇI» ^p"ìÖ ¥£çB¥Ñ-V>Òך°ú¥öO$ÍŽ\Mì5½à™0çuÕš}x¹ú¬„­–§50^'P“Ùl0±*a›Y‹•.¿¿$–žÉ)T‚óT´KäŠ&Ä‘Ç%ÝàùŽ àýø8 Ç~¢ b©dzþÉб»ê‚]¥&Ó Pw-ä+Õ%,BZ™L ƒŠtéßS„w:òOEÐBS>åXƃ`$éöB%x2®t~öb\wl$úú&’gå8òPpÌ,û‹Ý…Øx¤–¬ïÀÀÕJ@m7½àä Éq_±1.˜^ðZ¤èf€ hdpÒƒ=ŸUöQ+COR=ÊHBÑ^Ó N¦­~×@µ5¯ú<"]ŽV’þ÷~÷*UøçHC·x[V)íÎWª^ݵ‡š%7§G³œ’d ZΚI"Š¢‹û†œkƒÀÇG€EBvä½`)„ 7!ZoOÏä˜^ðª„=Y–) 4x;„¥b—¾>Y´xm–¨fÏ€/›žÿb¯l?¶Z›‘‚µaYm¥]}9=ÁƒµRq³Y©âí6VOÎ'÷ý„Ã55 ]PCÂNÓóÇ$ÇϘ˜F¸š3„Rq+ÉSç†9Ù'h¾ƒ(*™•êsíâ¦e‚8p3‡Þ|QâNÓóŸë6õ™š’§g}v†ñ4€ùN ×NùÒSTŠá ½ ÒKÈÏ6Rw&wäIBUûã?¶ú™:¡îÚ›€r­½oΫ„£’J^`r€œCoûªÀiÌg…ýÄÐF`œâh¼h.Ž…©(ËÀHÑî‚W]×øÌI°_b4½ê))úÁ•i¯ä`œ ·àU—B×Ûø‰ `-¬M΂ÌMbn½é'³ž›*Ö"!xMà"L ‹LäTJ‘›ÒÛI?Q4i³c£àù'íÒ$ºH!’p«éUOO¥Ï\šÍñ™œZ©x%É3 Fé"ӹﶸŸŸÎdSye&ßUªçEí&Øhš4˜4&(i_*fLëõ¹é¾4•”Z©¸•àIXc(`CÒnÓ žéwÂëCï€vÆh]Aƒ/CÚ@²å‰ç‾h&êíGúÅɦÐkŒ¯+ŠA¼×¦ÿ훕ñ3AÀZ™ÍÚ$ð ˆõ”’ù'©!á&³ŸåzŒ™Ÿ8MÄU~ò]’ïI* X0+Áñбgº!ÿå?ì šˆIEND®B`‚Padre-Plugin-Git-0.12/share/icons/48x48/0002755000175000017500000000000012215174457016504 5ustar kevinkevinPadre-Plugin-Git-0.12/share/icons/48x48/git.png0000644000175000017500000000475312061410511017763 0ustar kevinkevin‰PNG  IHDR00Wù‡sRGB®ÎébKGDÿÿÿ ½§“ pHYs  šœtIMEÜ  'út½\ kIDAThÞÍšmŒ\uÅgöhîJP(R Ùtî–’h‚‘ ‰‘Ì -C ’€!‘’ÆB”Q* 4‚iE FbŠUâÜ•‚~0šàK Ì] ±”·ˆ-vfZ ¥»³süpïÙÝi·Ý-x?ÎÌþïózÎyžÿŠzêå °§t®4p›¬uˆ“ÁOÚ^Dc¯ÔŠò£c ò^-´ñµb¡_ÒÃ’®²XX~Ùv1í¨•BòQ<ïwçæ{@£<Âb/N)…‹”Ó6Ikãe#t–ÐŽz)< ÅÔËá{ë@£<‚m£§©—Â%À}²®¶-I$%9HZôãz) ‚JL­Xø¿(¡S…nÇ\k9'ã§ýÌ©cïÂÜDñ®,C•ê{SB‰i|ø´qã^Á’”•ÓùÀ–z)\ 0T©R/…bý«g¼ì9Ûe‘·íY@Y9] éþv9EñQ9qÔ%T/}|±PÙ“}¿žxî`£ú‚í-Àû²Ü¤=03gSŽŽ×Qüâ1Ï@#Eý¥‘~Èmm¥¯u[£|Nn¨3T©>Ü€´/ÁÏžêlì°½^ ‡3H>&ÔŠ†R¬ŸKú¢¥!‰õö¢oý»<Ò—–Âìkd¿Ó|§O'†%EµRayP‰©—F¶„:™³^]!Ø &°¿-MÞ5Ty¡™rB ±ó¦¤g§öO/«´¯Áøu·tQ~´úR'9ÎË΃ê¥p‡¤Ë±eÉiÛöµåÖ÷–FÏ×ÊÉêKÈÌÀ•’²Ý—qDÄb aû ËŸÊWÆ^ž‹äÐ\¢žE^èŠ4å31žÌ%n4~(ˆâñÎsjå‘ÙëßMŽ^ÍmûuÛçGÇþšÈŽùhlî=ÐU2¥°¿Qy45^=PE¤’Áø"à¤ì‹üèõòùJuBð[ÞC4 ÐÊåvÖJIc磱ž;ÃF)ä¤SOmk`°¶Côd)IHzUÒÁŒaÓÎ~vØ#©O´)Df™ ­‚(¦1Ksçº#Ò¿h€m¿žÒ6êÖ6‡$äĦaÛƒÃf­]©Âë(™HKI+Ô¡†¢*õb8»òƒƒâÄíÏP/…yÁ]’®µ›‹ñé˱ýÐ%S„×õÂW ›{”–Ël™è€Æà™ìF»[ÒðbN‹ž¦Q óF›$®ÇÎ1Gã§1ìàÛm¶QÜúÏ¥!¶úNÙYÜW Õ’®¾#8µƒ Ô£œ’¯Ì3Æë‚(~®Sæ2˜<-zš½¥p‰¥;$_ï#7¾MNàÓAßõôõiq¿¿Ò¸äœÜ’(ö[ðö-Ø{:`Ø=  â ­†*UårÆ7Já¢܃ùhÎe3;’dÎ8SpÇ nò ‹6ÖWŸÏ•ªsðK7KªÙ–mMËä '$/é‡YcUªIì-†ýß—t­pÎbk^"»ƒ%#ÝÄääÆz)dIûQÛ$ýø¥í¿¤u£^NIÛkÅ‘aí)«A¬•-Ž>ò]h$éŸ¶Ï ¢x¼^ óÀ+’–Ø~é®lZR©º^ %’Z6Ç _‚ô£N†ŸÙ`óø³ý¸MpU\X 4¥©a¾Ñ’[{Ëáæ Þì`üŸ'îgZ%L¡’¼ x"'kSMÖ ôIÞåA¬OäZzÿt¹Tâ ðÏ‘ê=*!Ek°YžCœœèJsŒ#ßñvü¦r­ÿfÒ%iÊ8ëžqàµÃ£Ê?™Š0ùX{ÑÑßB§Û¹¡L/5Ê!õr[*œœy8¾‘4ž³½ÞòËBž-„‡ë¦ Áþi9íè•*µòÈ`ºWšÍƒIz¹i{K>{­V*‘v­È lÞýpˆP¤8(éöááú0OÓÒ;'.6÷’ÛJf‘ ì­AßœKåênì+mI"™æ›‰C¦ Ó:´õ°ÐÏ0<.{«§Êy¹YHã˜{÷7›7䲺K·×ïJ'£y9a«ƒ‰ÛçM—ßɯìI—"¯@Ét9}ì´hÜxsßú¡/ Tªm¢8ÆÜ`óL²A;òÆvji2´?“¤ã³™xúDØF¨Èï˜SeÍAÛwc6-‰âñÆ嫨ÃDJäGǨ•ÚNì¯3ìÒÔ”4W'€”þn{ƒÍDúù[Æw¤µdçY²°ï²•ÐlŒÆÝEZ/DÕLLJÀ%ÒµÁœ¡¦å5A%í>; Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Kevin Dawson. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Padre-Plugin-Git-0.12/MANIFEST0000644000175000017500000000143212215174457014617 0ustar kevinkevinChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/DSL.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Share.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Padre/Plugin/Git.pm lib/Padre/Plugin/Git/FBP/Message.pm lib/Padre/Plugin/Git/FBP/Output.pm lib/Padre/Plugin/Git/Message.pm lib/Padre/Plugin/Git/Output.pm lib/Padre/Plugin/Git/Task/Git_cmd.pm lib/Padre/Plugin/Git/Task/Git_patch.pm LICENSE Makefile.PL MANIFEST This list of files META.yml Padre-Plugin-Git.fbp README share/icons/16x16/git.png share/icons/32x32/git.png share/icons/48x48/git.png share/icons/64x64/git.png t/01-compile.t t/02-exports.t t/03-pod.t t/04-pod-coverage.t t/05-report-prereqs.t Padre-Plugin-Git-0.12/Makefile.PL0000644000175000017500000000201512215170470015425 0ustar kevinkevinuse inc::Module::Install::DSL 1.06; all_from lib/Padre/Plugin/Git.pm requires_from lib/Padre/Plugin/Git.pm requires_from lib/Padre/Plugin/Git/Output.pm requires_from lib/Padre/Plugin/Git/Message.pm perl_version 5.010001 requires CPAN::Changes 0.23 requires Carp 1.32 requires File::Slurp 9999.19 requires File::Spec 3.4 requires File::Which 1.09 requires Padre 0.98 requires Pithub 0.0102 requires Try::Tiny 0.18 requires constant 1.27 requires parent 0.227 test_requires Test::Deep 0.11 test_requires Test::More 0.98 test_requires Test::Requires 0.07 recommends ExtUtils::MakeMaker 6.76 recommends File::Spec::Functions 3.4 recommends List::Util 1.32 recommends Test::Pod 1.48 recommends Test::Pod::Coverage 1.08 homepage http://padre.perlide.org/trac/wiki/PadrePluginGit bugtracker https://github.com/PadreIDE/Padre-Plugin-Git/issues repository https://github.com/PadreIDE/Padre-Plugin-Git.git install_share no_index directory qw{ share t } Padre-Plugin-Git-0.12/lib/0002755000175000017500000000000012215174457014236 5ustar kevinkevinPadre-Plugin-Git-0.12/lib/Padre/0002755000175000017500000000000012215174457015271 5ustar kevinkevinPadre-Plugin-Git-0.12/lib/Padre/Plugin/0002755000175000017500000000000012215174457016527 5ustar kevinkevinPadre-Plugin-Git-0.12/lib/Padre/Plugin/Git/0002755000175000017500000000000012215174457017252 5ustar kevinkevinPadre-Plugin-Git-0.12/lib/Padre/Plugin/Git/Task/0002755000175000017500000000000012215174457020154 5ustar kevinkevinPadre-Plugin-Git-0.12/lib/Padre/Plugin/Git/Task/Git_patch.pm0000644000175000017500000000633612215136447022417 0ustar kevinkevinpackage Padre::Plugin::Git::Task::Git_patch; use v5.10; use strict; use warnings; use Carp qw( croak ); our $VERSION = '0.12'; use Padre::Task (); use Padre::Unload; use parent qw{ Padre::Task }; ####### # Default Constructor from Padre::Task POD ####### sub new { my $class = shift; my $self = $class->SUPER::new(@_); # Assert required command parameter if ( not defined $self->{action} ) { croak "Failed to provide an action to git cmd task\n"; } return $self; } ####### # Default run re: Padre::Task POD ####### sub run { my $self = shift; my $cmd = $self->{action}; my $system; if (Padre::Constant::WIN32) { my $title = $cmd; $title =~ s/"//g; $system = qq(start "$title" cmd /C "$cmd & pause"); } elsif (Padre::Constant::UNIX) { if ( defined $ENV{COLORTERM} ) { if ( $ENV{COLORTERM} eq 'gnome-terminal' ) { #Gnome-Terminal line format: #gnome-terminal -e "bash -c \"prove -lv t/96_edit_patch.t; exec bash\"" $system = qq($ENV{COLORTERM} -e "bash -c \\\"$cmd ; exec bash\\\"" & ); } else { $system = qq(xterm -sb -e "$cmd ; sleep 1000" &); } } } elsif (Padre::Constant::MAC) { # tome my $pwd = $self->current->document->project_dir(); $cmd =~ s/"/\\"/g; # Applescript can throw spurious errors on STDERR: http://helpx.adobe.com/photoshop/kb/unit-type-conversion $system = qq(osascript -e 'tell app "Terminal"\n\tdo script "cd $pwd; clear; $cmd ;"\nend tell'\n); } else { $system = qq(xterm -sb -e "$cmd ; sleep 1000" &); } # say $system; my $git_patch; require Padre::Util; $git_patch = Padre::Util::run_in_directory_two( cmd => $system, dir => $self->{project_dir}, option => 0 ); # if ( $self->{action} !~ m/^diff/ ) { # #strip leading # # $git_patch->{output} =~ s/^(\#)//sxmg; # } # #ToDo sort out Fudge, why O why do we not get correct response # # p $git_cmd; # if ( $self->{action} =~ m/^[push|fetch]/ ) { # $git_patch->{output} = $git_patch->{error}; # $git_patch->{error} = undef; # } # #saving to $self makes thing availbe to on_finish under $task # $self->{error} = $git_patch->{error}; # $self->{output} = $git_patch->{output}; return; } 1; __END__ # Spider bait Perl programming -> TIOBE =pod =encoding utf8 =head1 NAME Padre::Plugin::Git::Task::Git_cmd - Git plugin for Padre, The Perl IDE. =head1 VERSION version 0.12 =head1 SYNOPSIS Perform the Git Task as a background Job, help to keep Padre sweet. =head1 DESCRIPTION git cmd actions in a padre task =head1 Standard Padre::Task API In order not to freeze Padre during web access, nopasting is done in a thread, as implemented by L. Refer to this module's documentation for more information. The following methods are implemented: =head1 METHODS =over 4 =item * new() default Padre Task constructor, see Padre::Task POD =item * run() This is where all the work is done. =back =head1 BUGS AND LIMITATIONS None known. =head1 DEPENDENCIES Padre::Task, =head1 SEE ALSO For all related information (bug reporting, source code repository, etc.), refer to L. =head1 AUTHOR See L =head2 CONTRIBUTORS See L =head1 COPYRIGHT See L =head1 LICENSE See L =cut Padre-Plugin-Git-0.12/lib/Padre/Plugin/Git/Task/Git_cmd.pm0000644000175000017500000000442212215136424022050 0ustar kevinkevinpackage Padre::Plugin::Git::Task::Git_cmd; use v5.10; use strict; use warnings; use Carp qw( croak ); our $VERSION = '0.12'; use Padre::Task (); use Padre::Unload ; use parent qw{ Padre::Task }; ####### # Default Constructor from Padre::Task POD ####### sub new { my $class = shift; my $self = $class->SUPER::new(@_); # Assert required command parameter if ( not defined $self->{action} ) { croak "Failed to provide an action to git cmd task\n"; } return $self; } ####### # Default run re: Padre::Task POD ####### sub run { my $self = shift; my $git_cmd; require Padre::Util; $git_cmd = Padre::Util::run_in_directory_two( cmd => "git $self->{action} $self->{location}", dir => $self->{project_dir}, option => 0 ); if ( $self->{action} !~ m/^diff/ ) { #strip leading # $git_cmd->{output} =~ s/^(\#)//sxmg; } #ToDo sort out Fudge, why O why do we not get correct response # p $git_cmd; if ( $self->{action} =~ m/^[push|fetch]/ ) { $git_cmd->{output} = $git_cmd->{error}; $git_cmd->{error} = undef; } #saving to $self makes thing availbe to on_finish under $task $self->{error} = $git_cmd->{error}; $self->{output} = $git_cmd->{output}; return; } 1; __END__ # Spider bait Perl programming -> TIOBE =pod =encoding utf8 =head1 NAME Padre::Plugin::Git::Task::Git_cmd - Git plugin for Padre, The Perl IDE. =head1 VERSION version 0.12 =head1 SYNOPSIS Perform the Git Task as a background Job, help to keep Padre sweet. =head1 DESCRIPTION git cmd actions in a padre task =head1 Standard Padre::Task API In order not to freeze Padre during web access, nopasting is done in a thread, as implemented by L. Refer to this module's documentation for more information. The following methods are implemented: =head1 METHODS =over 4 =item * new() default Padre Task constructor, see Padre::Task POD =item * run() This is where all the work is done. =back =head1 BUGS AND LIMITATIONS None known. =head1 DEPENDENCIES Padre::Task, =head1 SEE ALSO For all related information (bug reporting, source code repository, etc.), refer to L. =head1 AUTHOR See L =head2 CONTRIBUTORS See L =head1 COPYRIGHT See L =head1 LICENSE See L =cut Padre-Plugin-Git-0.12/lib/Padre/Plugin/Git/Message.pm0000644000175000017500000000443412215136403021164 0ustar kevinkevinpackage Padre::Plugin::Git::Message; use v5.10; use strict; use warnings; use Padre::Unload (); use Padre::Plugin::Git::FBP::Message (); use File::Spec; use File::Slurp; our $VERSION = '0.12'; use parent qw( Padre::Plugin::Git::FBP::Message Padre::Plugin ); ####### # Method new ####### sub new { my $class = shift; my $main = shift; my $title = shift; my $project = shift; my $commit_file = shift; # Create the dialogue my $self = $class->SUPER::new($main); $self->{project} = $project; # define where to display main dialogue $self->CenterOnParent; $self->SetTitle($title); if ($commit_file) { $self->type->SetLabel('File:'); $self->commit_file->SetLabel($commit_file); } else { $self->type->SetLabel('Project:'); $self->commit_file->SetLabel($project); } return $self; } ####### # event handler for on_show_last ####### sub on_show_last { my $self = shift; my $previous_commit_file = File::Spec->catfile( $self->{project}, '.git/COMMIT_EDITMSG' ); if ( -e $previous_commit_file ) { my $previous_text = read_file($previous_commit_file); $self->message->SetValue($previous_text); } return; } ####### # event handler for on_commit ####### sub on_commit { my $self = shift; my $message = $self->message->GetValue; chomp $message; # save config info my $config = $self->config_read; $config->{message} = $message; $self->config_write($config); $self->Hide; return; } 1; __END__ # Spider bait Perl programming -> TIOBE =pod =encoding utf8 =head1 NAME Padre::Plugin::Git::Message - Git plugin for Padre, The Perl IDE. =head1 VERSION version 0.12 =head1 DESCRIPTION This module handles the Commit messages dialogue. =head1 METHODS =over 4 =item * new $self->{dialog} = Padre::Plugin::Git::Message->new( $main, $title, $document->project_dir, $filename ); =item * on_commit =item * on_show_last =back =head1 BUGS AND LIMITATIONS None known. =head1 DEPENDENCIES Padre, Padre::Plugin::Git::FBP::Message =head1 SEE ALSO For all related information (bug reporting, source code repository, etc.), refer to L. =head1 AUTHOR See L =head2 CONTRIBUTORS See L =head1 COPYRIGHT See L =head1 LICENSE See L =cut Padre-Plugin-Git-0.12/lib/Padre/Plugin/Git/FBP/0002755000175000017500000000000012215174457017661 5ustar kevinkevinPadre-Plugin-Git-0.12/lib/Padre/Plugin/Git/FBP/Message.pm0000644000175000017500000000717412215133430021574 0ustar kevinkevinpackage Padre::Plugin::Git::FBP::Message; ## no critic # This module was generated by Padre::Plugin::FormBuilder::Perl. # To change this module edit the original .fbp file and regenerate. # DO NOT MODIFY THIS FILE BY HAND! use 5.008005; use utf8; use strict; use warnings; use Padre::Wx (); use Padre::Wx::Role::Main (); our $VERSION = '0.12'; our @ISA = qw{ Padre::Wx::Role::Main Wx::Dialog }; sub new { my $class = shift; my $parent = shift; my $self = $class->SUPER::new( $parent, -1, Wx::gettext("Git Commit Message"), Wx::DefaultPosition, Wx::DefaultSize, Wx::DEFAULT_DIALOG_STYLE | Wx::RESIZE_BORDER, ); $self->{m_staticText2} = Wx::StaticText->new( $self, -1, Wx::gettext("Guidance:"), ); $self->{m_staticText1} = Wx::StaticText->new( $self, -1, Wx::gettext("Please enter the commit message for your changes. Lines starting\nwith '#' will be ignored, and an empty message aborts the commit."), ); $self->{type} = Wx::StaticText->new( $self, -1, Wx::gettext("File:"), ); $self->{commit_file} = Wx::StaticText->new( $self, -1, Wx::gettext("commit file"), ); $self->{message} = Wx::TextCtrl->new( $self, -1, "", Wx::DefaultPosition, Wx::DefaultSize, Wx::TE_MULTILINE, ); $self->{message}->SetMinSize( [ 480, 60 ] ); $self->{m_staticline1} = Wx::StaticLine->new( $self, -1, Wx::DefaultPosition, Wx::DefaultSize, Wx::LI_HORIZONTAL, ); $self->{show_last_commit} = Wx::Button->new( $self, -1, Wx::gettext("Show Last Commit"), Wx::DefaultPosition, Wx::DefaultSize, ); Wx::Event::EVT_BUTTON( $self, $self->{show_last_commit}, sub { shift->on_show_last(@_); }, ); $self->{m_button_cancel} = Wx::Button->new( $self, Wx::ID_CANCEL, Wx::gettext("Cancel"), Wx::DefaultPosition, Wx::DefaultSize, ); $self->{m_button_cancel}->SetDefault; $self->{button_commit} = Wx::Button->new( $self, -1, Wx::gettext("Commit"), Wx::DefaultPosition, Wx::DefaultSize, ); $self->{button_commit}->SetDefault; Wx::Event::EVT_BUTTON( $self, $self->{button_commit}, sub { shift->on_commit(@_); }, ); my $fgSizer1 = Wx::FlexGridSizer->new( 2, 2, 0, 0 ); $fgSizer1->SetFlexibleDirection(Wx::BOTH); $fgSizer1->SetNonFlexibleGrowMode(Wx::FLEX_GROWMODE_SPECIFIED); $fgSizer1->Add( $self->{m_staticText2}, 0, Wx::ALL, 5 ); $fgSizer1->Add( $self->{m_staticText1}, 0, Wx::ALL, 5 ); $fgSizer1->Add( $self->{type}, 0, Wx::ALL, 5 ); $fgSizer1->Add( $self->{commit_file}, 0, Wx::ALL, 5 ); my $bSizer8 = Wx::BoxSizer->new(Wx::HORIZONTAL); $bSizer8->Add( $self->{show_last_commit}, 0, Wx::ALL, 5 ); $bSizer8->Add( 0, 0, 1, Wx::EXPAND, 5 ); $bSizer8->Add( $self->{m_button_cancel}, 0, Wx::ALL, 5 ); $bSizer8->Add( $self->{button_commit}, 0, Wx::ALL, 5 ); my $bSizer1 = Wx::BoxSizer->new(Wx::VERTICAL); $bSizer1->Add( $fgSizer1, 0, Wx::EXPAND, 5 ); $bSizer1->Add( $self->{message}, 1, Wx::ALL | Wx::EXPAND, 5 ); $bSizer1->Add( $self->{m_staticline1}, 0, Wx::EXPAND | Wx::ALL, 5 ); $bSizer1->Add( $bSizer8, 0, Wx::ALL | Wx::EXPAND, 5 ); $self->SetSizerAndFit($bSizer1); $self->Layout; return $self; } sub type { $_[0]->{type}; } sub commit_file { $_[0]->{commit_file}; } sub message { $_[0]->{message}; } sub on_show_last { $_[0]->main->error('Handler method on_show_last for event show_last_commit.OnButtonClick not implemented'); } sub on_commit { $_[0]->main->error('Handler method on_commit for event button_commit.OnButtonClick not implemented'); } 1; # Copyright 2008-2012 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. Padre-Plugin-Git-0.12/lib/Padre/Plugin/Git/FBP/Output.pm0000644000175000017500000000337512215133430021507 0ustar kevinkevinpackage Padre::Plugin::Git::FBP::Output; ## no critic # This module was generated by Padre::Plugin::FormBuilder::Perl. # To change this module edit the original .fbp file and regenerate. # DO NOT MODIFY THIS FILE BY HAND! use 5.008005; use utf8; use strict; use warnings; use Padre::Wx (); use Padre::Wx::Role::Main (); our $VERSION = '0.12'; our @ISA = qw{ Padre::Wx::Role::Main Wx::Dialog }; sub new { my $class = shift; my $parent = shift; my $self = $class->SUPER::new( $parent, -1, Wx::gettext("git output"), Wx::DefaultPosition, Wx::DefaultSize, Wx::DEFAULT_DIALOG_STYLE | Wx::RESIZE_BORDER, ); $self->{text} = Wx::TextCtrl->new( $self, -1, "", Wx::DefaultPosition, Wx::DefaultSize, Wx::TE_MULTILINE, ); $self->{text}->SetMinSize( [ 540, 240 ] ); $self->{m_staticline1} = Wx::StaticLine->new( $self, -1, Wx::DefaultPosition, Wx::DefaultSize, Wx::LI_HORIZONTAL, ); $self->{m_button_cancel} = Wx::Button->new( $self, Wx::ID_CANCEL, Wx::gettext("Close"), Wx::DefaultPosition, Wx::DefaultSize, ); $self->{m_button_cancel}->SetDefault; my $bSizer2 = Wx::BoxSizer->new(Wx::HORIZONTAL); $bSizer2->Add( 0, 0, 1, Wx::EXPAND, 5 ); $bSizer2->Add( $self->{m_button_cancel}, 0, Wx::ALL, 5 ); my $bSizer1 = Wx::BoxSizer->new(Wx::VERTICAL); $bSizer1->Add( $self->{text}, 1, Wx::ALL | Wx::EXPAND, 5 ); $bSizer1->Add( $self->{m_staticline1}, 0, Wx::EXPAND | Wx::ALL, 5 ); $bSizer1->Add( $bSizer2, 0, Wx::EXPAND, 5 ); $self->SetSizerAndFit($bSizer1); $self->Layout; return $self; } sub text { $_[0]->{text}; } 1; # Copyright 2008-2012 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. Padre-Plugin-Git-0.12/lib/Padre/Plugin/Git/Output.pm0000644000175000017500000000261412215136366021106 0ustar kevinkevinpackage Padre::Plugin::Git::Output; use v5.10; use strict; use warnings; use Padre::Unload (); use Padre::Plugin::Git::FBP::Output (); our $VERSION = '0.12'; use parent qw( Padre::Plugin::Git::FBP::Output Padre::Plugin ); ####### # Method new ####### sub new { my $class = shift; my $main = shift; my $title = shift || ''; my $text = shift || ''; # Create the dialogue my $self = $class->SUPER::new($main); # define where to display main dialogue $self->CenterOnParent; $self->SetTitle( $title ); $self->text->SetValue( $text ); return $self; } 1; __END__ # Spider bait Perl programming -> TIOBE =pod =encoding utf8 =head1 NAME Padre::Plugin::Git::Output - Git plugin for Padre, The Perl IDE. =head1 VERSION version 0.12 =head1 DESCRIPTION This module handles the Output dialogue that is used to show git response. =head1 METHODS =over 4 =item * new $self->{dialog} = Padre::Plugin::Git::Output->new( $main, "Git $action -> $location", $git_cmd->{output} ); =back =head1 BUGS AND LIMITATIONS None known. =head1 DEPENDENCIES Padre, Padre::Plugin::Git::FBP::Output =head1 SEE ALSO For all related information (bug reporting, source code repository, etc.), refer to L. =head1 AUTHOR See L =head2 CONTRIBUTORS See L =head1 COPYRIGHT See L =head1 LICENSE See L =cut Padre-Plugin-Git-0.12/lib/Padre/Plugin/Git.pm0000644000175000017500000005122512215172002017573 0ustar kevinkevinpackage Padre::Plugin::Git; use 5.010001; use strict; use warnings; use Padre::Unload; use Padre::Config (); use Padre::Wx (); use Padre::Plugin (); use Padre::Util (); use Padre::Wx::Action (); use File::Basename (); use File::Which (); use Try::Tiny; use File::Slurp; use CPAN::Changes; our $VERSION = '0.12'; use parent qw( Padre::Plugin Padre::Role::Task ); ######### # We need plugin_enable # as we have an external dependency git ######### sub plugin_enable { my $self = shift; my $local_git_exists = 0; try { if ( File::Which::which('git') ) { $local_git_exists = 1; } }; #ReSet Config data my $config = $self->config_read; $config = {}; $self->config_write($config); return $local_git_exists; } # Child modules we need to unload when disabled use constant CHILDREN => qw{ Padre::Plugin::Git::Output Padre::Plugin::Git::FBP::Output Padre::Plugin::Git::Message Padre::Plugin::Git::FBP::Message Padre::Plugin::Git::Task::Git_cmd Padre::Plugin::Git Pithub }; use constant { BLANK => qq{ }, NONE => q{}, }; ####### # Called by padre to check the required interface ####### sub padre_interfaces { return ( # Default, required 'Padre::Plugin' => '0.96', 'Padre::Task' => '0.96', 'Padre::Unload' => '0.96', 'Padre::Config' => '0.96', 'Padre::Wx' => '0.96', 'Padre::Wx::Action' => '0.96', 'Padre::Util' => '0.97', ); } ####### # Called by Padre to know the plugin name ####### sub plugin_name { return Wx::gettext('Git'); } ####### # Add Plugin to Padre Menu ####### sub menu_plugins_simple { my $self = shift; my $main = $self->main; my $document = $main->current->document; #Hide Git on Tools menu if current file is not in a Git controlled dir $self->current_files; my $tab_id = $self->main->editor_of_file( $document->{filename} ); try { if ( defined $tab_id && defined $self->{open_file_info}->{$tab_id}->{'vcs'} ) { if ( $self->{open_file_info}->{$tab_id}->{'vcs'} =~ m/Git/sxm ) { return $self->plugin_name => [ Wx::gettext('Local') => [ Wx::gettext('Staging') => [ Wx::gettext('Stage File') => sub { $self->git_cmd( 'add', $document->filename ); $self->git_cmd( 'status', $document->filename ); }, Wx::gettext('Stage All') => sub { $self->git_cmd( 'add', $document->project_dir ); $self->git_cmd( 'status', $document->project_dir ); }, Wx::gettext('Unstage File') => sub { #ToDo mj41 should we be using this instead #$self->git_cmd( 'rm --cached', $document->filename ); $self->git_cmd( 'reset HEAD', $document->filename ); $self->git_cmd( 'status', $document->filename ); }, Wx::gettext('Stage Patch') => sub { $self->git_patch( 'git add -p ' . $document->filename ); }, ], Wx::gettext('Commit') => [ Wx::gettext('Commit File') => sub { $self->git_cmd( 'commit', $document->filename, $document->filename ); }, Wx::gettext('Commit Project') => sub { $self->git_cmd( 'commit', $document->project_dir ); }, Wx::gettext('Commit Amend') => sub { $self->git_cmd( 'commit --amend', NONE ); }, Wx::gettext('Commit All') => sub { $self->git_cmd( 'commit -a', NONE ); }, Wx::gettext('Commit Patch') => sub { $self->git_patch( 'git commit -p ' . $document->filename ); }, ], Wx::gettext('Checkout') => [ Wx::gettext('Checkout File') => sub { $self->git_cmd( 'checkout --', $document->filename ); }, ], Wx::gettext('Status') => [ Wx::gettext('File Status') => sub { $self->git_cmd( 'status', $document->filename ); }, Wx::gettext('Directory Status') => sub { self->git_cmd( 'status', File::Basename::dirname( $document->filename ) ); }, Wx::gettext('Project Status') => sub { $self->git_cmd( 'status', $document->project_dir ); }, ], Wx::gettext('Diff') => [ Wx::gettext('Diff of File') => sub { my $result = $self->git_cmd( 'diff', $document->filename ); }, Wx::gettext('Diff of Staged File') => sub { $self->git_cmd( 'diff --cached', $document->filename ); }, Wx::gettext('Diff of Directory') => sub { $self->git_cmd( 'diff', File::Basename::dirname( $document->filename ) ); }, Wx::gettext('Diff of Project') => sub { $self->git_cmd( 'diff', $document->project_dir ); }, ], Wx::gettext('Log') => [ Wx::gettext('log --stat -2') => sub { $self->git_cmd( 'log --stat -2', NONE ); }, Wx::gettext('log -p -2') => sub { $self->git_cmd( 'log -p -2', NONE ); }, Wx::gettext('log pretty') => sub { $self->git_cmd( 'log --pretty=format:"%h %s" --graph', NONE ); }, Wx::gettext('log graph last 100 commits') => sub { $self->git_cmd( "log --graph --all --format=format:'%h - (%ar) %s - %an %d' --abbrev-commit --date=relative --cherry-pick --max-count=100", NONE ); }, ], Wx::gettext('Blame') => [ Wx::gettext('Blame, Current file') => sub { $self->git_cmd( 'blame', $document->filename ); }, ], ], Wx::gettext('Origin') => [ Wx::gettext('Show Origin Info.') => sub { $self->git_cmd_task( 'remote show origin', NONE ); }, Wx::gettext('Push to Origin') => sub { $self->git_cmd_task( 'push origin master', NONE ); }, Wx::gettext('Fetch from Origin') => sub { $self->git_cmd_task( 'fetch origin master', NONE ); }, Wx::gettext('Pull from Origin') => sub { $self->git_cmd_task( 'pull origin master', NONE ); }, ], Wx::gettext('Upstream') => [ Wx::gettext('Show Upstream Info.') => sub { $self->git_cmd_task( 'remote show upstream', NONE ); }, Wx::gettext('Fetch Upstream') => sub { $self->git_cmd_task( 'fetch upstream', NONE ); }, Wx::gettext('Merge Upstream Master') => sub { $self->git_cmd_task( 'merge upstream/master', NONE ); }, ], Wx::gettext('Branching') => [ Wx::gettext('Branch Info') => sub { $self->git_cmd( 'branch -r -a -v', NONE ); }, Wx::gettext('Fetch All Branches from Origin') => sub { $self->git_cmd_task( 'fetch --all', NONE ); }, ], Wx::gettext('GitHub') => [ Wx::gettext('GitHub Pull Request') => sub { $self->github_pull_request(); }, ], Wx::gettext('About...') => sub { $self->plugin_about; }, # Wx::gettext('Test Commit Message...') => sub { # # $self->commit_message(); # $self->commit_message( $document->filename ); # }, ]; } } }; # return; #do not enable this return as it Fucks-up the menu } ######## # Composed Method clean_dialog ######## sub clean_dialog { my $self = shift; # Close the main dialog if it is hanging around if ( $self->{dialog} ) { $self->{dialog}->Hide; $self->{dialog}->Destroy; delete $self->{dialog}; } return 1; } ######## # plugin_disable ######## sub plugin_disable { my $self = shift; # Close the dialog if it is hanging around $self->clean_dialog; # Unload all our child classes for my $package (CHILDREN) { require Padre::Unload; Padre::Unload->unload($package); } $self->SUPER::plugin_disable(@_); return 1; } ####### # Add icon to Plugin ####### sub plugin_icon { my $self = shift; my $share = $self->plugin_directory_share or return; my $file = File::Spec->catfile( $share, 'icons', '16x16', 'git.png' ); return unless -f $file; return unless -r $file; return Wx::Bitmap->new( $file, Wx::wxBITMAP_TYPE_PNG ); } ####### # plugin_about ####### sub plugin_about { my $self = shift; my $share = $self->plugin_directory_share or return; my $file = File::Spec->catfile( $share, 'icons', '48x48', 'git.png' ); return unless -f $file; return unless -r $file; my $info = Wx::AboutDialogInfo->new; $info->SetIcon( Wx::Icon->new( $file, Wx::wxBITMAP_TYPE_PNG ) ); $info->SetName('Padre::Plugin::Git'); $info->SetVersion($VERSION); $info->SetDescription( Wx::gettext('A Simple Git interface for Padre') ); $info->SetCopyright('(c) 2008-2012 The Padre development team'); $info->SetWebSite('http://padre.perlide.org/trac/wiki/PadrePluginGit'); $info->AddDeveloper('Kevin Dawson '); $info->AddDeveloper('Kaare Rasmussen '); $info->SetArtists( [ 'Scott Chacon ', 'Licence ' ] ); Wx::AboutBox($info); return; } ### # End of Padre API Methods ###### ####### # git_commit ####### sub git_cmd { my $self = shift; my $action = shift; my $location = shift; my $filename = shift; my $main = $self->main; my $document = $main->current->document; my $message; my $git_cmd; if ( $action =~ m/^commit/ ) { #ToDo this needs to be replaced with a dedicated dialogue, as all it dose is dump in to DB::History for no good reason # my $commit_editmsg = read_file( $document->project_dir . '/.git/COMMIT_EDITMSG' ); # chomp $commit_editmsg; # $message = $main->prompt( "Git Commit of $location", 'Please type in your message', 'MY_GIT_COMMIT' ); $message = $self->commit_message( 'Git Commit message', $filename ); return if not $message; require Padre::Util; $git_cmd = Padre::Util::run_in_directory_two( cmd => "git $action $location -m \"$message\"", dir => $document->project_dir, option => 0 ); # #update Changes file # $self->write_changes( $document->project_dir, $message ); } else { require Padre::Util; $git_cmd = Padre::Util::run_in_directory_two( cmd => "git $action $location", dir => $document->project_dir, option => 0 ); } if ( $action !~ m/^diff/ ) { #strip leading # $git_cmd->{output} =~ s/^(\#)//sxmg; } #ToDo sort out Fudge, why O why do we not get correct response # p $git_cmd; if ( $action =~ m/^push/ ) { $git_cmd->{output} = $git_cmd->{error}; $git_cmd->{error} = undef; } #Display correct result try { if ( $git_cmd->{error} ) { $main->error( sprintf( Wx::gettext("Git Error follows -> \n\n%s"), $git_cmd->{error} ), ); } if ( $git_cmd->{output} ) { $self->load_dialog_output( "Git $action -> $location", $git_cmd->{output} ); if ( $action =~ m/^commit/ ) { $git_cmd->{output} =~ m/master\s(?[\w|\d]{7})/; #update Changes file $self->write_changes( $document->project_dir, $message, $+{nr} ); } } else { $main->info( Wx::gettext('Info: There is no response, just as if you had run it on the cmd yourself.') ); } }; return; } ####### # github_pull_request ####### sub github_pull_request { my $self = shift; my $main = $self->main; my $document = $main->current->document; # Lets start with user-name and token being external to pp-git my $user = $ENV{GITHUB_USER}; my $token = $ENV{GITHUB_TOKEN}; unless ( $user && $token ) { $main->error( Wx::gettext( 'Error: missing $ENV{GITHUB_USER} and $ENV{GITHUB_TOKEN}' . "\n" . 'See http://padre.perlide.org/trac/wiki/PadrePluginGit' . "\n" . 'Wiki page for more info.' ) ); return; } # my $message = $main->prompt( "GitHub Pull Request", "Please type in your message" ); my $message = $self->commit_message('GitHub Pull Request message'); return if not $message; #Use first 32 chars of message as pull request title my $title = substr $message, 0, 32; my $git_cmd; require Padre::Util; $git_cmd = Padre::Util::run_in_directory_two( cmd => "git remote show upstream", dir => $document->project_dir, option => 0 ); try { if ( defined $git_cmd->{error} ) { if ( $git_cmd->{error} =~ m/^fatal/ ) { # $self->{error} = 'dose not have an upstream component'; say 'dose not have an upstream component'; $main->error( Wx::gettext('Error: this repo dose not have an upstream component') ); return; } } }; my $test_output = $git_cmd->{output}; $test_output =~ m{(?<=https://github.com/)(?.*)(?:/)(?.*)(?:.git)}; my $author = $+{author}; my $repo = $+{repo}; require Pithub; my $github = Pithub->new( repo => $repo, token => $token, user => $user, ); my $status = $github->pull_requests->create( repo => $repo, user => $author, data => { base => "$author:master", body => $message, head => "$user:master", title => $title, } ); if ( $status->success eq 1 ) { $main->message( sprintf( Wx::gettext("Info: Cool we got a: %s \nNow you should check your GitHub repo\n https://github.com/%s"), $status->response->{_rc}, $user, ) ); } else { $main->error( sprintf( Wx::gettext("Error: %s\n%s"), $status->response->{_rc}, $status->response->{_content}, ) ); } return; } ####### # git_cmd_task ####### sub git_cmd_task { my $self = shift; my $action = shift; my $location = shift; my $main = $self->main; my $document = $main->current->document; require Padre::Plugin::Git::Task::Git_cmd; # Fire the task $self->task_request( task => 'Padre::Plugin::Git::Task::Git_cmd', action => $action, location => $location, project_dir => $document->project_dir, on_finish => 'on_finish', ); return; } ####### # on completion of task do this #######patch->{output}; sub on_finish { my $self = shift; my $task = shift; my $main = $self->main; if ( $task->{error} ) { $main->error( sprintf( Wx::gettext("Git Error follows -> \n\n%s"), $task->{error} ), ); } elsif ( $task->{output} ) { $self->load_dialog_output( "Git task->{action} -> $task->{location}", $task->{output} ); } else { $main->info( Wx::gettext('Info: There is no response, just as if you had run it on the cmd yourself.') ); } return; } ######## # Composed Method, # Load Output dialog, only once ####### sub load_dialog_output { my $self = shift; my $title = shift; my $text = shift; # Padre main window integration my $main = $self->main; # Close the dialog if it is hanging around $self->clean_dialog; # Create the new dialog require Padre::Plugin::Git::Output; $self->{dialog} = Padre::Plugin::Git::Output->new( $main, $title, $text ); $self->{dialog}->Show; return; } ####### # event_on_context_menu ####### sub event_on_context_menu { my ( $self, $document, $editor, $menu, $event ) = @_; $self->current_files; return if not $document->filename; return if not $document->project_dir; my $tab_id = $self->main->editor_of_file( $document->{filename} ); if ( eval { $self->{open_file_info}->{$tab_id}->{'vcs'} =~ m/Git/sxm } ) { $menu->AppendSeparator; my $item = $menu->Append( -1, Wx::gettext('Git commit -a') ); Wx::Event::EVT_MENU( $self->main, $item, sub { $self->git_cmd( 'commit -a', NONE ) }, ); } return; } ####### # Method current_files hacked from wx-dialog-patch ####### sub current_files { my $self = shift; my $main = $self->main; my $current = $main->current; my $notebook = $current->notebook; my @label = $notebook->labels; # get last element # not size $self->{tab_cardinality} = $#label; # thanks Alias my @file_vcs = map { $_->project->vcs } $self->main->documents; # create a bucket for open file info, as only a current file bucket exist for ( 0 .. $self->{tab_cardinality} ) { $self->{open_file_info}->{$_} = ( { 'index' => $_, 'URL' => $label[$_][1], 'filename' => $notebook->GetPageText($_), 'changed' => 0, 'vcs' => $file_vcs[$_], }, ); if ( $notebook->GetPageText($_) =~ /^\*/sxm ) { # TRACE("Found an unsaved file, will ignore: $notebook->GetPageText($_)") if DEBUG; $self->{open_file_info}->{$_}->{'changed'} = 1; } } return; } ######## # Composed Method write_changes under {{$NEXT}} ######## sub write_changes { my $self = shift; my $dir = shift; my $message = shift; my $nr_code = shift; require File::Spec; my $change_file = File::Spec->catfile( $dir, 'Changes' ); # say $change_file; if ( -e $change_file ) { # say 'found Changes'; # say $change_file; my $changes = CPAN::Changes->load( $change_file, next_token => qr/\{\{\$NEXT}}/, ); my @releases = $changes->releases; if ( $releases[-1]->version eq '{{$NEXT}}' ) { $releases[-1]->add_changes( $message . " [$nr_code]" ); } # print $changes->serialize; write_file( $change_file, { binmode => ':utf8' }, $changes->serialize ); } return; } ####### # git_patch ####### sub git_patch { my $self = shift; my $cmd = shift; my $main = $self->main; my $document = $main->current->document; my $system; # hacked from Padre-Wx-Main->run_command if (Padre::Constant::WIN32) { my $title = $cmd; $title =~ s/"//g; $system = qq(start "$title" cmd /C "$cmd & pause"); } elsif (Padre::Constant::UNIX) { if ( defined $ENV{COLORTERM} ) { if ( $ENV{COLORTERM} eq 'gnome-terminal' ) { #Gnome-Terminal line format: #gnome-terminal -e "bash -c \"prove -lv t/96_edit_patch.t; exec bash\"" $system = qq($ENV{COLORTERM} -e "bash -c \\\"$cmd ; exec bash\\\"" & ); } else { $system = qq(xterm -sb -e "$cmd ; sleep 1000" &); } } } elsif (Padre::Constant::MAC) { # tome my $pwd = $self->current->document->project_dir(); $cmd =~ s/"/\\"/g; # Applescript can throw spurious errors on STDERR: http://helpx.adobe.com/photoshop/kb/unit-type-conversion $system = qq(osascript -e 'tell app "Terminal"\n\tdo script "cd $pwd; clear; $cmd ;"\nend tell'\n); } else { $system = qq(xterm -sb -e "$cmd ; sleep 1000" &); } # run 'git add -p file-name' in terminal require Padre::Util; Padre::Util::run_in_directory_two( cmd => $system, dir => $document->project_dir, option => 0 ); return; } ####### # new commit message dialog that dos not dump into DB::History ####### sub commit_message { my $self = shift; my $title = shift; my $filename = shift; # Padre main window integration my $main = $self->main; my $document = $main->current->document; # Close the dialog if it is hanging around $self->clean_dialog; # Create the new dialog require Padre::Plugin::Git::Message; $self->{dialog} = Padre::Plugin::Git::Message->new( $main, $title, $document->project_dir, $filename ); $self->{dialog}->ShowModal; $self->{dialog}->Destroy; delete $self->{dialog}; my $config = $self->config_read; if ( $config->{message} ) { my $message = $config->{message}; chomp $message; # say $message; return $message; } return; } 1; __END__ # Spider bait Perl programming -> TIOBE =pod =encoding utf8 =head1 NAME Padre::Plugin::Git - A Simple Git interface for Padre, the Perl IDE, =head1 VERSION version 0.12 =head1 SYNOPSIS B cpan install Padre::Plugin::Git Enable it via Padre->Tools->Plugin Manager For more info see L Padre::Plugin::Git is a Perl programming plug-in for Padre =head1 DESCRIPTION Basic git cmd commands, plus a bit more, which is a bit Eetaish =over 4 =item * if you configure your local ENV with GitHub Access you can also do GitHub Pull requests, =item * plus if you use {{$NEXT}} in your Changes file it will append commit messages below. see L for more info. =back =head1 METHODS =over 4 =item * clean_dialog =item * commit_message =item * current_files =item * event_on_context_menu =item * git_cmd =item * git_cmd_task =item * git_patch =item * github_pull_request =item * load_dialog_output =item * menu_plugins_simple =item * on_finish =item * padre_interfaces =item * plugin_about =item * plugin_disable =item * plugin_enable =item * plugin_icon =item * plugin_name =item * write_changes use CPAN::Changes to write git commits to project Change file, this abuses the {{$NEXT}} token as a valid version see CPAN::Changes::Spec for format =back =head1 CONFIGURATION AND ENVIRONMENT To be able to do a GitHub Pull request, the following need to be configured. $ENV{GITHUB_USER} $ENV{GITHUB_TOKEN} =head1 AUTHOR Kevin Dawson Ebowtie@cpan.orgE Kaare Rasmussen, Ekaare@cpan.orgE =head2 CONTRIBUTORS Alexandr Ciornii Ealexchorny@gmail.comE Ryan Niebur Eryanryan52@gmail.comE Dominique Dumont Edod@debian.orgE perlbotics Eperlbotics@yahoo.deE =head1 BUGS Please report any bugs or feature requests to L =head1 COPYRIGHT Copyright E 2009-2011 Kaare Rasmussen Copyright E 2009-2013 the Padre::Plugin::Git L and L as listed above. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl 5 itself. =cut Padre-Plugin-Git-0.12/t/0002755000175000017500000000000012215174457013733 5ustar kevinkevinPadre-Plugin-Git-0.12/t/02-exports.t0000644000175000017500000000162412214105424016027 0ustar kevinkevin#!perl use 5.010; use strict; use warnings FATAL => 'all'; use Test::More tests => 21; use Padre::Plugin::Git (); ###### # let's check our subs/methods. ###### my @subs = qw( clean_dialog commit_message current_files event_on_context_menu git_cmd git_cmd_task git_patch github_pull_request load_dialog_output menu_plugins_simple on_finish padre_interfaces plugin_about plugin_disable plugin_enable plugin_icon plugin_name write_changes); use_ok('Padre::Plugin::Git', @subs); foreach my $subs (@subs) { can_ok('Padre::Plugin::Git', $subs); } ###### # let's check our lib's are here. ###### my $test_object; require Padre::Plugin::Git::Output; $test_object = new_ok('Padre::Plugin::Git::Output'); require Padre::Plugin::Git::FBP::Output; $test_object = new_ok('Padre::Plugin::Git::FBP::Output'); require Padre::Plugin::Git::Task::Git_cmd; # $test_object = new_ok('Padre::Plugin::Git::Task::Git_cmd'); Padre-Plugin-Git-0.12/t/01-compile.t0000644000175000017500000000156012215137216015756 0ustar kevinkevin#!perl use strict; use warnings FATAL => 'all'; use English qw( -no_match_vars ); local $OUTPUT_AUTOFLUSH = 1; use Test::More tests => 14; # Check dependencies that are not checked but Padre::Plugin::Git.pm itself BEGIN { use_ok('Padre::Plugin::Git', '0.11'); use_ok('CPAN::Changes', '0.23'); use_ok('Carp', '1.32'); use_ok('File::Slurp', '9999.19'); use_ok('File::Spec', '3.4'); use_ok('File::Which', '1.09'); use_ok('Padre', '0.98'); use_ok('Pithub', '0.0102'); use_ok('Try::Tiny', '0.18'); use_ok('constant', '1.27'); use_ok('parent', '0.227'); use_ok('Test::Deep', '0.108'); use_ok('Test::More', '0.98'); use_ok('Test::Requires', '0.07'); } diag("Info: Testing Padre::Plugin::Git $Padre::Plugin::Git::VERSION"); done_testing(); __END__ Padre-Plugin-Git-0.12/t/05-report-prereqs.t0000644000175000017500000000313012215171450017315 0ustar kevinkevinuse strict; use warnings; our $VERSION = '0.04'; use English qw( -no_match_vars ); # Avoids regex performance penalty local $OUTPUT_AUTOFLUSH = 1; use Test::More; use Test::Requires {'ExtUtils::MakeMaker' => 6.76}; use Test::Requires {'File::Spec::Functions' => 3.40}; use Test::Requires {'List::Util' => 1.32}; use List::Util qw/max/; my @modules = qw( ); # replace modules with dynamic results from MYMETA.json if we can # (hide CPAN::Meta from prereq scanner) my $cpan_meta = "CPAN::Meta"; if (-f "MYMETA.json" && eval "require $cpan_meta") { ## no critic if (my $meta = eval { CPAN::Meta->load_file("MYMETA.json") }) { my $prereqs = $meta->prereqs; my %uniq = map { $_ => 1 } map { keys %$_ } map { values %$_ } values %$prereqs; $uniq{$_} = 1 for @modules; # don't lose any static ones @modules = sort keys %uniq; } } my @reports = [qw/Version Module/]; for my $mod (@modules) { next if $mod eq 'perl'; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e catfile($_, $file) } @INC; if ($prefix) { my $ver = MM->parse_version(catfile($prefix, $file)); $ver = "undef" unless defined $ver; # Newer MM should do this anyway push @reports, [$ver, $mod]; } else { push @reports, ["missing", $mod]; } } if (@reports) { my $vl = max map { length $_->[0] } @reports; my $ml = max map { length $_->[1] } @reports; splice @reports, 1, 0, ["-" x $vl, "-" x $ml]; diag "Prerequisite Report:\n", map { sprintf("  %*s %*s\n", $vl, $_->[0], -$ml, $_->[1]) } @reports; } pass; done_testing(); __END__ pass; # vim: ts=2 sts=2 sw=2 et: Padre-Plugin-Git-0.12/t/04-pod-coverage.t0000644000175000017500000000133712214115725016706 0ustar kevinkevinuse strict; use warnings FATAL => 'all'; use English qw( -no_match_vars ); local $OUTPUT_AUTOFLUSH = 1; BEGIN { unless ($ENV{RELEASE_TESTING}) { use Test::More; Test::More::plan(skip_all => 'Release Candidate testing, not required for installation.'); } } use Test::Requires {'Test::Pod::Coverage' => 1.08}; # Define the three overridden methods. my $trustme = { trustme => [qr/^(TRACE)$/] }; pod_coverage_ok( "Padre::Plugin::Git", $trustme ); pod_coverage_ok( "Padre::Plugin::Git::Message", $trustme ); pod_coverage_ok( "Padre::Plugin::Git::Output", $trustme ); pod_coverage_ok( "Padre::Plugin::Git::Task::Git_cmd", $trustme ); pod_coverage_ok( "Padre::Plugin::Git::Task::Git_patch", $trustme ); done_testing(); __END__ Padre-Plugin-Git-0.12/t/03-pod.t0000644000175000017500000000053312214133355015110 0ustar kevinkevinuse strict; use warnings FATAL => 'all'; use English qw( -no_match_vars ); local $OUTPUT_AUTOFLUSH = 1; BEGIN { unless ($ENV{RELEASE_TESTING}) { use Test::More; Test::More::plan( skip_all => 'Author tests, not required for installation.'); } } use Test::Requires { 'Test::Pod' => 1.48 }; all_pod_files_ok(); done_testing(); __END__ Padre-Plugin-Git-0.12/inc/0002755000175000017500000000000012215174457014241 5ustar kevinkevinPadre-Plugin-Git-0.12/inc/Module/0002755000175000017500000000000012215174457015466 5ustar kevinkevinPadre-Plugin-Git-0.12/inc/Module/Install.pm0000644000175000017500000003013512215174456017431 0ustar kevinkevin#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Padre-Plugin-Git-0.12/inc/Module/Install/0002755000175000017500000000000012215174457017074 5ustar kevinkevinPadre-Plugin-Git-0.12/inc/Module/Install/Can.pm0000644000175000017500000000615712215174456020141 0ustar kevinkevin#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Padre-Plugin-Git-0.12/inc/Module/Install/Win32.pm0000644000175000017500000000340312215174456020331 0ustar kevinkevin#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Padre-Plugin-Git-0.12/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612215174456021162 0ustar kevinkevin#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Padre-Plugin-Git-0.12/inc/Module/Install/Fetch.pm0000644000175000017500000000462712215174456020471 0ustar kevinkevin#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Padre-Plugin-Git-0.12/inc/Module/Install/Makefile.pm0000644000175000017500000002743712215174456021161 0ustar kevinkevin#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Padre-Plugin-Git-0.12/inc/Module/Install/Share.pm0000644000175000017500000000464312215174456020500 0ustar kevinkevin#line 1 package Module::Install::Share; use strict; use Module::Install::Base (); use File::Find (); use ExtUtils::Manifest (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub install_share { my $self = shift; my $dir = @_ ? pop : 'share'; my $type = @_ ? shift : 'dist'; unless ( defined $type and $type eq 'module' or $type eq 'dist' ) { die "Illegal or invalid share dir type '$type'"; } unless ( defined $dir and -d $dir ) { require Carp; Carp::croak("Illegal or missing directory install_share param: '$dir'"); } # Split by type my $S = ($^O eq 'MSWin32') ? "\\" : "\/"; my $root; if ( $type eq 'dist' ) { die "Too many parameters to install_share" if @_; # Set up the install $root = "\$(INST_LIB)${S}auto${S}share${S}dist${S}\$(DISTNAME)"; } else { my $module = Module::Install::_CLASS($_[0]); unless ( defined $module ) { die "Missing or invalid module name '$_[0]'"; } $module =~ s/::/-/g; $root = "\$(INST_LIB)${S}auto${S}share${S}module${S}$module"; } my $manifest = -r 'MANIFEST' ? ExtUtils::Manifest::maniread() : undef; my $skip_checker = $ExtUtils::Manifest::VERSION >= 1.54 ? ExtUtils::Manifest::maniskip() : ExtUtils::Manifest::_maniskip(); my $postamble = ''; my $perm_dir = eval($ExtUtils::MakeMaker::VERSION) >= 6.52 ? '$(PERM_DIR)' : 755; File::Find::find({ no_chdir => 1, wanted => sub { my $path = File::Spec->abs2rel($_, $dir); if (-d $_) { return if $skip_checker->($File::Find::name); $postamble .=<<"END"; \t\$(NOECHO) \$(MKPATH) "$root${S}$path" \t\$(NOECHO) \$(CHMOD) $perm_dir "$root${S}$path" END } else { return if ref $manifest && !exists $manifest->{$File::Find::name}; return if $skip_checker->($File::Find::name); $postamble .=<<"END"; \t\$(NOECHO) \$(CP) "$dir${S}$path" "$root${S}$path" END } }, }, $dir); # Set up the install $self->postamble(<<"END_MAKEFILE"); config :: $postamble END_MAKEFILE # The above appears to behave incorrectly when used with old versions # of ExtUtils::Install (known-bad on RHEL 3, with 5.8.0) # So when we need to install a share directory, make sure we add a # dependency on a moderately new version of ExtUtils::MakeMaker. $self->build_requires( 'ExtUtils::MakeMaker' => '6.11' ); # 99% of the time we don't want to index a shared dir $self->no_index( directory => $dir ); } 1; __END__ #line 154 Padre-Plugin-Git-0.12/inc/Module/Install/Metadata.pm0000644000175000017500000004327712215174456021164 0ustar kevinkevin#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Padre-Plugin-Git-0.12/inc/Module/Install/DSL.pm0000644000175000017500000000457012215174456020057 0ustar kevinkevin#line 1 package Module::Install::DSL; use strict; use vars qw{$VERSION $ISCORE}; BEGIN { $VERSION = '1.06'; $ISCORE = 1; *inc::Module::Install::DSL::VERSION = *VERSION; @inc::Module::Install::DSL::ISA = __PACKAGE__; } sub import { # Read in the rest of the Makefile.PL open 0 or die "Couldn't open $0: $!"; my $dsl; SCOPE: { local $/ = undef; $dsl = join "", <0>; } # Change inc::Module::Install::DSL to the regular one. # Remove anything before the use inc::... line. $dsl =~ s/.*?^\s*use\s+(?:inc::)?Module::Install::DSL(\b[^;]*);\s*\n//sm; # Load inc::Module::Install as we would in a regular Makefile.Pl SCOPE: { package main; require inc::Module::Install; inc::Module::Install->import; } # Add the ::DSL plugin to the list of packages in /inc my $admin = $Module::Install::MAIN->{admin}; if ( $admin ) { my $from = $INC{"$admin->{path}/DSL.pm"}; my $to = "$admin->{base}/$admin->{prefix}/$admin->{path}/DSL.pm"; $admin->copy( $from => $to ); } # Convert the basic syntax to code my $code = "INIT {\n" . "package main;\n\n" . dsl2code($dsl) . "\n\nWriteAll();\n" . "}\n"; # Execute the script eval $code; print STDERR "Failed to execute the generated code...\n$@" if $@; exit(0); } sub dsl2code { my $dsl = shift; # Split into lines and strip blanks my @lines = grep { /\S/ } split /[\012\015]+/, $dsl; # Each line represents one command my @code = (); my $static = 1; foreach my $line ( @lines ) { # Split the lines into tokens my @tokens = split /\s+/, $line; # The first word is the command my $command = shift @tokens; my @params = (); my @suffix = (); while ( @tokens ) { my $token = shift @tokens; if ( $token eq 'if' or $token eq 'unless' ) { # This is the beginning of a suffix push @suffix, $token; push @suffix, @tokens; # The conditional means this distribution # can no longer be considered fully static. $static = 0; last; } else { # Convert to a string $token =~ s/([\\\'])/\\$1/g; push @params, "'$token'"; } }; # Merge to create the final line of code @tokens = ( $command, @params ? join( ', ', @params ) : (), @suffix ); push @code, join( ' ', @tokens ) . ";\n"; } # Is our configuration static? push @code, "static_config;\n" if $static; # Join into the complete code block return join( '', @code ); } 1; Padre-Plugin-Git-0.12/inc/Module/Install/Base.pm0000644000175000017500000000214712215174456020305 0ustar kevinkevin#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159