view release on metacpan or  search on metacpan

lib/Image/Grab.pm  view on Meta::CPAN

use Carp;
use Config;
require HTTP::Request;
require HTML::TreeBuilder;
require URI::URL;
require Image::Grab::RequestAgent;
use POSIX qw(strftime);

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(
  &expand_url &grab
);

# %fields, new, AUTOLOAD are from perltoot

my %fields = (
	      cookiefile => undef,
	      cookiejar  => undef,
	      date       => undef,
	      image      => undef,
	      "index"    => undef,
	      md5        => undef,
	      refer      => undef,
	      regexp     => undef,
	      type       => undef,
	      ua         => undef,
	      url        => undef,
	      search_url => undef,
	      debug      => undef,
	      do_posix   => ($Config{patchlevel} && $Config{patchlevel} >= 5 and
			     $Config{baserev} && $Config{baserev}    >= 5) ? 1 : undef,
	     );

sub DESTROY {}

sub new {
  my $that  = shift;
  my $class = ref($that) || $that;
  my $self = {
	      _permitted => \%fields,
	      %fields,
	     };

  if(@_) {
    my %arg = @_;

    foreach (keys %arg) {
      croak "Can't access `$_' field"
	unless exists $self->{_permitted}->{lc($_)};
      $self->{lc($_)} = $arg{$_};
    }
  }

  bless ($self, $class);
  $self->ua(new Image::Grab::RequestAgent);
  $self->{have_DigestMD5} = eval {require Digest::MD5};
  $self->{have_MD5} = eval {require MD5;};
  $self->{have_magick} = eval {require Image::Magick;};
  return $self;
}

sub AUTOLOAD {
  my $self = shift;
  my $type = ref($self)
    or croak "$self is not an object";

  my $name = $AUTOLOAD;
  $name =~ s/.*://;

  unless (exists $self->{_permitted}->{$name} ) {
    croak "Can't access `$name' field in class $type";
  }

  if(@_) {
    my $val = shift;
    carp "$name: $val" if $self->debug;
    return $self->{$name} = $val;
  } elsif (defined $self->{$name}) {
    return $self->{$name};
  }

  return undef;

}

# Accessor functions that we have to write.
sub realm {
  my $self = shift;
  my $type = ref($self)
    or croak "$self is not an object";

  if($#_ == 2){
    $self->ua->register_realm(shift, shift, shift);
    return 1;
  } 

  croak "usage: realm(\$realm, \$user, \$pass)";
}

sub getAllURLs {
  my $self = shift;
  my $type = ref($self)
    or croak "$self is not an object";
  my $times = (shift or 10);
  my $req;
  my $count = 0;
  my @link;
  my @now;

  # Need to load Cookie Jar?
  $self->loadCookieJar;

  @now = localtime;
  $self->search_url(strftime $self->search_url, @now) 
    if defined $self->search_url and defined $self->do_posix;
  croak "Need to specify a search_url!" if !defined $self->search_url;
  $req = $self->ua->request(new HTTP::Request 'GET', $self->search_url);