webcheckout

   1 #!/usr/bin/perl
   2 use LWP::Simple;
   3 use HTML::Parser;
   4 use warnings;
   5 use strict;
   6
   7 # Controls whether to print what is being done.
   8 my $verbose=1;
   9
  10 # Controls whether to actually check anything out.
  11 my $noact=1;
  12
  13 # Controls whether to perfer repos that use authentication.
  14 my $want_auth=0;
  15
  16 # Controls where to check out to. If not set, the vcs is allowed to
  17 # decide.
  18 my $destdir;
  19
  20 # how to perform checkouts
  21 my %handlers=(
  22         git => sub { doit("git", "clone", shift, $destdir) },
  23         svn => sub { doit("svn", "checkout", shift, $destdir) },
  24         bzr => sub { doit("bzr", "branch", shift, $destdir) },
  25 );
  26
  27 # Regexps matching urls that are used for anonymous
  28 # repository checkouts. The order is significant:
  29 # urls matching earlier in the list are preferred over
  30 # those matching later.
  31 my @anon_urls=(
  32         qr/^git:\/\//i,
  33         qr/^bzr:\/\//i,
  34         qr/^svn:\/\//i,
  35         qr/^http:\/\//i, # generally the worst transport
  36 );
  37
  38 sub doit {
  39         my @args=grep { defined } @_;
  40         print join(" ", @args)."\n" if $verbose;
  41         return 0 if $noact;
  42         return system(@args);
  43 }
  44
  45 # Is repo a better than repo b?
  46 sub better {
  47         my ($a, $b)=@_;
  48
  49         my $firstanon=$b;
  50         foreach my $r (@anon_urls) {
  51                 if ($a->{href} =~ /$r/) {
  52                         $firstanon=$a;
  53                         last;
  54                 }
  55                 elsif ($b->{href} =~ /$r/) {
  56                         $firstanon=$b;
  57                         last;
  58                 }
  59         }
  60
  61         if ($want_auth) {
  62                 return $firstanon != $a;
  63         }
  64         else {
  65                 return $firstanon == $a;
  66         }
  67 }
  68
  69 # Eliminate duplicate repositories from list.
  70 # Duplicate repositories have the same title, or the same href.
  71 sub dedup {
  72         my %seenhref;
  73         my %bytitle;
  74         foreach my $repo (@_) {
  75                 if (exists $repo->{title} &&
  76                     length $repo->{title} &&
  77                     exists $bytitle{$repo->{title}}) {
  78                         my $other=$bytitle{$repo->{title}};
  79                         next unless better($repo, $other);
  80                         delete $bytitle{$other->{title}}
  81                 }
  82
  83                 if (! $seenhref{$repo->{href}}++) {
  84                         $bytitle{$repo->{title}}=$repo;
  85                 }
  86         }
  87
  88         return values %bytitle;
  89 }
  90
  91 sub parse {
  92         my $page=shift;
  93
  94         my @ret;
  95         my $parser=HTML::Parser->new(api_version => 3);
  96         $parser->handler(start => sub {
  97                 my $tagname=shift;
  98                 my $attr=shift;
  99                 return if lc $tagname ne 'link';
 100                 return if ! exists $attr->{rel} || lc $attr->{rel} ne 'vcs';
 101                 return if ! exists $attr->{href} || ! length $attr->{href};
 102                 return if ! exists $attr->{type} || ! length $attr->{type};
 103                 push @ret, $attr;
 104         }, "tagname, attr");
 105         $parser->parse($page);
 106         $parser->eof;
 107
 108         return @ret;
 109 }
 110
 111 my $url=shift;
 112 if (! defined $url) {
 113         die "usage: webcheckout url\n";
 114 }
 115
 116 my $page=get($url);
 117 if (! defined $page) {
 118         die "failed to download $url\n";
 119 }
 120
 121 my @repos=dedup(parse($page));
 122 if (! @repos) {
 123         die "no repositories found on $url\n";
 124 }
 125
 126 my $errors=0;
 127 foreach my $repo (@repos) {
 128         my $handler=$handlers{$repo->{type}};
 129         if ($handler) {
 130                 if ($handler->($repo->{href}) != 0) {
 131                         print STDERR "failed to checkout ".$repo->{href}."\n";
 132                         $errors++;
 133                 }
 134         }
 135         else {
 136                 print STDERR "unknown repository type ".$repo->{type}.
 137                         " for ".$repo->{href}."\n";
 138                 $errors++;
 139         }
 140 }
 141 exit($errors > 0);
 142
 143 #use Data::Dumper;
 144 #print Dumper(\@repos);