Add _selftest() function and test script to verify Grabber functionality

diff --git a/videosite-test.pl b/videosite-test.pl
new file mode 100755 (executable)
index 0000000..a0b71b9
--- /dev/null
+++ b/videosite-test.pl
@@ -0,0 +1,119 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Long;
+use File::Spec;
+use File::Basename;
+use Cwd qw(realpath);
+
+sub ploader {
+
+    my $dir = shift;
+    my $pattern = shift;
+    my $type = shift;
+    my @list;
+    my $p;
+    my $g;
+    my @g = ();
+
+    unshift(@INC, $dir);
+
+    opendir(D, $dir) || return ();
+    @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
+    closedir(D);
+
+    foreach $p (@list) {
+        $p =~ s/\.pm$//;
+        eval qq{ require videosite::$p; };
+        if ($@) {
+            print("Failed to load plugin: $@");
+            next;
+        }
+
+        $g = eval qq{ videosite::$p->new();};
+        if ($@) {
+            print("Failed to instanciate: $@");
+            delete($INC{$p});
+            next;
+        }
+
+        if ($type eq $g->{'TYPE'}) {
+            push(@g, $g);
+        } else {
+            printf('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
+            delete($INC{$p});
+        }
+    }
+
+    return @g;
+}
+
+sub connectors {
+    my $c = {-name => 'environment', -schemas => {}};
+
+    if (exists($ENV{'http_proxy'})) {
+        $c->{-schemas}->{'http'} = $ENV{'http_proxy'}
+    }
+
+    if (exists($ENV{'https_proxy'})) {
+        $c->{-schemas}->{'https'} = $ENV{'https_proxy'}
+    }
+
+    return ( $c );
+}
+
+
+my $hq = 0;
+my $ext = '.flv';
+my $y;
+my $f;
+my $m;
+my @g;
+my $bp;
+my $debug = 0;
+my ($success, $notest, $fail) = (0,0,0);
+
+GetOptions("d" => \$debug);
+
+# This is some dark magic to find out our real base directory,
+# where we hope to find our plugins.
+$bp = File::Spec->catdir(dirname(realpath($0)), 'videosite');
+unshift(@INC, dirname(realpath($0)));
+
+@g = ploader($bp, '.*Grabber\.pm$', 'grabber');
+($f) = ploader($bp, '^FileGetter\.pm$', 'getter');
+
+unless(@g and defined($f)) {
+    print("No plugins could be loaded\n");
+    exit 1;
+}
+
+foreach (@g, $f) {
+    $_->setio(sub { printf(@_); print("\n"); } );
+
+    if ($debug) {
+        $_->setdebug(1);
+        $_->setconn(\&connectors);
+    }
+}
+
+printf("Doing self tests:\n");
+foreach(@g) {
+    my $r;
+
+    printf("  %s...", $_->{'NAME'});
+    $r = $_->_selftest();
+    if(defined($r)) {
+        if ($r == 1) {
+            printf(" OK\n");
+            $success++;
+        } else {
+            printf(" no self test\n");
+            $notest++;
+        }
+    } else {
+        $fail++;
+    }
+}
+
+printf("\n\n%d succeeded\n%d failed\n%d not testable\n", $success, $fail, $notest);

diff --git a/videosite/GrabberBase.pm b/videosite/GrabberBase.pm
index e39be83..e354bc9 100644 (file)
--- a/videosite/GrabberBase.pm
+++ b/videosite/GrabberBase.pm
@@ -68,4 +68,25 @@ sub _parse {
     return undef;
 }
 
+sub _selftest {
+    my $self = shift;
+    my $info;
+
+    unless(exists($self->{_SELFTESTURL}) and exists($self->{_SELFTESTTITLE})) {
+        return 0;
+    }
+
+    unless(defined($info = $self->get($self->{_SELFTESTURL}))) {
+        $self->error("Could not get information from %s", $self->{_SELFTESTURL});
+        return undef;
+    }
+
+    unless($info->{TITLE} eq $self->{_SELFTESTTITLE}) {
+        $self->error("Title from info does not equal expected result (%s != %s)", $info->{TITLE}, $self->{_SELFTESTTITLE});
+        return undef;
+    }
+
+    return 1;
+}
+
 1;