WWW::Gitrious かいた。

社内で gitrious をつかってるけど、なんか検索機能が機能してないので、API たたいて勝手にどうこうするスクリプトをかいた。

XML::Simple を最初つかおうとしたけど、めんどくさいばかりなので、結局 XML::LibXML でやっつけた。

package WWW::Gitrious;
use strict;
use warnings;
use parent qw/Class::Accessor::Fast/;
use Carp;
use XML::LibXML;
use LWP::UserAgent;

__PACKAGE__->mk_accessors(qw/ua parser/);

sub new {
    my $class = shift;
    my %args = @_ == 1 ? @{$_[0]} : @_;
    unless ($args{url}) {
        croak "Missing mandatory parameter: url";
    }
    $args{parser} = do {
        local $_ = XML::LibXML->new();
        $_->recover(1);
        $_->recover_silently(1);
        $_->keep_blanks(0);
        $_->expand_entities(1);
        $_->no_network(1);
        $_;
    };
    $args{ua} ||= do {
        my $ua = LWP::UserAgent->new();
    };
    my $self = bless { %args }, $class;
}

sub projects {
    my ($self, $page) = @_;
    $page ||= 1;

    my $res = $self->ua->get("$self->{url}/projects.xml?page=$page");
    $res->is_success or die;
    return unless length($res->content);

    my $docs = $self->parser->parse_string($res->content);
    my @projects = $docs->findnodes('//project');

    my @ret;
    for my $project (@projects) {
        my $h = +{};
        for my $key (qw/license description title slug/) {
            $h->{$key} = $project->findvalue($key);
        }
        for my $path (qw(mainlines clones)) {
            for my $repository ($project->findnodes("./repositories/$path/repository")) {
                push @{$h->{repositories}->{$path}}, {
                    map { $_ => $repository->findvalue($_) }
                    qw/id name clone_url/
                };
            }
        }
        push @ret, $h;
    }
    return @ret;
}

1;

【追記】
結局、web の画面の方の検索おかしいのはなおしてもらた。

Published: 2012-08-08(Wed) 06:40