5 use warnings FATAL => 'all';
7 #use File::ShareDir 'dist_dir';
11 use File::Slurp qw(write_file);
12 use Class::Accessor 'antlers';
15 our $VERSION = '0.02';
19 Freeside testing suite
27 Returns the path to the shared data directory, which contains the reference
28 database image, the test plan, and probably other stuff.
34 # we no longer install this anywhere
35 my @dirs = File::Spec->splitdir(File::Spec->rel2abs(__FILE__));
36 splice @dirs, -3; # lib/FS/Test.pm
37 File::Spec->catdir( @dirs, 'share' );
42 Creates a test session. OPTIONS must contain 'dir', a directory to save the
43 output files into (this may eventually default to a temp directory). It can
46 - fsurl: the root Freeside url [http://localhost/freeside]
47 - user: the Freeside test username [test]
48 - pass: the Freeside test password [test]
52 has dir => ( is => 'rw' );
53 has fsurl => ( is => 'rw' );
54 has user => ( is => 'rw' );
55 has pass => ( is => 'rw' );
56 has mech => ( is => 'rw' );
61 fsurl => 'http://localhost/freeside',
68 # strip trailing slash, if any; it causes problems
69 $self->{fsurl} =~ s(/$)();
71 die "FS::Test->new: 'dir' required" unless $self->dir;
72 if ( ! -d $self->dir ) {
74 or die "can't create '".$self->dir."': $!";
76 if ( ! -w $self->dir ) {
77 die "FS::Test->new: can't write to '". $self->dir . "'";
80 $self->mech( WWW::Mechanize->new( autocheck => 0 ) );
83 $self->mech->credentials( $self->user, $self->pass );
96 Takes one or more PATHS (Freeside URIs, relative to $self->fsurl, including
97 query parameters) and downloads them from the web server, into the output
98 directory. Currently this will write progress messages to standard output.
99 If you don't like that, it's open source, fix it.
106 local $CWD = $self->dir;
108 my $base_uri = URI->new($self->fsurl);
109 my $basedirs = () = $base_uri->path_segments;
111 foreach my $path (@_) {
116 if ($path =~ /^#(.*)/) {
121 my $uri = URI->new( $self->fsurl . '/' . $path);
123 my $response = $self->mech->get($uri);
124 print " - " . $self->mech->status . "\n";
125 next unless $response->is_success;
128 my @dirs = $uri->path_segments;
129 splice @dirs, 0, $basedirs;
131 if ( length($uri->query) ) {
132 # if there's a query string, use the (server-side) file name as the
133 # last directory, and the query string as the local file name; this
134 # allows multiple tests that differ only in the query string.
135 push @dirs, $uri->query;
137 my $file = pop @dirs;
138 # make the filename safe for inclusion in a makefile/shell script.
139 # & and ; are both bad; using ":" is reversible and unambiguous (because
140 # it can't appear in query params)
142 foreach my $dir (@dirs) {
143 mkdir $dir unless -d $dir;
146 write_file($file, {binmode => ':utf8'}, $response->decoded_content);
148 # Detect Mason errors and make noise about them; they're presumably
149 # _never_ correct. Mason errors have one convenient property: there's no
150 # <title> element on the page.
151 if ( $self->mech->ct eq 'text/html' and !$self->mech->title ) {
152 print "***error***\n";
157 # what we don't do in here is diff the results.
158 # Test::HTML::Differences from CPAN would be one way to do that.