Test-WWW-Declare-0.02/0000755000076500007650000000000011074500336013736 5ustar sartaksartakTest-WWW-Declare-0.02/Changes0000644000076500007650000000035011074476416015242 0ustar sartaksartak0.02 Sun Oct 12 18:41:15 2008 Depend on new HTTP::Server::Simple to avoid race conditions in tests 0.01 Fri Nov 2 14:34:26 2007 Version bump 0.01_01 Wed Sep 26 16:15:16 2007 Initial release to CPAN Test-WWW-Declare-0.02/doc/0000755000076500007650000000000011074500336014503 5ustar sartaksartakTest-WWW-Declare-0.02/doc/fancy-sessions.t0000755000076500007650000000350110664406634017650 0ustar sartaksartak#!perl use BTDT::Test::WWW::Declare tests => 9; use strict; use warnings; session "gooduser" => run { flow "create task" => check { login as 'gooduser'; fill form 'tasklist-new_item_create' => { summary => "bouncy task", }; click button 'Create'; content should contain "bouncy task"; }; flow "assign task to otheruser" => check { click href qr{bouncy task}; fill form mech->moniker_for("BTDT::Action::UpdateTask", id => 3) => { owner_id => 'otheruser@example.com', }; click button 'Save'; content should contain 'something or other'; }; session "otheruser" => run { flow "accept gooduser's task" => check { login as 'otheruser'; click href qr{unaccepted task(s)?}; content should contain 'bouncy task'; click href qr{bouncy task}; fill form mech->moniker_for('BTDT::Action::AcceptTask') => { accepted => 1, }; click button 'Save'; content should contain 'Task accepted'; }; }; flow "comment on the task I gave" => check { click href qr{bouncy task}; content should contain 'bouncy task'; fill form mech->moniker_for('BTDT::Action::UpdateTask', id => 3) => { comment => "first comment", }; click button 'Save'; session "otheruser" => run { flow "check that we got the comment" => check { reload; content should contain 'first comment'; }; }; }; flow "add another comment" => check { fill form mech->moniker_for('BTDT::Action::UpdateTask', id => 3) => { comment => "second comment", }; click button 'Save'; }; }; Test-WWW-Declare-0.02/inc/0000755000076500007650000000000011074500336014507 5ustar sartaksartakTest-WWW-Declare-0.02/inc/Module/0000755000076500007650000000000011074500336015734 5ustar sartaksartakTest-WWW-Declare-0.02/inc/Module/Install/0000755000076500007650000000000011074500336017342 5ustar sartaksartakTest-WWW-Declare-0.02/inc/Module/Install/Base.pm0000644000076500007650000000203511074477245020566 0ustar sartaksartak#line 1 package Module::Install::Base; $VERSION = '0.70'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 Test-WWW-Declare-0.02/inc/Module/Install/Can.pm0000644000076500007650000000337411074477245020424 0ustar sartaksartak#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.70'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 Test-WWW-Declare-0.02/inc/Module/Install/Fetch.pm0000644000076500007650000000463011074477245020750 0ustar sartaksartak#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.70'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Test-WWW-Declare-0.02/inc/Module/Install/Makefile.pm0000644000076500007650000001416211074477245021435 0ustar sartaksartak#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.70'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 371 Test-WWW-Declare-0.02/inc/Module/Install/Metadata.pm0000644000076500007650000001710711074477245021442 0ustar sartaksartak#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.70'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { local *FH; open FH, "< $_[1]" or die "Cannot open $_[1].pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; } $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; Test-WWW-Declare-0.02/inc/Module/Install/Win32.pm0000644000076500007650000000340211074477245020615 0ustar sartaksartak#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.70'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Test-WWW-Declare-0.02/inc/Module/Install/WriteAll.pm0000644000076500007650000000132111074477245021434 0ustar sartaksartak#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.70'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; Test-WWW-Declare-0.02/inc/Module/Install.pm0000644000076500007650000001711211074477245017716 0ustar sartaksartak#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.70'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ( $self, $1 ); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; # Copyright 2008 Adam Kennedy. Test-WWW-Declare-0.02/lib/0000755000076500007650000000000011074500336014504 5ustar sartaksartakTest-WWW-Declare-0.02/lib/Test/0000755000076500007650000000000011074500336015423 5ustar sartaksartakTest-WWW-Declare-0.02/lib/Test/WWW/0000755000076500007650000000000011074500336016107 5ustar sartaksartakTest-WWW-Declare-0.02/lib/Test/WWW/Declare/0000755000076500007650000000000011074500336017446 5ustar sartaksartakTest-WWW-Declare-0.02/lib/Test/WWW/Declare/Tester.pm0000644000076500007650000000464711074500076021266 0ustar sartaksartak#!perl package Test::WWW::Declare::Tester::Server; use strict; use warnings; use base 'HTTP::Server::Simple::CGI'; my %content = ( index => << "INDEX",

