]> git.madduck.net Git - code/myrepos.git/blob - webcheckout

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

All patches and comments are welcome. Please squash your changes to logical commits before using git-format-patch and git-send-email to patches@git.madduck.net. If you'd read over the Git project's submission guidelines and adhered to them, I'd be especially grateful.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

9467c9d3032b13ad2cac0c2a26d57853f257f9b2
[code/myrepos.git] / webcheckout
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 webcheckout - check out repositories referenced on a web page
6
7 =head1 SYNOPSIS
8
9 B<webcheckout> [options] url [destdir]
10
11 =head1 DESCRIPTION
12
13 B<webcheckout> downloads an url and parses it, looking for version control 
14 repositories referenced by the page. It checks out each repository into
15 a subdirectory of the current directory, using whatever VCS program is
16 appropriate for that repository (git, svn, etc).
17
18 The information about the repositories is embedded in the web page using
19 the rel=vcs microformat, which is documented at
20 <http://kitenet.net/~joey/rfc/rel-vcs/>.
21
22 If the optional destdir parameter is specified, VCS programs will be asked
23 to check out repositories into that directory. If there are multiple
24 repositories to check out, each will be checked out into a separate
25 subdirectory of the destdir.
26
27 =head1 OPTIONS
28
29 =over 4
30
31 =item -a, --auth
32
33 Prefer authenticated repositories. By default, webcheckout will use
34 anonymous repositories when possible. If you have an account that
35 allows you to use authenticated repositories, you might want to use this
36 option.
37
38 =item -n
39
40 Do not actually check anything out, just print out the commands that would
41 be run to check out the repositories.
42
43 =item -q
44
45 Quiet mode. Do not print out the commands being run. (The VCS commands
46 may still be noisy however.)
47
48 =back
49
50 =head1 AUTHOR
51
52 Copyright 2009 Joey Hess <joey@kitenet.net>
53
54 Licensed under the GNU GPL version 2 or higher.
55
56 This program is included in mr <http://kitenet.net/~joey/code/mr/>
57
58 =cut
59
60 use LWP::Simple;
61 use HTML::Parser;
62 use Getopt::Long;
63 use warnings;
64 use strict;
65
66 # What to download.
67 my $url;
68
69 # Controls whether to print what is being done.
70 my $quiet=0;
71
72 # Controls whether to actually check anything out.
73 my $noact=0;
74
75 # Controls whether to perfer repos that use authentication.
76 my $want_auth=0;
77
78 # Controls where to check out to. If not set, the vcs is allowed to
79 # decide.
80 my $destdir;
81
82 # how to perform checkouts
83 my %handlers=(
84         git => sub { doit("git", "clone", shift, $destdir) },
85         svn => sub { doit("svn", "checkout", shift, $destdir) },
86         bzr => sub { doit("bzr", "branch", shift, $destdir) },
87 );
88
89 # Regexps matching urls that are used for anonymous
90 # repository checkouts. The order is significant:
91 # urls matching earlier in the list are preferred over
92 # those matching later.
93 my @anon_urls=(
94         qr/^git:\/\//i,
95         qr/^bzr:\/\//i,
96         qr/^svn:\/\//i,
97         qr/^http:\/\//i, # generally the worst transport
98 );
99
100 sub getopts {
101         Getopt::Long::Configure("bundling", "no_permute");
102         my $result=GetOptions(
103                 "q|quiet" => \$quiet,
104                 "n|noact" => \$noact,
105                 "a|auth", => \$want_auth,
106         );
107         if (! $result || @ARGV < 1) {
108                 die "usage: webcheckout [options] url [destdir]\n";
109         }
110
111         $url=shift @ARGV;
112         $destdir=shift @ARGV;
113
114         if ($noact) {
115                 $quiet=0;
116         }
117 }
118
119 sub doit {
120         my @args=grep { defined } @_;
121         print join(" ", @args)."\n" unless $quiet;
122         return 0 if $noact;
123         return system(@args);
124 }
125
126 # Is repo a better than repo b?
127 sub better {
128         my ($a, $b)=@_;
129
130         my $firstanon=$b;
131         foreach my $r (@anon_urls) {
132                 if ($a->{href} =~ /$r/) {
133                         $firstanon=$a;
134                         last;
135                 }
136                 elsif ($b->{href} =~ /$r/) {
137                         $firstanon=$b;
138                         last;
139                 }
140         }
141
142         if ($want_auth) {
143                 return $firstanon != $a;
144         }
145         else {
146                 return $firstanon == $a;
147         }
148 }
149
150 # Eliminate duplicate repositories from list.
151 # Duplicate repositories have the same title, or the same href.
152 sub dedup {
153         my %seenhref;
154         my %bytitle;
155         foreach my $repo (@_) {
156                 if (exists $repo->{title} &&
157                     length $repo->{title} &&
158                     exists $bytitle{$repo->{title}}) {
159                         my $other=$bytitle{$repo->{title}};
160                         next unless better($repo, $other);
161                         delete $bytitle{$other->{title}}
162                 }
163
164                 if (! $seenhref{$repo->{href}}++) {
165                         $bytitle{$repo->{title}}=$repo;
166                 }
167         }
168
169         return values %bytitle;
170 }
171
172 sub parse {
173         my $page=shift;
174
175         my @ret;
176         my $parser=HTML::Parser->new(api_version => 3);
177         $parser->handler(start => sub {
178                 my $tagname=shift;
179                 my $attr=shift;
180                 return if lc $tagname ne 'link';
181                 return if ! exists $attr->{rel} || lc $attr->{rel} ne 'vcs';
182                 return if ! exists $attr->{href} || ! length $attr->{href};
183                 return if ! exists $attr->{type} || ! length $attr->{type};
184                 push @ret, $attr;
185         }, "tagname, attr");
186         $parser->parse($page);
187         $parser->eof;
188
189         return @ret;
190 }
191
192 getopts();
193
194 my $page=get($url);
195 if (! defined $page) {
196         die "failed to download $url\n";
197 }
198
199 my @repos=dedup(parse($page));
200 if (! @repos) {
201         die "no repositories found on $url\n";
202 }
203
204 if (defined $destdir && @repos > 1) {
205         # create subdirs of $destdir for the multiple repos
206         mkdir($destdir);
207         chdir($destdir) || die "failed to chdir to $destdir: $!";
208         $destdir=undef;
209 }
210
211 my $errors=0;
212 foreach my $repo (@repos) {
213         my $handler=$handlers{$repo->{type}};
214         if ($handler) {
215                 if ($handler->($repo->{href}) != 0) {
216                         print STDERR "failed to checkout ".$repo->{href}."\n";
217                         $errors++;
218                 }
219         }
220         else {
221                 print STDERR "unknown repository type ".$repo->{type}.
222                         " for ".$repo->{href}."\n";
223                 $errors++;
224         }
225 }
226 exit($errors > 0);
227
228 #use Data::Dumper;
229 #print Dumper(\@repos);