package WWW::OpenSVN; use strict; use warnings; use LWP::UserAgent; use LWP::Simple; use HTTP::Cookies; =head1 NAME WWW::OpenSVN - An automated interface for OpenSVN.csie.org. =cut use vars qw($VERSION); $VERSION = '0.1.3'; =head1 SYNOPSIS my $opensvn = WWW::OpenSVN->new( 'project' => "myproject", 'password' => "MySecretPassphrase", ); $opensvn->fetch_dump('filename' => "/backup-dir/myproject-dump.gz"); =head1 FUNCTIONS =cut package WWW::OpenSVN::Base; =head2 WWW::OpenSVN->new() A constructor. Accepts these mandatory named arguments: 'project' - The OpenSVN Project ID. 'password' - The OpenSVN Project Management Password. =cut sub new { my $class = shift; my $self = {}; bless $self, $class; $self->_init(@_); return $self; } sub project { my $self = shift; return $self->{'project'}; } package WWW::OpenSVN::Error; use vars qw(@ISA); @ISA=(qw(WWW::OpenSVN::Base)); sub _init { my $self = shift; my (%args) = (@_); $self->{'project'} = $args{'project'}; $self->{'phase'} = $args{'phase'}; return 0; } sub phase { my $self = shift; return $self->{'phase'}; } package WWW::OpenSVN; use vars qw(@ISA); @ISA=(qw(WWW::OpenSVN::Base)); sub _init { my $self = shift; my (%args) = (@_); $self->{'project'} = $args{'project'} or die "Project ID not specified!"; $self->{'_password'} = $args{'password'} or die "Project Password not speicified!"; return 0; } sub _password { my $self = shift; return $self->{'_password'}; } sub _gen_error { my $self = shift; my (%args) = (@_); die WWW::OpenSVN::Error->new( 'project' => $self->project(), 'phase' => $args{'phase'} ); } sub _get_repos_revision { my $self = shift; if (exists($self->{'repos_revision'})) { return $self->{'repos_revision'}; } my $project = $self->project(); my $url = "http://opensvn.csie.org/$project/"; my $page = get($url); if ($page =~ /Revision (\d+): \/<\/title>/) { return ($self->{'repos_revision'} = $1); } else { $self->_gen_error( 'phase' => 'get_repos_rev', ); } } =head2 $opensvn->fetch_dump('filename' => "myfile.dump.gz") Fetches a subversion repository dump and stores it in a file. Accepts an optional argument - 'filename' that is used to specify the filename to store the dump into. If not specified, it defaults to "$project.dump.gz" =cut sub fetch_dump { my $self = shift; my (%args) = (@_); my $url = "https://opensvn.csie.org/"; my $repos_top_version = $self->_get_repos_revision(); my %login_params = ( 'project' => $self->project(), 'password' => $self->_password(), 'action' => "login", ); my $ua = LWP::UserAgent->new(); $ua->cookie_jar({}); my $response = $ua->post($url, \%login_params); if (!$response->is_success()) { $self->_gen_error( 'phase' => "login", ); } # We only need the previous response for the cookie. my %backup_params = ( 'action' => "backup1", 'r1' => 0, 'r2' => $repos_top_version, 'i' => 1, 'd' => 1, ); $response = $ua->post($url, \%backup_params); if (! $response->is_success()) { $self->_gen_error( 'phase' => "dump_request", ); } my $server_return = $response->content(); my $fetch_file_path; if ($server_return =~ m{_gen_error( 'phase' => "dump_wrong_redirect", ); } $response = $ua->get( "$url$fetch_file_path", ":content_file" => ($args{'filename'} || ($self->project() . ".dump.gz")), ); if (! $response->is_success()) { $self->_gen_error( 'phase' => "dump_fetch" ); } return 0; } 1; __END__ =head1 AUTHOR Shlomi Fish, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2005 Shlomi Fish, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the terms of the MIT X11 License. =cut