{ =head1 NAME Net::Blogger::Engine::Base - base class for Blogger API engines =head1 SYNOPSIS package Net::Blogger::Engine::SuperFly; use vars qw ( @ISA ); @ISA = qw ( Net::Blogger::Engine::Base ); use Net::Blogger::Engine::Base; sub new { my $pkg = shift; my $self = {}; bless $self,$pkg; $self->SUPER::init(@_); return $self; } =head1 DESCRIPTION Base.pm is used a base class by implementation specific modules for the Blogger API. If an implementation follows the Blogger API to the letter then, conceivably, all it's package would need to define is a constructor and I method to define the URI of it's XML-RPC server. Base.pm inherits the functionality of Net::Blogger::Base::API and Net::Blogger::Base::Ext and defines private methods used by each. =cut package Net::Blogger::Engine::Base; use strict; use vars qw ( $AUTOLOAD ); $Net::Blogger::Engine::Base::VERSION = '1.01'; @Net::Blogger::Engine::Base::ISA = qw ( Exporter Net::Blogger::API::Core Net::Blogger::API::Extended ); @Net::Blogger::Engine::Base::ISA::EXPORT = qw (); @Net::Blogger::Engine::Base::ISA::EXPORT_OK = qw (); use Carp; use Error; use Exporter; use SOAP::Lite; use Net::Blogger::API::Core; use Net::Blogger::API::Extended; =head1 PACKAGE METHODS =cut =head2 __PACKAGE->new(\%args) Instantiate a new Blogger object. Valid arguments are : =over 4 =item * B String. The magic appkey for connecting to the Blogger XMLRPC server. =item * B String. The unique ID that Blogger uses for your weblog =item * B String. A valid username for blogid =item * B String. A valid password for the username/blogid pair. =back Releases prior to Net::Blogger 0.85 accepted a list of arguments rather than a reference. Version 0.85+ are backwards compatible. Returns an object. Woot! =head2 __PACKAGE__->init Initializes the option values =cut sub new { my $pkg = shift; my $self = {}; bless $self,$pkg; $self->init(@_) || return undef; return $self; } sub init { my $self = shift; my $args = (ref($_[0]) eq "HASH") ? shift : { @_ }; $self->AppKey($args->{'appkey'}); $self->Username($args->{'username'}); $self->Password($args->{'password'}); $self->BlogId($args->{'blogid'}); $self->{'debug'} = $args->{'debug'}; $self->{"_posts"} = []; # Note to self: this is what comments are for. # It's late, I'm hungry, I don't want to have # to remember what I was smoking when I wrote # this... (my $caller = (caller(2))[3]) =~ /(.*)[:]{2}([^:]{1,})[:]{2}([^:]{1,})$/; $self->{'__parent'} = $2; return 1; } =head1 OBJECT METHODS There are no public methods. See I and I. =cut =head1 PRIVATE METHODS =cut =head2 $pkg->Proxy() Get/set the URI of the Blogger API server. =head2 $pkg->AppKey($key) Get/set the magic appkey =head2 $pkg->BlogId($id) Get/set the blogid =head2 $pkg->Username($username) Get/set the username =head2 $pkg->Password($password) Get/set the password =head2 $pkg->MaxPostLength() Return the maximum number of characters a single post may contain. =cut =head2 $pkg->LastError($e) Fetch the last recorded error message. Returns a string. =cut sub LastError { my $self = shift; my $e = shift; if ($e) { Error::Simple->record($e); return 1; } $e = Error->prior(); chomp $e; return $e; } =head2 $pkg->Transport Just returns XMLRPC by default =cut sub Transport { return "XMLRPC"; } sub _Client { my $self = shift; unless (ref($self->{"_client"}) =~ /^(XMLRPC|SOAP)::Lite$/) { my $pkg = uc $self->Transport(); if ($pkg =~ /^(XMLRPC|SOAP)$/) { $pkg = join("::",$pkg,"Lite"); } else { die "Unknown transport : '$pkg'\n"; $self->LastError("Unknown transport : $pkg"); return undef; } eval "require $pkg"; if ($@) { die "Failed to eval, $@\n"; } my $client = $pkg->new() || Error->throw(-text=>$!); $client->on_fault(\&_ClientFault); # Obey $http_proxy, if set. if (defined($ENV{http_proxy})) { $client->proxy($self->Proxy, proxy => ['http' => $ENV{http_proxy} ]); } else { $client->proxy($self->Proxy); } $client->uri($self->Uri()); # Fix this. if ($self->{'debug'}) { $client->on_debug(sub { print @_; }); } $self->{"_client"} = $client; } return $self->{"_client"}; } sub _ClientFault { my $client = shift; my $res = shift; Error::Simple->record(join("\n", "Fatal client error.", ((ref $res) ? $res->faultstring() : $client->transport->status())) ); return 0; } sub _Type { my $self = shift; my $name = shift; if ($name =~ /^(hash|array)$/) { return SOAP::Data->name(args=>@_); } return SOAP::Data->type($name,@_); } sub DESTROY { return 1; } sub AUTOLOAD { my $self = shift; $AUTOLOAD =~ s/.*:://; if ($AUTOLOAD eq "Publish") { $self->LastError("This method has been deprecated."); return undef; } unless ($AUTOLOAD =~ /^(Proxy|Uri|AppKey|BlogId|Username|Password)$/) { $self->LastError("Unknown method '$AUTOLOAD' called. Skipping."); return undef; } my $property = lc "_".$AUTOLOAD; if (my $arg = shift) { $self->{ $property } = $arg; if ($AUTOLOAD eq "Proxy") { $self->{"_client"} = undef; } # if (exists $self->{'__meta'}) { $self->{'__meta'}->$property($arg); } if (exists $self->{'__mt'}) { $self->{'__mt'}->$property($arg); } if (exists $self->{'__slash'}) { $self->{'__slash'}->$property($arg); } } return $self->{ $property }; } =head1 VERSION 1.0 =head1 DATE $Date: 2005/03/26 19:29:08 $ =head1 AUTHOR Aaron Straup Cope =head1 SEE ALSO L L L =head1 LICENSE Copyright (c) 2001-2005 Aaron Straup Cope. This is free software, you may use it and distribute it under the same terms as Perl itself. =cut return 1; }