videosite/GrabberBase.pm

   1 # (c) 2007 by Ralf Ertzinger <ralf@camperquake.de>
   2 # licensed under GNU GPL v2
   3
   4 package videosite::GrabberBase;
   5 use videosite::Base;
   6 use MIME::Base64;
   7 use Data::Dumper;
   8 @ISA = qw(videosite::Base);
   9
  10 use strict;
  11
  12 sub new {
  13     my $class = shift;
  14     my $self = $class->SUPER::new(
  15         NAME => 'FlashGrab',
  16         TYPE => 'grabber',
  17         PATTERNS => [],
  18         @_,
  19     );
  20     return bless($self, $class);
  21 }
  22
  23 sub get($$) {
  24     my $self = shift;
  25     my $url = shift;
  26     my $pattern;
  27     my $res;
  28
  29     return undef unless $self->_getval('enabled');
  30
  31     foreach $pattern (@{$self->{'PATTERNS'}}) {
  32         $self->debug("Matching %s against %s", $pattern, $url);
  33         if ($url =~ m|$pattern|) {
  34             $self->debug("Match");
  35             foreach ($self->connectors()) {
  36                 $self->debug("Using connector %s", $_->{'name'});
  37                 $self->selectconn($_);
  38                 $res = $self->_parse($url, $pattern);
  39                 if (defined($res)) {
  40                     $res->{'CONNECTOR'} = $_;
  41                     last;
  42                 }
  43             }
  44             if (defined($res)) {
  45                 if (defined($self->_cached_ua())) {
  46                     $res->{COOKIES} = encode_base64("#LWP-Cookies-1.0\n" . $self->_cached_ua()->cookie_jar->as_string(), "");
  47                 }
  48             }
  49
  50             return wantarray?($res, $pattern):$res;
  51         }
  52     }
  53
  54     return undef;
  55 }
  56
  57 sub enable {
  58     my $self = shift;
  59
  60     $self->debug('Enabling %s grabber', $self->{'NAME'});
  61     $self->setval('enabled', '1');
  62 }
  63
  64 sub disable {
  65     my $self = shift;
  66
  67     $self->debug('Disabling %s grabber', $self->{'NAME'});
  68     $self->setval('enabled', '0');
  69 }
  70
  71 sub _parse {
  72     my $self = shift;
  73     my $url = shift;
  74
  75     return undef;
  76 }
  77
  78 sub _selftest {
  79     my $self = shift;
  80     my $info;
  81
  82     unless(exists($self->{_SELFTESTURL}) and exists($self->{_SELFTESTTITLE})) {
  83         return 0;
  84     }
  85
  86     unless(defined($info = $self->get($self->{_SELFTESTURL}))) {
  87         $self->error("Could not get information from %s", $self->{_SELFTESTURL});
  88         return undef;
  89     }
  90
  91     unless($info->{TITLE} eq $self->{_SELFTESTTITLE}) {
  92         $self->error("Title from info does not equal expected result (%s != %s)", $info->{TITLE}, $self->{_SELFTESTTITLE});
  93         return undef;
  94     }
  95
  96     return 1;
  97 }
  98
  99 1;