videosite-test.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Getopt::Long;
   5 use File::Spec;
   6 use File::Basename;
   7 use Cwd qw(realpath);
   8
   9 sub ploader {
  10
  11     my $dir = shift;
  12     my $pattern = shift;
  13     my $type = shift;
  14     my @list;
  15     my $p;
  16     my $g;
  17     my @g = ();
  18
  19     unshift(@INC, $dir);
  20
  21     opendir(D, $dir) || return ();
  22     @list = grep {/$pattern/ && -f File::Spec->catfile($dir, $_) } readdir(D);
  23     closedir(D);
  24
  25     foreach $p (@list) {
  26         $p =~ s/\.pm$//;
  27         eval qq{ require videosite::$p; };
  28         if ($@) {
  29             print("Failed to load plugin: $@");
  30             next;
  31         }
  32
  33         $g = eval qq{ videosite::$p->new();};
  34         if ($@) {
  35             print("Failed to instanciate: $@");
  36             delete($INC{$p});
  37             next;
  38         }
  39
  40         if ($type eq $g->{'TYPE'}) {
  41             push(@g, $g);
  42         } else {
  43             printf('%s has wrong type (got %s, expected %s)', $p, $g->{'TYPE'}, $type);
  44             delete($INC{$p});
  45         }
  46     }
  47
  48     return @g;
  49 }
  50
  51 sub connectors {
  52     my $c = {-name => 'environment', -schemas => {}};
  53
  54     if (exists($ENV{'http_proxy'})) {
  55         $c->{-schemas}->{'http'} = $ENV{'http_proxy'}
  56     }
  57
  58     if (exists($ENV{'https_proxy'})) {
  59         $c->{-schemas}->{'https'} = $ENV{'https_proxy'}
  60     }
  61
  62     return ( $c );
  63 }
  64
  65
  66 my $hq = 0;
  67 my $ext = '.flv';
  68 my $y;
  69 my $f;
  70 my $m;
  71 my @g;
  72 my $bp;
  73 my $debug = 0;
  74 my ($success, $notest, $fail) = (0,0,0);
  75
  76 GetOptions("d" => \$debug);
  77
  78 # This is some dark magic to find out our real base directory,
  79 # where we hope to find our plugins.
  80 $bp = File::Spec->catdir(dirname(realpath($0)), 'videosite');
  81 unshift(@INC, dirname(realpath($0)));
  82
  83 @g = ploader($bp, '.*Grabber\.pm$', 'grabber');
  84 ($f) = ploader($bp, '^FileGetter\.pm$', 'getter');
  85
  86 unless(@g and defined($f)) {
  87     print("No plugins could be loaded\n");
  88     exit 1;
  89 }
  90
  91 foreach (@g, $f) {
  92     $_->setio(sub { printf(@_); print("\n"); } );
  93
  94     if ($debug) {
  95         $_->setdebug(1);
  96         $_->setconn(\&connectors);
  97     }
  98 }
  99
 100 select(STDOUT);
 101 $| = 1;
 102 printf("Doing self tests:\n");
 103 foreach(@g) {
 104     my $r;
 105
 106     printf("  %s...", $_->{'NAME'});
 107     $r = $_->_selftest();
 108     if(defined($r)) {
 109         if ($r == 1) {
 110             printf(" OK\n");
 111             $success++;
 112         } else {
 113             printf(" no self test\n");
 114             $notest++;
 115         }
 116     } else {
 117         $fail++;
 118     }
 119 }
 120
 121 printf("\n\n%d succeeded\n%d failed\n%d not testable\n", $success, $fail, $notest);