=head1 NAME SVN::Web::Test - automated web testing for SVN::Web =head1 DESCRIPTION =cut package SVN::Web::Test; use strict; use warnings; our $VERSION = 0.63; use File::Path; use File::Spec; use File::Temp qw(tempdir); use POSIX (); use Test::More; use SVN::Web; use YAML (); my $uri_base; my $script; my $fake_cgi = 0; sub new { my $class = shift; my $self = bless {}, $class; %$self = @_; my @mech_args = exists $self->{mech_args} ? $self->{mech_args} : (); $self->{_mech} = SVN::Web::Test::Mechanize->new(@mech_args); if ( !exists $self->{root_url} ) { if ( exists $self->{httpd_port} ) { $self->{root_url} = "http://localhost:$self->{httpd_port}/svnweb"; } else { $self->{root_url} = "http://localhost/svnweb"; } } $self->{repo_path} = File::Spec->rel2abs( $self->{repo_path} ); $self->{repo_dump} = File::Spec->rel2abs( $self->{repo_dump} ); $self->create_env(); $self->create_install(); return $self; } # Returns the Test::WWW::Mechanize object sub mech { return shift->{_mech}; } sub install_dir { return shift->{install_dir}; } sub site_root { return shift->{root_url}; } sub set_config { my $self = shift; my $opts = shift; $uri_base = $opts->{uri_base}; $script = $opts->{script}; $fake_cgi = 1; my $config = { version => $VERSION, actions => { 'browse' => { 'class' => 'SVN::Web::Browse', 'action_menu' => { 'show' => ['directory'], 'link_text' => '(browse directory)' } }, 'blame' => { 'class' => 'SVN::Web::Blame', 'action_menu' => { 'show' => ['file'], 'link_text' => '(view blame)' } }, 'checkout' => { 'class' => 'SVN::Web::Checkout', 'action_menu' => { 'show' => ['file'], 'link_text' => '(checkout)' } }, 'revision' => { 'class' => 'SVN::Web::Revision' }, 'view' => { 'class' => 'SVN::Web::View', 'action_menu' => { 'show' => ['file'], 'link_text' => '(view file)' } }, 'diff' => { 'class' => 'SVN::Web::Diff' }, 'log' => { 'class' => 'SVN::Web::Log', 'action_menu' => { 'show' => [ 'file', 'directory' ], 'link_text' => '(view revision log)' } }, 'rss' => { 'class' => 'SVN::Web::RSS', 'action_menu' => { 'icon' => '/css/trac/feed-icon-16x16.png', 'show' => [ 'file', 'directory' ], 'head_only' => '1', 'link_text' => '(rss)' } }, 'list' => { 'class' => 'SVN::Web::List' } }, cgi_class => 'Plack::Request', templatedirs => ['template/trac'], %{ $opts->{config} }, }; SVN::Web::set_config($config); } # Create a Subversion repo from a dump file. sub create_env { my $self = shift; plan skip_all => 'Test::WWW::Mechanize not installed' unless eval { require Test::WWW::Mechanize; 1; }; plan skip_all => q{Can't find svnadmin} unless `svnadmin --version` =~ m/version/; rmtree( [ $self->{repo_path} ] ) if -d $self->{repo_path}; $ENV{SVNFSTYPE} ||= ( ( $SVN::Core::VERSION =~ m/^1\.0/ ) ? 'bdb' : 'fsfs' ); `svnadmin create --fs-type=$ENV{SVNFSTYPE} $self->{repo_path}`; `svnadmin load $self->{repo_path} < $self->{repo_dump}`; } # Create a scratch area, run svnweb-install. The generated config.yaml # file will be changed to list the repo created create_env(). # # Returns the directory in which the scratch area is rooted. sub create_install { my $self = shift; $self->{install_dir} = tempdir( CLEANUP => 1 ); #warn "Created $self->{install_dir}\n"; my $cwd = POSIX::getcwd(); chdir( $self->{install_dir} ); my $lib_dir = File::Spec->catdir( $cwd, 'blib', 'lib' ); my $svnweb_install = File::Spec->catfile( $cwd, 'bin', 'svnweb-install' ); system "$^X -I$lib_dir $svnweb_install"; # Make the directory world-readable by all. Otherwise, if Apache is # started as root the default behaviour is to set user/group to -1. # This results in the directory being unreadable by SVN::Web. chmod 0755, $self->{install_dir}; chdir($cwd); # Get back to the original directory # Change the config to point to the test repo my $config_file = File::Spec->catfile( $self->{install_dir}, 'config.yaml' ); my $config = YAML::LoadFile($config_file); $config->{repos}{repos} = $self->{repo_path}; YAML::DumpFile( $config_file, $config ); return $self->{install_dir}; } # Walk the site sub walk_site { my $self = shift; my $test = shift; my $seen = shift || {}; $test->($self); my @links = $self->mech()->links(); for my $i ( 0 .. $#links ) { my $link_url = $links[$i]->url_abs; diag sprintf "Fetching %d/%d %s (%s)", $i + 1, $#links + 1, $link_url, $links[$i]->text()||'' if exists $ENV{TEST_VERBOSE} and $ENV{TEST_VERBOSE}; next if $seen->{$link_url}; diag "Skipping $link_url", next if $link_url !~ m/(?:localhost|127\.0\.0\.1)/; ++$seen->{$link_url}; $self->mech()->get($link_url); $self->walk_site( $test, $seen ); $self->mech()->back; } } package SVN::Web::Test::Mechanize; use base qw(Test::WWW::Mechanize); use Plack::Test; use SVN::Web; use Plack::Builder; sub send_request { my ( $self, $request ) = @_; my $buf = ''; my $uri = $request->uri; my $response; my $app = builder { mount "/svnweb" => sub { SVN::Web->run_psgi(@_) }, }; test_psgi app => $app, client => sub { my $cb = shift; my $req = HTTP::Request->new(GET => $uri); $response = $cb->($req); } ; return $response; } =head1 AUTHORS Chia-liang Kao Eclkao@clkao.orgE and Enik@cpan.org. Dean Hamstead Edean@fragfest.com.auE =head1 COPYRIGHT Copyright (c) 2012 by Dean Hamstead Edean@fragfest.com.auE Copyright (c) 2005-2007 by Nik Clayton Enik@cpan.org. Copyright (c) 2004 by Chia-liang Kao Eclkao@clkao.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut 1;