| @@ -0,0 +1,138 | |||
|
|
1 | #!/usr/bin/perl | |
|
|
2 | # | |
|
|
3 | # redMine is free software; you can redistribute it and/or | |
|
|
4 | # modify it under the terms of the GNU General Public License | |
|
|
5 | # as published by the Free Software Foundation; either version 2 | |
|
|
6 | # of the License, or (at your option) any later version. | |
|
|
7 | # | |
|
|
8 | # This program is distributed in the hope that it will be useful, | |
|
|
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
|
|
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
|
|
11 | # GNU General Public License for more details. | |
|
|
12 | # | |
|
|
13 | # You should have received a copy of the GNU General Public License | |
|
|
14 | # along with this program; if not, write to the Free Software | |
|
|
15 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. | |
|
|
16 | ||
|
|
17 | use strict; | |
|
|
18 | use SOAP::Lite; | |
|
|
19 | use Getopt::Long; | |
|
|
20 | Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); | |
|
|
21 | use Pod::Usage; | |
|
|
22 | use vars qw/$VERSION/; | |
|
|
23 | ||
|
|
24 | $VERSION = "1.0"; | |
|
|
25 | ||
|
|
26 | my %opts = (verbose => 0); | |
|
|
27 | GetOptions(\%opts, 'verbose|v+', 'version|V', 'help|h', 'man|m', 'quiet|q', 'svn-dir|s=s', 'redmine-host|r=s') or pod2usage(2); | |
|
|
28 | ||
|
|
29 | die "$VERSION\n" if $opts{version}; | |
|
|
30 | pod2usage(1) if $opts{help}; | |
|
|
31 | pod2usage( -verbose => 2 ) if $opts{man}; | |
|
|
32 | ||
|
|
33 | my $repos_base = $opts{'svn-dir'}; | |
|
|
34 | my $redmine_host = $opts{'redmine-host'}; | |
|
|
35 | ||
|
|
36 | pod2usage(2) unless $repos_base and $redmine_host; | |
|
|
37 | ||
|
|
38 | unless (-d $repos_base) { | |
|
|
39 | Log(text => "$repos_base doesn't exist", exit => 1); | |
|
|
40 | } | |
|
|
41 | ||
|
|
42 | Log(level => 1, text => "querying redMine for projects..."); | |
|
|
43 | my $wdsl = "http://$redmine_host/sys/service.wsdl"; | |
|
|
44 | my $service = SOAP::Lite->service($wdsl); | |
|
|
45 | ||
|
|
46 | my $projects = $service->Projects(''); | |
|
|
47 | my $project_count = @{$projects}; | |
|
|
48 | Log(level => 1, text => "retrieved $project_count projects"); | |
|
|
49 | ||
|
|
50 | foreach my $project (@{$projects}) { | |
|
|
51 | Log(level => 1, text => "treating project $project->{name}"); | |
|
|
52 | my $repos_name = $project->{identifier}; | |
|
|
53 | ||
|
|
54 | if ($repos_name eq "") { | |
|
|
55 | Log(text => "\tno identifier for project $project->{name}"); | |
|
|
56 | next; | |
|
|
57 | } | |
|
|
58 | ||
|
|
59 | unless ($repos_name =~ /^[a-z0-9\-]+$/) { | |
|
|
60 | Log(text => "\tinvalid identifier for project $project->{name}"); | |
|
|
61 | next; | |
|
|
62 | } | |
|
|
63 | ||
|
|
64 | my $repos_path = "$repos_base/$repos_name"; | |
|
|
65 | ||
|
|
66 | if (-e $repos_path) { | |
|
|
67 | # check unix right and change them if needed | |
|
|
68 | my $other_read = (stat($repos_path))[2] & 00007; | |
|
|
69 | my $right; | |
|
|
70 | ||
|
|
71 | if ($project->{is_public} and not $other_read) { | |
|
|
72 | $right = "0775"; | |
|
|
73 | } elsif (not $project->{is_public} and $other_read) { | |
|
|
74 | $right = "0770"; | |
|
|
75 | } else { | |
|
|
76 | next; | |
|
|
77 | } | |
|
|
78 | ||
|
|
79 | # change mode | |
|
|
80 | system('chmod', '-R', $right, $repos_path) == 0 or | |
|
|
81 | warn("\tunable to change mode on $repos_path : $?\n"), next; | |
|
|
82 | ||
|
|
83 | Log(text => "\tmode change on $repos_path"); | |
|
|
84 | ||
|
|
85 | } else { | |
|
|
86 | # change umask to suit the repository's privacy | |
|
|
87 | $project->{is_public} ? umask 0002 : umask 0007; | |
|
|
88 | ||
|
|
89 | # create the repository | |
|
|
90 | system('svnadmin', 'create', $repos_path) == 0 or | |
|
|
91 | warn("\tsystem svnadmin failed unable to create $repos_path\n"), next; | |
|
|
92 | ||
|
|
93 | # set the group owner | |
|
|
94 | system('chown', '-R', "root:$repos_name", $repos_path) == 0 or | |
|
|
95 | warn("\tunable to create $repos_path : $?\n"), next; | |
|
|
96 | ||
|
|
97 | Log(text => "\trepository $repos_path created"); | |
|
|
98 | my $call = $service->RepositoryCreated($project->{id}, "svn://host/$repos_name"); | |
|
|
99 | } | |
|
|
100 | } | |
|
|
101 | ||
|
|
102 | ||
|
|
103 | sub Log { | |
|
|
104 | my %args = (level => 0, text => '', @_); | |
|
|
105 | ||
|
|
106 | my $level = delete $args{level}; | |
|
|
107 | my $text = delete $args{text}; | |
|
|
108 | return unless $level <= $opts{verbose}; | |
|
|
109 | return if $opts{quiet}; | |
|
|
110 | print "$text\n"; | |
|
|
111 | ||
|
|
112 | exit $args{exit} | |
|
|
113 | if defined $args{exit}; | |
|
|
114 | } | |
|
|
115 | ||
|
|
116 | ||
|
|
117 | __END__ | |
|
|
118 | ||
|
|
119 | =head1 NAME | |
|
|
120 | ||
|
|
121 | reposman - manages your svn repositories with redMine | |
|
|
122 | ||
|
|
123 | =head1 SYNOPSIS | |
|
|
124 | ||
|
|
125 | reposman [options] arguments | |
|
|
126 | example: reposman --svn-dir=/var/svn --redmine-host=redmine.mydomain.foo | |
|
|
127 | reposman -s /var/svn -r redmine.mydomain.foo | |
|
|
128 | ||
|
|
129 | =head1 ARGUMENTS | |
|
|
130 | ||
|
|
131 | -s, --svn-dir=DIR use DIR as base directory for svn repositories | |
|
|
132 | -r, --redmine-host=HOST assume redMine is hosted on HOST | |
|
|
133 | ||
|
|
134 | =head1 OPTIONS | |
|
|
135 | ||
|
|
136 | -v verbose | |
|
|
137 | -V print version and exit | |
|
|
138 | ||
General Comments 0
You need to be logged in to leave comments.
Login now