This is an index

good link bad link same good link INDEX good => << "GOOD",

This is a good page

index bad link infinite recursion GOOD formy => << "FORMY",

This page has two forms!

FORMY result1 => sub { my $cgi = shift; my $clever = $cgi->param('clever'); return "

\U$clever\E

"; }, result2 => sub { my $cgi = shift; my $clever = $cgi->param('clever'); return "

\L$clever\E

"; }, ); sub wrap_content { my ($url, $content) = @_; $content =~ s/^/ /mg; $content = << "WRAPPER"; \U$url\E $content WRAPPER return $content; } sub get { my $page = (split '/', shift)[-1]; $page ||= 'index'; $page =~ s/\s+//g; my $content = $content{$page}; return if !defined($content); return wrap_content($page, $content->(@_)) if ref($content) eq 'CODE'; return wrap_content($page, $content); } sub handle_request { my $self = shift; my $cgi = shift; if (my $content = get($cgi->path_info, $cgi)) { print "HTTP/1.0 200 OK\r\n"; print "Content-Type: text/html\r\nContent-Length: ", length($content), "\r\n\r\n", $content; return; } print "HTTP/1.0 404 Not Found\r\n\r\n"; } package Test::WWW::Declare::Tester; use Test::Tester; use Test::WWW::Declare; use base 'Test::More'; our $VERSION = '0.02'; our @EXPORT = qw($PORT $SERVER $PID); our $PORT = 12321; our $SERVER = Test::WWW::Declare::Tester::Server->new($PORT); our $PID = $SERVER->background or die "Cannot start the server"; sleep 1; sub import_extra { Test::Tester->export_to_level(2); Test::WWW::Declare->export_to_level(2); Test::More->export_to_level(2); } END { kill(9, $PID); } 1; Test-WWW-Declare-0.02/lib/Test/WWW/Declare.pm0000644000076500000000000002650411074500077017612 0ustar sartakwheelpackage Test::WWW::Declare; use warnings; use strict; use base 'Test::More'; use Test::WWW::Mechanize; use Test::Builder; our $VERSION = '0.02'; our @EXPORT = qw(flow run get session check mech match follow_link content should shouldnt click href button fill form SKIP _twd_dummy title equal caselessly contain matches equals contains never always lack lacks url uri); our $BUILDER = Test::Builder->new(); our $WWW_MECHANIZE; our $IN_FLOW; our %mechs; =begin private =head2 import_extra Called by L's C code when L is first C'd, it asks Test::More to export its symbols to the namespace that C'd this one. =end private =cut sub import_extra { Test::More->export_to_level(2); } =head1 NAME Test::WWW::Declare - declarative testing for your web app =head1 SYNOPSIS use Test::WWW::Declare tests => 3; use Your::Web::App::Test; Your::Web::App::Test->start_server; session 'testuser' => run { flow 'log in and out' => check { flow 'log in' => check { get 'http://localhost/'; fill form 'login' => { username => 'testuser', password => 'drowssap', }; content should contain 'log out'; }; flow 'log out' => check { get 'http://localhost/'; click href 'log out'; }; }; }; =head1 DESCRIPTION Often in web apps, tests are very dependent on the state set up by previous tests. If one test fails (e.g. "follow the link to the admin page") then it's likely there will be many more failures. This module aims to alleviate this problem, as well as provide a nicer interface to L. The central idea is that of "flow". Each flow is a sequence of commands ("fill in this form") and assertions ("content should contain 'testuser'"). If any of these commands or assertions fail then the flow is aborted. Only that one failure is reported to the test harness and user. Flows may also contain other flows. If an inner flow fails, then the outer flow fails as well. =head1 FLOWS AND SESSIONS =head2 session NAME => run { CODE } Sessions are a way of associating a set of flows with a L instance. A session is mostly equivalent with a user interacting with your web app. Within a session, every command (C, C, etc) is operating on that session's L instance. You may have multiple sessions in one test file. Two sessions with the same name are in fact the same session. This lets you write code like the following, simplified slightly: session 'first user' => run { get "$URL/give?task=1&victim=other"; session 'other user' => run { get "$URL/tasks"; content should match qr/task 1/; # this is the same session/mech as the outermost 'first user' session 'first user' => run { get "$URL/tasks"; content shouldnt match qr/task 1/; }; }; }; =head2 flow NAME => check { CODE } A flow encompasses a single test. As described above, each flow is a sequence of commands, assertions, and other flows. If any of the components of a flow fail, the rest of the flow is aborted and one or more test failures are reported to the test harness. =head1 COMMANDS =head2 get URL =head2 click button =head2 click href =head2 follow_link =head2 fill form NAME => {FIELD1 => VALUE1, FIELD2 => VALUE2} =head1 ASSERTIONS Every assertion has two parts: a subject and a verb. =head2 SUBJECTS =head3 content =head3 title =head3 url =head2 VERBS =head3 should(nt) (caselessly) match REGEX =head3 should(nt) (caselessly) contain STRING =head3 should(nt) (caselessly) lack STRING =head3 should(nt) (caselessly) equal STRING =cut # DSLey functions sub to($) { return $_[0] } sub _args { my $args = shift; return $args if ref($args) eq 'HASH'; return {expected => $args}; } sub should ($) { return _args(shift); } sub shouldnt ($) { my $args = _args(shift); $args->{negative} = 1; return $args; } sub match ($) { my $args = _args(shift); $args->{match} = 'regex'; return $args; } sub equal ($) { my $args = _args(shift); $args->{match} = 'equality'; return $args; } sub contain ($) { my $args = _args(shift); $args->{match} = 'index'; return $args; } sub lack ($) { my $args = _args(shift); $args->{match} = 'index'; $args->{negative} = 1; return $args; } sub caselessly ($) { my $args = _args(shift); $args->{case_insensitive} = 1; return $args; } sub check (&) { my $coderef = shift; return $coderef; } sub run (&) { my $coderef = shift; return $coderef; } # alternates (e.g. "foo matches bar" instead of "foo should match bar") sub contains ($) { contain $_[0] } sub equals ($) { equal $_[0] } sub matches ($) { match $_[0] } sub lacks ($) { lack $_[0] } sub always ($) { should $_[0] } sub never ($) { shouldnt $_[0] } # Mech interactions sub mech(;$) { my $name = shift; return defined $name ? $mechs{$name} : $WWW_MECHANIZE; } sub get { my $url = shift; mech()->get($url); if (!$IN_FLOW) { $BUILDER->ok(mech->success, "navigated to $url"); } return if mech->success; Carp::croak mech->status . (mech->response ? ' - ' . mech->response->message : '') } sub href ($) { return (shift, 'href'); } sub button ($) { return (shift, 'button'); } sub click { my $link = shift; my $type = shift; if ($type eq 'button') { my $ok = mech()->click_button(value => $link); $ok = $ok->is_success if $ok; my $verb = ref($link) eq 'Regexp' ? "matching " : ""; $BUILDER->ok($ok, "Clicked button $verb$link") if !$IN_FLOW; return $ok; } else { if (ref $link ne 'Regexp') { Carp::croak "click doesn't know what to do with a link type of " . ref($link); } my $ok; my $response = mech()->follow_link(text_regex => $link); $ok = 1 if $response && $response->is_success; $BUILDER->ok($ok, "Clicked link matching $link") if !$IN_FLOW; Carp::croak($response ? $response->as_string : "No link matching $link found") if !$ok; return $ok; } } sub follow_link { my $ret = mech()->follow_link(@_); if (!$ret) { Carp::croak "follow_link couldn't find a link matching " . "(" . join(', ', @_) . ")"; } } sub content ($) { _magic_match({got => mech()->content, name => "Content", %{shift @_}}); } sub title ($) { my $title = mech()->title; _magic_match({got => $title, name => "Title '$title'", %{shift @_}}); } sub url ($) { my $url = mech()->uri; _magic_match({got => $url, name => "URL '$url'", %{shift @_}}); } *uri = \&url; # yes, there's a little too much logic in here. that's why it's magic sub _magic_match { my $orig = shift @_; my %args = %$orig; my $match; my @output; $args{negative} ||= 0; push @output, $args{name}; push @output, $args{negative} ? () : "does not"; if ($args{match} eq 'equality') { if ($args{case_insensitive}) { push @output, "caselessly"; $args{got} = lc $args{got}; $args{expected} = lc $args{expected}; } push @output, $args{negative} ? "equals" : "equal"; push @output, $orig->{expected}; $match = $args{got} eq $args{expected}; } elsif ($args{match} eq 'index') { if ($args{case_insensitive}) { push @output, "caselessly"; $args{got} = lc $args{got}; $args{expected} = lc $args{expected}; } push @output, $args{negative} ? "contains" : "contain"; push @output, $orig->{expected}; $match = index($args{got}, $args{expected}) >= 0; } elsif ($args{match} eq 'regex') { if ($args{case_insensitive}) { push @output, "caselessly"; push @output, $args{expected}; $args{expected} = "(?i:$args{expected})"; } push @output, $args{negative} ? "matches" : "match"; push @output, $orig->{expected}; $match = $args{got} =~ $args{expected}; } else { Carp::croak "No \$args{match} (yes this error needs to be fixed)"; } my $ok = ($match ? 1 : 0) ^ $args{negative}; if (!$IN_FLOW) { $BUILDER->ok($ok, join(' ', @output)); return $ok; } return 1 if $ok; Carp::croak join(' ', @output); } sub form ($$) { my $form_name = shift; my $data = shift; my $form = mech()->form_name($form_name); if (!defined($form)) { Carp::croak "There is no form named '$form_name'"; } return $data; } sub fill { my $data = shift; Carp::croak "fill expects a hashref" if ref($data) ne 'HASH'; mech()->set_fields(%{$data}); } # the meat of the module sub SKIP ($) { my $reason = shift; Carp::croak "SKIP: $reason"; } sub flow ($$) { my $name = shift; my $coderef = shift; eval { local $IN_FLOW = 1; $coderef->() }; if ($@ =~ /^SKIP: (.*)$/) { my $reason = $1; $BUILDER->skip($reason); } elsif ($@) { if ($IN_FLOW) { if ($@ =~ /^Flow '/) { die $@; } die "Flow '$name' failed: $@"; } $BUILDER->ok(0, $name); if ($@ =~ /^Flow '/) { $BUILDER->diag($@); } else { $BUILDER->diag("Flow '$name' failed: $@"); } } else { $BUILDER->ok(1, $name); } } sub session ($$) { my $title = shift; my $coderef = shift; $mechs{$title} ||= Test::WWW::Mechanize->new(quiet => 1); local $WWW_MECHANIZE = $mechs{$title}; $coderef->(); if ($@ =~ /^SKIP: (.*)$/) { my $reason = $1; $BUILDER->skip($reason); } elsif ($@ =~ /^Flow '/) { # flow already displayed the error } elsif ($@) { $BUILDER->diag($@); } } sub dump($) { my $file = shift; mech->save_content($file); } # used only for testing that we got T:W:D's goods sub _twd_dummy { "XYZZY" } =head1 SUBCLASSING One of the goals of this module is to let you subclass it to provide extra features, such as automatically logging in a user each time a session is created. =head1 CAVEATS If you fail any tests, then the actual number of tests run may be fewer than you have in your file. This is because when a flow fails, it immediately aborts the rest of its body (which may include other flows). So if you're setting the number of tests based on how many ran, make sure that all tests passed. =head1 BUGS Hopefully few. We'd like to know about any of them. Please report them to C. =head1 SEE ALSO L, L. =head1 MAINTAINER Shawn M Moore C<< >> =head1 ORIGINAL AUTHOR Jesse Vincent C<< >> =head1 COPYRIGHT Copyright 2007-2008 Best Practical Solutions, LLC This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Test-WWW-Declare-0.02/Makefile.PL0000755000076500007650000000061311074476074015726 0ustar sartaksartakuse inc::Module::Install; name 'Test-WWW-Declare'; all_from 'lib/Test/WWW/Declare.pm'; build_requires 'Test::Tester' => '0.107'; build_requires 'HTTP::Server::Simple' => '0.35'; # Work around Test::Builder's complaint about the need to preload Test::Tester. $INC{'Test/Tester.pm'} = __FILE__; requires 'Test::More'; requires 'Test::Builder'; requires 'Test::WWW::Mechanize'; WriteAll; Test-WWW-Declare-0.02/MANIFEST0000644000076500007650000000111611074477447015106 0ustar sartaksartakChanges doc/fancy-sessions.t inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Test/WWW/Declare.pm lib/Test/WWW/Declare/Tester.pm Makefile.PL MANIFEST This list of files META.yml SIGNATURE t/00-load.t t/01-basic.t t/02-skip.t t/03-mech.t t/04-fail.t t/05-forms.t t/06-title.t t/07-alt-names.t t/08-error.t t/09-multisession.t t/10-nested-flow.t t/11-nested-flow-error.t t/12-nested-flow-skip.t t/13-flowless.t Test-WWW-Declare-0.02/META.yml0000644000076500007650000000075011074477245015225 0ustar sartaksartak--- abstract: declarative testing for your web app author: - Best Practical Solutions, LLC build_requires: HTTP::Server::Simple: 0.35 Test::Tester: 0.107 distribution_type: module generated_by: Module::Install version 0.70 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Test-WWW-Declare no_index: directory: - inc - t requires: Test::Builder: 0 Test::More: 0 Test::WWW::Mechanize: 0 version: 0.02 Test-WWW-Declare-0.02/SIGNATURE0000644000076500007650000000506511074500161015224 0ustar sartaksartakThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 48ff1a92e30eb6954bcb9b248df37f6be6db8968 Changes SHA1 c6f11f9c433b61f30078455595178bbdd66473e7 MANIFEST SHA1 10d41809ae6441ff641c08d5c7f47be39abcf872 META.yml SHA1 8e6da5c504e0278f75f846653a6f8f9e0cb27dc2 Makefile.PL SHA1 7866362462e7d5ddec536956cd6a4d743764bd82 doc/fancy-sessions.t SHA1 8b836389e4bc170eb8d19b7296b2f4978ac36136 inc/Module/Install.pm SHA1 85b32a1d5f215d99f411c3dd6113b537fcd5c57d inc/Module/Install/Base.pm SHA1 fde745e180861c7c0ba3ee5a767cafdbdb1d3ebd inc/Module/Install/Can.pm SHA1 e259400ceb54c34def9c994f52d7091108ce7ffc inc/Module/Install/Fetch.pm SHA1 da42b522e5a7ffbae0ceec900f3635ad9990c565 inc/Module/Install/Makefile.pm SHA1 ba005818ee9f97146bfa4e14e53c684e9e446902 inc/Module/Install/Metadata.pm SHA1 85e6b1cf5b7ca81bfb469a99389fa947d4b8a08e inc/Module/Install/Win32.pm SHA1 d32dff9f0d2f02023ca6d79a48d62fd855916351 inc/Module/Install/WriteAll.pm SHA1 a9cb74e6c446a303d108ee0712e26c152b44c179 lib/Test/WWW/Declare.pm SHA1 3df846aef9eb74f50a4d5b628fd1375cef1c038f lib/Test/WWW/Declare/Tester.pm SHA1 9a4d18d8c4fc8a619691f0654738b5e43286ffdf t/00-load.t SHA1 162f15a1cdb4f2be0851361562635fe5887e62b7 t/01-basic.t SHA1 f9b5f4d041826294222571069fccffbbf4687b14 t/02-skip.t SHA1 695cead8c0cf155b179e47f41b5f667057533c73 t/03-mech.t SHA1 e605e2688c3e00b29b292ea043e9175f5c586516 t/04-fail.t SHA1 29523034edfdf0d6fd127945f8ed8475d9829f2b t/05-forms.t SHA1 189a151e3947670846ebe78774f27ab4c99a3168 t/06-title.t SHA1 1471f00cc7add721cd515eaf8db7ea8e057bce6c t/07-alt-names.t SHA1 c845b24562c68b40b8bb1978aa8592738a64edd3 t/08-error.t SHA1 22c10e0718ba1baed0989926d5e5fe7941b121ca t/09-multisession.t SHA1 e0628d10300b95dfb52fb01425acf87fd0c2fe62 t/10-nested-flow.t SHA1 48eaccf733d518aa37d7f95dc32cffe753af5297 t/11-nested-flow-error.t SHA1 34c1bd8496863ee04d83fa4f69e9b9325ac99201 t/12-nested-flow-skip.t SHA1 5b4e46b35abb5f2f328d6e19e43d570fc26500c6 t/13-flowless.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.7 (Darwin) iD8DBQFI8oBtsxfQtHhyRPoRAi2xAJ4/zo9RlC5C/zSDUctgVIB0snzB1wCfYKfc oGX7pgJ82oqS9+N/EE9oWX4= =FXV3 -----END PGP SIGNATURE----- Test-WWW-Declare-0.02/t/0000755000076500007650000000000011074500336014201 5ustar sartaksartakTest-WWW-Declare-0.02/t/00-load.t0000644000076500007650000000045410664406633015536 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 3; ok(1, "successfully got Test::More's exportables"); my @results = run_tests(sub { isnt(2 + 2, 5) } ); is(@results, 2, "successfully got Test::Tester's exportables"); is(_twd_dummy(), "XYZZY", "successfully got Test::WWW::Declare's exportables"); Test-WWW-Declare-0.02/t/01-basic.t0000644000076500007650000000133310676531730015676 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 4; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "basic connectivity" => check { get "http://localhost:$PORT/"; content should match qr{This is an index}; click href qr{good}; content should match qr{This is a good page}i; uri should contain 'good'; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 1, "had one test"); ok($results[0]{ok}, "1st test passed"); is($results[0]{name}, "basic connectivity", "test name was correct"); is($results[0]{diag}, '', 'no warnings/errors'); Test-WWW-Declare-0.02/t/02-skip.t0000644000076500007650000000176510664406633015575 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 9; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "this will skip" => check { get "http://localhost:$PORT/"; SKIP "Just testing skip"; }; flow "make sure we don't skip the rest of the flows" => check { title should equal 'INDEX'; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 2, "had two tests"); ok($results[0]{ok}, "1st test passed"); ok($results[1]{ok}, "1st test passed"); is($results[0]{type}, "skip", "type was skip"); like($results[0]{reason}, qr/^Just testing skip at/, "skip reason was right"); is($results[0]{name}, "", "skipped test name doesn't appear"); is($results[0]{diag}, '', 'no warnings/errors'); is($results[1]{name}, "make sure we don't skip the rest of the flows", "correct name for flow"); is($results[1]{diag}, "", "no warnings/errrors"); Test-WWW-Declare-0.02/t/03-mech.t0000644000076500007650000000142510664406633015535 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 7; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "basic connectivity" => check { get "http://localhost:$PORT/"; mech()->title_is("INDEX", "drop down to mech for checking title"); }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 2, "had three tests"); ok($results[0]{ok}, "1st test passed"); ok($results[1]{ok}, "2nd test passed"); is($results[0]{name}, "drop down to mech for checking title", "1st test was by mech"); is($results[1]{name}, "basic connectivity", "2nd test was flow"); is($results[0]{diag}, "", "no warnings/errors"); is($results[1]{diag}, "", "no warnings/errors"); Test-WWW-Declare-0.02/t/04-fail.t0000644000076500007650000000205210667331474015535 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 7; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "basic connectivity" => check { get "http://localhost:$PORT/"; content should match qr{This is an index}; click href qr{bad}; content should match qr{NOT!}i; }; flow "should be run" => check { get "http://localhost:$PORT/"; content should match qr{This is an index}; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 2, "had two tests"); ok(!$results[0]{ok}, "1st test failed"); ok( $results[1]{ok}, "2nd test passed"); is($results[0]{name}, "basic connectivity", "1st test was flow"); is($results[1]{name}, "should be run", "2nd test was flow"); like($results[0]{diag}, qr/404 Not Found/, "reasonable error message for 'content should match' failing"); is($results[1]{diag}, '', "no errors/warnings on the second flow"); Test-WWW-Declare-0.02/t/05-forms.t0000644000076500007650000000216510664406633015753 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 7; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "search1" => check { get "http://localhost:$PORT/formy"; fill form 'one' => { clever => 'Modestly', }; click button 'sub-mits'; content should match qr{MODESTLY}; }; flow "search2" => check { get "http://localhost:$PORT/formy"; fill form 'two' => { clever => 'Verily', }; click button 'sub-mits 2'; content should match qr{verily}; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 2, "two tests"); ok($results[0]{ok}, "1st test passed"); ok($results[1]{ok}, "2nd test passed"); is($results[0]{name}, "search1", "1st test was flow"); is($results[1]{name}, "search2", "2nd test was flow"); is($results[0]{diag}, '', 'no errors/warnings'); is($results[1]{diag}, '', 'no errors/warnings'); Test-WWW-Declare-0.02/t/06-title.t0000644000076500007650000000164610664406633015752 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 4; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "basic connectivity" => check { get "http://localhost:$PORT/"; title should match qr{in.ex}i; click href qr{good}; title should equal 'GOOD'; click href qr{index}; title should caselessly equal 'InDeX'; title should contain 'DEX'; title shouldnt contain 'dEX'; title should caselessly contain 'dEX'; title should lack 'foo'; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 1, "had two tests"); ok($results[0]{ok}, "1st test passed"); is($results[0]{name}, "basic connectivity", "1st test was flow"); is($results[0]{diag}, '', 'no errors/warnings'); Test-WWW-Declare-0.02/t/07-alt-names.t0000644000076500000000000000172510676537555016321 0ustar sartakwheel#!perl use Test::WWW::Declare::Tester tests => 4; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "basic connectivity" => check { get "http://localhost:$PORT/"; title matches qr{in.ex}i; click href qr{good}; title always equals 'GOOD'; click href qr{index}; title caselessly equals 'InDeX'; title contains 'DEX'; title never contains 'dEX'; title contains caselessly 'dEX'; content shouldnt equal 'anything this short'; content shouldnt match qr/HELLO CPAN/; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 1, "had two tests"); ok($results[0]{ok}, "test passed"); is($results[0]{name}, "basic connectivity", "1st test was flow"); is($results[0]{diag}, '', 'no errors/warnings'); Test-WWW-Declare-0.02/t/08-error.t0000644000076500000000000000202410676537675015566 0ustar sartakwheel#!perl use Test::WWW::Declare::Tester tests => 7; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "click href expects a regex" => check { get "http://localhost:$PORT/"; click href 3; }; flow "no form foo" => check { fill form foo => { true => 'false', false => 'true', }; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 2, "had two tests"); ok(!$results[0]{ok}, "1st test passed"); ok(!$results[1]{ok}, "2nd test passed"); is($results[0]{name}, "click href expects a regex"); is($results[1]{name}, "no form foo"); like($results[0]{diag}, qr/click doesn\'t know what to do with a link type of at/, 'reasonable error message for "click href 3"'); like($results[1]{diag}, qr/Flow 'no form foo' failed: There is no form named 'foo'/, 'reasonable error message for "fill form nonexistent"'); Test-WWW-Declare-0.02/t/09-multisession.t0000644000076500007650000000320010664406633017356 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester; use warnings; use strict; my @testnames = ('a', 'b', 'c', 'argy mech', 'd', 'f', 'e'); plan tests => 1 + 3 * @testnames; my @results = run_tests( sub { session "visit GOOD" => run { flow "a" => check { get "http://localhost:$PORT/"; click href qr{good}; title should equal 'GOOD'; }; session "visit FORMY" => run { flow "b" => check { get "http://localhost:$PORT/formy"; title should equal 'FORMY'; }; }; flow "c" => check { title should equal 'GOOD'; }; is(mech("visit FORMY")->title, "FORMY", "argy mech"); }; session "visit FORMY" => run { flow "d" => check { title should equal 'FORMY'; }; session "visit GOOD" => run { flow "e" => check { title should equal 'GOOD'; session "visit FORMY" => run { flow "f" => check { title should equal 'FORMY'; }; }; }; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, @testnames, "had ".@testnames." tests"); for (1..@testnames) { ok($results[$_-1]{ok}, "test $_ passed") } for (1..@testnames) { is($results[$_-1]{name}, $testnames[$_-1], "correct test name for test $_"); } for (1..@testnames) { is($results[$_-1]{diag}, '', "no errors/warnings") } Test-WWW-Declare-0.02/t/10-nested-flow.t0000644000076500007650000000250110664406633017042 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 13; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "visit index good and formy" => check { flow "visit index" => check { get "http://localhost:$PORT/"; title should equal 'INDEX'; }; flow "visit good" => check { click href qr/good/; title should equal 'GOOD'; }; flow "visit formy" => check { get "http://localhost:$PORT/formy"; title should equal 'FORMY'; }; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 4, "had four tests"); ok($results[0]{ok}, "1st test passed"); ok($results[1]{ok}, "2nd test passed"); ok($results[2]{ok}, "3rd test passed"); ok($results[3]{ok}, "4th test passed"); is($results[0]{name}, "visit index"); is($results[1]{name}, "visit good"); is($results[2]{name}, "visit formy"); is($results[3]{name}, "visit index good and formy"); is($results[0]{diag}, '', 'no errors/warnings'); is($results[1]{diag}, '', 'no errors/warnings'); is($results[2]{diag}, '', 'no errors/warnings'); is($results[3]{diag}, '', 'no errors/warnings'); Test-WWW-Declare-0.02/t/11-nested-flow-error.t0000644000076500007650000000242010667331220020162 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 7; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "visit index good and formy" => check { flow "visit index" => check { get "http://localhost:$PORT/"; title should equal 'INDEX'; }; flow "visit good" => check { click href qr/AAHHH!!!/; # this needs to be line 16 (see last test) title should equal 'GOOD'; }; flow "visit formy" => check { get "http://localhost:$PORT/formy"; title should equal 'FORMY'; }; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 2, "had four tests"); ok($results[0]{ok}, "1st test passed"); ok(!$results[1]{ok}, "2nd test failed"); is($results[0]{name}, "visit index"); is($results[1]{name}, "visit index good and formy"); is($results[0]{diag}, '', 'no errors/warnings'); is($results[1]{diag}, "Flow 'visit good' failed: No link matching (?-xism:AAHHH!!!) found at t/11-nested-flow-error.t line 16\n", 'nested flow failing only reports once, and gives the right line number'); Test-WWW-Declare-0.02/t/12-nested-flow-skip.t0000644000076500007650000000354010664406633020014 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 21; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { flow "visit index good and formy" => check { flow "visit index" => check { get "http://localhost:$PORT/"; title should equal 'INDEX'; }; flow "visit good" => check { SKIP "we have no 'AAHHH!!!' yet"; click href qr/AAHHH!!!/; title should equal 'GOOD'; }; flow "visit formy" => check { get "http://localhost:$PORT/formy"; title should equal 'FORMY'; }; }; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 4, "had four tests"); ok($results[0]{ok}, "1st test passed"); ok($results[1]{ok}, "2nd test passed"); ok($results[2]{ok}, "3rd test passed"); ok($results[3]{ok}, "4th test passed"); is($results[0]{name}, "visit index"); is($results[1]{name}, "", "skipped tests are nameless"); is($results[2]{name}, "visit formy"); is($results[3]{name}, "visit index good and formy"); is($results[0]{type}, "", "no type for normal tests"); is($results[1]{type}, "skip", "type set to skip"); is($results[2]{type}, "", "no type for normal tests"); is($results[3]{type}, "", "no type for normal tests"); is($results[0]{reason}, "", "skip doesn't propagate"); like($results[1]{reason}, qr/^we have no 'AAHHH!!!' yet/, "correct skip reason"); is($results[2]{reason}, "", "skip doesn't propagate"); is($results[3]{reason}, "", "skip doesn't propagate"); is($results[0]{diag}, '', 'no errors/warnings'); is($results[1]{diag}, '', 'no errors/warnings'); is($results[2]{diag}, '', 'no errors/warnings'); is($results[3]{diag}, '', 'no errors/warnings'); Test-WWW-Declare-0.02/t/13-flowless.t0000644000076500007650000000224510667327505016464 0ustar sartaksartak#!perl use Test::WWW::Declare::Tester tests => 13; use warnings; use strict; my @results = run_tests( sub { session "check logins" => run { get "http://localhost:$PORT/"; content should match qr{This is an index}; click href qr{good}; content should match qr{This is a good page}i; }; } ); shift @results; # Test::Tester gives 1-based arrays is(@results, 4, "had four tests"); ok($results[0]{ok}, "1st test passed"); ok($results[1]{ok}, "2st test passed"); ok($results[2]{ok}, "3st test passed"); ok($results[3]{ok}, "4st test passed"); is($results[0]{diag}, '', 'no warnings/errors'); is($results[1]{diag}, '', 'no warnings/errors'); is($results[2]{diag}, '', 'no warnings/errors'); is($results[3]{diag}, '', 'no warnings/errors'); is($results[0]{name}, "navigated to http://localhost:$PORT/", "test name was correct"); is($results[1]{name}, "Content does not match (?-xism:This is an index)", "test name was correct"); is($results[2]{name}, "Clicked link matching (?-xism:good)", "test name was correct"); is($results[3]{name}, "Content does not match (?i-xsm:This is a good page)", "test name was correct");