SVN-Hooks-1.34000755004231004231 013011116525 13520 5ustar00gustavogustavo000000000000TODO100644004231004231 306313011116525 14273 0ustar00gustavogustavo000000000000SVN-Hooks-1.34* Email UTF-8 The SVN::Look module should obtain all information from the svnlook command in UTF-8 and use it accordingly. In particular, the emails sent by the Mailer plugin should be MIME compatible and specify UTF-8 character encoding. * Use YAML for the configuration files I've mixed feelings about the Perl-script-as-a-configuration-file thing. It gives us power, but the power is in the hands of the repository admins, which can then run scripts in the subversion server. A declarative configuration file would be more secure. Perhaps we can still preserve all the power we need by using YAML [http://www.yaml.org/]. * Reimplement SVN::Look to use the Perl SVN bindings instead of calling svnlook. However, another approach would be to implement an option in svnlook to dump all information in a format like XML so that we wouldn't need to call it several times. * Check the svnchecker project to see if there is some interesting functionality there that is missing here. * Check the hook ideas in http://stackoverflow.com/questions/884608/share-common-useful-svn-pre-commit-hooks. * Implement a plugin for kicking of Jenkins builds. * Implement a scmbug integration plugin. * Implement a clone of http://svn.collab.net/viewvc/svn/trunk/contrib/hook-scripts/case-insensitive.py * I18N the SVN::Hooks messages. * Implement the funcionality of http://svn.collab.net/repos/svn/trunk/contrib/hook-scripts/case-insensitive.py as a plugin. * Increment SVN::Hooks::Notify to send emails in HTML. Changes100644004231004231 3140413011116525 15116 0ustar00gustavogustavo000000000000SVN-Hooks-1.34Revision history for SVN-Hooks. -*- text -*- 1.34 2016-11-10 14:16:13-02:00 America/Sao_Paulo [Fix] - Remove tests for SVN::Hooks::JiraAcceptance that should have been removed on 1.33. 1.33 2016-10-31 13:41:42-02:00 America/Sao_Paulo [Changes] - The SVN::Hooks::CheckJira plugin now uses the JIRA::REST module instead of the JIRA::Client module to talk to JIRA. The JIRA::Client module uses the SOAP API which was deprecated in JIRA 6 and isn't supported anymore by JIRA 7. Note that this may break hooks that use one of the check-* options to the CHECK_JIRA directive, because they now pass a JIRA::REST object to the user functions instead of a JIRA::Client object. - The SVN::Hooks::JiraAcceptance plugin was removed from the distribution because it depended directly on the JIRA::Client module. 1.32 2016-07-19 14:05:37-03:00 America/Sao_Paulo [Changes] - Now hooks can assume they run with their current directory set to the repository's roor directory on the server. Previously they could not assume anything, since Subversion does not specify where the hooks run. 1.31 2015-11-26 23:13:57-02:00 America/Sao_Paulo [Fixes] - Fix bug introduced in version 1.26 that made hooks be invoked as many times as their plugin directives was used. For example, if the CHECK_JIRA directive was used 10 times to configure the CheckJira plugin, the pre-commit function hook was invoked 10 times too! Hooks that just checked conditions were made slower by this bug, but hooks that performed actions (such as sending notifications) would execute them multiple times, with probably bad effects. 1.30 2015-08-29 13:19:57-03:00 America/Sao_Paulo [Fixes] - Make sure tests are performed using the C locale. 1.29 2015-08-24 08:20:10-03:00 America/Sao_Paulo [Fixes] - Andrey Starodubtsev contributed fixes to make tests pass on Windows. - Subversion 1.9.0 seems to have a bug on the pre-lock/pre-unlock hooks that makes the commands lock/unlock succeed even if the hooks fail. This release skips tests using those hooks when using svn 1.9. 1.28 2015-02-18 09:33:41-02:00 America/Sao_Paulo [Internal changes] - Clean up module prerequisite list in dist.ini. - Use Dist::Zilla::Plugin::MetaProvide to insert provides into META.yml. - Replace README with brian d foy's README.pod template. - Update documentation. 1.27 2014-08-09 17:04:45 America/Sao_Paulo [Fixes] - UpdateConfFile: Fix detection of paths outside of the repository's conf directori when specified as a TO argument to the UPDATE_CONF_FILE directive. - CheckJira: Fix default value for CHECK_JIRA_CONFIG 4th argument. 1.26 2014-07-04 10:48:58 America/Sao_Paulo [Changes] - Add directive CHECK_JIRA_DISABLE to SVN::Hooks::CheckJira to disable all CHECK_JIRA directives. - Make hooks execute in the order they are defined. Previously, the execution order was unspecified. (Change kindly contributed by DC. Thanks!) 1.25 2014-04-13 16:50:07 America/Sao_Paulo [Fixes] - UpdateConfFile: the specification of a subdirectory as the destination file wasn't working. 1.24 2014-03-16 23:31:06 America/Sao_Paulo [Fixes] - CheckMimeTypes: disregard symbolic links because they don't need to have the svn:mime-type property set. - UpdateConfFile: create non-existing directories if the 'to' specification contains directories they are created if they don't exist. 1.23 2013-11-22 08:13:25 America/Sao_Paulo [Fixes] - Some tests were failing when run with Subversion 1.8 because of changes in the 'svn propset' command. 1.22 2013-11-19 11:19:06 America/Sao_Paulo [Changes] CheckJira: accept and disregard spaces in the "projects" specification. [Fixes] The META.yml information which is automatically generated from Github had a wrong URL for the module repository. 1.21 2013-06-18 09:36:02 America/Sao_Paulo UpdateConfFile implements a new option 'remove' which, when set, makes the configuration file in the server be removed if the its versioned counterpart is removed from the repository. 1.20 2013-06-12 15:08:11 America/Sao_Paulo In CheckJira, the PROJKEYS in a 'projects' option may now have spaces around the comma separating project keys. Fix UpdateConfFile. It was considering only the fist added/updated file in a commit for updating. Fix CheckStructure numeric else-clause detection. Also, fix its documentation to say that negative values are also treated as true. Only zeroes are considered false. (Thanks to Uwe Satthoff for bringing this to my attention!) 1.19 2012-06-24 15:12:56 America/Sao_Paulo Fix example/check-mergeinfo.pl. 1.18 2012-05-21 13:06:06 America/Sao_Paulo Implement 'exclude' option for CHECK_JIRA directive. 1.17 2012-05-01 18:07:52 America/Sao_Paulo Use Data::Util to make for cleaner code. 1.16 2012-04-21 21:35:48 America/Sao_Paulo Moved from Google Code to GitHub. 1.15 2012-04-19 23:06:42 America/Sao_Paulo Fix and optimize example/check-mergeinfo.pl. 1.14 2012-04-19 22:22:39 America/Sao_Paulo Implement example/check-mergeinfo.pl showing how to garantee that merges are performed only on allowed places. 1.13 2012-03-05 11:49:34 America/Sao_Paulo Fix RT#75547 by making Windows test scripts non-verbose. (Thanks Mike Brimer!) 1.12 2012-02-25 23:34:48 America/Sao_Paulo Convert distribution to Dist::Zilla. 1.11 2011-12-04 Fix UpdateConfFile's shell command invokation. 1.10 2011-11-09 Pass the SVN::Look object as the third argument to the validator, generator, and actuator in UpdateConfFile. 1.09 2011-11-02 Document importance of defining the PATH properly and set it properly in the hooks used during testing. (This was a problem in FreeBSD systems.) Repository moved to git (http://code.google.com/p/svn-hooks/source). 1.08 2011-09-26 Deprecate SVN::Hooks::Mailer. Its directives now produce errors. 1.07 2011-08-27 Requiring at least svnlook version 1.4.0. 1.06 2011-08-21 Checking in Makefile.PL if we can exec svnlook. Just specifying the dependency from SVN::Look in it doesn't do. 1.05 2011-08-12 Fixing a bug in the new DENY_FILENAMES_PER_PATH directive. 1.04 2011-08-11 Implementing directive DENY_FILENAMES_PER_PATH in SVN::Hooks::DenyFilenames. 1.03 2011-07-30 SVN::Hooks::CheckJira's check_one and check_all_svnlook checks now get a SVN::Look object to make it possible to grok information about the commit. Tests made a little more robust. 1.02 2011-07-27 Porting Makefile.PL to Windows. Adjusting dependency from SVN::Look version. Supporting absolute file names for SVN::Hooks configuration files. Adding URI::file to the dependencies. 1.01 2011-07-21 Avoiding dependency from File::Slurp in the tests. 1.00 2011-07-20 Ported to Windows with Strawberry Perl and with Active Perl. 0.91 2011-07-07 CHECK_JIRA_CONFIG accepts a fifth argument to match JIRA project keys. Fixes an error on UpdateConfFile. Configuration files should be optional, but they were always required. Now it's fixed. 0.90 2011-05-14 Big refactoring of the code base. Implements hook directives in SVN::Hooks and simplifies the implementation and configuration of plugins. Revises the POD documentation. Deprecates SVN::Hooks::Generic. Preparing for a 1.00 release. 0.33 2011-01-16 Corrects a few gotchas in the test suite. 0.32 2010-12-10 Corrects some long standing errors in the arguments passed to some hooks. Corrects some hard errors in the SVN::Hooks::Generic plugin and enhances its test suite. 0.31 2010-12-09 Implements the SVN::Hooks::Generic plugin to allow for the easy creation of custom hooks. Corrects CheckJira's "projects" verification. 0.30 2010-10-07 Small adjustment in some test cases to accomodate changes in Perl 5.13.5. 0.29 2010-10-06 Extends the syntax of DENY_FILENAME directive to allow customized error messages. 0.28 2010-04-28 Being more careful during tests. 0.27 2010-03-09 Substitutes DENY_EXCEPT_USERS for DENY_EXEMPT_USERS. (My wife asked me to change it.) 0.26 2010-03-08 Implements the DENY_EXEMPT_USERS directive in DenyChanges. 0.25 2010-01-19 Add a 'post_action' pseudo-check to CheckJira so that the plugin can perform an action during the post-commit hook phase. 0.24 2010-01-06 Applies a spelling errors patch by Angel Abad. 0.23 2009-10-24 Add kwalitee tests. (See http://cpants.perl.org/dist/overview/SVN-Hooks) 0.22 2009-09-23 New hook: CheckCapability. 0.21 2009-08-19 The pod tests are skipped by default unless you use perl Makefile.PL --author-tests. 0.20 2009-07-28 Reverting the change in 0.19 and better documenting the CHECK_JIRA behaviour. Updating SVN::Hooks documentation. 0.19 2009-07-28 Corrects a bug in CheckJira. 0.18 2009-07-24 Corrects two bugs. Drops the sub-minor versions. 0.17 2009-04-26 Implements the CheckJira plugin and deprecates JiraAcceptance. Make Makefile.PL know about online tests. 0.16 2009-04-12 Implements the AllowPropChange plugin. Better document the CheckProperty plugin. Accepts relative paths in CHECK_STRUCTURE. 0.15 2009-03-12 Corrects a nasty bug in CheckStructure. Corrects some problems with the test scripts that prevented them to work right in some environments. Implements the function SVN::Hooks::CheckStructure::check_structure. 0.14 2009-02-08 JiraAcceptance: don't replay the user's log in the error message. Removed LICENSE file because it was inconsistent with the licensing information in META.yml. UpdateConfFile: - It accepts an 'actuator' function to be executed in the post-commit hook after a succesful commit. - All functions (validator, generator, and actuator) receive the same two parameters: the file contents and the file relative path in the repository. - The files to be updated can be specified via Regexps and they can be copied to subdirectories of /repo/conf. 0.13 2008-12-03 Moving code to http://code.google.com/p/svn-hooks/. Improving some tests. 0.12 2008-10-09 Updating documentation at lib/SVN/Hooks.pm and lib/SVN/Hooks/CheckProperty.pm. 0.11 2008-10-04 Implemented new plugin SVN::Hooks::Notify which uses SVN::Notify. With this we deprecate the SVN::Hooks::Mailer plugin. Using File::Spec to be a little more portable. Changed license to the license of Perl itself. 0.10 2008-09-27 The Mailer plugin can send GNU-style diffs of the files changed in the commit. 0.09 2008-09-27 Implemented the AllowLogChange plugin to allow changes in past revision logs by specific users. Removed dependency from Switch.pm. Now the tests will check if the svn commands are available and be skipped otherwise. Enabled tests: t/pod.t and t/pod-coverage.t. Added test t/02-allowlogchange.t. Removed test t/boilerplate.t. Private functions got the _ prefix to avoid complaints from pod-coverage.t. 0.08 2008-09-25 Moving SVN::Look out to its own distribution as sugested by Daniel Muey, the owner of its namespace. 0.07 2008-09-23 META.yml gets more complete. Makefile.PL exits if can't find /usr/bin/svnlook. Some typo corrections. 0.06 2008-09-21 All modules are documented now. New files: LICENSE and META.yml. 0.05 2008-09-19 New test t/02-jiraacceptance.t. JiraAcceptance has a new directive: JIRA_LOG_MATCH(Regexp, Help). You can specify a regexp to extract the JIRA keys from a specific part of the log message. You can also pass a help message to be shown to the user if the commit fails. The error messages generated by JIRA_ACCEPTANCE are more helpful. This file was renamed from Changes to ChangeLog to make my life easier. 0.04 2008-08-21 New test t/02-checklog.t. CheckMimeTypes: now accepts an optional error message to show to the user. New plugin CheckLog to check the commit log message with a regexp. 0.03 2008-08-20 New test t/02-mailer.t. Removing deprecated plugin AccessControl.pm. UpdateConfFile now can rotate (a la logrotate) the files it updates. Finished first usable version of the plugin Mailer. JiraAcceptance: dropped the CHECK_ suffix from the directive names. Also implemented the directive JIRA_CONFIG the pass the information needed to connect to the JIRA server. 0.02 2008-08-12 Hooks::UpdateRepoFile was renamed to UpdateConfFile to make it more specific. But it also was enhanced in the configuration options. Hooks::JiraAcceptance was optimized. Hooks.pm now can process a list of configuration files. Removed files t/01-noplugins.pl, t/svn-hook.pl, t/svn-hook.conf. LICENSE100644004231004231 4371313011116525 14636 0ustar00gustavogustavo000000000000SVN-Hooks-1.34This software is copyright (c) 2016 by CPqD . 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) 2016 by CPqD . 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, Fifth Floor, Boston, MA 02110-1301 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) 2016 by CPqD . 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.ini100644004231004231 105113011116525 15242 0ustar00gustavogustavo000000000000SVN-Hooks-1.34; See this to understand: http://dzil.org/tutorial/convert-dist.html name = SVN-Hooks author = Gustavo L. de M. Chaves license = Perl_5 copyright_holder = CPqD [GatherDir] exclude_match = ~$ [@Filter] -bundle = @Basic -remove = GatherDir -remove = Readme [NextRelease] [@Git] [MetaProvides::Package] [AutoPrereqs] [Prereqs / TestRequires] Config = 0 File::Compare = 0 [PodWeaver] [Git::NextVersion] [PkgVersion] [PodSyntaxTests] [PodCoverageTests] [Test::Kwalitee] [GitHub::Update] [GitHub::Meta] META.yml100644004231004231 424713011116525 15061 0ustar00gustavogustavo000000000000SVN-Hooks-1.34--- abstract: 'Framework for implementing Subversion hooks' author: - 'Gustavo L. de M. Chaves ' build_requires: Config: '0' File::Compare: '0' File::Copy: '0' Test::More: '0' URI::file: '0' lib: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.043, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: SVN-Hooks provides: SVN::Hooks: file: lib/SVN/Hooks.pm version: '1.34' SVN::Hooks::AllowLogChange: file: lib/SVN/Hooks/AllowLogChange.pm version: '1.34' SVN::Hooks::AllowPropChange: file: lib/SVN/Hooks/AllowPropChange.pm version: '1.34' SVN::Hooks::CheckCapability: file: lib/SVN/Hooks/CheckCapability.pm version: '1.34' SVN::Hooks::CheckJira: file: lib/SVN/Hooks/CheckJira.pm version: '1.34' SVN::Hooks::CheckLog: file: lib/SVN/Hooks/CheckLog.pm version: '1.34' SVN::Hooks::CheckMimeTypes: file: lib/SVN/Hooks/CheckMimeTypes.pm version: '1.34' SVN::Hooks::CheckProperty: file: lib/SVN/Hooks/CheckProperty.pm version: '1.34' SVN::Hooks::CheckStructure: file: lib/SVN/Hooks/CheckStructure.pm version: '1.34' SVN::Hooks::DenyChanges: file: lib/SVN/Hooks/DenyChanges.pm version: '1.34' SVN::Hooks::DenyFilenames: file: lib/SVN/Hooks/DenyFilenames.pm version: '1.34' SVN::Hooks::Generic: file: lib/SVN/Hooks/Generic.pm version: '1.34' SVN::Hooks::Mailer: file: lib/SVN/Hooks/Mailer.pm version: '1.34' SVN::Hooks::Notify: file: lib/SVN/Hooks/Notify.pm version: '1.34' SVN::Hooks::UpdateConfFile: file: lib/SVN/Hooks/UpdateConfFile.pm version: '1.34' requires: Carp: '0' Cwd: '0' Data::Util: '0' Exporter: '0' File::Basename: '0' File::Path: '0' File::Spec::Functions: '0' File::Temp: '0' JIRA::REST: '0' SVN::Look: '0' SVN::Notify: '0' strict: '0' warnings: '0' resources: bugtracker: https://github.com/gnustavo/SVN-Hooks/issues homepage: http://search.cpan.org/dist/SVN-Hooks/ repository: git://github.com/gnustavo/SVN-Hooks.git version: '1.34' MANIFEST100644004231004231 222413011116525 14732 0ustar00gustavogustavo000000000000SVN-Hooks-1.34# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.043. Changes LICENSE MANIFEST META.yml Makefile.PL README.pod TODO dist.ini examples/README.txt examples/check-filesize-limit.pl examples/check-java-style.pl examples/check-mergeinfo.pl examples/check-perl-critic.pl examples/check-valid-utf8.pl lib/SVN/Hooks.pm lib/SVN/Hooks/AllowLogChange.pm lib/SVN/Hooks/AllowPropChange.pm lib/SVN/Hooks/CheckCapability.pm lib/SVN/Hooks/CheckJira.pm lib/SVN/Hooks/CheckLog.pm lib/SVN/Hooks/CheckMimeTypes.pm lib/SVN/Hooks/CheckProperty.pm lib/SVN/Hooks/CheckStructure.pm lib/SVN/Hooks/DenyChanges.pm lib/SVN/Hooks/DenyFilenames.pm lib/SVN/Hooks/Generic.pm lib/SVN/Hooks/Mailer.pm lib/SVN/Hooks/Notify.pm lib/SVN/Hooks/UpdateConfFile.pm t/00-load.t t/01-direct.t t/02-allowlogchange.t t/02-allowpropchange.t t/02-checkcapability.t t/02-checkjira.t t/02-checklog.t t/02-checkmimetypes.t t/02-checkproperty.t t/02-checkstructure.t t/02-checkstructurealone.t t/02-denychanges.t t/02-denyfilenames.t t/02-generic.t t/02-mailer.t t/02-notify.t t/02-updateconffile.t t/author-pod-coverage.t t/author-pod-syntax.t t/release-kwalitee.t t/test-functions.pl tidyall.ini README.pod100644004231004231 542213011116525 15245 0ustar00gustavogustavo000000000000SVN-Hooks-1.34=pod =encoding utf8 =head1 The SVN::Hooks module L are programs you install in SVN repositories in order to augment SVN's functionality. The SVN::Hooks module is a framework to make it easier to implement SVN hooks. =head2 Documentation To read about L, look at the embedded documentation in the module itself. Inside the distribution, you can format it with L: $ perldoc lib/SVN/Hooks.pm If you have already installed the module, you can specify the module name instead of the file location: $ perldoc SVN::Hooks You can read the documentation and inspect the meta data on one of the CPAN web interfaces, such as L or L: =over 4 =item * L =item * L =back The standard module documentation has example uses in the SYNOPSIS section, but you can also look in the I directory (if it's there), or look at the test files in I. =head2 Installation You can install this module with a CPAN client, which will resolve and install the dependencies: $ cpan SVN::Hooks $ cpanm SVN::Hooks SVN::Hooks is packaged with L, so that you can't install it directly from the repository. =head2 Source location The meta data, such as the source repository and bug tracker, is in I or the I files it creates. You can find that on those CPAN web interfaces, but you can also look at files directly in the source repository: =over 4 =item * L =back If you find a problem, file a ticket in the L: =over 4 =item * L =back =head2 Getting help Although I'm happy to hear from module users in private email, that's the best way for me to forget to do something. Besides the issue trackers, you can find help at L or L, both of which have many competent Perlers who can answer your question, almost in real time. They might not know the particulars of this module, but they can help you diagnose your problem. You might like to read L. =head2 Copyright and License You should have received a I file, but the license is also noted in the module files. About the only thing you can't do is pretend that you wrote code that you didn't. =head2 Good luck! Enjoy, Gustavo Chaves, gnustavo@cpan.org =cut tidyall.ini100644004231004231 26313011116525 15725 0ustar00gustavogustavo000000000000SVN-Hooks-1.34[PerlCritic] select = lib/**/*.pm [PodChecker] select = lib/**/*.pm, TODO.pod [PodSpell] select = lib/**/*.pm, TODO.pod ispell_argv = -p .ispell_english -d american suggest = 1 t000755004231004231 013011116525 13704 5ustar00gustavogustavo000000000000SVN-Hooks-1.3400-load.t100755004231004231 141113011116525 15365 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 1; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::AllowLogChange; use SVN::Hooks::AllowPropChange; use SVN::Hooks::CheckJira; use SVN::Hooks::CheckLog; use SVN::Hooks::CheckMimeTypes; use SVN::Hooks::CheckProperty; use SVN::Hooks::CheckStructure; use SVN::Hooks::DenyChanges; use SVN::Hooks::DenyFilenames; use SVN::Hooks::Generic; use SVN::Hooks::Mailer; use SVN::Hooks::Notify; use SVN::Hooks::UpdateConfFile; EOS my $file = catfile($t, 'wc', 'file'); work_ok('commit' => <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -q -mx $file EOS Makefile.PL100644004231004231 327413011116525 15561 0ustar00gustavogustavo000000000000SVN-Hooks-1.34# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.043. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Framework for implementing Subversion hooks", "AUTHOR" => "Gustavo L. de M. Chaves ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "SVN-Hooks", "LICENSE" => "perl", "NAME" => "SVN::Hooks", "PREREQ_PM" => { "Carp" => 0, "Cwd" => 0, "Data::Util" => 0, "Exporter" => 0, "File::Basename" => 0, "File::Path" => 0, "File::Spec::Functions" => 0, "File::Temp" => 0, "JIRA::REST" => 0, "SVN::Look" => 0, "SVN::Notify" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Config" => 0, "File::Compare" => 0, "File::Copy" => 0, "Test::More" => 0, "URI::file" => 0, "lib" => 0 }, "VERSION" => "1.34", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Config" => 0, "Cwd" => 0, "Data::Util" => 0, "Exporter" => 0, "File::Basename" => 0, "File::Compare" => 0, "File::Copy" => 0, "File::Path" => 0, "File::Spec::Functions" => 0, "File::Temp" => 0, "JIRA::REST" => 0, "SVN::Look" => 0, "SVN::Notify" => 0, "Test::More" => 0, "URI::file" => 0, "lib" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 02-mailer.t100755004231004231 340313011116525 15724 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; my $io_available = 1; if (not can_svn()) { plan skip_all => 'Cannot find or use svn commands.'; } else { plan tests => 10; } my $t = reset_repo(); my $wc = catdir($t, 'wc'); set_hook(<<'EOS'); use SVN::Hooks::Mailer; EOS sub work { my $file = catfile($wc, $_[0]); <<"EOS"; echo txt >$file svn add -q --no-auto-props $file svn ci -mmessage $wc EOS } set_conf(<<'EOS'); EMAIL_CONFIG(); EOS work_nok('config sans args', 'DEPRECATED', work('f')); set_conf(<<'EOS'); EMAIL_CONFIG(WHAT => 1); EOS work_nok('config invalid', 'DEPRECATED', work('f')); set_conf(<<'EOS'); EMAIL_COMMIT(1); EOS work_nok('commit odd args', 'DEPRECATED', work('f')); set_conf(<<'EOS'); EMAIL_COMMIT(what => 1); EOS work_nok('commit invalid opt', 'DEPRECATED', work('f')); set_conf(<<'EOS'); EMAIL_COMMIT(match => 1); EOS work_nok('commit invalid match', "DEPRECATED", work('f')); set_conf(<<'EOS'); EMAIL_COMMIT(match => qr/./); EOS work_nok('commit missing from', "DEPRECATED", work('f')); set_conf(<<'EOS'); EMAIL_COMMIT(match => qr/./, from => 's@a.b'); EOS work_nok('commit missing to', "DEPRECATED", work('f')); exit 0 unless $io_available; my $log = '02-mailer.log'; set_conf(<<'EOS'); EMAIL_CONFIG(IO => '02-mailer.log'); EMAIL_COMMIT( match => qr/^a/, tag => 'A', from => 'from@example.net', to => 'to@example.net', diff => undef, ); EMAIL_COMMIT( match => qr/^b/, tag => 'B', from => 'from@example.net', to => 'to@example.net', diff => ['--no-diff-deleted'], ); EOS work_nok('commit none', 'DEPRECATED', work('none')); work_nok('commit A', 'DEPRECATED', work('a')); work_nok('commit B', 'DEPRECATED', work('b')); 01-direct.t100755004231004231 171113011116525 15724 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 2; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); START_COMMIT { my ($repos_path, $username, $capabilities) = @_; length $username or die "Empty username not allowed to commit.\n"; }; PRE_COMMIT { my ($svnlook) = @_; foreach my $added ($svnlook->added()) { warn "= $added\n"; $added !~ /\.(exe|o|jar|zip)$/ or die "Please, don't commit binary files such as '$added'.\n"; } }; EOS my $txtfile = catfile($t, 'wc', 'file.txt'); work_ok('setup', <<"EOS"); echo txt >$txtfile svn add -q --no-auto-props $txtfile svn ci -mx $txtfile EOS my $zipfile = catfile($t, 'wc', 'file.zip'); work_nok('binary' => 'Please, don\'t commit binary files', <<"EOS"); echo txt >$zipfile svn add -q --no-auto-props $zipfile svn ci -mx $zipfile EOS 02-notify.t100755004231004231 125013011116525 15761 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (not can_svn()) { plan skip_all => 'Cannot find or use svn commands.'; } elsif (! eval {require SVN::Notify}) { plan skip_all => 'Need SVN::Notify.'; } else { plan tests => 1; } my $t = reset_repo(); my $wc = catdir($t, 'wc'); set_hook(<<'EOS'); use SVN::Hooks::Notify; EOS sub work { my $file = catfile($wc, $_[0]); <<"EOS"; echo txt >$file svn add -q --no-auto-props $file svn ci -mmessage $wc EOS } set_conf(<<'EOS'); NOTIFY_DEFAULTS(); NOTIFY(to_email_map => {'dontmatch' => 'none@nowhere.com'}); EOS work_ok('load and config', work('f')); 02-generic.t100755004231004231 610613011116525 16072 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 13; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::Generic; EOS set_conf(<<'EOS'); GENERIC(1); EOS my $wc = catdir($t, 'wc'); my $file = catfile($wc, 'file.txt'); work_nok('odd' => 'odd number of arguments', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC('non_hook' => sub {}); EOS work_nok('non hook' => 'invalid hook name', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC('start-commit' => 'non ref'); EOS work_nok('non ref' => 'should be mapped to a CODE-ref or to an ARRAY-ref', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC('start-commit' => {}); EOS work_nok('non array' => 'should be mapped to a CODE-ref or to an ARRAY-ref', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC('start-commit' => ['non code']); EOS work_nok('non code' => 'should be mapped to CODE-refs', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC('start-commit' => sub { die "died from within"; }); EOS work_nok('died from within' => 'died from within', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC('start-commit' => sub { return 1; }); EOS work_ok('ok', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC( 'start-commit' => sub { die join(',',@_), "\n"; }, ); EOS my $repo = catdir($t, 'repo'); work_nok('cry start-commit' => "$repo,", <<"EOS"); echo asdf >>$file svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC( 'pre-commit' => sub { die join(',',@_), "\n"; }, ); EOS work_nok('cry pre-commit' => 'SVN::Look=HASH', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); GENERIC( 'pre-revprop-change' => sub { die join(',',@_), "\n"; }, ); EOS work_nok('cry pre-revprop-change' => 'SVN::Look=HASH', <<"EOS"); svn ps svn:log --revprop -r 1 'changed' $t/wc EOS SKIP: { skip 'SVN 1.9.x has a bug on the pre-lock/pre-unlock hooks', 2 if svn_version() =~ /^1\.9\./; set_conf(<<'EOS'); GENERIC( 'pre-lock' => sub { die join(',',@_), "\n"; }, ); EOS work_nok('cry pre-lock' => qr:\Q$repo\E,/?file.txt,:, <<"EOS"); svn lock -mx $file EOS set_conf(<<'EOS'); GENERIC( 'pre-unlock' => sub { die join(',',@_), "\n"; }, ); EOS work_nok('cry pre-unlock' => qr:\Q$repo\E,/?file.txt,:, <<"EOS"); svn lock $file svn unlock $file EOS } set_conf(<<"EOS"); sub truncate { open FILE, '>', '$file' or die 'Cannot open $file: \$!'; close FILE; } sub mark { my (\$mark) = \@_; return sub { open FILE, '>>', '$file' or die \"Cannot open $file: \$!\"; print FILE \$mark; close FILE; }; } GENERIC('pre-commit' => \\&truncate); GENERIC('pre-commit' => mark(1)); GENERIC('pre-commit' => mark(2)); GENERIC('pre-commit' => mark(3)); GENERIC('pre-commit' => mark(4)); EOS do_script(newdir(), <<"EOS"); svn ci -mx $file EOS open FILE, '<', $file or die "Cannot open $file: $!"; my $marks = ; close FILE; ok($marks eq '1234', 'hook order'); 02-checklog.t100755004231004231 176013011116525 16236 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 5; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::CheckLog; EOS set_conf(<<'EOS'); CHECK_LOG(); EOS my $file = catfile($t, 'wc', 'file.txt'); work_nok('miss regexp' => 'first argument must be a qr', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_LOG(qr/./, []); EOS work_nok('invalid second arg' => 'second argument must be', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_LOG(qr/without error/); CHECK_LOG(qr/with error/, 'Error Message'); EOS work_nok('dont match without error' => 'log message must match', <<"EOS"); svn ci -mx $file EOS work_nok('dont match with error', 'Error Message', <<"EOS"); svn ci -m"without error" $file EOS work_ok('match all', <<"EOS"); svn ci -m"without error with error" $file EOS SVN000755004231004231 013011116525 14655 5ustar00gustavogustavo000000000000SVN-Hooks-1.34/libHooks.pm100644004231004231 4663313011116525 16472 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVNpackage SVN::Hooks; # ABSTRACT: Framework for implementing Subversion hooks $SVN::Hooks::VERSION = '1.34'; use strict; use warnings; use File::Basename; use File::Spec::Functions; use Data::Util qw(:check); use SVN::Look; use Exporter qw/import/; our @EXPORT = qw/run_hook POST_COMMIT POST_LOCK POST_REVPROP_CHANGE POST_UNLOCK PRE_COMMIT PRE_LOCK PRE_REVPROP_CHANGE PRE_UNLOCK START_COMMIT/; our @Conf_Files = (catfile('conf', 'svn-hooks.conf')); our $Repo = undef; our %Hooks = (); sub run_hook { my ($hook_name, $repo_path, @args) = @_; $hook_name = basename $hook_name; -d $repo_path or die "not a directory ($repo_path): $_\n"; $Repo = $repo_path; # Allow all hooks assume they execute on the repository's root directory chdir $repo_path or die "cannot chdir to $repo_path: $!\n"; # Reload all configuration files foreach my $conf (@Conf_Files) { my $conffile = file_name_is_absolute($conf) ? $conf : catfile($Repo, $conf); next unless -e $conffile; # Configuration files are optional # The configuration file must be evaluated in the main:: namespace package main; $main::VERSION = '1.34'; unless (my $return = do $conffile) { die "couldn't parse '$conffile': $@\n" if $@; die "couldn't do '$conffile': $!\n" unless defined $return; die "couldn't run '$conffile'\n" unless $return; } } # Substitute a SVN::Look object for the first argument # in the hooks where this makes sense. if ($hook_name eq 'pre-commit') { # The next arg is a transaction number $repo_path = SVN::Look->new($repo_path, '-t' => $args[0]); } elsif ($hook_name =~ /^(?:post-commit|(?:pre|post)-revprop-change)$/) { # The next arg is a revision number $repo_path = SVN::Look->new($repo_path, '-r' => $args[0]); } foreach my $hook (@{$Hooks{$hook_name}{list}}) { if (is_code_ref($hook)) { $hook->($repo_path, @args); } elsif (is_array_ref($hook)) { foreach my $h (@$hook) { $h->($repo_path, @args); } } else { die "SVN::Hooks: internal error!\n"; } } return; } ## no critic (Subroutines::ProhibitSubroutinePrototypes) # post-commit(SVN::Look, revision, txn-name) sub POST_COMMIT (&) { my ($hook) = @_; unless (exists $Hooks{'post-commit'}{set}{$hook}) { push @{$Hooks{'post-commit'}{list}}, ($Hooks{'post-commit'}{set}{$hook} = sub { $hook->(@_); }); } return; } # post-lock(repos-path, username) sub POST_LOCK (&) { my ($hook) = @_; unless (exists $Hooks{'post-lock'}{set}{$hook}) { push @{$Hooks{'post-lock'}{list}}, ($Hooks{'post-lock'}{set}{$hook} = sub { $hook->(@_); }); } return; } # post-revprop-change(SVN::Look, revision, username, property-name, action) sub POST_REVPROP_CHANGE (&) { my ($hook) = @_; unless (exists $Hooks{'post-revprop-change'}{set}{$hook}) { push @{$Hooks{'post-revprop-change'}{list}}, ($Hooks{'post-revprop-change'}{set}{$hook} = sub { $hook->(@_); }); } return; } # post-unlock(repos-path, username) sub POST_UNLOCK (&) { my ($hook) = @_; unless (exists $Hooks{'post-unlock'}{set}{$hook}) { push @{$Hooks{'post-unlock'}{list}}, ($Hooks{'post-unlock'}{set}{$hook} = sub { $hook->(@_); }); } return; } # pre-commit(SVN::Look, txn-name) sub PRE_COMMIT (&) { my ($hook) = @_; unless (exists $Hooks{'pre-commit'}{set}{$hook}) { push @{$Hooks{'pre-commit'}{list}}, ($Hooks{'pre-commit'}{set}{$hook} = sub { $hook->(@_); }); } return; } # pre-lock(repos-path, path, username, comment, steal-lock-flag) sub PRE_LOCK (&) { my ($hook) = @_; unless (exists $Hooks{'pre-lock'}{set}{$hook}) { push @{$Hooks{'pre-lock'}{list}}, ($Hooks{'pre-lock'}{set}{$hook} = sub { $hook->(@_); }); } return; } # pre-revprop-change(SVN::Look, revision, username, property-name, action) sub PRE_REVPROP_CHANGE (&) { my ($hook) = @_; unless (exists $Hooks{'pre-revprop-change'}{set}{$hook}) { push @{$Hooks{'pre-revprop-change'}{list}}, ($Hooks{'pre-revprop-change'}{set}{$hook} = sub { $hook->(@_); }); } return; } # pre-unlock(repos-path, path, username, lock-token, break-unlock-flag) sub PRE_UNLOCK (&) { my ($hook) = @_; unless (exists $Hooks{'pre-unlock'}{set}{$hook}) { push @{$Hooks{'pre-unlock'}{list}}, ($Hooks{'pre-unlock'}{set}{$hook} = sub { $hook->(@_); }); } return; } # < 1.8: start-commit(repos-path, username, capabilities) # >= 1.8: start-commit(repos-path, username, capabilities, txn-name) # Subversion 1.8 added a txn-name argument to the start-commit. However it's # only good to get at the commit properties but not to know about the files # being changed by the commit, which would allow us to use the start-commit # to perform many of the checks that we perform currently in the pre-commit # hook. So, for now I'm not going to use the new argument to construct a # SVN::Look object, since it is mostly useless anyway. sub START_COMMIT (&) { my ($hook) = @_; unless (exists $Hooks{'start-commit'}{set}{$hook}) { push @{$Hooks{'start-commit'}{list}}, ($Hooks{'start-commit'}{set}{$hook} = sub { $hook->(@_); }); } return; } ## use critic 1; # End of SVN::Hooks __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks - Framework for implementing Subversion hooks =head1 VERSION version 1.34 =head1 SYNOPSIS A single script can implement several hooks: #!/usr/bin/perl use SVN::Hooks; START_COMMIT { my ($repo_path, $username, $capabilities, $txn_name) = @_; # ... }; PRE_COMMIT { my ($svnlook) = @_; # ... }; run_hook($0, @ARGV); Or you can use already implemented hooks via plugins: #!/usr/bin/perl use SVN::Hooks; use SVN::Hooks::DenyFilenames; use SVN::Hooks::DenyChanges; use SVN::Hooks::CheckProperty; ... run_hook($0, @ARGV); =for Pod::Coverage run_hook POST_COMMIT POST_LOCK POST_REVPROP_CHANGE POST_UNLOCK PRE_COMMIT PRE_LOCK PRE_REVPROP_CHANGE PRE_UNLOCK START_COMMIT =head1 INTRODUCTION In order to really understand what this is all about you need to understand Subversion L and its hooks. You can read everything about this in the svnbook, a.k.a. Version Control with Subversion, at L. Subversion is a version control system, and as such it is used to keep historical revisions of files and directories. Each revision maintains information about all the changes introduced since the previous one: date, author, log message, files changed, files renamed, etc. Subversion uses a client/server model. The server maintains the B, which is the database containing all the historical information we talked about above. Users use a Subversion client tool to query and change the repository but also to maintain one or more B. A working area is a directory in the user machine containing a copy of a particular revision of the repository. The user can use the client tool to make all sorts of changes in his working area and to "commit" them all in an atomic operation that bumps the repository to a new revision. A hook is a specifically named program that is called by the Subversion server during the execution of some operations. There are exactly nine hooks which must reside under the C directory in the repository. When you create a new repository, you get nine template files in this directory, all of them having the C<.tmpl> suffix and helpful instructions inside explaining how to convert them into working hooks. When Subversion is performing a commit operation on behalf of a client, for example, it calls the C hook, then the C hook, and then the C hook. The first two can gather all sorts of information about the specific commit transaction being performed and decide to reject it in case it doesn't comply to specified policies. The C can be used to log or alert interested parties about the commit just done. IMPORTANT NOTE from the svnbook: "For security reasons, the Subversion repository executes hook programs with an empty environment---that is, no environment variables are set at all, not even $PATH (or %PATH%, under Windows). Because of this, many administrators are baffled when their hook program runs fine by hand, but doesn't work when run by Subversion. Be sure to explicitly set any necessary environment variables in your hook program and/or use absolute paths to programs." Not even the current directory where the hooks run is specified by Subversion. However, the hooks executed by the SVN::Hooks framework run with their currect directory set to the repository's root directory in the server. This can be useful sometimes. There are several useful hook scripts available elsewhere L, mainly for those three associated with the commit operation. However, when you try to combine the functionality of two or more of those scripts in a single hook you normally end up facing two problems. =over =item B In order to integrate the funcionality of more than one script you have to write a driver script that's called by Subversion and calls all the other scripts in order, passing to them the arguments they need. Moreover, some of those scripts may have configuration files to read and you may have to maintain several of them. =item B This arrangement is inefficient in two ways. First because each script runs as a separate process, which usually have a high startup cost because they are, well, scripts and not binaries. And second, because as each script is called in turn they have no memory of the scripts called before and have to gather the information about the transaction again and again, normally by calling the C command, which spawns yet another process. =back SVN::Hooks is a framework for implementing Subversion hooks that tries to solve these problems. Instead of having separate scripts implementing different functionality you have a single script implementing all the funcionality you need either directly or using some of the existing plugins, which are implemented by Perl modules in the SVN::Hooks:: namespace. This single script can be used to implement all nine standard hooks, because each hook knows when to perform based on the context in which the script was called. =head1 USAGE In the Subversion server, go to the C directory under the directory where the repository was created. You should see there the nine hook templates. Create a script there using the SVN::Hooks module. $ cd /path/to/repo/hooks $ cat >svn-hooks.pl < passing to it the name with which it wass called (C<$0>) and all the arguments it received (C<@ARGV>). =head2 Implementing Hooks Implement hooks using one of the nine hook I below. Each one of them get a single block (anonymous function) as argument. The block will be called by C with proper arguments, as indicated below. These arguments are the ones gotten from @ARGV, with the exception of the ones identified by C. These are SVN::Look objects which can be used to grok detailed information about the repository and the current transaction. (Please, refer to the L documentation to know how to use it.) =over =item * POST_COMMIT(SVN::Look) =item * POST_LOCK(repos-path, username) =item * POST_REVPROP_CHANGE(SVN::Look, username, property-name, action) =item * POST_UNLOCK(repos-path, username) =item * PRE_COMMIT(SVN::Look) =item * PRE_LOCK(repos-path, path, username, comment, steal-lock-flag) =item * PRE_REVPROP_CHANGE(SVN::Look, username, property-name, action) =item * PRE_UNLOCK(repos-path, path, username, lock-token, break-unlock-flag) =item * START_COMMIT(repos-path, username, capabilities, txn-name) =back This is an example of a script implementing two hooks: #!/usr/bin/perl use SVN::Hooks; # ... START_COMMIT { my ($repos_path, $username, $capabilities, $txn_name) = @_; exists $committers{$username} or die "User '$username' is not allowed to commit.\n"; $capabilities =~ /mergeinfo/ or die "Your Subversion client does not support mergeinfo capability.\n"; }; PRE_COMMIT { my ($svnlook) = @_; foreach my $added ($svnlook->added()) { $added !~ /\.(exe|o|jar|zip)$/ or die "Please, don't commit binary files such as '$added'.\n"; } }; run_hook($0, @ARGV); Note that the hook directives resemble function definitions but they're not. They are function calls, and as such must end with a semi-colon. Most of the C and C hooks are used to check some condition. If the condition holds, they must simply end without returning anything. Otherwise, they must C with a suitable error message. Also note that each hook directive can be called more than once if you need to implement more than one specific hook. The hooks will run in the order they were defined. =head2 Using Plugins There are several hooks already implemented as plugin modules under the namespace C, which you can use. The main ones are described succinctly below. Please, see their own documentation for more details. =over =item SVN::Hooks::AllowPropChange Allow only specified users make changes in revision properties. =item SVN::Hooks::CheckCapability Check if the Subversion client implements the required capabilities. =item SVN::Hooks::CheckJira Integrate Subversion with the JIRA L ticketing system. =item SVN::Hooks::CheckLog Check if the log message in a commit conforms to a Regexp. =item SVN::Hooks::CheckMimeTypes Check if the files added to the repository have the C property set. Moreover, for text files, check if the properties C and C are also set. =item SVN::Hooks::CheckProperty Check for specific properties for specific kinds of files. =item SVN::Hooks::CheckStructure Check if the files and directories being added to the repository conform to a specific structure. =item SVN::Hooks::DenyChanges Deny the addition, modification, or deletion of specific files and directories in the repository. Usually used to deny modifications in the C directory. =item SVN::Hooks::DenyFilenames Deny the addition of files which file names doesn't comply with a Regexp. Usually used to disallow some characteres in the filenames. =item SVN::Hooks::Notify Sends notification emails after successful commits. =item SVN::Hooks::UpdateConfFile Allows you to maintain Subversion configuration files versioned in the same repository where they are used. Usually used to maintain the configuration file for the hooks and the repository access control file. =back This is an example of a script using some plugins: #!/usr/bin/perl use SVN::Hooks; use SVN::Hooks::CheckProperty; use SVN::Hooks::DenyChanges; use SVN::Hooks::DenyFilenames; # Accept only letters, digits, underlines, periods, and hifens DENY_FILENAMES(qr/[^-\/\.\w]/i); # Disallow modifications in the tags directory DENY_UPDATE(qr:^tags:); # OpenOffice.org documents need locks CHECK_PROPERTY(qr/\.(?:od[bcfgimpst]|ot[ghpst])$/i => 'svn:needs-lock'); run_hook($0, @ARGV); Those directives are implemented and exported by the hooks. Note that using hooks you don't need to be explicit about which one of the nine hooks will be triggered by the directives. This is on purpose, because some plugins can trigger more than one hook. The plugin documentation should tell you which hooks can be triggered so that you know which symbolic links you need to create in the F repository directory. =head2 Configuration file Before calling the hooks, the function C evaluates a file called F under the F directory in the repository, if it exists. Hence, you can choose to put all the directives in this file and not in the script under the F directory. The advantage of this is that you can then manage the configuration file with the C and have it versioned under the same repository that it controls. One way to do this is to use this hook script: #!/usr/bin/perl use SVN::Hooks; use SVN::Hooks::UpdateConfFile; use ... UPDATE_CONF_FILE( 'conf/svn-hooks.conf' => 'svn-hooks.conf', validator => [qw(/usr/bin/perl -c)], rotate => 2, ); run_hook($0, @ARGV); Use this hook script and create a directory called F at the root of the repository (besides the common F, F, and F directories). Add the F file under the F directory. Then, whenever you commit a new version of the file, the pre-commit hook will validate it sintactically (C) and copy its new version to the F file in the repository. (Read the L documentation to understand it in details.) Being a Perl script, it's possible to get fancy with the configuration file, using variables, functions, and whatever. But for most purposes it consists just in a series of configuration directives. Don't forget to end it with the C<1;> statement, though, because it's evaluated with a C statement and needs to end with a true expression. Please, see the plugins documentation to know about the directives. =head1 PLUGIN DEVELOPER TUTORIAL Yet to do. =head1 EXPORT =head2 run_hook This is responsible to invoke the right plugins depending on the context in which it was called. Its first argument must be the name of the hook that was called. Usually you just pass C<$0> to it, since it knows to extract the basename of the parameter. Its second argument must be the path to the directory where the repository was created. The remaining arguments depend on the hook for which it's being called, like this: =over =item * start-commit repo-path user capabilities txn-name =item * pre-commit repo-path txn =item * post-commit repo-path rev =item * pre-lock repo-path path user =item * post-lock repo-path user =item * pre-unlock repo-path path user =item * post-unlock repo-path user =item * pre-revprop-change repo-path rev user propname action =item * post-revprop-change repo-path rev user propname action =back But as these are exactly the arguments Subversion passes when it calls the hooks, you usually call C like this: run_hook($0, @ARGV); =head1 REPOSITORY L =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 02-checkjira.t100755004231004231 703313011116525 16401 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (not can_svn()) { plan skip_all => 'Cannot find or use svn commands.'; } elsif (not eval {require JIRA::REST}) { plan skip_all => 'Need JIRA::REST'; } else { plan tests => 16; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::CheckJira; EOS my $wc = catfile($t, 'wc'); my $file = catfile($wc, 'file'); work_ok('prepare', <<"EOS"); echo line >$file svn add -q --no-auto-props $file svn ci -m"prepare" --force-log $wc EOS sub work { my ($msg) = @_; <<"EOS"; echo line >>$file svn ci -m"$msg" --force-log $wc EOS } set_conf(<<'EOS'); CHECK_JIRA_CONFIG(); EOS work_nok('config sans args', 'CHECK_JIRA_CONFIG: requires three, four, or five arguments', work('')); set_conf(<<'EOS'); CHECK_JIRA_CONFIG('http://jira.atlassian.com/', 'user', 'pass', 'asdf'); EOS work_nok('invalid fourth arg', 'CHECK_JIRA_CONFIG: fourth argument must be a Regexp', work('')); set_conf(<<'EOS'); CHECK_JIRA(); EOS work_nok('accept invalid first arg', 'CHECK_JIRA: first arg must be a qr/Regexp/ or the string \'default\'.', work('')); set_conf(<<'EOS'); CHECK_JIRA(default => 'invalid'); EOS work_nok('accept invalid second arg', 'CHECK_JIRA: second argument must be a HASH-ref.', work('')); set_conf(<<'EOS'); CHECK_JIRA(default => {invalid => 1}); EOS work_nok('invalid option', 'CHECK_JIRA: unknown option \'invalid\'.', work('')); set_conf(<<'EOS'); CHECK_JIRA(default => {projects => 1}); EOS work_nok('invalid projects arg', 'CHECK_JIRA: projects\'s value must be a string matching', work('')); set_conf(<<'EOS'); CHECK_JIRA(default => {require => undef}); EOS work_nok('undefined arg', 'CHECK_JIRA: undefined require\'s value', work('')); set_conf(<<'EOS'); CHECK_JIRA(default => {check_one => 1}); EOS work_nok('invalid code arg', 'CHECK_JIRA: check_one\'s value must be a CODE-ref', work('')); set_conf(<<'EOS'); CHECK_JIRA(qr/./ => {}); EOS work_nok('not configured', 'CHECK_JIRA: plugin not configured. Please, use the CHECK_JIRA_CONFIG directive', work('')); set_conf(<<'EOS'); CHECK_JIRA_DISABLE; CHECK_JIRA(qr/./); EOS work_ok('disabled', work('no issue')); ################################################ # From now on the checks need a JIRA connection. SKIP: { skip 'online checks are disabled', 5 unless -e 't/online.enabled'; set_conf(<<'EOS'); CHECK_JIRA_CONFIG('http://no.way.to.get.there', 'user', 'pass'); CHECK_JIRA(qr/./); EOS work_nok('no server', 'Bad hostname', work('[TST-1] no server')); my $config = <<'EOS'; CHECK_JIRA_CONFIG('https://jira.atlassian.com/', 'gustavo+jiraclient@gnustavo.com', 'W3PvT&9q0d^HLG0n', qr/^\[([^\]]+)\]/); EOS set_conf($config . <<'EOS'); CHECK_JIRA(qr/asdf/); EOS work_ok('no need to accept', work('ok')); set_conf($config . <<'EOS'); sub fix_for { my ($version) = @_; return sub { my ($jira, $issue, $svnlook) = @_; die "CHECK_JIRA: missing SVN::Look object" unless ref $svnlook eq 'SVN::Look'; foreach my $fv (@{$issue->{fields}{fixVersion}}) { return if $version eq $fv->{name}; } die "CHECK_JIRA: issue $issue->{key} not scheduled for version $version.\n"; } } CHECK_JIRA(qr/./, {check_one => fix_for('A version')}); EOS work_nok('no keys', 'CHECK_JIRA: you must cite at least one JIRA issue key in the commit message', work('no keys')); work_nok('not valid', 'CHECK_JIRA: issue ZYX-1 is not valid:', work('[ZYX-1]')); work_nok('check_one', 'CHECK_JIRA: issue TST-55263 not scheduled for version future-version.', work('[TST-55263]')); } 02-denychanges.t100755004231004231 325213011116525 16745 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 10; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); my $wc = catdir($t, 'wc'); my $file = catfile($wc, 'file'); set_hook(<<'EOS'); use SVN::Hooks::DenyChanges; EOS set_conf(<<'EOS'); DENY_ADDITION('string'); EOS work_nok('conf: no regex', 'DENY_CHANGES: all arguments must be qr/Regexp/', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); DENY_ADDITION(qr/add/, qr/ADD/); DENY_DELETION(qr/del/); DENY_UPDATE (qr/upd/); EOS my $add = catfile($wc, 'add'); my $ADD = catfile($wc, 'ADD'); my $del = catfile($wc, 'del'); my $upd = catfile($wc, 'upd'); work_nok('deny add', 'Cannot add:', <<"EOS"); echo txt >$add svn add -q --no-auto-props $add svn ci -mx $add EOS work_nok('deny second arg', 'Cannot add:', <<"EOS"); echo txt >$ADD svn add -q --no-auto-props $ADD svn ci -mx $ADD EOS work_ok('add del upd', <<"EOS"); echo txt >$del echo txt >$upd svn add -q --no-auto-props $del $upd svn ci -mx $del $upd EOS work_nok('deny del', 'Cannot delete:', <<"EOS"); svn rm -q $del svn ci -mx $del EOS work_nok('deny upd', 'Cannot update:', <<"EOS"); echo adsf >$upd svn ci -mx $upd EOS work_ok('update f', <<"EOS"); echo adsf >$file svn ci -mx $file EOS work_ok('del f', <<"EOS"); svn del -q $file svn ci -mx $file EOS # Grok the author name ok(my $author = get_author($t), 'grok author'); set_conf(<<"EOS"); DENY_ADDITION(qr/add/); DENY_EXCEPT_USERS('$author'); EOS work_ok('except user', <<"EOS"); echo txt >$add svn add -q --no-auto-props $add svn ci -mx $add EOS test-functions.pl100755004231004231 1236613011116525 17421 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/tuse strict; use warnings; use Cwd; use File::Temp qw/tempdir/; use File::Spec::Functions; use File::Path; use File::Copy; use URI::file; use Config; # Make sure the svn messages come in English. # https://www.gnu.org/software/gettext/manual/html_node/Locale-Environment-Variables.html $ENV{LC_ALL} = 'C'; delete $ENV{LANGUAGE}; sub can_svn { CMD: for my $cmd (qw/svn svnadmin svnlook/) { eval { open my $pipe, '-|', "$cmd --version" or die; local $/ = undef; # slurp mode <$pipe>; close $pipe or die; }; return 0 if $@; } return 1; } sub svn_version { open my $pipe, '-|', "svn --version" or die; my $version = <$pipe>; local $/ = undef; # slurp mode to read everything else up <$pipe>; close $pipe or die; if ($version =~ /version ([\d\.]+)/) { return $1; } else { die "Couldn't grok version from 'svn --version' command output: '$version'"; } } our $T; sub newdir { my $num = 1 + Test::Builder->new()->current_test(); my $dir = catdir($T, $num); mkdir $dir; $dir; } sub do_script { my ($dir, $cmd) = @_; my $script = catfile($dir, 'script.bat'); my $stdout = catfile($dir, 'stdout'); my $stderr = catfile($dir, 'stderr'); { open my $fd, '>', $script or die; print $fd $cmd; close $fd; chmod 0755, $script; } copy(catfile($T, 'repo', 'hooks', 'svn-hooks.pl') => catfile($dir, 'svn-hooks.pl')); copy(catfile($T, 'repo', 'conf', 'svn-hooks.conf') => catfile($dir, 'svn-hooks.conf')); system("$script 1>$stdout 2>$stderr"); } sub read_file { my ($file) = @_; open my $fd, '<', $file or die "Can't open '$file': $!\n"; local $/ = undef; # slurp mode return <$fd>; } sub work_ok { my ($tag, $cmd) = @_; my $dir = newdir(); ok((do_script($dir, $cmd) == 0), $tag) or diag("work_ok command failed with following stderr:\n", scalar(read_file(catfile($dir, 'stderr')))); } sub work_nok { my ($tag, $error_expect, $cmd) = @_; my $dir = newdir(); my $exit = do_script($dir, $cmd); if ($exit == 0) { fail($tag); diag("work_nok command worked but it shouldn't!\n"); return; } my $stderr = scalar(read_file(catfile($dir, 'stderr'))); if (! ref $error_expect) { ok(index($stderr, $error_expect) >= 0, $tag) or diag("work_nok:\n '$stderr'\n does not contain\n '$error_expect'\n"); } elsif (ref $error_expect eq 'Regexp') { like($stderr, $error_expect, $tag); } else { fail($tag); diag("work_nok: invalid second argument to test.\n"); } } my $pathsep = $^O eq 'MSWin32' ? ';' : ':'; my $bliblib = catdir('blib', 'lib'); sub set_hook { my ($text) = @_; my $hookdir = catdir($T, 'repo', 'hooks'); my $hookscript = catfile($hookdir, 'svn-hooks.pl'); open my $fd, '>', $hookscript or die "Can't create $hookscript: $!"; my $debug = exists $ENV{DBG} ? '-d' : ''; print $fd <<"EOS"; #!$Config{perlpath} $debug use strict; use warnings; EOS # Subversion hooks are invoked with an empty PATH. This means that # if the user doesn't define it explicitly, bare commands will be # invoked with execvp, which usually works as if the PATH was # ":/bin:/usr/bin". During the tests we try to set up the hooks so # that they will use the PATH as it is in the test environment. if (defined $ENV{PATH} and length $ENV{PATH}) { my $path = $ENV{PATH}; $path =~ s/\\$//; print $fd "BEGIN { \$ENV{PATH} = '$path' }\n"; } if (defined $ENV{PERL5LIB} and length $ENV{PERL5LIB}) { foreach my $path (reverse split "$pathsep", $ENV{PERL5LIB}) { print $fd "use lib '$path';\n"; } } print $fd <<"EOS"; use lib '$bliblib'; use SVN::Hooks; EOS print $fd $text, "\n\n"; if ($^O eq 'MSWin32') { print $fd 'my $hook = shift; run_hook($hook, @ARGV);'; } else { print $fd 'run_hook($0, @ARGV);'; } print $fd "\n"; close $fd; chmod 0755 => $hookscript; foreach my $hook (qw/post-commit post-lock post-refprop-change post-unlock pre-commit pre-lock pre-revprop-change pre-unlock start-commit/) { my $hookfile = catfile($hookdir, $hook); if ($^O eq 'MSWin32') { $hookfile .= '.cmd'; open my $fd, '>', $hookfile or die "Can't create $hookfile: $!"; print $fd "\@echo off\n"; print $fd "$^X $hookscript $hook %1 %2 %3 %4 %5\n"; close $fd; chmod 0755 => $hookfile; } else { symlink $hookscript => $hookfile; } } } sub set_conf { my ($text) = @_; my $hooksconf = catfile($T, 'repo', 'conf', 'svn-hooks.conf'); open my $fd, '>', $hooksconf or die "Can't create $hooksconf: $!"; print $fd $text, "\n1;\n"; close $fd; } sub get_author { my ($t) = @_; my $repo = catfile($t, 'repo'); open my $cmd, '-|', "svnlook info $repo" or die "Can't exec svn info\n"; chomp(my $author = <$cmd>); local $/ = undef; <$cmd>; close $cmd; return $author; } sub reset_repo { my $cleanup = exists $ENV{REPO_CLEANUP} ? $ENV{REPO_CLEANUP} : 1; $T = tempdir('t.XXXX', DIR => getcwd(), CLEANUP => $cleanup); my $repo = catfile($T, 'repo'); my $wc = catfile($T, 'wc'); system("svnadmin create $repo"); set_hook(''); set_conf(''); my $repouri = URI::file->new($repo); system("svn co -q $repouri $wc"); return $T; } 1; examples000755004231004231 013011116525 15257 5ustar00gustavogustavo000000000000SVN-Hooks-1.34README.txt100644004231004231 22313011116525 17072 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/examplesThe files in this directory contain snippets that may be useful. You can just copy them to your svn-hooks.conf file and adapt them to your needs. 02-checkproperty.t100755004231004231 755213011116525 17346 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 20; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::CheckProperty; EOS set_conf(<<'EOS'); CHECK_PROPERTY(); EOS my $file = catfile($t, 'wc', 'file'); work_nok('conf: no first arg', 'CHECK_PROPERTY: first argument must be a STRING or a qr/Regexp/', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_PROPERTY(bless({}, 'Nothing')); EOS work_nok('conf: wrong first arg', 'CHECK_PROPERTY: first argument must be a STRING or a qr/Regexp/', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_PROPERTY('string'); EOS work_nok('conf: no second arg', 'CHECK_PROPERTY: second argument must be a STRING', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_PROPERTY('s', qr/asdf/); EOS work_nok('conf: wrong second arg', 'CHECK_PROPERTY: second argument must be a STRING', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_PROPERTY('s', 's', bless({}, 'Nothing')); EOS work_nok('conf: wrong third arg', 'CHECK_PROPERTY: third argument must be undefined, or a NUMBER, or a STRING, or a qr/Regexp/', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_PROPERTY('file1', 'prop'); CHECK_PROPERTY('file2', 'prop', 0); CHECK_PROPERTY('file3', 'prop', 1); CHECK_PROPERTY('file4', 'prop', 'value'); CHECK_PROPERTY('file5', 'prop', qr/^value$/); CHECK_PROPERTY(qr/file6/, 'prop'); EOS work_nok('check(string, string, undef) fail', 'property prop must be set for: file1', <<"EOS"); echo txt >${file}1 svn add -q --no-auto-props ${file}1 svn ci -mx ${file}1 EOS work_ok('check(string, string, undef) succeed', <<"EOS"); svn ps prop x ${file}1 svn ci -mx ${file}1 EOS work_nok('check(string, string, false) fail', 'property prop must not be set for: file2', <<"EOS"); echo txt >${file}2 svn add -q --no-auto-props ${file}2 svn ps prop x ${file}2 svn ci -mx ${file}2 EOS work_ok('check(string, string, false) succeed', <<"EOS"); svn pd prop ${file}2 svn ci -mx ${file}2 EOS work_nok('check(string, string, true) fail', 'property prop must be set for: file3', <<"EOS"); echo txt >${file}3 svn add -q --no-auto-props ${file}3 svn ci -mx ${file}3 EOS work_ok('check(string, string, true) succeed', <<"EOS"); svn ps prop x ${file}3 svn ci -mx ${file}3 EOS work_nok('check(string, string, string) fail because not set', 'property prop must be set to "value" for: file4', <<"EOS"); echo txt >${file}4 svn add -q --no-auto-props ${file}4 svn ci -mx ${file}4 EOS work_nok('check(string, string, string) fail because of wrong value', 'property prop must be set to "value" and not to "x" for: file4', <<"EOS"); svn ps prop x ${file}4 svn ci -mx ${file}4 EOS work_ok('check(string, string, string) succeed', <<"EOS"); svn ps prop value ${file}4 svn ci -mx ${file}4 EOS work_nok('check(string, string, regex) fail because not set', qr/property prop must be set and match "\(\?(?:-xism|\^):\^value\$\)" for: file5/, <<"EOS"); echo txt >${file}5 svn add -q --no-auto-props ${file}5 svn ci -mx ${file}5 EOS work_nok('check(string, string, regex) fail because of wrong value', qr/property prop must match "\(\?(?:-xism|\^):\^value\$\)" but is "x" for: file5/, <<"EOS"); svn ps prop x ${file}5 svn ci -mx ${file}5 EOS work_ok('check(string, string, regex) succeed', <<"EOS"); svn ps prop value ${file}5 svn ci -mx ${file}5 EOS work_nok('check(regex, string, undef) fail', 'property prop must be set for: file6', <<"EOS"); echo txt >${file}6 svn add -q --no-auto-props ${file}6 svn ci -mx ${file}6 EOS work_ok('check(regex, string, undef) succeed', <<"EOS"); svn ps prop x ${file}6 svn ci -mx ${file}6 EOS work_ok('succeed because dont match file name', <<"EOS"); echo txt >${file}NOMATCH svn add -q --no-auto-props ${file}NOMATCH svn ci -mx ${file}NOMATCH EOS 02-denyfilenames.t100755004231004231 620113011116525 17275 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 14; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); my $wc = catdir($t, 'wc'); my $file = catfile($wc, 'file'); set_hook(<<'EOS'); use SVN::Hooks::DenyFilenames; EOS set_conf(<<'EOS'); DENY_FILENAMES('string'); EOS work_nok('cant parse config', 'DENY_FILENAMES: got "string" while expecting a qr/Regex/ or a', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); DENY_FILENAMES(qr/[^a-z0-9]/i, qr/substring/, [qr/custommessage/ => 'custom message']); EOS work_ok('valid', <<"EOS"); svn ci -mx $file EOS work_nok('invalid', 'DENY_FILENAMES: filename not allowed: file', <<"EOS"); echo txt >${file}_ svn add -q --no-auto-props ${file}_ svn ci -mx ${file}_ EOS my $withsubstringinthemiddle = catfile($wc, 'withsubstringinthemiddle'); work_nok('second invalid', 'DENY_FILENAMES: filename not allowed: withsubstringinthemiddle', <<"EOS"); echo txt >$withsubstringinthemiddle svn add -q --no-auto-props $withsubstringinthemiddle svn ci -mx $withsubstringinthemiddle EOS my $withcustommessage = catfile($wc, 'withcustommessage'); work_nok('custom message', 'DENY_FILENAMES: custom message: withcustommessage', <<"EOS"); echo txt >$withcustommessage svn add -q --no-auto-props $withcustommessage svn ci -mx $withcustommessage EOS # PER PATH set_conf(<<'EOS'); DENY_FILENAMES_PER_PATH('string'); EOS work_nok('odd config', 'DENY_FILENAMES_PER_PATH: got odd number of arguments', <<"EOS"); svn revert -q ${file}_ $withsubstringinthemiddle $withcustommessage echo newtxt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); DENY_FILENAMES_PER_PATH('bogus' => qr/check/); EOS work_nok('no regex', 'DENY_FILENAMES_PER_PATH: rule prefix isn\'t a Regexp.', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); DENY_FILENAMES([qr/c/ => 'no c']); DENY_FILENAMES_PER_PATH(qr:^A: => qr/a/, qr:^B: => [qr/b/ => 'no b']); EOS my $adir = catdir($wc, 'A'); my $bdir = catdir($wc, 'B'); my $cdir = catdir($wc, 'C'); work_ok('valid', <<"EOS"); svn mkdir $adir $bdir $cdir svn ci -mx -q $wc svn ci -mx $file EOS my $afile = catfile($adir, 'a'); work_nok('invalid a', 'filename not allowed', <<"EOS"); echo txt >$afile svn add -q --no-auto-props $afile svn ci -mx $afile EOS my $avalid = catfile($adir, 'vld'); work_ok('valid a', <<"EOS"); svn revert $afile echo txt >$avalid svn add -q --no-auto-props $avalid svn ci -mx $avalid EOS my $bfile = catfile($bdir, 'b'); work_nok('invalid b', ': no b:', <<"EOS"); echo txt >$bfile svn add -q --no-auto-props $bfile svn ci -mx $bfile EOS my $bvalid = catfile($bdir, 'vld'); work_ok('valid b', <<"EOS"); svn revert $bfile echo txt >$bvalid svn add -q --no-auto-props $bvalid svn ci -mx $bvalid EOS my $cfile = catfile($cdir, 'c'); work_nok('invalid c', ': no c:', <<"EOS"); echo txt >$cfile svn add -q --no-auto-props $cfile svn ci -mx $cfile EOS my $cvalid = catfile($cdir, 'vld'); work_ok('valid c', <<"EOS"); svn revert $cfile echo txt >$cvalid svn add -q --no-auto-props $cvalid svn ci -mx $cvalid EOS release-kwalitee.t100644004231004231 53313011116525 17435 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # this test was generated with Dist::Zilla::Plugin::Test::Kwalitee 2.12 use strict; use warnings; use Test::More 0.88; use Test::Kwalitee 1.21 'kwalitee_ok'; kwalitee_ok(); done_testing; 02-updateconffile.t100755004231004231 1276113011116525 17472 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 18; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); my $wc = catdir($t, 'wc'); my $file = catfile($wc, 'file'); set_hook(<<'EOS'); use SVN::Hooks::UpdateConfFile; EOS set_conf(<<'EOS'); UPDATE_CONF_FILE(); EOS work_nok('require first arg', 'UPDATE_CONF_FILE: invalid first argument.', <<"EOS"); echo asdf>$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); UPDATE_CONF_FILE('first'); EOS work_nok('require second arg', 'UPDATE_CONF_FILE: invalid second argument.', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); UPDATE_CONF_FILE('first', qr/regexp/); EOS work_nok('invalid second arg', 'UPDATE_CONF_FILE: invalid second argument', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); UPDATE_CONF_FILE('first', 'second', 'third'); EOS work_nok('odd number of args', 'UPDATE_CONF_FILE: odd number of arguments.', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); UPDATE_CONF_FILE('first', 'second', validator => 'string'); EOS work_nok('not code-ref', 'UPDATE_CONF_FILE: validator argument must be a CODE-ref or an ARRAY-ref', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); UPDATE_CONF_FILE('first', 'second', foo => 'string'); EOS work_nok('invalid option', 'UPDATE_CONF_FILE: invalid option names:', <<"EOS"); svn ci -mx $file EOS set_conf(<<'EOS'); UPDATE_CONF_FILE(file => 'file'); sub validate { my ($text, $file, $svnlook) = @_; die "undefined second argument" unless defined $file; die "undefined third argument" unless defined $svnlook; if ($text =~ /abort/) { die "Aborting!" } else { return 1; } } UPDATE_CONF_FILE(validate => 'validate', validator => \&validate); sub generate { my ($text, $file, $svnlook) = @_; die "undefined second argument" unless defined $file; die "undefined third argument" unless defined $svnlook; return "[$file, $text]\n"; } UPDATE_CONF_FILE(generate => 'generate', generator => \&generate); EOS my $conf = catdir($t, 'repo', 'conf'); my $cfile = catfile($conf, 'file'); # Implement a script to compare two files. In Unix we would use 'cmp' # but in Windows I couldn't use 'comp' because it's interactive. my $cmp = catfile($t, 'cmp.pl'); { open my $fh, '>', $cmp or die "Can't open '$cmp' for writing: $!\n"; print $fh <<'EOS'; use File::Compare; exit compare(@ARGV); EOS } my $perl = $^X; work_ok('update without validation', <<"EOS"); svn ci -mx $file $perl $cmp $file $cfile EOS my $validate = catfile($wc, 'validate'); my $cvalidate = catfile($conf, 'validate'); work_ok('update valid', <<"EOS"); echo asdf>$validate svn add -q --no-auto-props $validate svn ci -mx $validate $perl $cmp $validate $cvalidate EOS work_nok('update aborting', 'UPDATE_CONF_FILE: Validator aborted for:', <<"EOS"); echo abort >$validate svn ci -mx $validate EOS my $generate = catfile($wc, 'generate'); my $cgenerate = catfile($conf, 'generate'); my $generated = catfile($wc, 'generated'); { open my $fh, '>', $generated or die "Can't create $generated: $!\n"; print $fh <<'EOS'; [generate, asdf ] EOS } work_ok('generate', <<"EOS"); echo asdf>$generate svn add -q --no-auto-props $generate svn ci -mx $generate $perl $cmp $generated $cgenerate EOS my $config = <<'EOS'; UPDATE_CONF_FILE(subfile => 'subdir/'); UPDATE_CONF_FILE(outfile => '../outdir/'); UPDATE_CONF_FILE(qr/^file(\d)$/ => '$1-file'); sub actuate { my ($text, $file, $svnlook) = @_; die "undefined second argument" unless defined $file; die "undefined third argument" unless defined $svnlook; open F, '>', 'TTT/repo/conf/really-actuated' or die $!; print F $text; close F; } UPDATE_CONF_FILE(actuate => 'actuate', actuator => \&actuate); EOS $config =~ s/TTT/$t/; set_conf($config); my $subdir = catdir($conf, 'subdir'); my $subfile = catfile($wc, 'subfile'); my $csubfile = catfile($subdir, 'subfile'); work_ok('to subdir', <<"EOS"); echo asdf>$subfile svn add -q --no-auto-props $subfile svn ci -mx $subfile $perl $cmp $subfile $csubfile EOS my $outfile = catfile($wc, 'outfile'); my $coutfile = catfile($t, 'repo', 'outdir', 'outfile'); work_nok('to outdir', '', <<"EOS"); echo asdf>$outfile svn add -q --no-auto-props $outfile svn ci -mx $outfile $perl $cmp $outfile $coutfile EOS my $cfile1 = catfile($conf, '1-file'); work_ok('regexp', <<"EOS"); echo asdf>${file}1 svn add -q --no-auto-props ${file}1 svn ci -mx ${file}1 $perl $cmp ${file}1 $cfile1 EOS my $actuate = catfile($wc, 'actuate'); my $cactuate = catfile($conf, 'really-actuated'); work_ok('actuate', <<"EOS"); echo asdf>$actuate svn add -q --no-auto-props $actuate svn ci -mx $actuate $perl $cmp $actuate $cactuate EOS set_conf(<<'EOS'); UPDATE_CONF_FILE( unremoveable => 'unremoveable', ); UPDATE_CONF_FILE( removeable => 'removeable', remove => 1, ); EOS my $unremoveable = catfile($wc, 'unremoveable'); my $cunremoveable = catfile($conf, 'unremoveable'); my $removeable = catfile($wc, 'removeable'); my $cremoveable = catfile($conf, 'removeable'); work_ok('setup delete test', <<"EOS"); echo asdf>$unremoveable echo asdf>$removeable svn add -q --no-auto-props $unremoveable $removeable svn ci -mx $unremoveable $removeable EOS work_ok('delete files in commit', <<"EOS"); svn delete -q $unremoveable $removeable svn ci -mx $wc EOS ok(! -f $cremoveable, 'remove conf'); ok(-f $cunremoveable, 'do not remove conf by default'); 02-checkstructure.t100755004231004231 536013011116525 17515 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 13; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); my $wc = catdir($t, 'wc'); my $file = catfile($wc, '_'); set_hook(<<'EOS'); use SVN::Hooks::CheckStructure; EOS set_conf(<<'EOS'); CHECK_STRUCTURE( [ _invalid_rhs => 'invalid rhs', _deny => 0, _allow => 1, _file => 'FILE', _dir => 'DIR', sub1 => [ sub2 => [ sub3 => [ ], ], ], qr/regex/ => [ _just => 1, 0 => 'custom error message', ], 1 => 'DIR', ], ); EOS work_nok('invalid_rhs', 'syntax error: unknown string spec (invalid rhs)', <<"EOS"); echo txt >${file}invalid_rhs svn add -q --no-auto-props ${file}invalid_rhs svn ci -mx ${file}invalid_rhs EOS work_nok('deny 0', 'invalid path', <<"EOS"); echo txt >${file}deny svn add -q --no-auto-props ${file}deny svn ci -mx ${file}deny EOS work_ok('allow 1', <<"EOS"); echo txt >${file}allow svn add -q --no-auto-props ${file}allow svn ci -mx ${file}allow EOS work_nok('is not file', 'the component (_file) should be a FILE in', <<"EOS"); mkdir ${file}file svn add -q --no-auto-props ${file}file svn ci -mx ${file}file EOS work_ok('is file', <<"EOS"); svn rm -q --force ${file}file echo txt >${file}file svn add -q --no-auto-props ${file}file svn ci -mx ${file}file EOS work_nok('is not dir', 'the component (_dir) should be a DIR in', <<"EOS"); echo txt >${file}dir svn add -q --no-auto-props ${file}dir svn ci -mx ${file}dir EOS work_ok('is dir', <<"EOS"); svn rm -q --force ${file}dir mkdir ${file}dir svn add -q --no-auto-props ${file}dir svn ci -mx ${file}dir EOS my $sub1 = catdir($wc, 'sub1'); my $sub2 = catdir($sub1, 'sub2'); my $sub3 = catdir($sub2, 'sub3'); work_ok('allow sub', <<"EOS"); mkdir $sub1 $sub2 $sub3 svn add -q --no-auto-props $sub1 svn ci -mx $sub1 EOS my $deny = catfile($sub2, '_deny'); work_nok('deny sub', 'the component (_deny) is not allowed in', <<"EOS"); echo txt >$deny svn add -q --no-auto-props $deny svn ci -mx $deny EOS my $preregexsuf = catdir($wc, 'preregexsuf'); my $just = catfile($preregexsuf, '_just'); work_ok('regex allow', <<"EOS"); mkdir $preregexsuf echo txt >$just svn add -q --no-auto-props $preregexsuf svn ci -mx $preregexsuf EOS my $no = catfile($preregexsuf, 'no'); work_nok('0 error', 'custom error message', <<"EOS"); echo txt >$no svn add -q --no-auto-props $no svn ci -mx $no EOS work_nok('deny else', 'the component (_else) should be a DIR in', <<"EOS"); echo txt >${file}else svn add -q --no-auto-props ${file}else svn ci -mx ${file}else EOS work_ok('deny else', <<"EOS"); svn rm -q --force ${file}else mkdir ${file}else svn add -q --no-auto-props ${file}else svn ci -mx ${file}else EOS 02-allowlogchange.t100755004231004231 341313011116525 17442 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 9; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); my $repo = URI::file->new(catdir($t, 'repo')); set_hook(<<'EOS'); use SVN::Hooks::AllowLogChange; EOS my $wc = catdir($t, 'wc'); my $file = catfile($wc, 'file'); work_ok('setup', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); ALLOW_LOG_CHANGE({}); EOS work_nok('invalid argument' => 'ALLOW_LOG_CHANGE: invalid argument', <<"EOS"); svn ps svn:log --revprop -r 1 message $repo EOS set_conf(<<"EOS"); ALLOW_LOG_CHANGE(); EOS work_nok('nothing but svn:log' => 'ALLOW_LOG_CHANGE: the revision property svn:xpto cannot be changed.', <<"EOS"); svn ps svn:xpto --force --revprop -r 1 value $repo EOS work_nok('cannot delete' => 'ALLOW_LOG_CHANGE: a revision log can only be modified, not added or deleted.', <<"EOS"); svn pd svn:log --revprop -r 1 $repo EOS # Grok the author name ok(my $author = get_author($t), 'grok author'); set_conf(<<"EOS"); ALLOW_LOG_CHANGE('x$author'); EOS work_nok('deny user' => 'ALLOW_LOG_CHANGE: you are not allowed to change a revision log.', <<"EOS"); svn ps svn:log --revprop -r 1 value $repo EOS set_conf(<<"EOS"); ALLOW_LOG_CHANGE('$author'); EOS work_ok('can modify', <<"EOS"); svn ps svn:log --revprop -r 1 value $repo EOS set_conf(<<"EOS"); ALLOW_LOG_CHANGE(qr/./); EOS work_ok('can modify with regexp', <<"EOS"); svn ps svn:log --revprop -r 1 value2 $repo EOS set_conf(<<'EOS'); ALLOW_LOG_CHANGE(qr/^,/); EOS work_nok('deny user with regexp' => 'ALLOW_LOG_CHANGE: you are not allowed to change a revision log.', <<"EOS"); svn ps svn:log --revprop -r 1 value3 $repo EOS 02-checkmimetypes.t100755004231004231 222613011116525 17467 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 5; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::CheckMimeTypes; EOS set_conf(<<'EOS'); CHECK_MIMETYPES(); EOS my $file = catfile($t, 'wc', 'file.txt'); work_nok('miss svn:mime-type' => 'property svn:mime-type is not set for', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS work_nok('miss svn:eol-style on text file', 'property svn:eol-style is not set for', <<"EOS"); svn ps svn:mime-type "text/plain" $file svn ci -mx $file EOS work_nok('miss svn:keywords on text file', 'property svn:keywords is not set for', <<"EOS"); svn ps svn:eol-style native $file svn ci -mx $file EOS work_ok('all set on text file' => <<"EOS"); svn ps svn:keywords Id $file svn ci -q -mx $file EOS my $binary = catfile($t, 'wc', 'binary.exe'); work_ok('set only svn:mime-type on non-text file', <<"EOS"); echo bin >$binary svn add -q --no-auto-props $binary svn ps svn:mime-type "application/octet-stream" $binary svn ci -mx $binary EOS author-pod-syntax.t100644004231004231 50313011116525 17615 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 02-allowpropchange.t100755004231004231 347213011116525 17646 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 9; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); my $repo = URI::file->new(catdir($t, 'repo')); set_hook(<<'EOS'); use SVN::Hooks::AllowPropChange; EOS my $file = catfile($t, 'wc', 'file'); work_ok('setup', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); ALLOW_PROP_CHANGE({}); EOS work_nok('invalid argument' => 'ALLOW_PROP_CHANGE: invalid argument', <<"EOS"); svn ps svn:log --revprop -r 1 message $repo EOS set_conf(<<"EOS"); ALLOW_PROP_CHANGE(qr/./); EOS work_nok('unknowk property' => 'ALLOW_PROP_CHANGE: the revision property svn:xpto cannot be changed.', <<"EOS"); svn ps svn:xpto --force --revprop -r 1 value $repo EOS work_nok('cannot delete' => 'ALLOW_PROP_CHANGE: revision properties can only be modified, not added or deleted.', <<"EOS"); svn pd svn:log --revprop -r 1 $repo EOS # Grok the author name ok(my $author = get_author($t), 'grok author'); set_conf(<<"EOS"); ALLOW_PROP_CHANGE('svn:log' => 'x$author'); EOS work_nok('deny user' => 'ALLOW_PROP_CHANGE: you are not allowed to change property svn:log.', <<"EOS"); svn ps svn:log --revprop -r 1 value $repo EOS set_conf(<<"EOS"); ALLOW_PROP_CHANGE('svn:log' => '$author'); EOS work_ok('can modify', <<"EOS"); svn ps svn:log --revprop -r 1 value $repo EOS set_conf(<<"EOS"); ALLOW_PROP_CHANGE('svn:log' => qr/./); EOS work_ok('can modify with regexp', <<"EOS"); svn ps svn:log --revprop -r 1 value2 $repo EOS set_conf(<<'EOS'); ALLOW_PROP_CHANGE(qr/./ => qr/^,/); EOS work_nok('deny user with regexp' => 'ALLOW_PROP_CHANGE: you are not allowed to change property svn:log.', <<"EOS"); svn ps svn:log --revprop -r 1 value3 $repo EOS 02-checkcapability.t100755004231004231 177313011116525 17602 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use Test::More; require "test-functions.pl"; if (can_svn()) { plan tests => 3; } else { plan skip_all => 'Cannot find or use svn commands.'; } my $t = reset_repo(); set_hook(<<'EOS'); use SVN::Hooks::CheckCapability; EOS set_conf(<<'EOS'); CHECK_CAPABILITY(); EOS my $file = catfile($t, 'wc', 'file'); work_ok('setup', <<"EOS"); echo txt >$file svn add -q --no-auto-props $file svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_CAPABILITY('nonexistent-capability'); EOS work_nok('conf: nonexistent capability', 'CHECK_CAPABILITY: Your subversion client does not support', <<"EOS"); echo asdf >>$file svn ci -mx $file EOS set_conf(<<'EOS'); CHECK_CAPABILITY('mergeinfo'); EOS if (`svn help` =~ /\bmergeinfo\b/) { work_ok('has mergeinfo', <<"EOS"); echo asdf >>$file svn ci -mx $file EOS } else { work_nok('do not has mergeinfo', 'CHECK_CAPABILITY: Your subversion client does not support', <<"EOS"); echo asdf >>$file svn ci -mx $file EOS } Hooks000755004231004231 013011116525 15740 5ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVNMailer.pm100644004231004231 241113011116525 17645 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::Mailer; # ABSTRACT: Send emails after successful commits. $SVN::Hooks::Mailer::VERSION = '1.34'; use strict; use warnings; use Carp; use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'MAILER'; our @EXPORT = qw/EMAIL_CONFIG EMAIL_COMMIT/; sub _deprecated { croak <<"EOS"; DEPRECATED: The SVN::Hooks::Mailer plugin was deprecated in 2008 and became nonoperational in version 1.08. You must edit your hook configuration to remove the directives EMAIL_CONFIG and EMAIL_COMMIT. You may use the new SVN::Hooks::Notify plugin for sending email notifications. EOS } sub EMAIL_CONFIG { _deprecated(); } sub EMAIL_COMMIT { _deprecated(); } 1; # End of SVN::Hooks::Mailer __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::Mailer - Send emails after successful commits. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin is deprecated. You should use SVN::Hooks::Notify instead. =over =item EMAIL_CONFIG =item EMAIL_COMMIT =back =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Notify.pm100644004231004231 456413011116525 17717 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::Notify; # ABSTRACT: Subversion activity notification. $SVN::Hooks::Notify::VERSION = '1.34'; use strict; use warnings; use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'NOTIFY'; our @EXPORT = qw/NOTIFY_DEFAULTS NOTIFY/; my %Defaults; sub NOTIFY_DEFAULTS { %Defaults = @_; return 1; } my %Options; sub NOTIFY { %Options = @_; POST_COMMIT(\&post_commit); return 1; }; sub post_commit { my ($svnlook) = @_; require SVN::Notify; my $notifier = SVN::Notify->new( %Defaults, %Options, repos_path => $svnlook->repo(), revision => $svnlook->rev(), ); $notifier->prepare; $notifier->execute; return; } 1; # End of SVN::Hooks::Notify __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::Notify - Subversion activity notification. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin sends notification emails for Subversion repository activity. It is actually a simple wrapper around the SVN::Notify module. It's active in the C hook. It's configured by the following directives. =head2 NOTIFY_DEFAULTS(%HASH) This directive allows you to specify default arguments for the SVN::Notify constructor. NOTIFY_DEFAULTS( user_domain => 'cpqd.com.br', sendmail => '/usr/sbin/sendmail', language => 'pt_BR', ); NOTIFY_DEFAULTS(smtp => 'smtp.cpqd.com.br'); Please, see the SVN::Notify documentation to know about all the available options. =head2 NOTIFY(%HASH) This directive merges the options received with the defaults obtained from NOTIFY_DEFAULTS and passes the result to the SVN::Notify constructor. Note that neither the C nor the C options need to be specified. They are grokked automatically. NOTIFY( to => 'commit-list@example.com', with_diff => 1, ); NOTIFY( to_email_map => { '^trunk/produtos|^branches' => 'commit-list@example.com', '^conf' => 'admin@example.com', }, subject_prefix => '[REPO] ', attach_diff => 1, ); =for Pod::Coverage post_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut author-pod-coverage.t100644004231004231 56513011116525 20072 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Generic.pm100644004231004231 720213011116525 20013 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::Generic; # ABSTRACT: Implement generic checks for all Subversion hooks. $SVN::Hooks::Generic::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'GENERIC'; our @EXPORT = ($HOOK); sub GENERIC { my (@args) = @_; (@args % 2) == 0 or croak "$HOOK: odd number of arguments.\n"; my %args = @args; while (my ($hook, $functions) = each %args) { $hook =~ /(?:(?:pre|post)-(?:commit|lock|revprop-change|unlock)|start-commit)/ or die "$HOOK: invalid hook name ($hook)"; if (is_code_ref($functions)) { $functions = [$functions]; } elsif (! is_array_ref($functions)) { die "$HOOK: hook '$hook' should be mapped to a CODE-ref or to an ARRAY-ref.\n"; } foreach my $foo (@$functions) { is_code_ref($foo) or die "$HOOK: hook '$hook' should be mapped to CODE-refs.\n"; unless (exists $SVN::Hooks::Hooks{$hook}{set}{$foo}) { push @{$SVN::Hooks::Hooks{$hook}{list}}, ($SVN::Hooks::Hooks{$hook}{set}{$foo} = sub { $foo->(@_); }); } } } return 1; } 1; # End of SVN::Hooks::Generic __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::Generic - Implement generic checks for all Subversion hooks. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin allows you to easily write generic checks for all Subversion standard hooks. It's deprecated. You should use the SVN::Hooks hook defining exported directives instead. This module is configured by the following directive. =head2 GENERIC(HOOK => FUNCTION, HOOK => [FUNCTIONS], ...) This directive associates FUNCTION with a specific HOOK. You can make more than one association with a single directive call, or you can use multiple calls to make multiple associations. Moreover, you can associate a hook with a single function or with a list of functions (passing them as elements of an array). All functions associated with a hook will be called in an unspecified order with the same arguments. Each hook must be associated with functions with a specific signature, i.e., the arguments that are passed to the function depends on the hook to which it is associated. The hooks are specified by their standard names. The function signatures are the following: =over =item post-commit(SVN::Look) =item post-lock(repos-path, username) =item post-revprop-change(SVN::Look, username, property-name, action) =item post-unlock(repos-path, username) =item pre-commit(SVN::Look) =item pre-lock(repos-path, path, username, comment, steal-lock-flag) =item pre-revprop-change(SVN::Look, username, property-name, action) =item pre-unlock(repos-path, path, username, lock-token, break-unlock-flag) =item start-commit(repos-path, username, capabilities, txt-name) =back The functions may perform whatever checks they want. If the checks succeed the function must simply return. Otherwise, they must die with a suitable error message, which will be sent back to the user performing the Subversion action which triggered the hook. The sketch below shows how this directive could be used. sub my_start_commit { my ($repo_path, $username, $capabilities, $txt_name) = @_; # ... } sub my_pre_commit { my ($svnlook) = @_; # ... } GENERIC( 'start-commit' => \&my_start_commit, 'pre-commit' => \&my_pre_commit, ); =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CheckLog.pm100644004231004231 376713011116525 20132 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::CheckLog; # ABSTRACT: Check log messages in commits. $SVN::Hooks::CheckLog::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'CHECK_LOG'; our @EXPORT = ($HOOK); my @checks; sub CHECK_LOG { my ($regexp, $error_message) = @_; is_rx($regexp) or croak "$HOOK: first argument must be a qr/Regexp/\n"; ! defined $error_message || is_string($error_message) or croak "$HOOK: second argument must be undefined, or a STRING\n"; push @checks, { regexp => $regexp, error => $error_message || "log message must match $regexp.", }; PRE_COMMIT(\&pre_commit); return 1; } sub pre_commit { my ($svnlook) = @_; my $log = $svnlook->log_msg(); foreach my $check (@checks) { $log =~ $check->{regexp} or croak "$HOOK: $check->{error}"; } return; } 1; # End of SVN::Hooks::CheckLog __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::CheckLog - Check log messages in commits. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin allows one to check if the log message in a 'svn commit' conforms to a Regexp. It's active in the C hook. It's configured by the following directive. =head2 CHECK_LOG(REGEXP[, MESSAGE]) The REGEXP argument must be a qr/quoted regexp/ which must match the commit log messages. If it doesn't, then the commit is aborted. The MESSAGE argument is an optional error message that is shown to the user in case the check fails. CHECK_LOG(qr/.../ => "The log message cannot be empty!"); CHECK_LOG(qr/^\[(prj1|prj2|prj3)\]/ => "The log message must start with a project tag."); =for Pod::Coverage pre_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CheckJira.pm100644004231004231 3603513011116525 20310 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::CheckJira; # ABSTRACT: Integrate Subversion with the JIRA ticketing system. $SVN::Hooks::CheckJira::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use JIRA::REST; use Exporter qw/import/; my $HOOK = 'CHECK_JIRA'; our @EXPORT = qw/CHECK_JIRA_CONFIG CHECK_JIRA CHECK_JIRA_DISABLE/; my ($BaseURL, $Login, $Passwd, $MatchLog, $MatchKey); my $JIRA; my @Checks; my %Defaults = ( require => 1, valid => 1, unresolved => 1, by_assignee => 0, ); sub CHECK_JIRA_CONFIG { ($BaseURL, $Login, $Passwd, $MatchLog, $MatchKey) = @_; if (defined $MatchKey) { is_rx($MatchKey) or croak "CHECK_JIRA_CONFIG: fifth argument must be a Regexp.\n"; } else { $MatchKey = qr/[A-Z]{2,}/; } if (defined $MatchLog) { is_rx($MatchLog) or croak "CHECK_JIRA_CONFIG: fourth argument must be a Regexp.\n"; } else { $MatchLog = qr/(.*)/; } @_ >= 3 && @_ <= 5 or croak "CHECK_JIRA_CONFIG: requires three, four, or five arguments.\n"; $BaseURL =~ s/\/+$//; return 1; } sub _validate_projects { my ($opt, $val) = @_; is_string($val) && $val =~ /^[A-Z,\s]+$/ or croak "$HOOK: $opt\'s value must be a string matching /^[A-Z,\\s]+\$/.\n"; my %projects = map {$_ => undef} grep {/./} split /\s*,\s*/, $val; return \%projects; } sub _validate_bool { my ($opt, $val) = @_; defined $val or croak "$HOOK: undefined $opt\'s value.\n"; return $val; } sub _validate_code { my ($opt, $val) = @_; is_code_ref($val) or croak "$HOOK: $opt\'s value must be a CODE-ref.\n"; return $val; } sub _validate_regex { my ($opt, $val) = @_; is_rx($val) or croak "$HOOK: $opt\'s value must be a qr/REGEX/.\n"; return $val; } my %opt_checks = ( projects => \&_validate_projects, require => \&_validate_bool, valid => \&_validate_bool, unresolved => \&_validate_bool, by_assignee => \&_validate_bool, check_one => \&_validate_code, check_all => \&_validate_code, check_all_svnlook => \&_validate_code, post_action => \&_validate_code, exclude => \&_validate_regex, ); sub CHECK_JIRA { my ($regex, $opts) = @_; is_rx($regex) || (is_string($regex) && $regex eq 'default') or croak "$HOOK: first arg must be a qr/Regexp/ or the string 'default'.\n"; ! defined $opts || is_hash_ref($opts) or croak "$HOOK: second argument must be a HASH-ref.\n"; $opts = {} unless defined $opts; foreach my $opt (keys %$opts) { exists $opt_checks{$opt} or croak "$HOOK: unknown option '$opt'.\n"; $opts->{$opt} = $opt_checks{$opt}->($opt, $opts->{$opt}); } if (ref $regex) { push @Checks, [$regex => $opts]; } else { while (my ($opt, $val) = each %$opts) { $Defaults{$opt} = $val; } } PRE_COMMIT(\&pre_commit); POST_COMMIT(\&post_commit) if exists $opts->{post_action}; return 1; } my $Disabled; sub CHECK_JIRA_DISABLE { $Disabled = 1; } sub _pre_checks { my ($svnlook, $keys, $opts) = @_; # Grok and check each JIRA issue my @issues; foreach my $key (@$keys) { my $issue = eval {$JIRA->GET("/issue/$key")}; if ($opts->{valid}) { croak "$HOOK: issue $key is not valid: $@\n" if $@; } $issue or next; if ($opts->{unresolved}) { croak "$HOOK: issue $key is already resolved.\n" if defined $issue->{fields}{resolution}; } if ($opts->{by_assignee}) { my $author = $svnlook->author(); my $assignee = $issue->{fields}{assignee}{name}; croak "$HOOK: committer ($author) is different from issue ${key}'s assignee ($assignee).\n" if $author ne $assignee; } if (my $check = $opts->{check_one}) { $check->($JIRA, $issue, $svnlook); } push @issues, $issue; } if (my $check = $opts->{check_all}) { $check->($JIRA, @issues) if @issues; } if (my $check = $opts->{check_all_svnlook}) { $check->($svnlook, $JIRA, @issues) if @issues; } return; } sub _post_action { my ($svnlook, $keys, $opts) = @_; if (my $action = $opts->{post_action}) { $action->($JIRA, $svnlook, @$keys); } return; } sub _check_if_needed { my ($svnlook, $docheck) = @_; return if $Disabled; defined $BaseURL or croak "$HOOK: plugin not configured. Please, use the CHECK_JIRA_CONFIG directive.\n"; my @files = $svnlook->changed(); foreach my $check (@Checks) { my ($regex, $opts) = @$check; for my $file (@files) { if ($file =~ $regex) { # skip exclusions next if exists $opts->{exclude} && $file =~ $opts->{exclude}; # Grok the JIRA issue keys from the commit log my ($match) = ($svnlook->log_msg() =~ $MatchLog); my @keys = defined $match ? $match =~ /\b$MatchKey-\d+\b/g : (); my %opts = (%Defaults, %$opts); if ($opts{require}) { croak "$HOOK: you must cite at least one JIRA issue key in the commit message.\n" unless @keys; } return unless @keys; # Check if there is a restriction on the project keys allowed if (exists $opts->{projects}) { foreach my $key (@keys) { my ($pkey, $pnum) = split /-/, $key; croak "$HOOK: issue $key is not allowed. You must cite only JIRA issues for the following projects: ", join(', ', sort keys %{$opts->{projects}}), ".\n" unless exists $opts->{projects}{$pkey}; } } # Connect to JIRA if not yet connected. unless (defined $JIRA) { $JIRA = eval {JIRA::REST->new($BaseURL, $Login, $Passwd)}; croak "CHECK_JIRA_CONFIG: cannot connect to the JIRA server: $@\n" if $@; } $docheck->($svnlook, \@keys, \%opts); last; } } } return; } sub pre_commit { my ($svnlook) = @_; _check_if_needed($svnlook, \&_pre_checks); return; } sub post_commit { my ($svnlook) = @_; _check_if_needed($svnlook, \&_post_action); return; } 1; # End of SVN::Hooks::CheckJira __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::CheckJira - Integrate Subversion with the JIRA ticketing system. =head1 VERSION version 1.34 =head1 DESCRIPTION This SVN::Hooks plugin requires that any Subversion commits affecting some parts of the repository structure must make reference to valid JIRA issues in the commit log message. JIRA issues are referenced by their keys which consists of a sequence of uppercase letters separated by an hyfen from a sequence of digits. E.g., CDS-123, RT-1, and SVN-97. It's active in the C and/or the C hook. It's configured by the following directives. =head2 CHECK_JIRA_CONFIG(BASEURL, LOGIN, PASSWORD [, REGEXP [, REGEXP]]) This directive specifies how to connect and to authenticate to the JIRA server. BASEURL is the base URL of the JIRA server, usually, something like C. LOGIN and PASSWORD are the credentials of a JIRA user who has browsing rights to the JIRA projects that will be referenced in the commit logs. The fourth argument is an optional qr/Regexp/ object. It will be used to match against the commit logs in order to extract the list of JIRA issue keys. By default, the JIRA keys are looked for in the whole commit log, which is equivalent to qr/(.*)/. Sometimes this can be suboptimal because the user can introduce in the message some text that inadvertently looks like a JIRA issue key without being so. With this argument, the log message is matched against the REGEXP and only the first matched group (i.e., the part of the message captured by the first parenthesis (C<$1>)) is used to look for JIRA issue keys. The fifth argument is another optional qr/Regexp/ object. It is used to match JIRA project keys, which match qr/[A-Z]{2,}/ by default. However, since you can specify different patterns for JIRA project keys (L), you need to be able to specify this here too. The JIRA issue keys are extracted from the commit log (or the part of it specified by the REGEXP) with the following pattern: C; =head2 CHECK_JIRA(REGEXP => {OPT => VALUE, ...}) This directive tells how each part of the repository structure must be integrated with JIRA. During a commit, all files being changed are tested against the REGEXP of each CHECK_JIRA directive, in the order that they were called. If at least one changed file matches a regexp, the issues cited in the commit log are checked against their current status on JIRA according to the options specified after the REGEXP. The available options are the following: =over =item projects => 'PROJKEYS' By default, the committer can reference any JIRA issue in the commit log. You can restrict the allowed keys to a set of JIRA projects by specifying a comma-separated list of project keys to this option. =item require => [01] By default, the log must reference at least one JIRA issue. You can make the reference optional by passing a false value to this option. =item valid => [01] By default, every issue referenced must be valid, i.e., it must exist on the JIRA server. You can relax this requirement by passing a false value to this option. (Why would you want to do that, though?) =item unresolved => [01] By default, every issue referenced must be unresolved, i.e., it must not have a resolution. You can relax this requirement by passing a false value to this option. =item by_assignee => [01] By default, the committer can reference any valid JIRA issue. Passing a true value to this option you require that the committer can only reference issues to which she is the current assignee. =item check_one => CODE-REF If the above checks aren't enough you can pass a code reference (subroutine) to this option. The subroutine will be called once for each referenced issue with three arguments: =over =item the JIRA::REST object used to talk to the JIRA server. Note that up to version 1.26 of SVN::Hooks::CheckJira this used to be a JIRA::Client object, which uses JIRA's SOAP API which was deprecated on JIRA 6.0 and won't be available anymore on JIRA 7.0. If you have code relying on the JIRA::Client module you're advised to rewrite it using the JIRA::REST module. As a stopgap measure you can disregard the JIRA::REST object and create your own JIRA::Client object. For this you only need the three arguments you've passed to the CHECK_JIRA_CONFIG directive. =item the hash representing the issue. =item the SVN::Look object used to grok information about the commit. =back The subroutine must simply return with no value to indicate success and must die to indicate failure. Plese, read the JIRA::REST and SVN::Look modules documentation to understand how to use these objects. =item check_all => CODE-REF Sometimes checking each issue separatelly isn't enough. You may want to check some relation among all the referenced issues. In this case, pass a code reference to this option. It will be called once for the commit. Its first argument is the JIRA::REST object used to talk to the JIRA server. The following arguments are references to hashes representing every referenced issue. The last argument is the SVN::Look object used to grok information about the commit. The subroutine must simply return with no value to indicate success and must die to indicate failure. =item check_all_svnlook => CODE-REF This check is the same as the previous one, except that the first argument passed to the routine is the SVN::Look object used to grok information about the commit. The rest of the arguments are the same. =item post_action => CODE-REF This is not a check, but an opportunity to perform some action after a successful commit. The code reference passed will be called once during the post-commit hook phase. Its first argument is the JIRA::REST object used to talk to the JIRA server. The second argument is the SVN::Look object that can be used to inspect all the information about the commit proper. The following arguments are the JIRA keys mentioned in the commit log message. The value returned by the routine, if any, is ignored. =item exclude => REGEXP Normally you specify a CHECK_JIRA with a regex matching a root directory in the repository hierarchy. Sometimes you need to specify some subparts of that root directory that shouldn't be treated by this CHECK_JIRA directive. You can use this option to specify these exclusions by means of another regex. =back You can set defaults for these options using a CHECK_JIRA directive with the string C<'default'> as a first argument, instead of a qr/Regexp/. # Set some defaults CHECK_JIRA(default => { projects => 'CDS,TST', by_assignee => 1, }); # Check if some commits are scheduled, i.e., if they reference # JIRA issues that have at least one fix version. sub is_scheduled { my ($jira, $issue, $svnlook) = @_; return scalar @{$issue->{fixVersions}}; } CHECK_JIRA(qr/^(trunk|branches/fix)/ => { check_one => \&is_scheduled, }); Note that you need to call CHECK_JIRA at least once with a qr/Regexp/ in order to trigger the checks. A call for (C<'default'> doesn't count. If you want to change defaults and force checks for every commit, do this: CHECK_JIRA(default => {projects => 'CDS'}); CHECK_JIRA(qr/./); The C<'post_action'> pseudo-check can be used to interact with the JIRA server after a successful commit. For instance, you may want to add a comment to each referred issue like this: # This routine returns a closure that can be passed to # post_action. The closure receives a string to be added as a # comment to each issue referred to by the commit message. The # commit info can be interpolated inside the comment using the # SVN::Look method names inside angle brackets. sub add_comment { my ($format) = @_; return sub { my ($jira, $svnlook, @keys) = @_; # Substitute keywords in the input comment with calls # into the $svnlook reference $format =~ s/\{(\w+)\}/"\$svnlook->$1()"/eeg; for my $key (@keys) { $jira->POST("/issue/$key/comment", undef, { body => $format }); } } } CHECK_JIRA(qr/./ => { post_action => add_comment("Subversion Commit r{rev} by {author} on {date}\n{log_msg}") }); You can use a generic CHECK_JIRA excluding specific directories from it using the "exclude" option like this: CHECK_JIRA(qr:^(trunk|branches/[^/]): => { exclude => qr:/documentation/:, # other options... }); =head2 CHECK_JIRA_DISABLE This directive globally disables all CHECK_JIRA directives. It's useful, for instance, when your JIRA server must be taken down for maintenance and you don't want to reject Subversion commits in this period. =for Pod::Coverage post_commit pre_commit =head1 SEE ALSO =over =item * L =item * L =item * L =back =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 02-checkstructurealone.t100755004231004231 275113011116525 20535 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/t# -*- cperl -*- use strict; use warnings; use lib 't'; use lib 'blib/lib'; use Test::More tests => 14; use SVN::Hooks::CheckStructure; my $structure = [ file => 'FILE', dir => 'DIR', subdir1 => [ qr/^regex/ => 1, qr/^noregex/ => 0, 1 => 'FILE', ], subdir2 => [ subfile => 'FILE', 0 => 'error 2', ], sub1 => [ sub2 => [ sub3 => [ ], ], ], ]; sub check_ok { my ($path, $test) = @_; eval {check_structure($structure, $path)}; ok(!$@, $test) or diag $@; } sub check_nok { my ($path, $expect, $test) = @_; eval {check_structure($structure, $path)}; if ($@) { like($@, $expect, $test); } else { fail($test); diag('test succeeded unexpectedly'); } } check_ok('/file', 'FILE ok'); check_nok('/file/', qr/the component \(file\) should be a FILE/, 'FILE nok'); check_ok('/dir/', 'DIR ok'); check_nok('/dir', qr/the component \(dir\) should be a DIR/, 'DIR nok'); check_nok('/subdir1', qr/the component \(subdir1\) should be a DIR/, 'array DIR nok'); check_ok('/subdir1/', 'array DIR ok'); check_ok('/subdir1/regex', 'regex ok'); check_nok('/subdir1/noregex', qr/invalid path/, 'regex nok'); check_ok('/subdir1/file', 'else FILE ok'); check_nok('/subdir1/file/', qr/the component \(file\) should be a FILE/, 'else FILE nok'); check_nok('/subdir2/other', qr/error 2/, '0 =>'); check_ok('/sub1/', '/sub1'); check_ok('/sub1/sub2/', '/sub1/sub2/'); check_ok('/sub1/sub2/sub3/', '/sub1/sub2/sub3/'); check-mergeinfo.pl100755004231004231 413513011116525 21010 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/examples# The SVNBOOK's section called "The Final Word on Merge Tracking" # (http://svnbook.red-bean.com/en/1.7/svn.branchmerge.advanced.html#svn.branchmerge.advanced.finalword) # says that one of Subversion's best practices is to "avoid subtree # merges and subtree mergeinfo, perform merges only on the root of # your branches, not on subdirectories or files". # What follows is a pre-commit hook that checks when it's commiting # the result of a merge and that the merge root matches on of a list # of allowed regexes. my @allowed_merge_roots = ( qr@^(?:trunk|branches/[^/]+)/$@, # only on trunk and on branch roots ); # This hook loops over every path which had the svn:mergeinfo property # changed in this commit in string order. The first such path must be # the merge root and it must match at least one of the allowed merge # roots or die otherwise. PRE_COMMIT { my ($svnlook) = @_; my $headlook; # initialized inside the loop if needed foreach my $path (sort $svnlook->prop_modified()) { next unless exists $svnlook->proplist($path)->{'svn:mergeinfo'}; # Get a SVN::Look to the HEAD revision in order to see what # has changed in this commit transaction $headlook ||= SVN::Look->new($svnlook->repo()); # Try to get properties for the file in HEAD my $head_props = eval { $headlook->proplist($path) }; # If path didn't exist in HEAD it must be a copy and not a # merge root, so we skip it. next unless $head_props; # If it didn't have the svn:mergeinfo property or if the # property was different then, it must be the merge root. if (! exists $head_props->{'svn:mergeinfo'} || $head_props->{'svn:mergeinfo'} ne $svnlook->proplist($path)->{'svn:mergeinfo'} ) { # We've found a path that had the svn:mergeinfo property # modified in this commit. Since we're looking at them in # string order, the first one found must be the merge # root. Check if it matches any of the allowed roots or # die otherwise. foreach my $allowed_root (@allowed_merge_roots) { return if $path =~ $allowed_root; } die "Merge not allowed on '$path'\n"; } } return; }; 1; DenyChanges.pm100644004231004231 655713011116525 20643 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::DenyChanges; # ABSTRACT: Deny some changes in a repository. $SVN::Hooks::DenyChanges::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'DENY_CHANGES'; our @EXPORT = ('DENY_ADDITION', 'DENY_DELETION', 'DENY_UPDATE', 'DENY_EXCEPT_USERS'); my %Deny; # List of deny regexen my %Except; # Users exempt from the checks sub _deny_change { my ($change, @regexes) = @_; foreach (@regexes) { is_rx($_) or croak "$HOOK: all arguments must be qr/Regexp/\n"; } push @{$Deny{$change}}, @regexes; PRE_COMMIT(\&pre_commit); return 1; } sub DENY_ADDITION { my @args = @_; return _deny_change(add => @args); } sub DENY_DELETION { my @args = @_; return _deny_change(delete => @args); } sub DENY_UPDATE { my @args = @_; return _deny_change(update => @args); } sub DENY_EXCEPT_USERS { my @users = @_; foreach my $user (@users) { is_string($user) or croak "DENY_EXCEPT_USERS: all arguments must be strings\n"; $Except{$user} = undef; } return 1; } sub pre_commit { my ($svnlook) = @_; # Except users return if exists $Except{$svnlook->author()}; my @errors; foreach my $regex (@{$Deny{add}}) { ADDED: foreach my $file ($svnlook->added()) { if ($file =~ $regex) { push @errors, " Cannot add: $file"; next ADDED; } } } foreach my $regex (@{$Deny{delete}}) { DELETED: foreach my $file ($svnlook->deleted()) { if ($file =~ $regex) { push @errors, " Cannot delete: $file"; next DELETED; } } } foreach my $regex (@{$Deny{update}}) { UPDATED: foreach my $file ($svnlook->updated()) { if ($file =~ $regex) { push @errors, " Cannot update: $file"; next UPDATED; } } } croak "$HOOK:\n", join("\n", @errors), "\n" if @errors; return; } 1; # End of SVN::Hooks::CheckMimeTypes __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::DenyChanges - Deny some changes in a repository. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin is used to disallow the addition, deletion, or modification of parts of the repository structure. It's active in the C hook. It's configured by the following directives. =head2 DENY_ADDITION(REGEXP, ...) This directive denies the addition of new files matching the Regexps passed as arguments. DENY_ADDITION(qr/\.(doc|xls|ppt)$/); # ODF only, please =head2 DENY_DELETION(REGEXP, ...) This directive denies the deletion of files matching the Regexps passed as arguments. DENY_DELETION(qr/contract/); # Can't delete contracts =head2 DENY_UPDATE(REGEXP, ...) This directive denies the modification of files matching the Regexps passed as arguments. DENY_UPDATE(qr/^tags/); # Can't modify tags =head2 DENY_EXCEPT_USERS(LIST) This directive receives a list of user names which are to be exempt from the rules specified by the other directives. DENY_EXCEPT_USERS(qw/john mary/); This rule exempts users C and C from the other deny rules. =for Pod::Coverage pre_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut check-java-style.pl100755004231004231 202613011116525 21111 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/examples# Check if every added/changed Java file passes our code quality # standards. PRE_COMMIT { my ($svnlook) = @_; # CONFIG: Uncomment the following return to disable all checks # return; use autodie qw(:all); use Cwd; use File::Temp; use IO::Handle; my @javas = grep {/\.java$/} ($svnlook->added(), $svnlook->updated()); return unless @javas; # CONFIG: Set $limit to 0 to have no limits on the number of files to be checked. if (my $limit = 10) { splice @javas, $limit if @javas > $limit; } # Create a copy of each java file in a temporary directory. my $dir = File::Temp->newdir(); foreach my $java (@javas) { (my $file = $java) =~ tr:/:_:; # flaten the java file name open my $fh, '>', "$dir/$file"; $fh->print($svnlook->cat($java)); } my $cwd = cwd(); chdir '/ha/subversion/admin/hooks/dsb'; # Invoke the code quality tool on all saved java files system('java', '-jar', 'code-quality-hook-1.0-SNAPSHOT.jar', glob("$dir/*.java")); chdir $cwd; }; 1; check-valid-utf8.pl100755004231004231 116613011116525 21021 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/examples# Check if every changed text file contains valid UTF-8 data. PRE_COMMIT { my ($svnlook) = @_; foreach my $file ($svnlook->added(), $svnlook->updated()) { next if $file =~ m:/$:; # skip directories my $props = $svnlook->proplist($file); next unless exists $props->{'svn:mime-type'}; # skip files without a mime-type next unless $props->{'svn:mime-type'} =~ m:^text/:; # skip non-text files # Try to decode file contents as UTF-8 and dies if not require Encode; eval {Encode::decode_utf8($svnlook->cat($file), Encode::FB_CROAK)}; die "New file '$file' does not contain valid UTF-8 data: $@\n" if $@; } }; 1; check-perl-critic.pl100755004231004231 124613011116525 21252 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/examples# Check if every added/changed Perl file respects Perl::Critic's code # standards. PRE_COMMIT { my ($svnlook) = @_; my %violations; my $critic; foreach my $file ($svnlook->added(), $svnlook->updated()) { next unless $file =~ /\.p[lm]$/i; require Perl::Critic; $critic ||= Perl::Critic->new(-severity => 'stern', -top => 10); my $contents = $svnlook->cat($file); my @violations = $critic->critique(\$contents); $violations{$file} = \@violations if @violations; } if (%violations) { # FIXME: this is a lame way to format the output. require Data::Dumper; die "Perl::Critic Violations:\n", Data::Dumper::Dumper(\%violations), "\n"; } }; 1; CheckProperty.pm100644004231004231 710013011116525 21216 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::CheckProperty; # ABSTRACT: Check properties in added files. $SVN::Hooks::CheckProperty::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'CHECK_PROPERTY'; our @EXPORT = ($HOOK); my @Checks; sub CHECK_PROPERTY { my ($where, $prop, $what) = @_; is_string($where) || is_rx($where) or croak "$HOOK: first argument must be a STRING or a qr/Regexp/\n"; is_string($prop) or croak "$HOOK: second argument must be a STRING\n"; ! defined $what || is_string($what) || is_rx($what) or croak "$HOOK: third argument must be undefined, or a NUMBER, or a STRING, or a qr/Regexp/\n"; push @Checks, [$where, $prop => $what]; PRE_COMMIT(\&pre_commit); return 1; } sub pre_commit { my ($svnlook) = @_; my @errors; foreach my $added ($svnlook->added()) { foreach my $check (@Checks) { my ($where, $prop, $what) = @$check; if (is_rx($where) && $added =~ $where || is_string($where) && $where eq substr($added, 0, length $where)) { my $props = $svnlook->proplist($added); my $is_set = exists $props->{$prop}; if (! defined $what) { $is_set or push @errors, "property $prop must be set for: $added"; } elsif (is_value($what)) { if (is_integer($what)) { if ($what) { $is_set or push @errors, "property $prop must be set for: $added"; } else { $is_set and push @errors, "property $prop must not be set for: $added"; } } elsif (! $is_set) { push @errors, "property $prop must be set to \"$what\" for: $added"; } elsif ($props->{$prop} ne $what) { push @errors, "property $prop must be set to \"$what\" and not to \"$props->{$prop}\" for: $added"; } } elsif (! $is_set) { push @errors, "property $prop must be set and match \"$what\" for: $added"; } elsif ($props->{$prop} !~ $what) { push @errors, "property $prop must match \"$what\" but is \"$props->{$prop}\" for: $added"; } } } } croak join("\n", "$HOOK:", @errors), "\n" if @errors; return; } 1; # End of SVN::Hooks::CheckProperty __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::CheckProperty - Check properties in added files. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin checks if some files added to the repository have some properties set. It's active in the C hook. It's configured by the following directive. =head2 CHECK_PROPERTY(WHERE, PROPERTY[, VALUE]) This directive enables the checking, causing the commit to abort if it doesn't comply. The WHERE argument must be a qr/Regexp/ matching all files that must comply to this rule. The PROPERTY argument is the name of the property that must be set for the files matching WHERE. The optional VALUE argument specifies the value for PROPERTY depending on its type: =over =item UNDEF or not present The PROPERTY must be set. =item NUMBER If non-zero, the PROPERTY must be set. If zero, the PROPERTY must NOT be set. =item STRING The PROPERTY must be set with a value equal to the string. =item qr/Regexp/ The PROPERTY must be set with a value that matches the Regexp. =back Example: CHECK_PROPERTY(qr/\.(?:do[ct]|od[bcfgimpst]|ot[ghpst]|pp[st]|xl[bst])$/i => 'svn:needs-lock'); =for Pod::Coverage pre_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DenyFilenames.pm100644004231004231 1137313011116525 21206 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::DenyFilenames; # ABSTRACT: Deny some file names. $SVN::Hooks::DenyFilenames::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'DENY_FILENAMES'; our @EXPORT = ($HOOK, 'DENY_FILENAMES_PER_PATH'); sub _grok_check { my ($directive, $check) = @_; if (is_rx($check)) { return [$check => 'filename not allowed']; } elsif (is_array_ref($check)) { @$check == 2 or croak "$directive: array arguments must have two arguments.\n"; is_rx($check->[0]) or croak "$directive: got \"$check->[0]\" while expecting a qr/Regex/.\n"; is_string($check->[1]) or croak "$directive: got \"$check->[1]\" while expecting a string.\n"; return $check; } else { croak "$directive: got \"$check\" while expecting a qr/Regex/ or a [qr/Regex/, 'message'].\n"; } } my @Checks; # default restrictions sub DENY_FILENAMES { foreach my $check (@_) { push @Checks, _grok_check('DENY_FILENAMES', $check); } PRE_COMMIT(\&pre_commit); return 1; } my @Per_path_checks; # per path restrictions sub DENY_FILENAMES_PER_PATH { my (@rules) = @_; @rules % 2 == 0 or croak "DENY_FILENAMES_PER_PATH: got odd number of arguments.\n"; while (@rules) { my ($match, $check) = splice @rules, 0, 2; is_rx($match) or croak "DENY_FILENAMES_PER_PATH: rule prefix isn't a Regexp.\n"; push @Per_path_checks, [$match => _grok_check('DENY_FILENAMES_PER_PATH', $check)]; } PRE_COMMIT(\&pre_commit); return 1; } sub pre_commit { my ($svnlook) = @_; my $errors; ADDED: foreach my $added ($svnlook->added()) { foreach my $rule (@Per_path_checks) { if ($added =~ $rule->[0]) { $errors .= "$HOOK: $rule->[1][1]: $added\n" if $added =~ $rule->[1][0]; next ADDED; } } foreach my $check (@Checks) { if ($added =~ $check->[0]) { $errors .= "$HOOK: $check->[1]: $added\n"; next ADDED; } } } croak $errors if $errors; } 1; # End of SVN::Hooks::DenyFilenames __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::DenyFilenames - Deny some file names. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin is used to disallow the addition of some file names. It's active in the C hook. It's configured by the following directives. =head2 DENY_FILENAMES(REGEXP, [REGEXP => MESSAGE], ...) This directive denies the addition of new files matching the Regexps passed as arguments. If any file or directory added in the commit matches one of the specified Regexps the commit is aborted with an error message telling about every denied file. The arguments may be compiled Regexps or two-element arrays consisting of a compiled Regexp and a specific error message. If a file matches one of the lone Regexps an error message like this is produced: DENY_FILENAMES: filename not allowed: filename If a file matches a Regexp associated with an error message, the specified error message is substituted for the 'filename not allowed' default. Note that this directive specifies a default restriction. If there are any B directives (see below) being used, this one is only used for files that don't match any specific rules there. Example: DENY_FILENAMES( qr/\.(doc|xls|ppt)$/i, # ODF only, please [qr/\.(exe|zip|jar)/i => 'No binaries, please!'], ); =head2 DENY_FILENAMES_PER_PATH(REGEXP => REGEXP, REGEXP => [REGEXP => MESSAGE], ...) This directive is more specific than the B, because it allows one to specify different restrictions in different regions of the repository tree. Its arguments are a sequence of rules, each one consisting of a pair. The first element of each pair is a regular expression specifying where in the repository this rule applies. It applies if any file being added matches the regexp. The second element specifies the restrictions that should be imposed, just like the arguments to B. The first rule matching an added file is used to check it. The following rules aren't tried. Only if no rules match a particular file will the restrictions defined by B be imposed. Example: DENY_FILENAMES_PER_PATH( qr:/src/: => [qr/[^\w.-]/ => 'source files must be strict'], qr:/doc/: => qr/[^\w\s.-]/i, # document files allow spaces too. qr:/notes/: => qr/^$/, # notes directory allows anything. ); =for Pod::Coverage pre_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut UpdateConfFile.pm100644004231004231 3020613011116525 21307 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::UpdateConfFile; # ABSTRACT: Maintain the repository configuration versioned. $SVN::Hooks::UpdateConfFile::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use File::Spec::Functions; use File::Temp qw/tempdir/; use Cwd qw/abs_path/; use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'UPDATE_CONF_FILE'; our @EXPORT = ($HOOK); my @Config; sub UPDATE_CONF_FILE { my ($from, $to, @args) = @_; is_string($from) || is_rx($from) or croak "$HOOK: invalid first argument.\n"; is_string($to) or croak "$HOOK: invalid second argument.\n"; (@args % 2) == 0 or croak "$HOOK: odd number of arguments.\n"; file_name_is_absolute($to) and croak "$HOOK: second argument cannot be an absolute pathname ($to).\n"; my %confs = (from => $from, to => $to); my %args = @args; for my $function (qw/validator generator actuator/) { if (my $what = delete $args{$function}) { if (is_code_ref($what)) { $confs{$function} = $what; } elsif (is_array_ref($what)) { # This should point to list of command arguments @$what > 0 or croak "$HOOK: $function argument must have at least one element.\n"; -x $what->[0] or croak "$HOOK: $function argument is not a valid command ($what->[0]).\n"; $confs{$function} = _functor($what); } else { croak "$HOOK: $function argument must be a CODE-ref or an ARRAY-ref.\n"; } PRE_COMMIT(\&pre_commit); } } if (my $rotate = delete $args{rotate}) { $rotate =~ /^\d+$/ or croak "$HOOK: rotate argument must be numeric, not '$rotate'"; $rotate < 10 or croak "$HOOK: rotate argument must be less than 10, not '$rotate'"; $confs{rotate} = $rotate; } if (my $remove = delete $args{remove}) { $confs{remove} = $remove; } keys %args == 0 or croak "$HOOK: invalid option names: ", join(', ', sort keys %args), ".\n"; push @Config, \%confs; POST_COMMIT(\&post_commit); return 1; } sub pre_commit { my ($svnlook) = @_; CONF: foreach my $conf (@Config) { if (my $validator = $conf->{validator}) { my $from = $conf->{from}; for my $file ($svnlook->added(), $svnlook->updated()) { if (is_string($from)) { next if $file ne $from; } else { next if $file !~ $from; } my $text = $svnlook->cat($file); if (my $generator = $conf->{generator}) { $text = eval { $generator->($text, $file, $svnlook) }; defined $text or croak "$HOOK: Generator aborted for: $file\n", $@, "\n"; } my $validation = eval { $validator->($text, $file, $svnlook) }; defined $validation or croak "$HOOK: Validator aborted for: $file\n", $@, "\n"; next CONF; } } } return; } sub post_commit { my ($svnlook) = @_; my $absbase = abs_path(catdir($SVN::Hooks::Repo, 'conf')); foreach my $conf (@Config) { my $from = $conf->{from}; for my $file ($svnlook->added(), $svnlook->updated()) { my $to = _post_where_to($absbase, $file, $from, $conf->{to}); next unless defined $to; my $text = $svnlook->cat($file); if (my $generator = $conf->{generator}) { $text = eval { $generator->($text, $file, $svnlook) }; defined $text or croak <<"EOS"; $HOOK: generator in post-commit aborted for: $file This means that $file was committed but the associated configuration file wasn't generated in the server at: $to Please, investigate the problem and re-commit the file. Any error message produced by the generator appears below: $@ EOS } # Create the directory where $to is to be created, if it doesn't # already exist. my $todir = (File::Spec->splitpath($to))[1]; unless (-d $todir) { require File::Path; File::Path::make_path($todir); } open my $fd, '>', "$to.new" or croak "$HOOK: Can't open file \"$to.new\" for writing: $!\n"; print $fd $text; close $fd; _rotate($to, $conf->{rotate}) if $conf->{rotate}; rename "$to.new", $to; if (my $actuator = $conf->{actuator}) { my $rc = eval { $actuator->($text, $file, $svnlook) }; defined $rc or croak <<"EOS"; $HOOK: actuator in post-commit aborted for: $file This means that $file was committed and the associated configuration file was generated in the server at: $to But the actuator command that was called after the file generation didn't work right. Please, investigate the problem. Any error message produced by the actuator appears below: $@ EOS } } if ($conf->{remove}) { for my $file ($svnlook->deleted()) { my $to = _post_where_to($absbase, $file, $from, $conf->{to}); next unless defined $to && -f $to; if (my $rotate = $conf->{rotate}) { _rotate($to, $rotate); } else { unlink $to or carp "$HOOK: can't unlink '$to'.\n"; } } } } return; } sub _functor { my ($cmdlist) = @_; my $cmd = join(' ', @$cmdlist); return sub { my ($text, $path, $svnlook) = @_; my $temp = tempdir('UpdateConfFile.XXXXXX', TMPDIR => 1, CLEANUP => 1); # FIXME: this is Unix specific! open my $th, '>', "$temp/file" or croak "Can't create $temp/file: $!"; print $th $text; close $th; local $ENV{SVNREPOPATH} = $svnlook->repo(); if (system("$cmd $temp/file $path $ENV{SVNREPOPATH} 1>$temp/output 2>$temp/error") == 0) { return `cat $temp/output`; } else { croak `cat $temp/error`; } }; } # Return the server-side absolute path mapping for the configuration file, or # undef if $file doesn't match $from. $absbase is the absolute path to the # repo's conf directory. $file is the path of a file added, modified, or # deleted in the commit. $from and $to are the configured mapping. sub _post_where_to { my ($absbase, $file, $from, $to) = @_; if (is_string($from)) { return if $file ne $from; } else { return if $file !~ $from; # interpolate backreferences $to = eval qq{"$to"}; ## no critic (BuiltinFunctions::ProhibitStringyEval) } $to !~ m@(?:^|/)\.\.(?:/|$)@ or croak <<"EOS"; $HOOK: post-commit aborted for: $file This means that $file was committed but the associated configuration file wasn't generated because its specified location ($to) contains a '..' path component which is not accepted by this hook. Please, correct the ${HOOK}'s second argument. EOS my $is_directory = ($to =~ s:/$::); $to =~ s:^/+::; my $abs_to = catfile($absbase, $to); if ($is_directory || -d $abs_to) { $abs_to = catfile($abs_to, (File::Spec->splitpath($file))[2]); } return $abs_to; } # Rotates file $to $rotate times. sub _rotate { my ($to, $rotate) = @_; for (my $i=$rotate-1; $i >= 0; --$i) { rename "$to.$i", sprintf("$to.%d", $i+1) if -e "$to.$i"; } rename $to, "$to.0" if -e $to; } 1; # End of SVN::Hooks::UpdateConfFile __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::UpdateConfFile - Maintain the repository configuration versioned. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin allows you to maintain the repository configuration files under version control. The repository configuration is usually kept in the directory C under the directory where the repository was created. In a brand new repository you see there the files C, C, and C. It's too bad that these important files are usually kept out of any version control system. This plugin tries to solve this problem allowing you to keep these files versioned under the same repository where they are used. It's active in the C and the C hooks. It's configured by the following directive. =head2 UPDATE_CONF_FILE(FROM, TO, @ARGS) This directive makes that after a successful commit in which the file FROM, under version control, have been added or modified, its newest version is copied to TO. FROM can be a string or a qr/Regexp/ specifying the file path relative to the repository's root (e.g. "trunk/src/version.c" or "qr:^conf/(\w+).conf$:"). TO must be a relative path indicating where the original file must be copied to below the C directory in the server. It can be an explicit file name or a directory, in which case the basename of FROM is used as the name of the destination file. Non-existing directory components of TO are automatically created. Note that if the path doesn't exist the hook assumes that it should be a file. To make sure it's understood as a directory you may end it with a forward slash (/). If FROM is a qr/Regexp/, TO is evaluated as a string in order to allow for the interpolation of capture buffers from the regular expression. This is useful to map the copy operation to a different directory structure. For example, this configuration "qr:^conf/(\w+).conf$: => '$1.conf'" updates any .conf file in the repository conf directory. The optional @ARGS must be a sequence of pairs like these: =over =item validator => ARRAY or CODE A validator is a function or a command (specified by an array of strings that will be passed to the shell) that will check the contents of FROM in the pre-commit hook to see if it's valid. If there is no validator, the contents are considered valid. The function receives three arguments: =over =item A string with the contents of FROM =item A string with the relative path to FROM in the repository =item An SVN::Look object representing the commit transaction =back The command is called with three arguments: =over =item The path to a temporary copy of FROM =item The relative path to FROM in the repository =item The path to the root of the repository in the server =back =item generator => ARRAY or CODE A generator is a function or a command (specified by an array of strings that will be passed to the shell) that will transform the contents of FROM in the post-commit hook before copying it to TO. If there is no generator, the contents are copied as is. The function receives the same three arguments as the validator's function above. The command is called with the same three arguments as the validator's command above. =item actuator => ARRAY or CODE An actuator is a function or a command (specified by an array of strings that will be passed to the shell) that will be invoked after a successful commit of FROM in the post-commit hook. The function receives the same three arguments as the validator's function above. The command is called with the same three arguments as the validator's command above. =item rotate => NUMBER By default, after each successful commit the TO file is overwriten by the new contents of FROM. With this option, the last NUMBER versions of TO are kept on disk with numeric suffixes ranging from C<.0> to C<.NUMBER-1>. This can be useful, for instance, in case you manage to commit a wrong authz file that denies any subsequent commit. =item remove => BOOL By default, if FROM is B in the commit, nothing happens to TO. If you want to have the file TO removed from the repository when FROM is deleted, set this option to a true value such as '1'. =back UPDATE_CONF_FILE( 'conf/authz' => 'authz', validator => ['/usr/local/bin/svnauthcheck'], generator => ['/usr/local/bin/authz-expand-includes'], actuator => ['/usr/local/bin/notify-auth-change'], rotate => 2, ); UPDATE_CONF_FILE( 'conf/svn-hooks.conf' => 'svn-hooks.conf', validator => [qw(/usr/bin/perl -c)], actuator => sub { my ($contents, $file) = @_; die "Can't use Gustavo here." if $contents =~ /gustavo/; }, rotate => 2, ); UPDATE_CONF_FILE( qr:/file(\n+)$:' => 'subdir/$1/file', rotate => 2, remove => 1, ); =for Pod::Coverage post_commit pre_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CheckStructure.pm100644004231004231 1706013011116525 21420 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::CheckStructure; # ABSTRACT: Check the structure of a repository. $SVN::Hooks::CheckStructure::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'CHECK_STRUCTURE'; our @EXPORT = ($HOOK, 'check_structure'); my $Structure; sub CHECK_STRUCTURE { ($Structure) = @_; PRE_COMMIT(\&pre_commit); return 1; } sub _check_structure { my ($structure, $path) = @_; @$path > 0 or croak "Can't happen!"; if (is_string($structure)) { if ($structure eq 'DIR') { return (1) if @$path > 1; return (0, "the component ($path->[0]) should be a DIR in"); } elsif ($structure eq 'FILE') { return (0, "the component ($path->[0]) should be a FILE in") if @$path > 1; return (1); } elsif (is_integer($structure)) { return (1) if $structure; return (0, "invalid path"); } else { return (0, "syntax error: unknown string spec ($structure), while checking"); } } elsif (is_array_ref($structure)) { return (0, "syntax error: odd number of elements in the structure spec, while checking") unless scalar(@$structure) % 2 == 0; return (0, "the component ($path->[0]) should be a DIR in") unless @$path > 1; shift @$path; # Return ok if the directory doesn't have subcomponents. return (1) if @$path == 1 && length($path->[0]) == 0; for (my $s=0; $s<$#$structure; $s+=2) { my ($lhs, $rhs) = @{$structure}[$s, $s+1]; if (is_string($lhs)) { if ($lhs eq $path->[0]) { return _check_structure($rhs, $path); } elsif (is_integer($lhs)) { if ($lhs) { return _check_structure($rhs, $path); } elsif (is_string($rhs)) { return (0, "$rhs, while checking"); } else { return (0, "syntax error: the right hand side of a number must be string, while checking"); } } } elsif (is_rx($lhs)) { if ($path->[0] =~ $lhs) { return _check_structure($rhs, $path); } } else { my $what = ref $lhs; return (0, "syntax error: the left hand side of arrays in the structure spec must be scalars or qr/Regexes/, not $what, while checking"); } } return (0, "the component ($path->[0]) is not allowed in"); } else { my $what = ref $structure; return (0, "syntax error: invalid reference to a $what in the structure spec, while checking"); } } sub check_structure { my ($structure, $path) = @_; $path = "/$path" unless $path =~ m@^/@; # make sure it's an absolute path my @path = split '/', $path, -1; # preserve trailing empty components my ($code, $error) = _check_structure($structure, \@path); croak "$error: $path\n" if $code == 0; return 1; } sub pre_commit { my ($svnlook) = @_; my @errors; foreach my $added ($svnlook->added()) { # Split the $added path in its components. We prefix $added # with a slash to make it look like an absolute path for # _check_structure. The '-1' is to preserve trailing empty # components so that we can differentiate directory paths from # file paths. my @added = split '/', "/$added", -1; my ($code, $error) = _check_structure($Structure, \@added); push @errors, "$error: $added" if $code == 0; } croak join("\n", "$HOOK:", @errors), "\n" if @errors; return; } 1; # End of SVN::Hooks::CheckStructure __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::CheckStructure - Check the structure of a repository. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin checks if the files and directories added to the repository are allowed by its structure definition. If they don't, the commit is aborted. It's active in the C hook. It's configured by the following directive. =head2 CHECK_STRUCTURE(STRUCT_DEF) This directive enables the checking, causing the commit to abort if it doesn't comply. The STRUCT_DEF argument specify the repository strucure with a recursive data structure consisting of one of: =over =item ARRAY REF An array ref specifies the contents of a directory. The referenced array must contain a pair number of elements. Each pair consists of a NAME_DEF and a STRUCT_DEF. The NAME_DEF specifies the name of the component contained in the directory and the STRUCT_DEF specifies recursively what it must be. The NAME_DEF specifies a name in one of these ways: =over =item STRING A string specifies a name directly. =item REGEXP A regexp specifies the class of names that match it. =item NUMBER A number may be used as an else-clause. A non-zero number means that any name not yet matched by the previous pair must conform to the associated STRUCT_DEF. A zero means that no name will do and signals an error. In this case, if the STRUCT_DEF is a string it is used as a help message shown to the user. =back If no NAME_DEF matches the component being looked for, then it is a structure violation and the commit fails. =item STRING A string must be one of 'FILE' and 'DIR', specifying what the current component must be. =item NUMBER A non-zero number simply tells that whatever the current component is is ok and finishes the check successfully. A zero tells that whatever the current component is is a structure violation and aborts the commit. =back Now that we have this semi-formal definition off the way, let's try to understand it with some examples. my $tag_rx = qr/^[a-z]+-\d+\.\d+$/; # e.g. project-1.0 my $branch_rx = qr/^[a-z]+-/; # must start with letters and hifen my $project_struct = [ 'META.yml' => 'FILE', 'Makefile.PL' => 'FILE', ChangeLog => 'FILE', LICENSE => 'FILE', MANIFEST => 'FILE', README => 'FILE', t => [ qr/\.t$/ => 'FILE', ], lib => 'DIR', ]; CHECK_STRUCTURE( [ trunk => $project_struct, branches => [ $branch_rx => $project_rx, ], tags => [ $tag_rx => $project_rx, ], ], ); The structure's first level consists of the three usual directories: C, C, and C. Anything else in this level is denied. Below the C we allow some usual files and two directories only: C and C. Below C we may allow only test files with the C<.t> extension and below C we allow anything. We require that each branch and tag have the same structure as the C, which is made easier by the use of the C<$project_struct> variable. Moreover, we impose some restrictions on the names of the tags and the branches. =for Pod::Coverage pre_commit =head1 EXPORT =head2 check_structure(STRUCT_DEF, PATH) SVN::Hooks::CheckStructure exports a function to allow for the verification of path structures outside the context of a Subversion hook. (It would probably be better to take this function to its own module and use that module here. We'll take care of that eventually.) The function check_structure takes two arguments. The first is a STRUCT_DEF exactly the same as specified for the CHECK_STRUCTURE directive above. The second is a PATH to a file which will be checked against the STRUCT_DEF. The function returns true if the check succeeds and dies with a proper message otherwise. The function is intended to check paths as they're shown by the 'svn ls' command, i.e., with no leading slashes and with a trailing slash to indicate directories. The leading slash is assumed if it's missing, but the trailing slash is needed to indicate directories. =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut AllowLogChange.pm100644004231004231 467313011116525 21276 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::AllowLogChange; # ABSTRACT: Allow changes in revision log messages. $SVN::Hooks::AllowLogChange::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'ALLOW_LOG_CHANGE'; our @EXPORT = ($HOOK); my @Valid_Users; sub ALLOW_LOG_CHANGE { my @args = @_; foreach my $who (@args) { if (is_string($who) || is_rx($who)) { push @Valid_Users, $who; } else { croak "$HOOK: invalid argument '$who'\n"; } } PRE_REVPROP_CHANGE(\&pre_revprop_change); return 1; } sub pre_revprop_change { my ($svnlook, $rev, $author, $propname, $action) = @_; $propname eq 'svn:log' or croak "$HOOK: the revision property $propname cannot be changed.\n"; $action eq 'M' or croak "$HOOK: a revision log can only be modified, not added or deleted.\n"; # If no users are specified, anyone can do it. return unless @Valid_Users; for my $user (@Valid_Users) { return if is_string($user) && $author eq $user || $author =~ $user; } croak "$HOOK: you are not allowed to change a revision log.\n"; } 1; # End of SVN::Hooks::AllowLogChange __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::AllowLogChange - Allow changes in revision log messages. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin is used to allow revision log changes by some users. It's deprecated. You should use SVN::Hooks::AllowPropChange instead. It's active in the C hook. It's configured by the following directive. =head2 ALLOW_LOG_CHANGE(WHO, ...) This directive enables the change of revision log messages, which are maintained in the C revision property. The optional WHO argument specifies the users that are allowed to make those changes. If absent, any user can change a log message. Otherwise, it specifies the allowed users depending on its type. =over =item STRING Specify a single user by name. =item REGEXP Specify the class of users whose names are matched by the Regexp. =back ALLOW_LOG_CHANGE(); ALLOW_LOG_CHANGE('jsilva'); ALLOW_LOG_CHANGE(qr/silva$/); =for Pod::Coverage pre_revprop_change =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CheckMimeTypes.pm100644004231004231 603713011116525 21316 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::CheckMimeTypes; # ABSTRACT: Require the svn:mime-type property. $SVN::Hooks::CheckMimeTypes::VERSION = '1.34'; use strict; use warnings; use Carp; use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'CHECK_MIMETYPES'; our @EXPORT = ($HOOK); my $Help = <<"EOS"; You may want to consider uncommenting the auto-props section in your ~/.subversion/config file. Read the Subversion book (http://svnbook.red-bean.com/), Chapter 7, Properties section, Automatic Property Setting subsection for more help. EOS sub CHECK_MIMETYPES { my ($help) = @_; $Help = $help if defined $help; PRE_COMMIT(\&pre_commit); return 1; } sub pre_commit { my ($svnlook) = @_; my @errors; foreach my $added ($svnlook->added()) { next if $added =~ m:/$:; # disregard directories my $props = $svnlook->proplist($added); next if exists $props->{'svn:special'}; # disregard symbolic links too unless (my $mimetype = $props->{'svn:mime-type'}) { push @errors, "property svn:mime-type is not set for: $added"; } elsif ($mimetype =~ m:^text/:) { for my $prop ('svn:eol-style', 'svn:keywords') { push @errors, "property $prop is not set for text file: $added" unless exists $props->{$prop}; } } } if (@errors) { croak "$HOOK:\n", join("\n", @errors), <<'EOS', $Help; Every added file must have the svn:mime-type property set. In addition, text files must have the svn:eol-style and svn:keywords properties set. For binary files try running svn propset svn:mime-type application/octet-stream path/of/file For text files try svn propset svn:mime-type text/plain path/of/file svn propset svn:eol-style native path/of/file svn propset svn:keywords 'Author Date Id Revision' path/of/file EOS } } 1; # End of SVN::Hooks::CheckMimeTypes __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::CheckMimeTypes - Require the svn:mime-type property. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin checks if the files added to the repository have the B property set. Moreover, for text files, it checks if the properties B and B are also set. The plugin was based on the L script. It's active in the C hook. It's configured by the following directive. =head2 CHECK_MIMETYPES([MESSAGE]) This directive enables the checking, causing the commit to abort if it doesn't comply. The MESSAGE argument is an optional help message shown to the user in case the commit fails. Note that by default the plugin already inserts a rather verbose help message in case of errors. CHECK_MIMETYPES("Use TortoiseSVN -> Properties menu option to set properties."); =for Pod::Coverage pre_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut AllowPropChange.pm100644004231004231 624713011116525 21474 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::AllowPropChange; # ABSTRACT: Allow changes in revision properties. $SVN::Hooks::AllowPropChange::VERSION = '1.34'; use strict; use warnings; use Carp; use Data::Util qw(:check); use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'ALLOW_PROP_CHANGE'; our @EXPORT = ($HOOK); my @Specs; sub ALLOW_PROP_CHANGE { my @args = @_; my @whos; foreach my $arg (@args) { if (is_string($arg) || is_rx($arg)) { push @whos, $arg; } else { croak "$HOOK: invalid argument '$arg'\n"; } } @whos != 0 or croak "$HOOK: you must specify at least the first argument\n"; my $prop = shift @whos; push @Specs, [$prop => \@whos]; PRE_REVPROP_CHANGE(\&pre_revprop_change); return 1; } sub pre_revprop_change { my ($svnlook, $rev, $author, $propname, $action) = @_; $propname =~ /^svn:(?:author|date|log)$/ or croak "$HOOK: the revision property $propname cannot be changed.\n"; $action eq 'M' or croak "$HOOK: revision properties can only be modified, not added or deleted.\n"; foreach my $spec (@Specs) { my ($prop, $whos) = @$spec; if (is_string($prop)) { next if $propname ne $prop; } else { next if $propname !~ $prop; } for my $who (@$whos) { if (is_string($who)) { return if $author eq $who; } else { return if $author =~ $who; } } } croak "$HOOK: you are not allowed to change property $propname.\n"; } 1; # End of SVN::Hooks::AllowPropChange __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::AllowPropChange - Allow changes in revision properties. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin is used to allow revision (or non-versioned) properties (C, C, and C) to be changed by a group of users. It's active in the C hook. It's configured by the following directive. =head2 ALLOW_PROP_CHANGE(PROP => WHO, ...) This directive enables the change of revision properties. By default any change is denied unless explicitly allowed by the directive. You can use the directive more than once. The PROP argument specifies the propertie(s) that are to be configured depending on its type. If no argument is given, no user can change any property. =over =item STRING Specify a single property by name (C, C, or C). =item REGEXP Specify all properties that match the Regexp. =back The optional WHO arguments specify the users that are allowed to make those changes. If absent, no user can change a log message. Otherwise, it specifies the allowed users depending on its type. =over =item STRING Specify a single user by name. =item REGEXP Specify the class of users whose names are matched by the Regexp. =back ALLOW_PROP_CHANGE('svn:log' => 'jsilva'); # jsilva can change svn:log ALLOW_PROP_CHANGE(qr/./ => qr/silva$/); # any *silva can change any property =for Pod::Coverage pre_revprop_change =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CheckCapability.pm100644004231004231 374213011116525 21463 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/lib/SVN/Hookspackage SVN::Hooks::CheckCapability; # ABSTRACT: Check the svn client capabilities. $SVN::Hooks::CheckCapability::VERSION = '1.34'; use strict; use warnings; use Carp; use SVN::Hooks; use Exporter qw/import/; my $HOOK = 'CHECK_CAPABILITY'; our @EXPORT = ($HOOK); my @Capabilities; sub CHECK_CAPABILITY { push @Capabilities, @_; START_COMMIT(\&start_commit); return 1; } sub start_commit { my ($repo_path, $user, $capabilities, $txt_name) = @_; $capabilities ||= ''; # pre 1.5 svn clients don't pass the capabilities # Create a hash to facilitate the checks my %supported; @supported{split /:/, $capabilities} = undef; # Grok which required capabilities are missing my @missing = grep {! exists $supported{$_}} @Capabilities; if (@missing) { croak "$HOOK: Your subversion client does not support the following capabilities:\n\n\t", join(', ', @missing), "\n\nPlease, consider upgrading to a newer version of your client.\n"; } } 1; # End of SVN::Hooks::CheckCapability __END__ =pod =encoding UTF-8 =head1 NAME SVN::Hooks::CheckCapability - Check the svn client capabilities. =head1 VERSION version 1.34 =head1 SYNOPSIS This SVN::Hooks plugin checks if the Subversion client implements the required capabilities. It's active in the C hook. It's configured by the following directive. =head2 CHECK_CAPABILITY(CAPABILITY...) This directive enables the checking, causing the commit to abort if it doesn't comply. The arguments are a list of capability names. Every capability specified must be supported by the client in order to the hook to succeed. Example: CHECK_CAPABILITY('mergeinfo'); =for Pod::Coverage start_commit =head1 AUTHOR Gustavo L. de M. Chaves =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 by CPqD . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut check-filesize-limit.pl100755004231004231 103513011116525 21757 0ustar00gustavogustavo000000000000SVN-Hooks-1.34/examples# Check if every added/updated file is smaller than a fixed limit. my $LIMIT = 10 * 1024 * 1024; # 10MB # Note that this need at least version 0.29 of SVN::Look, which # implements method 'filesize', new with Subversion 1.7.0. PRE_COMMIT { my ($svnlook) = @_; foreach my $file ($svnlook->added(), $svnlook->updated()) { next if $file =~ m:/$:; # skip directories my $size = $svnlook->filesize($file); die "Added file '$file' has $size bytes, more than our current limit of $LIMIT bytes.\n" if $size > $LIMIT; } }; 1;