{
=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<Proxy> 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<appkey>
String. The magic appkey for connecting to the Blogger XMLRPC server.
=item *
B<blogid>
String. The unique ID that Blogger uses for your weblog
=item *
B<username>
String. A valid username for blogid
=item *
B<password>
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<Net::Blogger::Base::API> and
I<Net::Blogger::Base::Ext>.
=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<Net::Blogger::API::Core>
L<Net::Blogger::API::Extended>
L<SOAP::Lite>
=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;
}