Git-Repository-1.310000755001750001750 012266062417 13473 5ustar00bookbook000000000000README100644001750001750 226512266062417 14441 0ustar00bookbook000000000000Git-Repository-1.310Git-Repository Git::Repository is a Perl interface to Git, allowing scripted interactions with one or more repositories. It's a low-level interface, allowing to call any Git command, either porcelain or plumbing, including bidirectional commands such as git commit-tree. Since it is a low-level interface, it doesn't provide any fancy way to call Git commands. It is up to the programmer to setup any environment variables (except GIT_DIR and GIT_WORK_TREE) that the underlying Git command may need and use. SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Git::Repository You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-Repository AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Git-Repository CPAN Ratings http://cpanratings.perl.org/d/Git-Repository Search CPAN http://search.cpan.org/dist/Git-Repository COPYRIGHT AND LICENCE Copyright (C) 2010-2013 Philippe Bruhat (BooK) This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Changes100644001750001750 3755712266062417 15110 0ustar00bookbook000000000000Git-Repository-1.310Revision history for Git-Repository 1.310 Fri Jan 17 2014 [ENHANCEMENTS] - add support for a 'clone' option in test_repository() [DOCUMENTATION] - better document the test_repository() options - better document the options hash - make method names easier to link to throughout the documentation [TESTS] - tested against 350 versions of git (including all RC), from 1.5.0.rc0 to 1.8.5.3 1.309 Sat Nov 2 2013 [TESTS] - replace use_ok by simply running perl -M$module -e1 [DOCUMENTATION] - some guidelines for naming attributes in plugins [PACKAGING] - split Git::Repository::Plugin::Log and its supporting modules (Git::Repository::Log and Git::Repository::Log::Iterator) out in their own distribution (Git-Repository-Plugin-Log) as of version 1.309 of both distributions 1.308 Thu Aug 8 2013 [ENHANCEMENTS] - require System-Command 1.103, since 1.102 was somewhat broken [DOCUMENTATION] - new tutorial item based on RT#87334 1.307 Fri Jul 26 2013 [ENHANCEMENTS] - avoid creating zombie processes in _is_git - require the latest System-Command, as it properly works with FCGI, Plack et al. [DOCUMENTATION] - various minor documentation improvements 1.306 Tue Jul 2 2013 [DOCUMENTATION] - document how to run git from cwd in Git::Repository::Tutorial (follow-up of RT #86154, thanks to Daniel B. Boorstein (DANBOO)) - document how to avoid the translation of Git messages by using LC_ALL=C in Git::Repository::Tutorial [TESTS] - made tests more robust no matter which locale is defined (thanks to Lars Dieckow (DAXIM)) 1.305 Sun Jun 16 2013 [DOCUMENTATION] - list the 'fatal' option in the documentation for run() [TESTS] - various fixes for t/24-errors.t (mostly for Win32, thanks to Christian Walde (MITHALDU)) 1.304 Sat May 25 2013 [ENHANCEMENTS] - the new 'fatal' option makes it possible to define in detail which exit status codes will make run() die, in addition to the defaults 128 and 129 (many thanks to Grant McLean for a great discussion about this, which inspired the feature) [DOCUMENTATION] - add a section about 'fatal' in Git::Repository::Tutorial [TESTS] - let Dist::Zilla manage the author tests - fixed tests with older gits, and also moved requirements for some tests a little bit further in the past - tested against 326 versions of git (including all RC), from 1.5.0.rc0 to 1.8.3.rc3 1.303 Sun Apr 28 2013 [ENHANCEMENTS] - now depends on System::Command 1.100 for proper Win32 support - thanks to a lot of testing help from Christian Walde (MITHALDU) the test suite passes on Win32 (by skipping tests of little importance) 1.302 Fri Mar 1 2013 [ENHANCEMENTS] - Git::Repository::Plugin::Log is now able to parse commits with completely empty log messages - Git::Repository::Plugin::Log is now able to parse commits containing multiline headers (like gpgsig and mergetag) 1.301 Mon Jan 21 2013 [DEPRECATION] - the following Git::Repository methods are obsolete, and will die when called: create, wc_path, repo_path - the following parameters to Git::Repository->new are obsolete, and will cause the constructor to die: repository, working_copy [PACKAGING] - switch to Dist::Zilla for maintaining the distribution 1.300 Mon Jan 7 2013 [ENHANCEMENTS] - fixed support for overloaded objects (e.g. Path::Class objects) in Git::Repository::Command (RT #82373) - fixed Git::Repository::Log::Iterator to work with older gits when disabling colored output (thanks to Dominic Humphries) - fixed some cases where Git::Repository::Command and Git::Repository new() methods ignored some of their parameters. They now die when passed ambiguous or unexpected parameters. (follow-up of RT #82373, thanks to Michael G. Schwern) 1.29 Tue Dec 4 2012 [ENHANCEMENTS] - added support for callbacks in run() [DOCUMENTATION] - minor documentation improvements 1.28 Sun Nov 4 2012 [ENHANCEMENTS] - disabled colored output from logs in Git::Repository::Log::Iterator - wc_path() and repo_path() accessors are deprecated and now warn - improved the inter-documentation links by liberal use of L<> [TESTS] - ignore commit hooks that may be included with templates (RT #80593) - test for quiet won't fail if no identity is defined (RT #80321) 1.27 Thu Oct 11 2012 [ENHANCEMENTS] - Git::Repository::Command skips non-executable files when searching for a git command in the PATH [TEST] - Fixed tests failing with a directory named git in the PATH (RT #80117) 1.26 Tue Aug 1 2012 [ENHANCEMENTS] - added a 'quiet' option to silence warnings - improved carp level for the run() method [DOCUMENTATION] - provide an example for the 'quiet' option in Git::Repository::Tutorial 1.25 Tue Dec 27 23:07:11 CET 2011 [ENHANCEMENTS] - None. It's as good as 1.24, without the stupid test fail. [TESTS] - fixed a test plan when a git binary is not available 1.24 Mon Dec 26 14:51:36 CET 2011 [ENHANCEMENTS] - the command cache for _is_git() is now properly populated when the git option is a command with options (e.g. sudo) - _is_git() still finds git when the PATH contains a directory named git in a better position (RT #72154) - Fix spelling errors fixed in Debian (RT #73079) - Defend against changes to $/ (RT #71621) 1.23 Sun Dec 4 16:06:08 CET 2011 [TESTS] - made t/07-version.t pass when /tmp is mounted noexec (RT #72610) 1.22 Tue Sep 6 23:39:54 CEST 2011 [TESTS] - made t/21-submodule.t pass with git > 1.7.6.0 (RT #70585) - made t/21-submodule.t pass with git < 1.5.4.4 1.21 Mon Jul 11 23:34:47 CEST 2011 [ENHANCEMENTS] - fix a deep recursion caused by a change in System::Command 1.05 (thanks to Thomas Klausner) [TESTS] - made t/21-submodule.t pass when git is not available or too old or no identity is configured 1.20 Thu Jun 9 14:08:43 CEST 2011 [ENHANCEMENTS] - None. It's as good as 1.19, without the stupid test fail. [TESTS] - one test always failed if run outside of a git repository, so I didn't detect it, but all testers did :-( Kazuhiro Shibuya provided a patch! 1.19 Wed Jun 8 23:39:22 CEST 2011 [ENHANCEMENTS] - new final_output() method to Git::Repository::Command, that does the git-specific error checking when collecting the final output - Git::Repository::Log::Iterator will now properly die/warn when the log command is incorrect (thanks to Lasse Makholm for the bug report and proposed patch) - Git::Repository::Command now supports an arrayref as the 'git' option value, thus allowing calling wrappers like sudo (thanks to Dominic Humphries for the initial patch) [DOCUMENTATION] - moved the HOWTO part of the doc to Git::Repository::Tutorial 1.18 Sat Apr 16 13:47:26 CEST 2011 [ENHANCEMENTS] - the create() method was fragile (parsing the output of porcelain commands) and is now obsolete [DOCUMENTATION] - added an example for running git shortlog (RT #66783) 1.17 Tue Feb 1 01:01:10 CET 2011 [ENHANCEMENTS] - Git::Repository::Command now uses System::Command internally [TESTS] - skip some tests that needed a specific version of git - delete GIT_EDITOR in tests that check it (Nigel Metheringham) [BUGS] - getting a working Win32 implementation is now delegated to System::Command 1.16 Sun Jan 16 12:23:42 CET 2011 [ENHANCEMENTS] - the reaping of the child process is now delegated to a special Git::Repository::Command::Reaper object. Code such as my $fh = Git::Repository::Command->new(@cmd)->stdout() will now work as expected. [TESTS] - Test::Git::has_git() now accepts the usual options hash - fixed tests to pass again under Perl 5.6.2 1.15 Tue Jan 11 22:42:35 CET 2011 [ENHANCEMENTS] - experimental MSWin32 full support using pipes (thanks to BinGOs for pointing me to a perlmonks post by ikegami, that contained working code) - Git::Repository::Log now has a raw_message() accessor, that returns the message with 4-space indent output by git log (Note that this change is INCOMPATIBLE with previous versions, in which message() returned the indented log message, and you had to make up your own "clean" version). [TESTS] - no more skipping tests under MSWin32, but there are some issues with the win32 code, as sometimes the output or errput of the git command is lost (HELP!) - bundle Test::Git, a module providing a few utility functions for testing code requiring a git repository 1.14 Wed Oct 27 21:49:45 CEST 2010 [ENHANCEMENTS] - complete rewrite of _has_git, which was renamed to _is_git, with a much improved cache for the "is this git valid?" info - calling new() with the 'git' option will now work correctly when there is no git in the PATH (fixes RT bug #62283, reported by Todd Rinaldo) - improved the plugin system design (thanks to Aristotle Pagaltzis) - fixes for making Git::Repository work with modules that do bad things to STDIN, STDOUT and STDERR (thanks to Todd Rinaldo) [TESTS] - improved tests on Win32 (thanks to Olivier Raginel (BABAR) for giving me access to a Win32 VM with Git installed) [BUGS] - sadly, the work on Win32 showed that Git::Repository doesn't fully support that platform, but the test suite safely skips the tests that hang under Win32. I hope to fix this over time. 1.13 Mon Oct 18 22:36:17 CEST 2010 [ENHANCEMENTS] - using 'git' as an option of a Git::Repository object now works as expected - version() also accepts option hashes - plugin system to load new keywords in the Git::Repository namespace - Git::Repository::Plugin::Log provides the log() method with the help of Git::Repository::Log and Git::Repository::Log::Iterator (Thanks to Todd Rinaldo and Aristotle Pagaltzis for discussions and ideas about what became the plugin system.) [TESTS] - tested against 120+ versions of git, including all versions of the 1.6.* and 1.7.* branches up until 1.7.3.1 1.12 Mon Oct 4 02:30:51 CEST 2010 [ENHANCEMENTS] - the input option can now be empty: it means "close stdin first" - if the input option is undef, it still means "don't touch stdin" 1.11 Sat Oct 2 18:17:33 CEST 2010 [ENHANCEMENTS] - fixed a bug in version comparison (version 1.7.1.209.gd60ad81 is smaller than 1.7.1.1.1.g66bd8ab) [TESTS] - skip tests that fail between between versions 1.7.1 and 1.7.1.1 (thanks to Sébastien Aperghis-Tramoni for the private report) - fix abs_path dying on Win32 with a path to a non-existent file (again) 1.10 Fri Sep 24 18:04:05 CEST 2010 [ENHANCEMENTS] - Git::Repository::Command doesn't write to the command stdin if the input option is set to something empty - Git::Repository::Command now has a version number too [DOCUMENTATION] - minor copy editing by Aristotle Pagaltzis 1.09 Thu Aug 19 00:34:47 CEST 2010 [ENHANCEMENTS] - now handle SIGPIPE when writing to git stdin (fixes RT bug #60482, reported by Todd Rinaldo (TODDR)) - new() ignores the 'input' option for git commands called during initialization [TESTS] - t/20-simple.t should stop failing with "Non-zero wait status: 13" as it has been doing since 1.05. 1.08 Tue Aug 17 14:49:11 CEST 2010 [ENHANCEMENTS] - Git::Repository->new() now supports git versions older than 1.5.3 [TESTS] - ensure we have some identity when committing - make tests require the lowest git version they support 1.07 Sat Aug 14 16:52:21 CEST 2010 [ENHANCEMENTS] - support for option hash in create(), which is attached to the returned Git::Repository object - accessors for Git::Repository::Command objects (including a 'cmdline' accessor) - removed the wc_subdir() attribute, which is useless and redundant with the cwd option - completely rewrote the repo_path and wc_path computation in new() - support new (post-v1.7.1) clone output in create() - less confusing names for options and attributes: + new() now takes git_dir and work_tree (instead of repository and working_copy) + the corresponding attributes are now git_dir and work_tree (instead of repo_path and wc_path) + the older options and attributes are being kept for compatibility [TESTS] - tests for the case when GIT_DIR is not .git (Mark Lawrence) - protect git log tests against format.pretty (Aristotle Pagaltzis) - tests for backward-compatibility with repository, working_copy, etc. 1.06 Sat Jul 3 22:02:59 CEST 2010 [ENHANCEMENTS] - none [TESTS] - just make sure all tests fail gracefully when git is not installed 1.05 Sat Jul 3 00:40:09 CEST 2010 [ENHANCEMENTS] - version() method returns the git binary version - version_eq(), version_gt(), etc allow simple version comparison for the current git binary - allow providing a default option hash to Git::Repository->new() [DOCUMENTATION] - Document git init behaviour changed in 1.6.5 [TESTS] - extensive version comparison tests 1.04 Sun Jun 27 17:24:02 CEST 2010 [ENHANCEMENTS] - create() now supports "reinitializing existing Git repository" (thanks to Michael G. Schwern) [TESTS] - test a few extra cases 1.03 Sat Jun 19 00:27:28 CEST 2010 [ENHANCEMENTS] - fix module to work with Perl 5.6.x - support GIT_DIR & GIT_WORK_TREE environment variables, when run without a Git::Repository object, and even allow an override when there is one, for those who know what they're doing [TESTS] - fix the case where /tmp is a symlink to some other place - fix abs_path dying on Win32 with a path to a non-existent file 1.02 Wed Jun 16 01:27:17 CEST 2010 [ENHANCEMENTS] - sensible defaults for Git::Repository->new() without parameters - correctly setup Git::Repository if working_copy points to a subdirectory of the actual work tree - wc_subdir() points to the given subdirectory [TESTS] - skip tests that fail if /tmp is a git repository 1.01 Mon Jun 14 08:17:38 CEST 2010 [ENHANCEMENTS] - consider git failing with a usage message as a fatal error [TESTS] - don't bother testing too much if git is older than v1.6.0 1.00 Sat Jun 12 11:50:06 CEST 2010 [YET ANOTHER GIT WRAPPER] - Git::Repository provides context and a simple run() method - Git::Repository::Command is the actual workhorse - 94% test coverage LICENSE100644001750001750 4371112266062417 14607 0ustar00bookbook000000000000Git-Repository-1.310This software is copyright (c) 2014 by Philippe Bruhat (BooK). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2014 by Philippe Bruhat (BooK). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. 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) 2014 by Philippe Bruhat (BooK). 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 dist.ini100644001750001750 166512266062417 15230 0ustar00bookbook000000000000Git-Repository-1.310name = Git-Repository author = Philippe Bruhat (BooK) license = Perl_5 copyright_holder = Philippe Bruhat (BooK) ; copyright_year = 2010-2013 [PkgVersion] [@Filter] -bundle = @Basic -remove = Readme [PruneFiles] filename = setup match = \.patch$ match = mess/.* match = cover_db [AutoPrereqs] [Prereqs] System::Command = 1.103 [ReportVersions::Tiny] [MetaResources] repository.web = http://github.com/book/Git-Repository repository.url = http://github.com/book/Git-Repository.git repository.type = git bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-Repository bugtracker.mailto = bug-git-repository@rt.cpan.org [PodWeaver] [MetaTests] [PodSyntaxTests] [PodCoverageTests] [NextRelease] format = %v %{EEE MMM d yyyy}d [@Git] changelog = Changes commit_msg = Changes for version %v tag_format = v%v tag_message = %N v%v push_to = origin push_to = github [Git::NextVersion] t000755001750001750 012266062417 13657 5ustar00bookbook000000000000Git-Repository-1.310config100644001750001750 7512266062417 15151 0ustar00bookbook000000000000Git-Repository-1.310/t[user] name = Philippe Bruhat (BooK) email = book@cpan.org META.yml100644001750001750 153212266062417 15026 0ustar00bookbook000000000000Git-Repository-1.310--- abstract: 'Perl interface to Git repositories' author: - 'Philippe Bruhat (BooK) ' build_requires: File::Find: 0 File::Path: 0 Test::More: 0.88 constant: 0 overload: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300020, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Git-Repository requires: Carp: 0 Config: 0 Cwd: 0 Exporter: 0 File::Spec: 0 File::Spec::Functions: 0 File::Temp: 0 IO::Handle: 0 Scalar::Util: 0 System::Command: 1.103 Test::Builder: 0 perl: 5.006 strict: 0 warnings: 0 resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-Repository repository: http://github.com/book/Git-Repository.git version: 1.310 MANIFEST100644001750001750 121612266062417 14705 0ustar00bookbook000000000000Git-Repository-1.310Changes LICENSE MANIFEST META.yml Makefile.PL README dist.ini lib/Git/Repository.pm lib/Git/Repository/Command.pm lib/Git/Repository/Plugin.pm lib/Git/Repository/Tutorial.pod lib/Test/Git.pm t/00-load.t t/000-report-versions-tiny.t t/05-try_git.t t/06-version.t t/07-version.t t/10-new_fail.t t/11-create.t t/12-create.t t/13-sudo.t t/20-simple.t t/21-submodule.t t/22-backward.t t/23-quiet.t t/24-errors.t t/25-plugins.t t/26-overloaded_objects.t t/30-test_repository.t t/Git/Repository/Plugin/Hello.pm t/Git/Repository/Plugin/Hello2.pm t/MyGit/Hello.pm t/config t/release-distmeta.t t/release-pod-coverage.t t/release-pod-syntax.t t/sudo.pl weaver.ini sudo.pl100644001750001750 16512266062417 15310 0ustar00bookbook000000000000Git-Repository-1.310/t#!/usr/bin/env perl # a tiny fake git wrapper print "@ARGV" =~ /git.*version/ ? "git version 9.8.7\n" : "@ARGV\n"; weaver.ini100644001750001750 22212266062417 15522 0ustar00bookbook000000000000Git-Repository-1.310[@CorePrep] [Name] [Version] [Generic / SYNOPSIS] [Generic / DESCRIPTION] [Leftovers] [Bugs] [Authors] [Generic / COPYRIGHT] [Generic / LICENSE] 13-sudo.t100644001750001750 120012266062417 15370 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Spec; has_git(); plan tests => 3; # test using a wrapper my $sudo = File::Spec->catfile( t => 'sudo.pl' ); my $out = Git::Repository->run( qw( a b ), { git => [ $^X, $sudo, 'git' ] } ); is( $out, 'git a b', 'wrapper called correctly' ); # same wrapper, but to something that fails to identify as git ok( !eval { $out = Git::Repository->run( qw( a b ), { git => [ $^X, $sudo, 'meh' ] } ); }, 'sudo meh fails to pass for sudo git' ); like( $@, qr/^git binary '.*meh' not available or broken/, '... with expected error message' ); 00-load.t100644001750001750 66712266062417 15331 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use File::Find; my @modules; find( sub { push @modules, $File::Find::name if /\.pm$/ }, 'lib' ); plan tests => scalar @modules; @modules = reverse sort map { s!/!::!g; s/\.pm$//; s/^lib:://; $_ } @modules; # load in isolation local $ENV{PERL5LIB} = join $Config::Config{path_sep} || ';', @INC; for my $module (@modules) { `$^X -M$module -e1`; is( $? >> 8, 0, "perl -M$module -e1" ); } Makefile.PL100644001750001750 257512266062417 15537 0ustar00bookbook000000000000Git-Repository-1.310 use strict; use warnings; use 5.006; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl interface to Git repositories", "AUTHOR" => "Philippe Bruhat (BooK) ", "BUILD_REQUIRES" => { "File::Find" => 0, "File::Path" => 0, "Test::More" => "0.88", "constant" => 0, "overload" => 0 }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "Git-Repository", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "Git::Repository", "PREREQ_PM" => { "Carp" => 0, "Config" => 0, "Cwd" => 0, "Exporter" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "File::Temp" => 0, "IO::Handle" => 0, "Scalar::Util" => 0, "System::Command" => "1.103", "Test::Builder" => 0, "strict" => 0, "warnings" => 0 }, "VERSION" => "1.310", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 23-quiet.t100644001750001750 321112266062417 15552 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use Git::Repository; has_git('1.5.0.rc4'); # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; $ENV{GIT_AUTHOR_NAME} = 'Test Author'; $ENV{GIT_AUTHOR_EMAIL} = 'test.author@example.com'; $ENV{GIT_COMMITTER_NAME} = 'Test Committer'; $ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com'; # a place to put a git repository my $r = test_repository; # PREV will be replaced by the result of the previous command my @tests = ( [ [ qw( mktree ), { input => '' } ] ], [ [ qw( commit-tree PREV ), { input => 'empty tree' } ] ], [ [qw( update-ref refs/heads/master PREV )] ], [ [qw( checkout -b slave )], qr/^Switched to a new branch ['"]slave['"] at / ], [ [qw( checkout master )], qr/^Switched to branch ['"]master['"] at / ], [ [ qw( checkout slave ), { quiet => 1 } ] ], [ [ qw( checkout master ), { quiet => 1 } ] ], ); plan tests => scalar @tests; my $PREV; for my $t (@tests) { my ( $args, $re ) = @$t; # capture warnings my @warnings; local $SIG{__WARN__} = sub { push @warnings, shift }; # replace the args $args = [ map $_ eq 'PREV' ? $PREV : $_, @$args ]; # run the command $PREV = $r->run(@$args); # format the command for test output my $cmd = join ' ', 'git', map { my $v = $_; ref $v ? "{ @{[map{qq'$_ => $v->{$_}'}sort keys %$v]} }" : $v } @$args; # run the actual test if ($re) { like( $warnings[0], $re, "Got the expected warning for: $cmd" ); } else { is( @warnings, 0, "No warning for: $cmd" ); } } 20-simple.t100644001750001750 2453512266062417 15745 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Temp qw( tempdir ); use File::Spec; use Cwd qw( cwd abs_path ); use Git::Repository; has_git( '1.5.5' ); my $version = Git::Repository->version; plan tests => my $tests; # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; $ENV{GIT_AUTHOR_NAME} = 'Test Author'; $ENV{GIT_AUTHOR_EMAIL} = 'test.author@example.com'; $ENV{GIT_COMMITTER_NAME} = 'Test Committer'; $ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com'; my $home = cwd; local $/ = chr rand 128; # small helper sub sub update_file { my ( $file, $content ) = @_; open my $fh, '>', $file or die "Can't open $file: $!"; print {$fh} $content; close $fh; } # a place to put a git repository my $dir = abs_path( tempdir( CLEANUP => 1 ) ); # PASS - non-existent directory BEGIN { $tests += 3 } chdir $dir; Git::Repository->run('init'); my $r = Git::Repository->new(); isa_ok( $r, 'Git::Repository' ); chdir $home; is( $r->work_tree, $dir, 'work tree' ); my $gitdir = $r->run( qw( rev-parse --git-dir ) ); $gitdir = File::Spec->catfile( $dir, $gitdir ) if ! File::Spec->file_name_is_absolute( $gitdir ); is( $gitdir, $r->git_dir, 'git-dir' ); # check usage exit code BEGIN { $tests += 2 } ok( ! eval { $r->run( qw( commit --bonk ) ); }, "FAIL with usage text" ); like( $@, qr/^usage: .*?git[- ]commit/m, '... expected usage message' ); # add file to the index update_file( File::Spec->catfile( $dir, 'readme.txt' ), << 'TXT' ); Some readme text for our example TXT $r->run( add => 'readme.txt' ); # unset all editors delete @ENV{qw( EDITOR VISUAL GIT_EDITOR )}; SKIP: { BEGIN { $tests += 2 } skip "these tests require git >= 1.6.6, but we only have $version", 2 if Git::Repository->version_lt('1.6.6'); skip "editor defined directly in .gitconfig", 2 if $r->run( config => 'core.editor' ); skip "this test does not work with msysgit on Win32", 2 if $^O eq 'MSWin32'; ok( !eval { $r->run( var => 'GIT_EDITOR' ); 1; }, 'git var GIT_EDITOR' ); like( $@, qr/^fatal: Terminal is dumb, but EDITOR unset /, 'Git complains about lack of smarts and editor' ); } # with git commit it's not fatal BEGIN { $tests += 4 } SKIP: { skip "editor defined directly in .gitconfig", 4 if $r->run( config => 'core.editor' ); skip "this test does not work with msysgit on Win32", 4 if $^O eq 'MSWin32'; ok( my $cmd = $r->command('commit'), 'git commit' ); isa_ok( $cmd, 'Git::Repository::Command' ); local $/ = "\n"; my $error = $cmd->stderr->getline; is_deeply( [ $cmd->cmdline ], [ qw( git commit ) ], 'command-line' ); $cmd->close; like( $error, qr/^(?:error: )?Terminal is dumb/, 'Git complains about lack of smarts and editor' ); } # commit again BEGIN { $tests += 1 } my $message = 'a readme file'; $r->run( commit => '-m', $message ); my @log = $r->run( log => '--pretty=format:%s' ); is_deeply( \@log, [$message], 'git commit ; git log' ); # test callbacks BEGIN { $tests += 2 } @log = $r->run( log => '--pretty=format:%s', sub { ~~ reverse } ); is_deeply( \@log, [ ~~ reverse $message ], 'run() with 1 callback' ); sub rot13 { $_[0] =~ y/a-z/n-za-m/; $_[0] } @log = $r->run( log => '--pretty=format:%s', \&rot13, sub { ~~ reverse } ); is_deeply( \@log, [ ~~ reverse rot13 $message ], 'run() with 2 callback' ); # use commit-tree with input option BEGIN { $tests += 4 } my $parent = $r->run( log => '--pretty=format:%H' ); like( $parent, qr/^[a-f0-9]{40}$/, 'parent commit id' ); my $tree = $r->run( log => '--pretty=format:%T' ); like( $parent, qr/^[a-f0-9]{40}$/, 'parent tree id' ); my $commit; $commit = $r->run( 'commit-tree' => $tree, '-p', $parent, { input => "$message $tree" }, ); like( $commit, qr/^[a-f0-9]{40}$/, 'new commit id' ); cmp_ok( $commit, 'ne', $parent, 'new commit id is different from parent id' ); $r->run( reset => $commit ); # process "long" output BEGIN { $tests += 3 } { my $lines; my $cmd = $r->command( log => '--pretty=oneline', '--all' ); isa_ok( $cmd, 'Git::Repository::Command' ); is_deeply( [ $cmd->cmdline ], [ qw( git log --pretty=oneline --all ) ], 'command-line' ); my $log = $cmd->stdout; local $/ = "\n"; while (<$log>) { $lines++; } is( $lines, 2, 'git log' ); # no call to close, we count on DESTROY } # use command as a class method, with cwd option BEGIN { $tests += 2 } { my $cmd = Git::Repository->command( { cwd => $dir }, log => '-1', '--pretty=format:%H' ); isa_ok( $cmd, 'Git::Repository::Command' ); local $/ = "\n"; my $line = $cmd->stdout->getline(); chomp $line; is( $line, $commit, 'git log -1' ); } # use command as a class method, with env option BEGIN { $tests += 2 } { my $cmd = Git::Repository->command( { env => { GIT_DIR => $gitdir } }, log => '-1', '--pretty=format:%H' ); isa_ok( $cmd, 'Git::Repository::Command' ); local $/ = "\n"; my $line = $cmd->stdout->getline(); chomp $line; is( $line, $commit, 'git log -1' ); $cmd->stdout->close; $cmd->stderr->close; } # FAIL - run a command in a non-existent directory BEGIN { $tests += 2 } ok( !eval { $r->run( log => '-1', { cwd => File::Spec->catdir( $dir, 'not-there' ) }, bless( {}, 'Foo' ) # will be ignored silently ); }, 'Fail with option { cwd => non-existent dir }' ); like( $@, qr/^Can't chdir to .*not-there/, '... expected error message' ); # FAIL - pass more than one Git::Repository to Git::Repository::Command BEGIN { $tests += 2 } ok( !eval { $r->run( 'version', bless( { work_tree => 'TEH FAIL' }, 'Git::Repository' ) ); }, 'Fail with more than one Git::Repository object' ); like( $@, qr/^Too many Git::Repository objects given: /, '... expected error message' ); # now work with GIT_DIR and GIT_WORK_TREE only BEGIN { $tests += 1 } { local %ENV = %ENV; $ENV{GIT_DIR} = $gitdir; my $got = Git::Repository->run( log => '-1', '--pretty=format:%H' ); is( $got, $commit, 'git log -1' ); } # PASS - try with a relative dir BEGIN { $tests += 3 } chdir $dir; $r = Git::Repository->new( work_tree => '.' ); isa_ok( $r, 'Git::Repository' ); chdir $home; is( $r->work_tree, $dir, 'work tree' ); is( $r->git_dir, $gitdir, 'git dir' ); # PASS - try with a no dir BEGIN { $tests += 3 } chdir $dir; $r = Git::Repository->new(); isa_ok( $r, 'Git::Repository' ); chdir $home; is( $r->work_tree, $dir, 'work tree' ); is( $r->git_dir, $gitdir, 'git dir' ); # PASS - pass the git binary as an option to new() BEGIN { $tests += 9 } { my $path_sep = $Config::Config{path_sep} || ';'; my $re = qr/\Q$path_sep\E/; my @ext = ( '', $^O eq 'MSWin32' ? ( split $re, $ENV{PATHEXT} ) : () ); my ($abs_git) = grep { -x && !-d } map { my $path = $_; map { File::Spec->catfile( $path, $_ ) } map { "git$_" } @ext } split $re, ( $ENV{PATH} || '' ); # do not wipe the Windows PATH local $ENV{PATH} = join $path_sep, $^O eq 'MSWin32' ? grep { /\Q$ENV{SYSTEMROOT}\E/ } split $re, $ENV{PATH} : grep { -x File::Spec->catfile( $_, 'pwd' ) } split $re, $ENV{PATH}; $r = Git::Repository->new( git_dir => $gitdir, { git => $abs_git } ); isa_ok( $r, 'Git::Repository' ); is( $r->work_tree, $dir, 'work tree (git_dir, no PATH, git option)' ); is( $r->git_dir, $gitdir, 'git dir (git_dir, no PATH, git option)' ); $r = Git::Repository->new( work_tree => $dir, { git => $abs_git } ); isa_ok( $r, 'Git::Repository' ); is( $r->work_tree, $dir, 'work tree (work_tree, no PATH, git option)' ); is( $r->git_dir, $gitdir, 'git dir (work_tree, no PATH, git option)' ); chdir $dir; $r = Git::Repository->new( { git => $abs_git } ); isa_ok( $r, 'Git::Repository' ); chdir $home; is( $r->work_tree, $dir, 'work tree (no PATH, git option)' ); is( $r->git_dir, $gitdir, 'git dir (no PATH, git option)' ); } # PASS - use an option HASH BEGIN { $tests += 3 } is( Git::Repository->options(), undef, 'No options on the class' ); $r = Git::Repository->new( work_tree => $dir, { env => { GIT_AUTHOR_NAME => 'Example author', GIT_AUTHOR_EMAIL => 'author@example.com' } }, ); update_file( my $file = File::Spec->catfile( $dir, 'other.txt' ), << 'TXT' ); Some other text forcing an author TXT $r->run( add => $file ); $r->run( commit => '-m', 'Test option hash in new()' ); my ($author) = grep {/^Author:/} $r->run( log => '-1', '--pretty=medium' ); is( $author, 'Author: Example author ', 'Option hash in new()' ); update_file( $file, << 'TXT' ); Some other text forcing another author TXT $r->run( commit => '-a', '-m', 'Test option hash in run()', { env => { GIT_AUTHOR_EMAIL => 'fail@fail.com' } }, # ignored silently { env => { GIT_AUTHOR_EMAIL => 'example@author.com' } } # not ignored ); ($author) = grep {/^Author:/} $r->run( log => '-1', '--pretty=medium' ); is( $author, 'Author: Example author ', 'Option hash in new() and run()' ); # FAIL - use more than one option HASH BEGIN { $tests += 2 } ok( !eval { $r = Git::Repository->new( work_tree => $dir, { env => { GIT_AUTHOR_NAME => 'Example author' } }, { git => '/bin/false' } ); }, 'new() dies when given more than one option HASH' ); like( $@, qr/^Too many option hashes given: /, '... expected error message' ); # PASS - use an option HASH (no env key) BEGIN { $tests += 2 } ( $parent, $tree ) = split /-/, $r->run( log => '--pretty=format:%H-%T', -1 ); ok( $r = eval { Git::Repository->new( work_tree => $dir, { input => 'a dumb way to set log message' }, ); }, 'Git::Repository->new()' ); $commit = $r->run( 'commit-tree', $tree, '-p', $parent ); my $log = $r->run( log => '--pretty=format:%s', -1, $commit, { input => undef } ); is( $log, 'a dumb way to set log message', 'Option hash in new() worked' ); # PASS - create the empty tree BEGIN { $tests += 2 } ok( $r = eval { Git::Repository->new( work_tree => $dir ) }, 'Git::Repository->new()' ); $tree = $r->run( mktree => { input => '' } ); is( $tree, '4b825dc642cb6eb9a060e54bf8d69288fbee4904', 'mktree empty tree' ); 11-create.t100644001750001750 2073012266062417 15710 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Temp qw( tempdir ); use File::Spec; use File::Path; use Cwd qw( cwd realpath ); use Git::Repository; has_git( '1.6.0'); my $version = Git::Repository->version; plan tests => my $tests + my $between + my $extra; # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; my $home = cwd(); # a place to put a git repository my $tmp = realpath( tempdir( CLEANUP => 1 ) ); # some dirname generating routine my $i; sub next_dir { return File::Spec->catdir( $tmp, ++$i ); } sub test_repo { my ( $r, $gitdir, $dir, $options ) = @_; # normalize actual paths, but do not die under Win32 eval { $gitdir = realpath($gitdir) } if defined $gitdir; eval { $dir = realpath($dir) } if defined $dir; local $Test::Builder::Level = $Test::Builder::Level + 1; isa_ok( $r, 'Git::Repository' ); is( $r->git_dir, $gitdir, '... correct git_dir' ); is( $r->work_tree, $dir, '... correct work_tree' ); is_deeply( $r->options, $options, "... correct options" ); } my ( $dir, $r ); $dir = next_dir; # PASS - non-existent directory BEGIN { $tests += 5 } my $gitdir = File::Spec->catdir( $dir, '.git' ); mkpath $dir; chdir $dir; ok( $r = eval { $r = Git::Repository->run( 'init', { cwd => $dir } ); Git::Repository->new( { cwd => $dir } ); }, "init => $i" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, { cwd => $dir } ); chdir $home; # PASS - new() on a normal repository BEGIN { $tests += 5 } ok( $r = eval { Git::Repository->new( git_dir => $gitdir ); }, "new( git_dir => $i )" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); # PASS - new() on a normal repository BEGIN { $tests += 5 } ok( $r = eval { Git::Repository->new( work_tree => $dir ); }, "new( work_tree => $i )" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); # PASS - new() on a subdir of the working copy BEGIN { $tests += 5 } my $subdir = File::Spec->catdir( $dir, 'sub' ); mkpath $subdir; ok( $r = eval { Git::Repository->new( work_tree => $subdir ); }, "new( work_tree => $i/sub )" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); # PASS - new() without arguments BEGIN { $tests += 5 } chdir $dir; ok( $r = eval { Git::Repository->new(); }, "new() => $i" ); diag $@ if $@; chdir $home; test_repo( $r, $gitdir, $dir, {} ); # PASS - new() without arguments from subdir BEGIN { $tests += 5 } chdir $subdir; ok( $r = eval { Git::Repository->new(); }, "new() => $i/sub" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); chdir $home; # PASS - new() with both arguments from subdir BEGIN { $tests += 5 } chdir $subdir; ok( $r = eval { Git::Repository->new( work_tree => $dir, git_dir => $gitdir ); }, "new( work_tree => $i, git_dir => $i/.git ) => $i/sub" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); chdir $home; my $old; SKIP: { skip "cloning an empty repo dies for 1.7.0.rc1 <= git <= 1.7.0.2, we have $version", $between if Git::Repository->version_le('1.7.0.2') && Git::Repository->version_ge('1.7.0.rc1'); # PASS - clone an existing repo and warns BEGIN { $between += 5 } $old = $dir; $dir = next_dir; ok( $r = eval { Git::Repository->run( clone => $old => $dir, { quiet => 1 } ); Git::Repository->new( work_tree => $dir ); }, "clone => @{[ $i - 1 ]} => $i" ); diag $@ if $@; test_repo( $r, File::Spec->catdir( $dir, '.git' ), $dir, {} ); # PASS - clone an existing repo as bare and warns # relative target path BEGIN { $between += 5 } $old = $dir; $dir = next_dir; chdir $tmp; ok( $r = eval { Git::Repository->run( clone => '--bare', $old => $i, { quiet => 1} ); Git::Repository->new( git_dir => $i ); }, "clone => --bare, @{[ $i - 1 ]} => $i" ); diag $@ if $@; chdir $home; test_repo( $r, $dir, undef, {} ); # PASS - clone an existing repo as bare and warns # absolute target path BEGIN { $between += 5 } SKIP: { $old = $dir; $dir = next_dir; skip 'git clone --bare fails with absolute target path', 5 if $^O eq 'MSWin32'; ok( $r = eval { Git::Repository->run( clone => '--bare', $old => $dir, { quiet => 1 } ); Git::Repository->new( git_dir => $dir ); }, "clone => --bare, @{[ $i - 1 ]} => $i" ); diag $@ if $@; test_repo( $r, $dir, undef, {} ); } } # FAIL - clone a non-existing repo BEGIN { $tests += 3 } $old = next_dir; $dir = next_dir; ok( !( $r = eval { Git::Repository->run( clone => $old => $dir ); Git::Repository->new( work_tree => $dir ); } ), "clone => @{[ $i - 1 ]} => $i - FAILED" ); is( $r, undef, "clone => @{[ $i - 1 ]} => $i - did not create a repository" ); like( $@, qr/^fatal: /, 'fatal error from git' ); # PASS - init a bare repository BEGIN { $tests += 5 } $dir = next_dir; mkpath $dir; chdir $dir; ok( $r = eval { Git::Repository->run(qw( init --bare )); Git::Repository->new(); }, "clone => @{[ $i - 1 ]} - $i" ); diag $@ if $@; test_repo( $r, $dir, undef, {} ); chdir $home; # PASS - new() on a bare repository BEGIN { $tests += 5 } ok( $r = eval { Git::Repository->new( git_dir => $dir ); }, "new( git_dir => $i )" ); diag $@ if $@; test_repo( $r, $dir, undef, {} ); # PASS - non-existent directory, not a .git GIT_DIR # no --work-tree mean it's bare BEGIN { $tests += 5 } $dir = next_dir; mkpath $dir; chdir $dir; $gitdir = File::Spec->catdir( $dir, '.notgit' ); my $options = { cwd => $dir, env => { GIT_DIR => File::Spec->abs2rel($gitdir) } }; ok( $r = eval { Git::Repository->run( 'init', $options ); Git::Repository->new($options); }, "init - cwd => $i, GIT_DIR => '.notgit'" ); diag $@ if $@; chdir $home; test_repo( $r, $gitdir, undef, $options ); BEGIN { $tests += 5 } ok( $r = eval { Git::Repository->new( git_dir => $gitdir ); }, "new( git_dir => $i )" ); diag $@ if $@; test_repo( $r, $gitdir, undef, {} ); # PASS - non-existent directory, not a .git GIT_DIR # now provide a --work-tree BEGIN { $tests += 5 } $dir = next_dir; mkpath $dir; chdir $dir; $gitdir = File::Spec->catdir( $dir, '.notgit' ); $options = { cwd => $dir, env => { GIT_DIR => File::Spec->abs2rel($gitdir) } }; ok( $r = eval { Git::Repository->run( "--work-tree=$dir", 'init', $options ); Git::Repository->new( work_tree => $dir, $options ); }, "init - cwd => $i, GIT_DIR => '.notgit'" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, $options ); chdir $home; # PASS - non-existent directory, not a .git GIT_DIR # provide a --work-tree, and start in a subdir BEGIN { $tests += 5 } $dir = next_dir; mkpath $dir; $gitdir = File::Spec->catdir( $dir, '.notgit' ); $subdir = File::Spec->catdir( $dir, 'sub' ); mkpath $subdir; chdir $subdir; $options = { cwd => $subdir, env => { GIT_DIR => File::Spec->abs2rel( $gitdir, $subdir ), GIT_WORK_TREE => File::Spec->abs2rel( $dir, $subdir ) } }; ok( $r = eval { Git::Repository->run( 'init', $options ); Git::Repository->new($options); }, "init - cwd => $i, GIT_DIR => '.notgit'" ); diag $@ if $@; chdir $home; test_repo( $r, $gitdir, $dir, $options ); # these tests requires git version >= 1.6.5 SKIP: { skip "these tests require git >= 1.6.5, but we only have $version", $extra if Git::Repository->version_lt('1.6.5'); # FAIL - init a dir that is a file BEGIN { $extra += 3 } $dir = next_dir; { open my $fh, '>', $dir; } # creates an empty file ok( !( $r = eval { Git::Repository->run( init => $dir ); Git::Repository->new( work_tree => $dir ); } ), "init => $i - FAILED" ); is( $r, undef, "init => $i - did not create a repository" ); like( $@, qr/^fatal: /, 'fatal error from git' ); # PASS - init on an existing repository BEGIN { $extra += 10 } $dir = next_dir; $gitdir = File::Spec->catdir( $dir, '.git' ); ok( $r = eval { Git::Repository->run( init => $dir ); Git::Repository->new( work_tree => $dir ); }, "init => $i" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); ok( $r = eval { Git::Repository->run( init => $dir ); Git::Repository->new( work_tree => $dir ); }, "init => $i - again" ); diag $@ if $@; test_repo( $r, $gitdir, $dir, {} ); } 24-errors.t100644001750001750 1364512266062417 15774 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use Git::Repository; use File::Temp qw( tempfile ); use constant MSWin32 => $^O eq 'MSWin32'; has_git('1.5.0.rc1'); # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; $ENV{GIT_AUTHOR_NAME} = 'Test Author'; $ENV{GIT_AUTHOR_EMAIL} = 'test.author@example.com'; $ENV{GIT_COMMITTER_NAME} = 'Test Committer'; $ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com'; # a place to put a git repository my $r; # a fake git binary used for setting the exit status my $exit; eval { my $version = Git::Repository->version; ( my $fh, $exit ) = tempfile( DIR => 't', UNLINK => 1, ( SUFFIX => '.bat' )x!! MSWin32, ); print {$fh} MSWin32 ? << "WIN32" : << "UNIX"; \@$^X -e "shift =~ /version/ ? print qq{git version $version\\n} : exit shift" -- %1 %2 WIN32 #!$^X shift =~ /version/ ? print "git version $version\\n" : exit shift; UNIX close $fh or diag "close $exit failed: $!"; chmod 0755, $exit or diag "chmod $exit failed: $!"; }; # make sure the binary is available if ( !-x $exit ) { diag "Skipping 'git exit' tests: $exit is not " . ( -e _ ? 'executable' : 'available' ); $exit = ''; } # capture all warnings my @warnings; local $SIG{__WARN__} = sub { push @warnings, shift }; my @tests = ( # empty repository { test_repo => [], cmd => [qw( log -1 )], exit => 128, dollar_at => qr/^fatal: bad default revision 'HEAD' /, }, # create the empty tree { cmd => [ mktree => { input => '' } ], exit => 0, }, # create a dummy commit { cmd => [ 'commit-tree', undef, { input => "empty tree" } ], exit => 0, }, # update master { cmd => [ 'update-ref' => 'refs/heads/master', undef ], exit => 0, }, # failing git rm { cmd => [ rm => 'does-not-exist' ], exit => 128, dollar_at => qr/^fatal: pathspec 'does-not-exist' did not match any files /, }, # failing git checkout { cmd => [ checkout => 'does-not-exist' ], exit => 1, warnings => [ qr/^error: pathspec 'does-not-exist' did not match any file\(s\) known to git\./, ], }, # failing git checkout (quiet) { cmd => [ checkout => 'does-not-exist', { quiet => 1 } ], exit => 1, }, # usage messages make run() die too { cmd => [ branch => '--does-not-exist' ], exit => '129', dollar_at => Git::Repository->version_lt('1.5.4.rc0') ? qr/^usage: git-branch / : qr/^error: unknown option `does-not-exist'/ }, # test fatal { cmd => [ checkout => 'does-not-exist', { fatal => [1] } ], exit => 1, dollar_at => qr/^error: pathspec 'does-not-exist' did not match any file\(s\) known to git\./, }, { cmd => [ checkout => 'does-not-exist', { fatal => 1 } ], exit => 1, dollar_at => qr/^error: pathspec 'does-not-exist' did not match any file\(s\) known to git\./, }, { cmd => [ rm => 'does-not-exist', { fatal => -128 } ], exit => 128, warnings => [ qr/^fatal: pathspec 'does-not-exist' did not match any files /, ], }, { cmd => [ rm => 'does-not-exist', { fatal => -128, quiet => 1 } ], exit => 128, }, ); # tests that depend on $exit push @tests, ( # test some fatal combinations { cmd => [ exit => 123, { git => $exit } ], exit => 123, }, { cmd => [ exit => 124, { git => $exit, fatal => [ 1 .. 255 ] } ], exit => 124, dollar_at => qr/^fatal: unknown git error/, }, # setup a repo with some 'fatal' options # and override them in the call to run() { test_repo => [ git => { fatal => [ 1 .. 255 ] } ], cmd => [ exit => 125, { git => $exit } ], exit => 125, dollar_at => qr/^fatal: unknown git error/, }, { cmd => [ exit => 126, { git => $exit, fatal => [ -130 .. -120 ] } ], exit => 126, }, )x!! $exit; # test case where EVERY exit status is fatal push @tests, ( # FATALITY { test_repo => [ git => { fatal => [ 0 .. 255 ] } ], cmd => ['version'], exit => 0, dollar_at => qr/^fatal: unknown git error/, }, { cmd => [ version => { fatal => '-0' } ], exit => 0, }, ); # more tests that depend on $exit push @tests, ( # "!0" is a shortcut for 1..255 { test_repo => [], cmd => [ exit => 140, { git => $exit, fatal => '!0' } ], exit => 140, dollar_at => qr/^fatal: unknown git error/, }, { test_repo => [ git => { fatal => '!0' } ], cmd => [ exit => 141, { git => $exit } ], exit => 141, dollar_at => qr/^fatal: unknown git error/, }, { cmd => [ exit => 142, { git => $exit, fatal => [ -150 .. -130 ] } ], exit => 142, }, )x!! $exit; # count the warnings we'll check @warnings = map @{ $_->{warnings} ||= [] }, @tests; plan tests => 3 * @tests + @warnings; my $output = ''; for my $t (@tests) { @warnings = (); # create a new test repository if needed $r = test_repository( @{ $t->{test_repo} } ) if $t->{test_repo}; # check if the command threw errors my @cmd = map { (defined) ? $_ : $output } @{ $t->{cmd} }; my $cmd = join ' ', grep !ref, @cmd; $output = eval { $r->run(@cmd); }; $t->{dollar_at} ? like( $@, $t->{dollar_at}, "$cmd: died" ) : is( $@, '', "$cmd: ran ok" ); is( $? >> 8, $t->{exit}, "$cmd: exit status $t->{exit}" ); # check warnings is( @warnings, @{ $t->{warnings} }, "warnings: " . @{ $t->{warnings} } ); for my $warning ( @{ $t->{warnings} } ) { like( shift @warnings, $warning, '... expected warning' ); } diag $_ for @warnings; } 12-create.t100644001750001750 142112266062417 15665 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Temp qw( tempdir ); use File::Spec; use File::Path; use Cwd qw( cwd realpath ); use Git::Repository; has_git('1.5.0.rc0'); my $version = Git::Repository->version; plan tests => my $tests; # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; my $home = cwd(); # a place to put a git repository my $dir = realpath( tempdir( CLEANUP => 1 ) ); BEGIN { $tests += 2 } mkpath $dir; chdir $dir; # check that create() dies my $r = eval { Git::Repository->create('init'); }; ok( !$r, "Git::Repository->create() fails " ); like( $@, qr/^create\(\) is deprecated, see Git::Repository::Tutorial for better alternatives at /, "... with expected error message" ); chdir $home; 05-try_git.t100644001750001750 702512266062417 16113 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Git::Repository; use Cwd qw( cwd ); use File::Spec; use File::Temp qw( tempdir ); use File::Path qw( mkpath rmtree ); use Config; my $cwd = cwd(); my @not_git = ( map ( { ( $_, File::Spec->catfile( $cwd, $_ ), File::Spec->catfile( File::Spec->updir, $_ ) ) } 'this-command-unlikely-to-even-exist-or-be-git' ), $^X, '', 't' ); plan tests => 3 * @not_git + 2 + 8; for my $not_git (@not_git) { # special case: '' means test removing $ENV{PATH} local $ENV{PATH} if ! $not_git; $not_git ||= 'git'; # direct test ok( !Git::Repository::Command::_is_git($not_git), "_is_git( $not_git ) fails with bad git command" ); # as an option ok( !eval { Git::Repository->run( '--version', { git => $not_git } ); 1; }, 'run() fails with bad git command' ); like( $@, qr/^git binary '.*?' not available or broken/, '... with expected error message' ); } # more tests if git is available SKIP: { skip 'Default git binary not found in PATH', 10 if !Git::Repository::Command::_is_git('git'); my $path_sep = $Config::Config{path_sep} || ';'; my ($abs_git) = grep { -x && !-d } map { my $path = $_; map { File::Spec->catfile( $path, $_ ) } map {"git$_"} '', '.cmd', '.exe' } split /\Q$path_sep\E/, ( $ENV{PATH} || '' ); diag "Testing _is_git with $abs_git from $cwd"; ok( Git::Repository::Command::_is_git($abs_git), "_is_git( $abs_git ) " ); my $rel_git = File::Spec->abs2rel($abs_git); diag "Testing _is_git with $rel_git from $cwd"; ok( Git::Repository::Command::_is_git($rel_git), "_is_git( $rel_git ) " ); # tests with symlinks SKIP: { my $osname = "@Config{qw( osname osvers archname archname64 )}"; skip "symlink() not supported on this $osname", 8 if !eval { symlink( '', '' ); 1 }; # a place to experiment my $dir = tempdir( DIR => 't', CLEANUP => 1 ); my $target = File::Spec->catfile( $dir, 'target' ); my $link = File::Spec->catfile( $dir, 'link' ); my $real = File::Spec->catfile( $dir, 'real' ); $ENV{PATH} = $dir; # symlink pointing to the real thing # (not using 'link', because the _is_git() cache is not very smart # with links that change of target while the program is running) ok( symlink( $abs_git, $real ), "real -> $abs_git" ); ok( Git::Repository::Command::_is_git('real'), 'symlink to git' ); unlink $link; # create a dangling symlink open my $fh, '>', $target or diag "Can't open $target: $!"; close $fh; chmod 0777, $target; ok( symlink( 'target', $link ), 'link -> target' ); unlink $target; ok( !Git::Repository::Command::_is_git('link'), 'dangling symlink' ); unlink $link; # symlink pointing to a directory mkpath $target; ok( symlink( 'target', $link ), 'link -> target/' ); ok( !Git::Repository::Command::_is_git('link'), 'symlink to a dir' ); # secondary target, working, but later in the PATH my $subdir = File::Spec->catdir( $dir, 'sub' ); mkpath $subdir; $ENV{PATH} = join $path_sep, $dir, $subdir; ok( symlink( $abs_git, File::Spec->catfile( $subdir, 'link' ) ), "sub/link -> $abs_git " ); ok( Git::Repository::Command::_is_git('link'), 'symlink to git' ); } } 07-version.t100644001750001750 344212266062417 16120 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Temp qw( tempfile ); use Git::Repository; use constant MSWin32 => $^O eq 'MSWin32'; has_git('1.4.0'); # setup fake git my $W = my $V = my $version = Git::Repository->version; $V =~ s/\.(\d+)\./.@{[$1+1]}./; $W =~ s/\.(\d+)\./.@{[$1+2]}./; my $o = { git => fake_git('1.2.3') }; # small one my $O = { git => fake_git($W) }; # big one # setup tests (that will fail if the real git is called) my @true = ( [ version_eq => '1.2.3', $o ], # small [ version_ne => $version, $o ], [ version_lt => '1.2.3.5', $o ], [ version_le => '1.2.3', $o ], [ version_le => '1.2.3.5', $o ], [ version_eq => $W, $O ], # big [ version_ne => $version, $O ], [ version_gt => $version, $O ], [ version_ge => $V, $O ], [ version_ge => $W, $O ], ); plan tests => 2 + 3 * @true; # use options in version() is( Git::Repository->version($o), '1.2.3', "version() options (small git)" ); is( Git::Repository->version($O), $W, "version() options (big git)" ); # use options in version_eq() for my $t (@true) { my ( $method, @args ) = @$t; ok( Git::Repository->$method(@args), "$method() options" ); ok( Git::Repository->$method( reverse @args ), "$method() options (any order)" ); ok( Git::Repository->$method( @args, 'bonk' ), "$method() options (with bogus extra args)" ); } # helper routine to build a fake fit binary sub fake_git { my ($version) = @_; my ( $fh, $filename ) = tempfile( DIR => 't', UNLINK => 1, MSWin32 ? ( SUFFIX => '.bat' ) : () ); print {$fh} MSWin32 ? << "WIN32" : << "UNIX"; \@echo git version $version WIN32 #!$^X print "git version $version\\n" UNIX close $fh; chmod 0755, $filename; return $filename; } 25-plugins.t100644001750001750 613212266062417 16113 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use lib 't'; use Test::More; use Test::Git; use File::Temp qw( tempdir ); use File::Spec; use Cwd qw( cwd abs_path ); use Git::Repository; has_git('1.5.0.rc1'); # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; plan tests => my $tests; # first create a new empty repository my $r = test_repository; my $dir = $r->work_tree; my $gitdir = $r->git_dir; # FAIL - no hello method BEGIN { $tests += 1 } ok( !eval { $r->hello }, 'No hello() method' ); # PASS - load Hello BEGIN { $tests += 1 } use_ok( 'Git::Repository', 'Hello' ); # PASS - new methods BEGIN { $tests += 4 } ok( my $got = eval { $r->hello }, 'hello() method is there' ); diag $@ if $@; is( $got, "Hello, git world!\n", '... with expected value' ); ok( $got = eval { $r->hello_gitdir }, 'hello_gitdir() method is there' ); diag $@ if $@; is( $got, "Hello, $gitdir!\n", '... with expected value' ); # FAIL - can't load this plugin BEGIN { $tests += 2 } ok( !eval q{use Git::Repository 'DoesNotExist'; 2;}, 'Failed to load inexistent plugin' ); like( $@, qr{^Can't locate Git/Repository/Plugin/DoesNotExist\.pm }, '... expected error message' ); # PASS - load Hello2 and throw various warnings my @warnings; { BEGIN { $tests += 5 } local $SIG{__WARN__} = sub { push @warnings, shift }; use_ok( 'Git::Repository', [ Hello2 => 'hello', 'zlonk' ] ); is( scalar @warnings, 3, 'Got 3 warnings' ); like( $warnings[0], qr/^Use of \@KEYWORDS by Git::Repository::Plugin::Hello2 is deprecated /, '... deprecation warning' ); like( $warnings[1], qr/^Unknown keyword 'zlonk' in Git::Repository::Plugin::Hello2 /, '... unknown keyword' ); like( $warnings[2], qr/^Subroutine (Git::Repository::)?hello redefined /, '... redefined method warning' ); @warnings = (); BEGIN { $tests += 5 } use_ok( 'Git::Repository', [ Hello2 => 'bam' ] ); is( scalar @warnings, 3, 'Got 3 warnings' ); like( $warnings[0], qr/^Use of \@KEYWORDS by Git::Repository::Plugin::Hello2 is deprecated /, '... deprecation warning' ); like( $warnings[1], qr/^Unknown keyword 'bam' in Git::Repository::Plugin::Hello2 /, '... unknown keyword' ); like( $warnings[2], qr/^No keywords installed from Git::Repository::Plugin::Hello2 /, '... no valid keyword left' ); @warnings = (); } # PASS - new methods BEGIN { $tests += 4 } ok( $got = eval { $r->hello }, 'hello() method is there' ); diag $@ if $@; is( $got, "Hello, world!\n", '... with new value' ); ok( !eval { $r->hello_worktree }, 'hello_worktree() method is not there' ); like( $@, qr/^Can't locate object method "hello_worktree" via package "Git::Repository" /, '... expected error message' ); # PASS - load a fully qualified plgin class BEGIN { $tests += 3 } use_ok( 'Git::Repository', '+MyGit::Hello' ); ok( $got = eval { $r->myhello }, 'myhello() method is there' ); diag $@ if $@; is( $got, "Hello, my git world!\n", '... with expected value' ); 06-version.t100644001750001750 1025212266062417 16134 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use Scalar::Util qw( looks_like_number ); use Git::Repository; has_git; # get the git version my ($version) = Git::Repository->run('--version') =~ /git version (.*)/g; diag "git version $version"; # other versions based on the current one my @version = split /\./, $version; my ( @lesser, @greater ); for ( 0 .. $#version ) { local $" = '.'; my @v = @version; next if !looks_like_number( $v[$_] ); $v[$_]++; push @greater, "@v"; next if 0 > ( $v[$_] -= 2 ); push @lesser, "@v"; } # more complex comparisons my @true = ( [ '1.7.2.rc0.13.gc9eaaa', 'version_eq', '1.7.2.rc0.13.gc9eaaa' ], [ '1.7.2.rc0.13.gc9eaaa', 'version_ge', '1.7.2.rc0.13.gc9eaaa' ], [ '1.7.2.rc0.13.gc9eaaa', 'version_le', '1.7.2.rc0.13.gc9eaaa' ], [ '1.7.1', 'version_gt', '1.7.1.rc0' ], [ '1.7.1.rc1', 'version_gt', '1.7.1.rc0' ], [ '1.3.2', 'version_gt', '0.99' ], [ '1.7.2.rc0.13.gc9eaaa', 'version_gt', '1.7.0.4' ], [ '1.7.1.rc2', 'version_gt', '1.7.1.rc1' ], [ '1.7.2.rc0.1.g078e', 'version_gt', '1.7.2.rc0' ], [ '1.7.2.rc0.10.g1ba5c', 'version_gt', '1.7.2.rc0.1.g078e' ], [ '1.7.1.1', 'version_gt', '1.7.1.1.gc8c07' ], [ '1.7.1.1', 'version_gt', '1.7.1.1.g5f35a' ], [ '1.0.0b', 'version_gt', '1.0.0a' ], [ '1.0.3', 'version_gt', '1.0.0a' ], [ '1.7.0.4', 'version_ne', '1.7.2.rc0.13.gc9eaaa' ], [ '1.7.1.rc1', 'version_ne', '1.7.1.rc2' ], [ '1.0.0a', 'version_ne', '1.0.0' ], [ '1.4.0.rc1', 'version_le', '1.4.1' ], [ '1.0.0a', 'version_gt', '1.0.0', 'TODO' ], # will probably never be done [ '1.7.1.236.g81fa0', 'version_gt', '1.7.1' ], [ '1.7.1.236.g81fa0', 'version_lt', '1.7.1.1' ], [ '1.7.1.211.g54fcb21', 'version_gt', '1.7.1.209.gd60ad81' ], [ '1.7.1.211.g54fcb21', 'version_ge', '1.7.1.209.gd60ad81' ], [ '1.7.1.209.gd60ad81', 'version_lt', '1.7.1.1.1.g66bd8ab' ], [ '1.7.0.2.msysgit.0', 'version_gt', '1.6.6' ], ); # operator reversal: $a op $b <=> $b rop $a my %reverse = ( version_eq => 'version_eq', version_ne => 'version_ne', version_ge => 'version_le', version_gt => 'version_lt', version_le => 'version_ge', version_lt => 'version_gt', ); my %negate = ( version_ne => 'version_eq', version_eq => 'version_ne', version_ge => 'version_lt', version_gt => 'version_le', version_le => 'version_gt', version_lt => 'version_ge', ); @true = ( @true, map { [ $_->[2], $reverse{ $_->[1] }, $_->[0], $_->[3] || () ] } @true ); plan tests => 5 + 6 * @lesser + 6 * @greater + 2 * @true; my $r = 'Git::Repository'; # version is( Git::Repository->version(), $version, "git version $version" ); # version_eq ok( $r->version_eq($version), "$version version_eq $version" ); ok( !$r->version_eq($_), "$version not version_eq $_" ) for @greater, @lesser; # version_ne ok( $r->version_ne($_), "$version version_ne $_" ) for @greater, @lesser; ok( !$r->version_ne($version), "$version not version_ne $version" ); # version_gt ok( $r->version_gt($_), "$version version_gt $_" ) for @lesser; ok( !$r->version_gt($_), "$version not version_gt $_" ) for @greater; # version_le ok( $r->version_lt($_), "$version version_lt $_" ) for @greater; ok( !$r->version_lt($_), "$version not version_lt $_" ) for @lesser; # version_le ok( $r->version_le($_), "$version version_le $_" ) for $version, @greater; ok( !$r->version_le($_), "$version not version_le $_" ) for @lesser; # version_ge ok( $r->version_ge($_), "$version version_ge $_" ) for $version, @lesser; ok( !$r->version_ge($_), "$version not version_ge $_" ) for @greater; # test a number of special cases my $dev; { package Git::Repository::VersionFaker; our @ISA = qw( Git::Repository ); sub version { return $dev } } $r = 'Git::Repository::VersionFaker'; for (@true) { ( $dev, my $meth, my $v, $TODO ) = @$_; local $TODO = $TODO ? 'version comparison not exhaustive' : ''; ok( $r->$meth($v), "$dev $meth $v" ); $meth = $negate{$meth}; ok( !$r->$meth($v), "$dev not $meth $v" ); } 22-backward.t100644001750001750 340312266062417 16203 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Temp qw( tempdir ); use File::Spec; use Cwd qw( cwd realpath ); use Git::Repository; has_git('1.5.0.rc1'); # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; my $home = cwd(); # a place to put a git repository my $fake = realpath( tempdir( CLEANUP => 1 ) ); my $r = test_repository; my $dir = $r->work_tree; my $gitdir = $r->git_dir; # capture warnings my @warnings; local $SIG{__WARN__} = sub { push @warnings, shift }; # use new with various options my $re_wc = qr/^working_copy is obsolete, please use work_tree instead /; my $re_re = qr/^repository is obsolete, please use git_dir instead /; my @tests = ( [ $home => [ working_copy => $dir ], $re_wc ], [ $home => [ work_tree => $dir, working_copy => $fake ], $re_wc ], [ $home => [ repository => $gitdir ], $re_re ], [ $home => [ git_dir => $gitdir, repository => $fake ], $re_re ], [ $home => [ git_dir => $gitdir, repository => $fake, work_tree => $dir, working_copy => $fake, ], $re_re ], # order doesn't matter [ $home => [ repository => $fake, working_copy => $fake, work_tree => $dir, git_dir => $gitdir, ], $re_re ], ); # test backward compatibility plan tests => 2 * @tests; # now test most possible cases for backward compatibility for my $t (@tests) { my ( $cwd, $args, $re ) = @$t; chdir $cwd; my $i; my @args = grep { ++$i % 2 } @$args; $r = eval { Git::Repository->new(@$args) }; ok( !$r, "Git::Repository->new( @args ) fails" ); like( $@, $re, '... with expected error message' ); } 10-new_fail.t100644001750001750 427312266062417 16214 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use Cwd qw( abs_path ); use File::Temp qw( tempdir ); use File::Spec; use File::Path; use Git::Repository; has_git; plan tests => 12; # a place to put a git repository my $dir = abs_path( tempdir( CLEANUP => 1 ) ); my $missing = File::Spec->catdir( $dir, 'missing' ); my $gitdir = File::Spec->catdir( $dir, '.git' ); # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; # FAIL - missing repository directory ok( !eval { Git::Repository->new( git_dir => $missing ) }, 'Missing repository directory' ); like( $@, qr/^directory not found: (?:\Q$missing\E)? /, '... expected error message' ); # FAIL - missing working copy directory ok( !eval { Git::Repository->new( work_tree => $missing ) }, 'Missing work_tree directory' ); like( $@, qr/^directory not found: (?:\Q$missing\E)? /, '... expected error message' ); # FAIL - repository is not a git repository ok( !eval { Git::Repository->new( git_dir => $dir ) }, 'repository directory is not a git repository' ); like( $@, qr/^fatal: Not a git repository/, # error from git itself '... expected error message' ); # FAIL - working copy is not a git working copy SKIP: { my $tmp = File::Spec->tmpdir(); skip "$tmp is already a working copy for some git repository", 2 if eval { Git::Repository->new( work_tree => $tmp ) }; ok( !eval { Git::Repository->new( work_tree => $dir ) }, 'work_tree directory is not a git working copy' ); like( $@, qr/^fatal: Not a git repository/, # error from git itself '... expected error message' ); } # FAIL - working copy is not a git working copy mkpath($gitdir); ok( !eval { Git::Repository->new( work_tree => $dir, git_dir => $gitdir ); }, 'work_tree\'s repository directory is not a git repository' ); like( $@, qr/^fatal: Not a git repository/, # error from git itself '... expected error message' ); # FAIL - extra parameters ok( !eval { Git::Repository->new( work_tree => $dir, extra => 'stuff' ); }, 'unknown extra parameter' ); like( $@, qr/^Unknown parameters: extra /, '... expected error message' ); Test000755001750001750 012266062417 15101 5ustar00bookbook000000000000Git-Repository-1.310/libGit.pm100644001750001750 1441212266062417 16344 0ustar00bookbook000000000000Git-Repository-1.310/lib/Testpackage Test::Git; { $Test::Git::VERSION = '1.310'; } use strict; use warnings; use Exporter; use Test::Builder; use Git::Repository; # 1.15 use File::Temp qw( tempdir ); use File::Spec::Functions qw( catdir ); use Cwd qw( cwd ); use Carp; our @ISA = qw( Exporter ); our @EXPORT = qw( has_git test_repository ); my $Test = Test::Builder->new(); sub has_git { my ( $version, @options ) = ( ( grep !ref, @_ )[0], grep ref, @_ ); # check some git is present $Test->skip_all('Default git binary not found in PATH') if !Git::Repository::Command::_is_git('git'); # check it's at least some minimum version my $git_version = Git::Repository->version(@options); $Test->skip_all( "Test script requires git >= $version (this is only $git_version)") if $version && Git::Repository->version_lt( $version, @options ); } sub test_repository { my %args = @_; croak "Can't use both 'init' and 'clone' paramaters" if exists $args{init} && exists $args{clone}; # setup some default values my $temp = $args{temp} || [ CLEANUP => 1 ]; # File::Temp options my $init = $args{init} || []; # git init options my $opts = $args{git} || {}; # Git::Repository options my $safe = { %$opts, fatal => [] }; # ignore 'fatal' settings my $clone = $args{clone}; # git clone options # version check my ( $cmd, $min_version ) = $clone ? ( clone => '1.6.2.rc0' ) : ( init => '1.5.0.rc1' ); my $git_version = Git::Repository->version($safe); croak "test_repository( $cmd => ... ) requires git >= $min_version (this is only $git_version)" if Git::Repository->version_lt( $min_version, $safe ); # create a temporary directory to host our repository my $dir = tempdir(@$temp); my $cwd = { cwd => $dir }; # option to chdir there # create the git repository there my @cmd = $clone ? ( clone => @$clone, $dir ) : ( init => @$init, $cwd ); Git::Repository->run( @cmd, $safe ); # create the Git::Repository object my $gitdir = Git::Repository->run( qw( rev-parse --git-dir ), $cwd ); return Git::Repository->new( git_dir => catdir( $dir, $gitdir ), $opts ); } 1; # ABSTRACT: Helper functions for test scripts using Git __END__ =pod =head1 NAME Test::Git - Helper functions for test scripts using Git =head1 VERSION version 1.310 =head1 SYNOPSIS use Test::More; use Test::Git; # check there is a git binary available, or skip all has_git(); # check there is a minimum version of git available, or skip all has_git( '1.6.5' ); # check the git we want to test has a minimum version, or skip all has_git( '1.6.5', { git => '/path/to/alternative/git' } ); # normal plan plan tests => 2; # create a new, empty repository in a temporary location # and return a Git::Repository object my $r = test_repository(); # clone an existing repository in a temporary location # and return a Git::Repository object my $c = test_repository( clone => [ $url ] ); # run some tests on the repository ... =head1 DESCRIPTION L provides a number of helpful functions when running test scripts that require the creation and management of a Git repository. =head1 EXPORTED FUNCTIONS =head2 has_git has_git( $version, \%options ); Checks if there is a git binary available, or skips all tests. If the optional L<$version> argument is provided, also checks if the available git binary has a version greater or equal to C<$version>. This function also accepts an option hash of the same kind as those accepted by L and L. This function must be called before C, as it performs a B if requirements are not met. =head2 test_repository test_repository( %options ); Creates a new empty git repository in a temporary location, and returns a L object pointing to it. This function takes options as a hash. Each key will influence a different part of the creation process. The keys are: =over 4 =item temp Array reference containing parameters to L C function. Default: C<[ CLEANUP => 1 ]> =item init Array reference containing parameters to C. Must not contain the target directory parameter, which is provided by C (via L). Default: C<[]> The C option is only supported with Git versions higher or equal to 1.6.2.rc0. =item clone Array reference containing parameters to C. Must not contain the target directory parameter, which is provided by C (via L). Note that C and C are mutually exclusive and that C will croak if both are provided. This option has no default value, since at least a Git URL must be provided to the C option. The C option is only supported with Git versions higher or equal to 1.6.2.rc0. =item git Hash reference containing options for L. Default: C<{}> =back This call is the equivalent of the default call with no options: test_repository( temp => [ CLEANUP => 1 ], # File::Temp::tempdir options init => [], # git init options git => {}, # Git::Repository options ); To create a I repository: test_repository( init => [ '--bare' ] ); To leave the repository in its location after the end of the test: test_repository( temp => [ CLEANUP => 0 ] ); Note that since C uses C to create the test repository, it requires at least Git version C<1.5.0.rc1>. =head1 BUGS Please report any bugs or feature requests on the bugtracker website http://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-Repository or by email to bug-git-repository@rt.cpan.org. When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Philippe Bruhat (BooK) =head1 COPYRIGHT Copyright 2010-2014 Philippe Bruhat (BooK), all rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 21-submodule.t100644001750001750 370012266062417 16423 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use Git::Repository; has_git( '1.5.3.rc0' ); # first git submodule appearance plan skip_all => "git clone fails for git between 1.5.4.rc0 and 1.6.0.rc0" if Git::Repository->version_le('1.6.0.rc0') && Git::Repository->version_ge('1.5.4.rc0'); plan skip_all => "git submodule add with a non-existing path fails for git between 1.7.0.rc1 and 1.7.0.2" if Git::Repository->version_le('1.7.0.2') && Git::Repository->version_ge('1.7.0.rc1'); plan skip_all => "Removing environment variables requires System::Command 1.04, this is only $System::Command::VERSION" if $System::Command::VERSION < 1.04; plan tests => 1; # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; $ENV{GIT_AUTHOR_NAME} = 'Test Author'; $ENV{GIT_AUTHOR_EMAIL} = 'test.author@example.com'; $ENV{GIT_COMMITTER_NAME} = 'Test Committer'; $ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com'; # create a small repository my $s = test_repository; my $blob = $s->run( qw( hash-object -t blob -w --stdin ), { input => 'hello' } ); my $tree = $s->run( mktree => { input => "100644 blob $blob\thello" } ); my $commit = $s->run( 'commit-tree' => $tree, { input => 'empty tree' } ); $s->run( 'update-ref', 'refs/heads/master' => $commit ); $s->run( checkout => 'master', { quiet => 1 } ); # now test adding a submodule my $r = test_repository; $r->run( submodule => add => $s->work_tree => 'sub', { env => { GIT_WORK_TREE => undef } } ); # the result of git submodule add has changed over time my $expected = $r->version_lt('1.5.3.rc1') ? " $commit sub" : $r->version_lt('1.5.4.4') ? " $commit sub (undefined)" : $r->version_lt('1.7.6.1') ? "-$commit sub" : " $commit sub (heads/master)"; # do the test my $status = $r->run( 'submodule', 'status', 'sub' ); is( $status, $expected, 'git submodule status' ); MyGit000755001750001750 012266062417 14710 5ustar00bookbook000000000000Git-Repository-1.310/tHello.pm100644001750001750 32412266062417 16430 0ustar00bookbook000000000000Git-Repository-1.310/t/MyGitpackage MyGit::Hello; use strict; use warnings; use Git::Repository::Plugin; our @ISA = qw( Git::Repository::Plugin ); sub _keywords { qw( myhello ) } sub myhello { return "Hello, my git world!\n" } 1; release-distmeta.t100644001750001750 45512266062417 17420 0ustar00bookbook000000000000Git-Repository-1.310/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::CPAN::Meta"; plan skip_all => "Test::CPAN::Meta required for testing META.yml" if $@; meta_yaml_ok(); Git000755001750001750 012266062417 14705 5ustar00bookbook000000000000Git-Repository-1.310/libRepository.pm100644001750001750 5424712266062417 17616 0ustar00bookbook000000000000Git-Repository-1.310/lib/Gitpackage Git::Repository; { $Git::Repository::VERSION = '1.310'; } use warnings; use strict; use 5.006; use Carp; use File::Spec; use Cwd qw( cwd realpath ); use Scalar::Util qw( looks_like_number ); use Git::Repository::Command; # a few simple accessors for my $attr (qw( git_dir work_tree options )) { no strict 'refs'; *$attr = sub { return ref $_[0] ? $_[0]{$attr} : () }; } # backward compatible aliases sub repo_path { croak "repo_path() is obsolete, please use git_dir() instead"; } sub wc_path { croak "wc_path() is obsolete, please use work_tree() instead"; } # helper function sub _abs_path { my ( $path, $base ) = @_; my $abs_path = File::Spec->rel2abs( $path, $base ); # normalize, but don't die on Win32 if the path doesn't exist eval { $abs_path = realpath($abs_path); }; return $abs_path; } # # support for loading plugins # sub import { my ( $class, @plugins ) = @_; for my $plugin (@plugins) { ( $plugin, my @names ) = @$plugin if ref $plugin; $plugin = substr( $plugin, 0, 1 ) eq '+' ? substr( $plugin, 1 ) : "Git::Repository::Plugin::$plugin"; eval "use $plugin; 1;" or croak $@; $plugin->install(@names); } } # # constructor-related methods # sub new { my ( $class, @arg ) = @_; # create the object my $self = bless {}, $class; # take out the option hash my ( $options, %arg ); { my @o; %arg = grep !( ref eq 'HASH' ? push @o, $_ : 0 ), @arg; croak "Too many option hashes given: @o" if @o > 1; $options = $self->{options} = shift @o || {}; } # ignore 'input' and 'fatal' options during object creation my $input = delete $options->{input}; my $fatal = delete $options->{fatal}; # die if deprecated parameters are given croak "repository is obsolete, please use git_dir instead" if defined delete $arg{repository}; croak "working_copy is obsolete, please use work_tree instead" if defined delete $arg{working_copy}; # setup default options my $git_dir = delete $arg{git_dir}; my $work_tree = delete $arg{work_tree}; croak "Unknown parameters: @{[keys %arg]}" if keys %arg; # compute the various paths my $cwd = defined $options->{cwd} ? $options->{cwd} : cwd(); # if work_tree or git_dir are relative, they are relative to cwd -d ( $git_dir = _abs_path( $git_dir, $cwd ) ) or croak "directory not found: $git_dir" if defined $git_dir; -d ( $work_tree = _abs_path( $work_tree, $cwd ) ) or croak "directory not found: $work_tree" if defined $work_tree; # if no cwd option given, assume we want to work in work_tree $cwd = defined $options->{cwd} ? $options->{cwd} : defined $work_tree ? $work_tree : cwd(); # we'll always have to compute it if not defined $self->{git_dir} = _abs_path( Git::Repository->run( qw( rev-parse --git-dir ), { %$options, cwd => $cwd } ), $cwd ) if !defined $git_dir; # there are 4 possible cases if ( !defined $work_tree ) { # 1) no path defined: trust git with the values # $self->{git_dir} already computed # 2) only git_dir was given: trust it $self->{git_dir} = $git_dir if defined $git_dir; # in a non-bare repository, the work tree is just above the gitdir if ( $self->run(qw( config --bool core.bare )) ne 'true' ) { $self->{work_tree} = _abs_path( File::Spec->updir, $self->{git_dir} ); } } else { # 3) only work_tree defined: if ( !defined $git_dir ) { # $self->{git_dir} already computed # check work_tree is the top-level work tree, and not a subdir my $cdup = Git::Repository->run( qw( rev-parse --show-cdup ), { %$options, cwd => $cwd } ); $self->{work_tree} = $cdup ? _abs_path( $cdup, $work_tree ) : $work_tree; } # 4) both path defined: trust the values else { $self->{git_dir} = $git_dir; $self->{work_tree} = $work_tree; } } # sanity check my $gitdir = eval { _abs_path( $self->run(qw( rev-parse --git-dir )), $cwd ) } || ''; croak "fatal: Not a git repository: $self->{git_dir}" if $self->{git_dir} ne $gitdir; # put back the ignored option $options->{input} = $input if defined $input; $options->{fatal} = $fatal if defined $fatal; return $self; } # create() is now fully deprecated sub create { croak "create() is deprecated, see Git::Repository::Tutorial for better alternatives"; } # # command-related methods # # return a Git::Repository::Command object sub command { shift @_ if !ref $_[0]; # remove class name if called as class method return Git::Repository::Command->new(@_); } # run a command, returns the output # die with errput if any sub run { my ( $self, @cmd ) = @_; # split the args to get the optional callbacks my @cb; @cmd = grep { ref eq 'CODE' ? !push @cb, $_ : 1 } @cmd; local $Carp::CarpLevel = 1; # run the command (pass the instance if called as an instance method) my $command = Git::Repository::Command->new( ref $self ? $self : (), @cmd ); # return the output or die return $command->final_output(@cb); } # # version comparison methods # # NOTE: it doesn't make sense to try to cache the results of version(): # - yes, it will make faster benchmarks, but # - the 'git' option allows to change the git binary anytime # - version comparison is usually done once anyway sub version { return ( shift->run( '--version', grep { ref eq 'HASH' } @_ ) =~ /git version (.*)/g )[0]; } sub _version_eq { my ( $v1, $v2 ) = @_; my @v1 = split /\./, $v1; my @v2 = split /\./, $v2; return '' if @v1 != @v2; $v1[$_] ne $v2[$_] and return '' for 0 .. $#v1; return 1; } sub _version_gt { my ( $v1, $v2 ) = @_; my @v1 = split /\./, $v1; my @v2 = split /\./, $v2; # pick up any dev parts my @dev1 = splice @v1, -2 if substr( $v1[-1], 0, 1 ) eq 'g'; my @dev2 = splice @v2, -2 if substr( $v2[-1], 0, 1 ) eq 'g'; # skip to the first difference shift @v1, shift @v2 while @v1 && @v2 && $v1[0] eq $v2[0]; # we're comparing dev versions with the same ancestor if ( !@v1 && !@v2 ) { @v1 = @dev1; @v2 = @dev2; } # prepare the bits to compare ( $v1, $v2 ) = ( $v1[0] || 0, $v2[0] || 0 ); # rcX is less than any number return looks_like_number($v1) ? looks_like_number($v2) ? $v1 > $v2 : 1 : looks_like_number($v2) ? '' : $v1 gt $v2; } # every op is a combination of eq and gt sub version_eq { my ( $r, $v, @o ) = ( shift, ( grep !ref, @_ )[0], grep ref, @_ ); return _version_eq( $r->version(@o), $v ); } sub version_ne { my ( $r, $v, @o ) = ( shift, ( grep !ref, @_ )[0], grep ref, @_ ); return !_version_eq( $r->version(@o), $v ); } sub version_gt { my ( $r, $v, @o ) = ( shift, ( grep !ref, @_ )[0], grep ref, @_ ); return _version_gt( $r->version(@o), $v ); } sub version_le { my ( $r, $v, @o ) = ( shift, ( grep !ref, @_ )[0], grep ref, @_ ); return !_version_gt( $r->version(@o), $v ); } sub version_lt { my ( $r, $v, @o ) = ( shift, ( grep !ref, @_ )[0], grep ref, @_ ); my $V = $r->version(@o); return !_version_eq( $V, $v ) && !_version_gt( $V, $v ); } sub version_ge { my ( $r, $v, @o ) = ( shift, ( grep !ref, @_ )[0], grep ref, @_ ); my $V = $r->version(@o); return _version_eq( $V, $v ) || _version_gt( $V, $v ); } 1; # ABSTRACT: Perl interface to Git repositories __END__ =pod =head1 NAME Git::Repository - Perl interface to Git repositories =head1 VERSION version 1.310 =head1 SYNOPSIS use Git::Repository; # start from an existing repository $r = Git::Repository->new( git_dir => $gitdir ); # start from an existing working copy $r = Git::Repository->new( work_tree => $dir ); # start from a repository reachable from the current directory $r = Git::Repository->new(); # or init our own repository first Git::Repository->run( init => $dir, ... ); $r = Git::Repository->new( work_tree => $dir ); # or clone from a URL first Git::Repository->run( clone => $url, $dir, ... ); $r = Git::Repository->new( work_tree => $dir ); # provide an option hash for Git::Repository::Command # (see Git::Repository::Command for all available options) $r = Git::Repository->new( ..., \%options ); # run commands # - get the full output (no errput) passing options for this command only $output = $r->run( @cmd, \%options ); # - get the full output as a list of lines (no errput), with options @output = $r->run( @cmd, \%options ); # - process the output with callbacks $output = $r->run( @cmd, sub {...} ); @output = $r->run( @cmd, sub {...} ); # - obtain a Git::Repository::Command object # (see Git::Repository::Command for details) $cmd = $r->command( @cmd, \%options ); # obtain version information my $version = $r->version(); # compare current git version if ( $r->version_gt('1.6.5') ) { ...; } =head1 DESCRIPTION L is a Perl interface to Git, for scripted interactions with repositories. It's a low-level interface that allows calling any Git command, whether I or I, including bidirectional commands such as C. A L object simply provides context to the git commands being run. It is possible to call the C and C methods against the class itself, and the context (typically I) will be obtained from the options and environment. As a low-level interface, it provides no sugar for particular Git commands. Specifically, it will not prepare environment variables that individual Git commands may need or use. However, the C and C environment variables are special: if the command is run in the context of a L object, they will be overridden by the object's C and C attributes, respectively. It is however still possible to override them if necessary, using the C option. L requires at least Git 1.5.0, and is expected to support any later version. See L for more code examples. =head1 CONSTRUCTOR =head2 new Git::Repository->new( %args, $options ); Create a new L object, based on an existing Git repository. Parameters are: =over 4 =item git_dir => $gitdir The location of the git repository (F<.git> directory or equivalent). For backward compatibility with versions 1.06 and before, C is accepted in place of C (but the newer name takes precedence). =item work_tree => $dir The location of the git working copy (for a non-bare repository). If C actually points to a subdirectory of the work tree, L will automatically recompute the proper value. For backward compatibility with versions 1.06 and before, C is accepted in place of C (but the newer name takes precedence). =back If none of the parameter is given, L will find the appropriate repository just like Git itself does. Otherwise, one of the parameters is usually enough, as L can work out where the other directory (if any) is. C also accepts a reference to an option hash which will be used as the default by L when working with the corresponding L instance. So this: my $r = Git::Repository->new( # parameters work_tree => $dir, # options { git => '/path/to/some/other/git', env => { GIT_COMMITTER_EMAIL => 'book@cpan.org', GIT_COMMITTER_NAME => 'Philippe Bruhat (BooK)', }, } ); is equivalent to explicitly passing the option hash to each C or C call. The documentation for L lists all available options. Note that Git::Repository and L take great care in finding the option hash wherever it may be in C<@_>, and to merge multiple option hashes if more than one is provided. It probably makes no sense to set the C option in C, but L won't stop you. Note that on some systems, some git commands may close standard input on startup, which will cause a C. L will raise an exception. To create a Git repository and obtain a L object pointing to it, simply do it in two steps: # run a clone or init command without an instance, # using options like cwd Git::Repository->run( ... ); # obtain a Git::Repository instance # on the resulting repository $r = Git::Repository->new( ... ); =head1 METHODS =for Pod::Coverage create repo_path wc_path L supports the following methods: =head2 command Git::Repository->command( @cmd ); $r->command( @cmd ); Runs the git sub-command and options, and returns a L object pointing to the sub-process running the command. As described in the L documentation, C<@cmd> may also contain a hashref containing options for the command. =head2 run Git::Repository->run( @cmd ); $r->run( @cmd ); Runs the command and returns the output as a string in scalar context, or as a list of lines in list context. Also accepts a hashref of options. Lines are automatically Ced. In addition to the options hashref supported by L, the parameter list can also contain code references, that will be applied successively to each line of output. The line being processed is in C<$_>, but the coderef must still return the result string (like C). If the git command printed anything on stderr, it will be printed as warnings. For convenience, if the git sub-process exited with status C<128> (fatal error), or C<129> (usage message), C will C. The exit status values for which C dies can be modified using the C option (see L for details). The exit status of the command that was just run is accessible as usual using C<<< $? >> 8 >>>. See L for details about C<$?>. =head2 git_dir Returns the repository path. =head2 work_tree Returns the working copy path. Used as current working directory by L. =head2 options Return the option hash that was passed to C<< Git::Repository->new() >>. =head2 version Return the version of git, as given by C. =head2 Version-comparison "operators" Git evolves very fast, and new features are constantly added. To facilitate the creation of programs that can properly handle the wide variety of Git versions seen in the wild, a number of version comparison "operators" are available. They are named C> where I is the equivalent of the Perl operators C, C, C, C, C, C. They return a boolean value, obtained by comparing the version of the git binary and the version string passed as parameter. The methods are: =over 4 =item version_lt( $version ) =item version_gt( $version ) =item version_le( $version ) =item version_ge( $version ) =item version_eq( $version ) =item version_ne( $version ) =back All those methods also accept an option hash, just like the others. Note that there are a small number of cases where the version comparison operators will I compare versions correctly for I versions of Git. Typical example is C<1.0.0a gt 1.0.0> which should return true, but doesn't. This only matters in comparisons, only for version numbers prior to C<1.4.0-rc1> (June 2006), and only when the compared versions are very close. Other issues exist when comparing development version numbers with one another. For example, C<1.7.1.1> is greater than both C<1.7.1.1.gc8c07> and C<1.7.1.1.g5f35a>, and C<1.7.1> is less than both. Obviously, C<1.7.1.1.gc8c07> will compare as greater than C<1.7.1.1.g5f35a> (asciibetically), but in fact these two version numbers cannot be compared, as they are two siblings children of the commit tagged C). If one were to compute the set of all possible version numbers (as returned by C) for all git versions that can be compiled from each commit in the F repository, the result would not be a totally ordered set. Big deal. Also, don't be too precise when requiring the minimum version of Git that supported a given feature. The precise commit in git.git at which a given feature was added doesn't mean as much as the release branch in which that commit was merged. =head1 PLUGIN SUPPORT L intentionally has only few methods. The idea is to provide a lightweight wrapper around git, to be used to create interesting tools based on Git. However, people will want to add extra functionality to L, the obvious example being a C method that returns simple objects with useful attributes. Taking the hypothetical C module which source code is listed in the previous reference, the methods it provides would be loaded and used as follows: use Git::Repository qw( Hello ); my $r = Git::Repository->new(); print $r->hello(); print $r->hello_gitdir(); It's possible to load only a selection of methods from the plugin: use Git::Repository [ Hello => 'hello' ]; my $r = Git::Repository->new(); print $r->hello(); # dies: Can't locate object method "hello_gitdir" print $r->hello_gitdir(); If your plugin lives in another namespace than C, just prefix the fully qualified class name with a C<+>. For example: use Git::Repository qw( +MyGit::Hello ); See L about how to create a new plugin. =head1 ACKNOWLEDGEMENTS Thanks to Todd Rinalo, who wanted to add more methods to L, which made me look for a solution that would preserve the minimalism of L. The C<::Plugin> interface is what I came up with. =head1 OTHER PERL GIT WRAPPERS (This section was written in June 2010. The other Git wrappers have probably evolved since that time.) A number of Perl git wrappers already exist. Why create a new one? I have a lot of ideas of nice things to do with Git as a tool to manipulate blobs, trees, and tags, that may or may not represent revision history of a project. A lot of those commands can output huge amounts of data, which I need to be able to process in chunks. Some of these commands also expect to receive input. What follows is a short list of "missing features" that I was looking for when I looked at the existing Git wrappers on CPAN. They are the "rational" reason for writing my own (the real reason being of course "I thought it would be fun, and I enjoyed doing it"). Even though it works well for me and others, L has its own shortcomings: it I a I, anything complex requires you to deal with input/output handles, it provides no high-level interface to generate actual Git commands or process the output of commands (but have a look at the plugins), etc. One the following modules may therefore be better suited for your needs, depending on what you're trying to achieve. =head2 Git.pm Git.pm is not on CPAN. It is usually packaged with Git, and installed with the system Perl libraries. Not being on CPAN makes it harder to install in any Perl. It makes it harder for a CPAN library to depend on it. It doesn't allow calling C or C. The C function especially has problems: L =head2 Git::Class L depends on Moose, which seems an unnecessary dependency for a simple wrapper around Git. The startup penalty could become significant for command-line tools. Although it supports C and C (and has methods to call any Git command), it is mostly aimed at porcelain commands, and provides no way to control bidirectional commands (such as C). =head2 Git::Wrapper L doesn't support streams or bidirectional commands. =head2 Git::Sub (This description was added for completeness in May 2013.) L appeared in 2013, as a set of Git-specific L functions. It provide a nice set of C functions, and has some limitations (due to the way L itself works) which don't impact most Git commands. L doesn't support working with streams. =head1 BUGS Since version 1.17, L delegates the actual command execution to L, which has better support for Win32 since version 1.100. Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Git::Repository You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website http://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-Repository or by email to bug-git-repository@rt.cpan.org. When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Philippe Bruhat (BooK) =head1 COPYRIGHT Copyright 2010-2014 Philippe Bruhat (BooK), all rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 30-test_repository.t100644001750001750 241412266062417 17703 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More; use Test::Git; use File::Temp qw( tempdir ); use File::Spec::Functions; use Cwd qw( cwd abs_path ); use Git::Repository; has_git('1.6.2.rc0'); # git clone supports existing directories since then plan tests => 6; # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; $ENV{GIT_AUTHOR_NAME} = 'Test Author'; $ENV{GIT_AUTHOR_EMAIL} = 'test.author@example.com'; $ENV{GIT_COMMITTER_NAME} = 'Test Committer'; $ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com'; my $home = cwd; my $r = test_repository; # add a file my $file = 'hello.txt'; { open my $fh, '>', catfile( $r->work_tree, $file ) or die "Can't open $file for writing: $!"; print $fh "Hello, world!\n"; } $r->run( add => $file ); $r->run( commit => '-m' => 'hello' ); my $sha1 = $r->run( 'rev-parse' => 'master' ); # make a clone with test_repository my $s; for my $meth (qw( work_tree git_dir )) { $s = test_repository( clone => [ $r->$meth ] ); isnt( $s->git_dir, $r->git_dir, "$meth clone: different git_dir" ); isnt( $s->work_tree, $r->work_tree, "$meth clone: different work_tree" ); is( $s->run( 'rev-parse' => 'master' ), $sha1, "$meth clone points to the same master" ); } release-pod-syntax.t100644001750001750 45012266062417 17707 0ustar00bookbook000000000000Git-Repository-1.310/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); release-pod-coverage.t100644001750001750 76512266062417 20165 0ustar00bookbook000000000000Git-Repository-1.310/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); 26-overloaded_objects.t100644001750001750 156212266062417 20272 0ustar00bookbook000000000000Git-Repository-1.310/t# Test that we work with stringified path objects like Path::Class. use strict; use warnings; use Test::More; use Test::Git; use File::Temp qw(tempdir); use Cwd qw(realpath); has_git('1.6.5'); plan tests => 3; # clean up the environment delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{LC_ALL} = 'C'; # A class with stringification to test with. { package My::Dir; use overload '""' => sub { $_[0]->{path} }, "fallback" => 1; sub new { my $class = shift; my $path = shift; return bless { path => $path }, $class; } } my $repo_dir = My::Dir->new( tempdir( CLEANUP => 1 ) ); note( Git::Repository->run( init => $repo_dir ) ); ok -d "$repo_dir/.git", "git repo initialized"; my $r = eval { Git::Repository->new( work_tree => $repo_dir ); }; isa_ok $r, "Git::Repository"; is $r->work_tree, realpath($repo_dir), $repo_dir; Repository000755001750001750 012266062417 17064 5ustar00bookbook000000000000Git-Repository-1.310/lib/GitPlugin.pm100644001750001750 700712266062417 21024 0ustar00bookbook000000000000Git-Repository-1.310/lib/Git/Repositorypackage Git::Repository::Plugin; { $Git::Repository::Plugin::VERSION = '1.310'; } use strict; use warnings; use 5.006; use Carp; sub install { my ( $class, @keywords ) = @_; no strict 'refs'; # get the list of keywords to install my %keyword = map { $_ => 1 } my @all_keywords = $class->_keywords; @keywords = @all_keywords if !@keywords; @keywords = grep { !( !exists $keyword{$_} and carp "Unknown keyword '$_' in $class" ) } @keywords; carp "No keywords installed from $class" if !@keywords; # install keywords *{"Git::Repository::$_"} = \&{"$class\::$_"} for @keywords; } sub _keywords { my ($class) = @_; no strict 'refs'; carp "Use of \@KEYWORDS by $class is deprecated"; return @{"$class\::KEYWORDS"}; } 1; # ABSTRACT: Base class for Git::Repository plugins __END__ =pod =head1 NAME Git::Repository::Plugin - Base class for Git::Repository plugins =head1 VERSION version 1.310 =head1 SYNOPSIS package Git::Repository::Plugin::Hello; use Git::Repository::Plugin; our @ISA = qw( Git::Repository::Plugin ); sub _keywords { return qw( hello hello_gitdir ) } sub hello { return "Hello, git world!\n"; } sub hello_gitdir { return "Hello, " . $_[0]->git_dir . "!\n"; } 1; =head1 DESCRIPTION L allows one to define new methods for L, that will be imported in the L namespace. The L provides a full example. The documentation of L describes how to load plugins with all the methods they provide, or only a selection of them. =head1 METHODS L provides a single method: =head2 install $plugin->install( @keywords ); Install all keywords provided in the L namespace. If called with an empty list, will install all available keywords. =head1 SUBCLASSING =head2 Adding methods to L When creating a plugin, the new keywords (i.e. methods) that are added by the plugin to L must be returned by a C<_keywords()> method. =head2 Adding attributes to L L is a blessed hash reference. If extra attributes are needed, the recommended name for the hash key (to avoid name clashes between plugins) is C<_plugin_I_I>, where I is the plugin lowercase name, and I is the attribute name. =head1 ACKNOWLEDGEMENTS Thanks to Todd Rinaldo, who wanted to add more methods to L, which made me look for a solution that would preserve the minimalism of L. After a not-so-good design using @ISA (so L would I the extra methods), further discussions with Aristotle Pagaltzis and a quick peek at L's plugin management helped me come up with the current design. Thank you Aristotle and the L team. Further improvements to the plugin system proposed by Aristotle Pagaltzis. =head1 BUGS Please report any bugs or feature requests on the bugtracker website http://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-Repository or by email to bug-git-repository@rt.cpan.org. When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Philippe Bruhat (BooK) =head1 COPYRIGHT Copyright 2010-2014 Philippe Bruhat (BooK), all rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 000-report-versions-tiny.t100644001750001750 543612266062417 20653 0ustar00bookbook000000000000Git-Repository-1.310/tuse strict; use warnings; use Test::More 0.88; # This is a relatively nice way to avoid Test::NoWarnings breaking our # expectations by adding extra tests, without using no_plan. It also helps # avoid any other test module that feels introducing random tests, or even # test plans, is a nice idea. our $success = 0; END { $success && done_testing; } # List our own version used to generate this my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.08\n"; eval { # no excuses! # report our Perl details my $want = '5.006'; $v .= "perl: $] (wanted $want) on $^O from $^X\n\n"; }; defined($@) and diag("$@"); # Now, our module version dependencies: sub pmver { my ($module, $wanted) = @_; $wanted = " (want $wanted)"; my $pmver; eval "require $module;"; if ($@) { if ($@ =~ m/Can't locate .* in \@INC/) { $pmver = 'module not found.'; } else { diag("${module}: $@"); $pmver = 'died during require.'; } } else { my $version; eval { $version = $module->VERSION; }; if ($@) { diag("${module}: $@"); $pmver = 'died during VERSION check.'; } elsif (defined $version) { $pmver = "$version"; } else { $pmver = ''; } } # So, we should be good, right? return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n"); } eval { $v .= pmver('Carp','any version') }; eval { $v .= pmver('Config','any version') }; eval { $v .= pmver('Cwd','any version') }; eval { $v .= pmver('Exporter','any version') }; eval { $v .= pmver('ExtUtils::MakeMaker','6.30') }; eval { $v .= pmver('File::Find','any version') }; eval { $v .= pmver('File::Path','any version') }; eval { $v .= pmver('File::Spec','any version') }; eval { $v .= pmver('File::Spec::Functions','any version') }; eval { $v .= pmver('File::Temp','any version') }; eval { $v .= pmver('IO::Handle','any version') }; eval { $v .= pmver('Scalar::Util','any version') }; eval { $v .= pmver('System::Command','1.103') }; eval { $v .= pmver('Test::Builder','any version') }; eval { $v .= pmver('Test::More','0.88') }; eval { $v .= pmver('constant','any version') }; eval { $v .= pmver('overload','any version') }; eval { $v .= pmver('strict','any version') }; eval { $v .= pmver('version','0.9901') }; eval { $v .= pmver('warnings','any version') }; # All done. $v .= <<'EOT'; Thanks for using my code. I hope it works for you. If not, please try and include this output in the bug report. That will help me reproduce the issue and solve your problem. EOT diag($v); ok(1, "we really didn't test anything, just reporting data"); $success = 1; # Work around another nasty module on CPAN. :/ no warnings 'once'; $Template::Test::NO_FLUSH = 1; exit 0; Command.pm100644001750001750 3261312266062417 21165 0ustar00bookbook000000000000Git-Repository-1.310/lib/Git/Repositorypackage Git::Repository::Command; { $Git::Repository::Command::VERSION = '1.310'; } use strict; use warnings; use 5.006; use Carp; use Cwd qw( cwd ); use IO::Handle; use Scalar::Util qw( blessed ); use File::Spec; use Config; use System::Command; our @ISA = qw( System::Command ); # a few simple accessors for my $attr (qw( pid stdin stdout stderr exit signal core )) { no strict 'refs'; *$attr = sub { return $_[0]{$attr} }; } for my $attr (qw( cmdline )) { no strict 'refs'; *$attr = sub { return @{ $_[0]{$attr} } }; } # CAN I HAS GIT? my %binary; # cache calls to _is_git sub _is_git { my ( $binary, @args ) = @_; my $args = join "\0", @args; # git option might be an arrayref containing an executable with arguments # Best that can be done is to check if the first part is executable # and use the arguments as part of the cache key # compute cache key: # - filename (path): path # - absolute path (abs): empty string # - relative path (rel): dirname my $path = defined $ENV{PATH} && length( $ENV{PATH} ) ? $ENV{PATH} : ''; my ( $type, $key ) = ( File::Spec->splitpath($binary) )[2] eq $binary ? ( 'path', $path ) : File::Spec->file_name_is_absolute($binary) ? ( 'abs', '' ) : ( 'rel', cwd() ); # This relatively complex cache key scheme allows PATH or cwd to change # during the life of a program using Git::Repository, which is likely # to happen. On the other hand, it completely ignores the possibility # that any part of the cached path to a git binary could be a symlink # which target may also change during the life of the program. # check the cache return $binary{$type}{$key}{$binary}{$args} if exists $binary{$type}{$key}{$binary}{$args}; # compute a list of candidate files (look in PATH if needed) my $git; if ( $type eq 'path' ) { my $path_sep = $Config::Config{path_sep} || ';'; my @ext = ( '', $^O eq 'MSWin32' ? ( split /\Q$path_sep\E/, $ENV{PATHEXT} ) : () ); ($git) = grep { -x && !-d } map { my $path = $_; map { File::Spec->catfile( $path, $_ ) } map {"$binary$_"} @ext } split /\Q$path_sep\E/, $path; } else { $git = File::Spec->rel2abs($binary); } # if we can't find any, we're done return $binary{$type}{$key}{$binary} = undef if !( defined $git && -x $git ); # try to run it my $cmd = System::Command->new( $git, @args, '--version' ); my $version = do { local $/ = "\n"; $cmd->stdout->getline; }; $cmd->close; # does it really look like git? return $binary{$type}{$key}{$binary}{$args} = $version =~ /^git version \d/ ? $type eq 'path' ? $binary # leave the shell figure it out itself too : $git : undef; } sub new { my ( $class, @cmd ) = @_; # split the args my (@r, @o); @cmd = # take out the first Git::Repository in $r, and options in @o grep !( blessed $_ && $_->isa('Git::Repository') ? push @r, $_ : 0 ), grep !( ref eq 'HASH' ? push @o, $_ : 0 ), @cmd; # wouldn't know what to do with more than one Git::Repository object croak "Too many Git::Repository objects given: @r" if @r > 1; my $r = shift @r; # keep changes to the environment local local %ENV = %ENV; # a Git::Repository object will give more context if ($r) { # pick up repository options unshift @o, $r->options; # get some useful paths my ( $git_dir, $work_tree ) = ( $r->git_dir, $r->work_tree ); unshift @o, { cwd => $work_tree } if defined $work_tree && length $work_tree; # setup our %ENV delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{GIT_DIR} = $git_dir; $ENV{GIT_WORK_TREE} = $work_tree if defined $work_tree; } # extract and process the 'fatal' option push @o, { fatal => { 128 => 1, # fatal 129 => 1, # usage map s/^-// ? ( $_ => '' ) : ( $_ => 1 ), map /^!0$/ ? ( 1 .. 255 ) : $_, map ref() ? @$_ : $_, grep defined, map $_->{fatal}, @o } }; # get and check the git command my $git_cmd = ( map { exists $_->{git} ? $_->{git} : () } @o )[-1]; # git option might be an arrayref containing an executable with arguments # (e.g. [ qw( /usr/bin/sudo -u nobody git ) ] ) ( $git_cmd, my @args ) = defined $git_cmd ? ref $git_cmd ? @$git_cmd : ($git_cmd) : ('git'); my $git = _is_git($git_cmd, @args); croak sprintf "git binary '%s' not available or broken", join( ' ', $git_cmd, @args ) # show the full command given if !defined $git; # turn us into a dumb terminal delete $ENV{TERM}; # spawn the command and re-bless the object in our class return bless System::Command->new( $git, @args, @cmd, @o ), $class; } sub final_output { my ($self, @cb) = @_; # get output / errput my ( $stdout, $stderr ) = @{$self}{qw(stdout stderr)}; my ( @output, @errput ); { local $/ = "\n"; chomp( @output = <$stdout> ); chomp( @errput = <$stderr> ); } # done with it $self->close; # fatal exit codes set by the 'fatal' option if ( $self->options->{fatal}{ $self->exit } ) { croak join( "\n", @errput ) || 'fatal: unknown git error'; } # something else's wrong if ( @errput && !$self->options->{quiet} ) { carp join "\n", @errput; } # process the output with the optional callbacks for my $cb (@cb) { @output = map $cb->($_), @output; } # return the output return wantarray ? @output : join "\n", @output; } 1; # ABSTRACT: Command objects for running git __END__ =pod =head1 NAME Git::Repository::Command - Command objects for running git =head1 VERSION version 1.310 =head1 SYNOPSIS use Git::Repository::Command; # invoke an external git command, and return an object $cmd = Git::Repository::Command->new(@cmd); # a Git::Repository object can provide more context $cmd = Git::Repository::Command->new( $r, @cmd ); # options can be passed as a hashref $cmd = Git::Repository::Command->new( $r, @cmd, \%option ); # $cmd is basically a hash, with keys / accessors $cmd->stdin(); # filehandle to the process' stdin (write) $cmd->stdout(); # filehandle to the process' stdout (read) $cmd->stderr(); # filehandle to the process' stdout (read) $cmd->pid(); # pid of the child process # done! $cmd->close(); # exit information $cmd->exit(); # exit status $cmd->signal(); # signal $cmd->core(); # core dumped? (boolean) # cut to the chase my ( $pid, $in, $out, $err ) = Git::Repository::Command->spawn(@cmd); =head1 DESCRIPTION L is a class that actually launches a B commands, allowing to interact with it through its C, C and C. This class is a subclass of L, meant to be invoked through L. =head1 METHODS As a subclass of L, L supports the following methods: =head2 new Git::Repository::Command->new( @cmd ); Runs a B command with the parameters in C<@cmd>. If C<@cmd> contains a L object, it is used to provide context to the B command. If C<@cmd> contains one or more hash reference, they are taken as I