SVN-Hooks-1.34 000755 004231 004231 0 13011116525 13520 5 ustar 00gustavo gustavo 000000 000000 TODO 100644 004231 004231 3063 13011116525 14273 0 ustar 00gustavo gustavo 000000 000000 SVN-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.
Changes 100644 004231 004231 31404 13011116525 15116 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34 Revision 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.
LICENSE 100644 004231 004231 43713 13011116525 14636 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34 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.
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.ini 100644 004231 004231 1051 13011116525 15242 0 ustar 00gustavo gustavo 000000 000000 SVN-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.yml 100644 004231 004231 4247 13011116525 15061 0 ustar 00gustavo gustavo 000000 000000 SVN-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'
MANIFEST 100644 004231 004231 2224 13011116525 14732 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pod 100644 004231 004231 5422 13011116525 15245 0 ustar 00gustavo gustavo 000000 000000 SVN-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.ini 100644 004231 004231 263 13011116525 15725 0 ustar 00gustavo gustavo 000000 000000 SVN-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
t 000755 004231 004231 0 13011116525 13704 5 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34 00-load.t 100755 004231 004231 1411 13011116525 15365 0 ustar 00gustavo gustavo 000000 000000 SVN-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.PL 100644 004231 004231 3274 13011116525 15561 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 3403 13011116525 15724 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 1711 13011116525 15724 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 1250 13011116525 15761 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 6106 13011116525 16072 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 1760 13011116525 16236 0 ustar 00gustavo gustavo 000000 000000 SVN-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
SVN 000755 004231 004231 0 13011116525 14655 5 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib Hooks.pm 100644 004231 004231 46633 13011116525 16472 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN package 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.t 100755 004231 004231 7033 13011116525 16401 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 3252 13011116525 16745 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pl 100755 004231 004231 12366 13011116525 17421 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/t use 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;
examples 000755 004231 004231 0 13011116525 15257 5 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34 README.txt 100644 004231 004231 223 13011116525 17072 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/examples The 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.t 100755 004231 004231 7552 13011116525 17346 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 6201 13011116525 17275 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100644 004231 004231 533 13011116525 17435 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 12761 13011116525 17472 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 5360 13011116525 17515 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 3413 13011116525 17442 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 2226 13011116525 17467 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100644 004231 004231 503 13011116525 17615 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 3472 13011116525 17646 0 ustar 00gustavo gustavo 000000 000000 SVN-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.t 100755 004231 004231 1773 13011116525 17602 0 ustar 00gustavo gustavo 000000 000000 SVN-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
}
Hooks 000755 004231 004231 0 13011116525 15740 5 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN Mailer.pm 100644 004231 004231 2411 13011116525 17645 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 4564 13011116525 17717 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.t 100644 004231 004231 565 13011116525 20072 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pm 100644 004231 004231 7202 13011116525 20013 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 3767 13011116525 20132 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 36035 13011116525 20310 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.t 100755 004231 004231 2751 13011116525 20535 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pl 100755 004231 004231 4135 13011116525 21010 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pm 100644 004231 004231 6557 13011116525 20643 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pl 100755 004231 004231 2026 13011116525 21111 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pl 100755 004231 004231 1166 13011116525 21021 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pl 100755 004231 004231 1246 13011116525 21252 0 ustar 00gustavo gustavo 000000 000000 SVN-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.pm 100644 004231 004231 7100 13011116525 21216 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 11373 13011116525 21206 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 30206 13011116525 21307 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 17060 13011116525 21420 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 4673 13011116525 21276 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 6037 13011116525 21316 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 6247 13011116525 21474 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pm 100644 004231 004231 3742 13011116525 21463 0 ustar 00gustavo gustavo 000000 000000 SVN-Hooks-1.34/lib/SVN/Hooks package 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.pl 100755 004231 004231 1035 13011116525 21757 0 ustar 00gustavo gustavo 000000 000000 SVN-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;