19 digit visa and discover cards

[freeside.git] / FS-Test / lib / FS / Test.pm

diff --git a/FS-Test/lib/FS/Test.pm b/FS-Test/lib/FS/Test.pm
index 673b8c5..bc97977 100644 (file)
--- a/FS-Test/lib/FS/Test.pm
+++ b/FS-Test/lib/FS/Test.pm
@@ -4,14 +4,15 @@ use 5.006;
 use strict;
 use warnings FATAL => 'all';
 
-use File::ShareDir 'dist_dir';
+#use File::ShareDir 'dist_dir';
 use WWW::Mechanize;
 use File::chdir;
 use URI;
 use File::Slurp qw(write_file);
 use Class::Accessor 'antlers';
+use File::Spec;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 NAME
 
@@ -29,7 +30,11 @@ database image, the test plan, and probably other stuff.
 =cut
 
 sub share_dir {
-  dist_dir('FS-Test')
+#  dist_dir('FS-Test')
+#  we no longer install this anywhere
+  my @dirs = File::Spec->splitdir(File::Spec->rel2abs(__FILE__));
+  splice @dirs, -3; # lib/FS/Test.pm
+  File::Spec->catdir( @dirs, 'share' );
 }
 
 =item new OPTIONS
@@ -74,8 +79,16 @@ sub new {
 
   $self->mech( WWW::Mechanize->new( autocheck => 0 ) );
 
-  #freeside v3
-  $self->mech->credentials( $self->user, $self->pass );
+  #freeside v4_
+  my $login = $self->fsurl . '/index.html';
+  $self->mech->get($login)
+    or die "FS::Test->new: couldn't fetch $login";
+  $self->mech->submit_form(
+    with_fields => {
+      credential_0 => $self->user,
+      credential_1 => $self->pass,
+    },
+  );
 
   return $self;
 }
@@ -116,7 +129,7 @@ sub fetch {
     my $uri = URI->new( $self->fsurl . '/' . $path);
     print $uri->path;
     my $response = $self->mech->get($uri);
-    print " - " . $response->code . "\n";
+    print " - " . $self->mech->status . "\n";
     next unless $response->is_success;
 
     local $CWD;
@@ -139,7 +152,17 @@ sub fetch {
       push @CWD, $dir;
     }
     write_file($file, {binmode => ':utf8'}, $response->decoded_content);
+
+    # Detect Mason errors and make noise about them; they're presumably
+    # _never_ correct.  Mason errors have one convenient property: there's no
+    # <title> element on the page.
+    if ( $self->mech->ct eq 'text/html' and !$self->mech->title ) {
+      print "***error***\n";
+    }
   }
 }
 
+# what we don't do in here is diff the results.
+# Test::HTML::Differences from CPAN would be one way to do that.
+
 1; # End of FS::Test