X-Git-Url: https://git.madduck.net/code/myrepos.git/blobdiff_plain/a48f904fea457d33eb8f7297469945fe3c05e4c1..d8426f37c88c5d980aa93855e40b50c97c282590:/webcheckout diff --git a/webcheckout b/webcheckout index 1238172..a6ae94f 100755 --- a/webcheckout +++ b/webcheckout @@ -127,23 +127,26 @@ sub doit { sub better { my ($a, $b)=@_; - my $firstanon=$b; + my @anon; foreach my $r (@anon_urls) { if ($a->{href} =~ /$r/) { - $firstanon=$a; - last; + push @anon, $a; } elsif ($b->{href} =~ /$r/) { - $firstanon=$b; - last; + push @anon, $b; } } if ($want_auth) { - return $firstanon != $a; + # Whichever is authed is better. + return 1 if ! @anon || ! grep { $_ eq $a } @anon; + return 0 if ! grep { $_ eq $b } @anon; + # Neither is authed, so the better anon method wins. + return $anon[0] == $a; } else { - return $firstanon == $a; + # Better anon method wins. + return @anon && $anon[0] == $a; } } @@ -179,15 +182,37 @@ sub parse { my @ret; my $parser=HTML::Parser->new(api_version => 3); + my $abody=undef; + my $aref=undef; $parser->handler(start => sub { my $tagname=shift; my $attr=shift; - return if lc $tagname ne 'link'; return if ! exists $attr->{rel} || lc $attr->{rel} ne 'vcs'; return if ! exists $attr->{href} || ! length $attr->{href}; return if ! exists $attr->{type} || ! length $attr->{type}; + + # need to collect the body of the tag if there is no title + if ($tagname eq "a" && ! exists $attr->{title}) { + $abody=""; + $aref=$attr; + } + push @ret, $attr; }, "tagname, attr"); + $parser->handler(text => sub { + if (defined $aref) { + $abody.=join(" ", @_); + } + }, "text"); + $parser->handler(end => sub { + my $tagname=shift; + if ($tagname eq "a" && defined $aref) { + $aref->{title}=$abody; + $aref=undef; + $abody=undef; + } + }, "tagname"); + $parser->report_tags(qw{link a}); $parser->parse($page); $parser->eof; @@ -206,10 +231,16 @@ if (! @repos) { die "no repositories found on $url\n"; } +#use Data::Dumper; +#print Dumper(\@repos); +#exit; + if (defined $destdir && @repos > 1) { # create subdirs of $destdir for the multiple repos - mkdir($destdir); - chdir($destdir) || die "failed to chdir to $destdir: $!"; + if (! $noact) { + mkdir($destdir); + chdir($destdir) || die "failed to chdir to $destdir: $!"; + } $destdir=undef; } @@ -229,6 +260,3 @@ foreach my $repo (@repos) { } } exit($errors > 0); - -#use Data::Dumper; -#print Dumper(\@repos);