5 use warnings FATAL => 'all';
7 use File::ShareDir 'dist_dir';
11 use File::Slurp qw(write_file);
12 use Class::Accessor 'antlers';
14 our $VERSION = '0.01';
18 Freeside testing suite
26 Returns the path to the shared data directory, which contains the reference
27 database image, the test plan, and probably other stuff.
37 Creates a test session. OPTIONS must contain 'dir', a directory to save the
38 output files into (this may eventually default to a temp directory). It can
41 - fsurl: the root Freeside url [http://localhost/freeside]
42 - user: the Freeside test username [test]
43 - pass: the Freeside test password [test]
47 has dir => ( is => 'rw' );
48 has fsurl => ( is => 'rw' );
49 has user => ( is => 'rw' );
50 has pass => ( is => 'rw' );
51 has mech => ( is => 'rw' );
56 fsurl => 'http://localhost/freeside',
63 # strip trailing slash, if any; it causes problems
64 $self->{fsurl} =~ s(/$)();
66 die "FS::Test->new: 'dir' required" unless $self->dir;
67 if ( ! -d $self->dir ) {
69 or die "can't create '".$self->dir."': $!";
71 if ( ! -w $self->dir ) {
72 die "FS::Test->new: can't write to '". $self->dir . "'";
75 $self->mech( WWW::Mechanize->new( autocheck => 0 ) );
78 my $login = $self->fsurl . '/index.html';
79 $self->mech->get($login)
80 or die "FS::Test->new: couldn't fetch $login";
81 $self->mech->submit_form(
83 credential_0 => $self->user,
84 credential_1 => $self->pass,
99 Takes one or more PATHS (Freeside URIs, relative to $self->fsurl, including
100 query parameters) and downloads them from the web server, into the output
101 directory. Currently this will write progress messages to standard output.
102 If you don't like that, it's open source, fix it.
109 local $CWD = $self->dir;
111 my $base_uri = URI->new($self->fsurl);
112 my $basedirs = () = $base_uri->path_segments;
114 foreach my $path (@_) {
119 if ($path =~ /^#(.*)/) {
124 my $uri = URI->new( $self->fsurl . '/' . $path);
126 my $response = $self->mech->get($uri);
127 print " - " . $self->mech->status . "\n";
128 next unless $response->is_success;
131 my @dirs = $uri->path_segments;
132 splice @dirs, 0, $basedirs;
134 if ( length($uri->query) ) {
135 # if there's a query string, use the (server-side) file name as the
136 # last directory, and the query string as the local file name; this
137 # allows multiple tests that differ only in the query string.
138 push @dirs, $uri->query;
140 my $file = pop @dirs;
141 # make the filename safe for inclusion in a makefile/shell script.
142 # & and ; are both bad; using ":" is reversible and unambiguous (because
143 # it can't appear in query params)
145 foreach my $dir (@dirs) {
146 mkdir $dir unless -d $dir;
149 write_file($file, {binmode => ':utf8'}, $response->decoded_content);
151 # Detect Mason errors and make noise about them; they're presumably
152 # _never_ correct. Mason errors have one convenient property: there's no
153 # <title> element on the page.
154 if ( $self->mech->ct eq 'text/html' and !$self->mech->title ) {
155 print "***error***\n";
160 # what we don't do in here is diff the results.
161 # Test::HTML::Differences from CPAN would be one way to do that.