File Coverage

blib/lib/Net/MovableType.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Net::MovableType;

# MovableType.pm,v 1.19 2004/08/25 02:49:28 sherzodr Exp

use strict;
use vars qw($VERSION $errstr $errcode);
use Carp;
use XMLRPC::Lite;

$VERSION = '1.75_01';

# Preloaded methods go here.


sub _mk_boolean {
    my $bool = shift;

    return $bool if ref( $bool );
    return SOAP::Data->type(boolean=>$bool || 0);
}



sub new {
    my $class = shift;
    $class = ref($class) || $class;

    my ($url, $username, $password) = @_;

    my $self = {
        proxy   => undef,
        blogid   => undef,
        username => $username,
        password => $password
    };

    bless $self, $class;

    # if $url starts with 'http://' and ends in '.xml', we assume it was a
    # location of rsd.xml file
    if ( $url =~ m/^http:\/\/.+\.xml$/ ) {
        $self->rsd_url($url) or return undef;

    # if the URL just starts with 'http://', we assume it was a url for
    # MT's XML-RPC server
    } elsif ( $url =~ m/^http:\/\// ) {
        $self->{proxy} = XMLRPC::Lite->proxy($url);

    # in neither case, we assume it was a file system location of rsd.xml file
    } elsif ( $url ) {
        $self->rsd_file($url) or return undef;
    }

    return $self;
}





# shortcut for XMLRPC::Lite's call() method. Main difference from original call()
# is, it returns native Perl data, instead of XMLRPC::SOM object
sub call {
    my ($self, $method, @args) = @_;

    unless ( $method ) {
        die "call(): usage error"
    }

    my $proxy = $self->{proxy} or die "'proxy' is missing";
    my $som   = $proxy->call($method, @args);
    my $result= $som->result();

    unless ( defined $result ) {
        $errstr = $som->faultstring;
        $errcode= $som->faultcode;
        return undef
    }

    return $result
}




sub process_rsd {
    my ($self, $string_or_file ) = @_;

    unless ( $string_or_file ) {
        croak "process_rsd() usage error"
    }

    require XML::Simple;
    my $xml     = XML::Simple::XMLin(ref($string_or_file) ? $$string_or_file : $string_or_file );
    my $apilink = $xml->{service}->{apis}->{api}->{MetaWeblog}->{apiLink};
    my $blogid  = $xml->{service}->{apis}->{api}->{MetaWeblog}->{blogID};

    unless ( $apilink && $blogid ) {
        croak "Couldn't retrieve 'apiLink' and 'blogID' from $xml"
    }

    $self->blogId($blogid);
    $self->{proxy} = XMLRPC::Lite->proxy($apilink);

    # need to return a true value indicating success
    return 1
}


# fetches RSD file from a remote location,
# and configures Net::MovableType object properly
sub rsd_url {
    my ($self, $url) = @_;

    unless ( $url ) {
        croak "rsd_url() usage error"
    }

    $self->{rsd_url} = $url;

    require LWP::UserAgent;

    my $ua = LWP::UserAgent->new();
    my $req= HTTP::Request->new('GET', $url);
    my $response = $ua->request($req);
    if ( $response->is_error ) {
        $errstr = $response->base . ": " . $response->message;
        $errcode= $response->code;
        return undef
    }

    return $self->process_rsd($response->content_ref)
}



sub rsd_file {
    my ($self, $file) = @_;

    unless ( $file ) {
        croak "rsd_file() usage error"
    }

    $self->{rsd_file} = $file;

    return $self->process_rsd($file)
}




sub username {
    my ($self, $username) = @_;

    if ( defined $username ) {
        $self->{username} = $username;
    }
    return $self->{username}
}



*error = \&errstr;
sub errstr {
    return $errstr
}


sub errcode {
    return $errcode
}




sub password {
    my ($self, $password) = @_;

    if ( defined $password ) {
        $self->{password} = $password
    }
    return $self->{password};
}



sub proxy {
    my ($self, $proxy) = @_;

    if ( defined $proxy ) {
        $self->{proxy} = $proxy
    }
    return $self->{proxy}
}



*blogid = \&blogId;
sub blogId {
    my ($self, $blogid) = @_;

    if ( defined $blogid ) {
        $self->{blogid} = $blogid
    }
    return $self->{blogid}
}



sub resolveBlogId {
    my ($self, $blogname) = @_;

    unless ( $self->username && $self->password ) {
        croak "username and password are missing\n"
    }

    my $blogs = $self->getUsersBlogs();
    while ( my $b = shift @$blogs ) {
        if ( $b->{blogName} eq $blogname ) {
            return $b->{blogid}
        }
    }

    $errstr = "Couldn't find blog '$blogname'";
    return undef
}




sub getBlogInfo {
    my ($self, $blogid) = @_;

    $blogid ||= $self->blogId() or croak "no 'blogId' set";
    my $blogs = $self->getUsersBlogs() or return undef;

    while ( my $b = shift @$blogs ) {
        if ( $b->{blogid} == $blogid ) {
            return $b
        }
    }

    $errstr = "No blog found with id '$blogid";
    return undef
}







*getBlogs = \&getUsersBlogs;
sub getUsersBlogs {
    my ($self, $username, $password)  = @_;

    $username = $self->username($username);
    $password = $self->password($password);

    unless ( $username && $password ) {
        croak "username and password are missing";
    }

    return $self->call('blogger.getUsersBlogs', "", $username, $password)
}






sub getUserInfo {
    my ($self, $username, $password) = @_;

    $username = $self->username($username);
    $password = $self->password($password);

    unless ( $username && $password ) {
        croak "username and/or password are missing"
    }

    return $self->call('blogger.getUserInfo', "", $username, $password)
}




sub getPost {
    my ($self, $postid, $username, $password) = @_;

    $username = $self->username($username);
    $password = $self->password($password);

    unless ( $username && $password && $postid ) {
        croak "getPost() usage error"
    }

    return $self->call('metaWeblog.getPost', $postid, $username, $password)
}







sub getRecentPosts {
    my ($self, $numposts) = @_;

    my $blogid   = $self->blogId()     or croak "no 'blogId' defined";
    my $username = $self->username()   or croak "no 'username' defined";
    my $password = $self->password()   or croak "no 'password' defined";
    $numposts ||= 1;

    return $self->call('metaWeblog.getRecentPosts', $blogid, $username, $password, $numposts)
}



sub getRecentPostTitles {
    my ($self, $numposts) = @_;

    my $blogid  = $self->blogId()       or croak "no 'blogId' defined";
    my $username= $self->username()     or croak "no 'username' defined";
    my $password= $self->password()     or croak "no 'password' defined";
    $numposts ||= 1;

    return $self->call('mt.getRecentPostTitles', $blogid, $username, $password, $numposts)
}






*getCategories = \&getCategoryList;
sub getCategoryList {
    my ($self, $blogid, $username, $password) = @_;

    $blogid      = $self->blogId($blogid) or croak "no 'blogId' defined";
    $username   = $self->username($username) or croak "no 'username' defined";
    $password   = $self->password($password) or croak "no 'password' defined";

    return $self->call('mt.getCategoryList', $blogid, $username, $password)
}




sub getPostCategories {
    my ($self, $postid, $username, $password) = @_;

    $username = $self->username($username) or croak "no 'username' defined";
    $password = $self->password($password) or croak "no 'password' defined";

    unless ( $postid ) {
        croak "getPostCategories() usage error"
    }

    return $self->call('mt.getPostCategories', $postid, $username, $password)
}



sub setPostCategories {
    my ($self, $postid, $cats) = @_;

    unless ( ref $cats ) {
        $cats = [$cats]
    }

    unless ( @$cats && $postid ) {
        croak "setPostCategories() usage error"
    }

    my $blogid = $self->blogId()    or croak "no 'blogId' set";

    my $category_list = $self->getCategoryList($blogid);
    my $post_categories = [];
    for my $cat ( @$cats ) {
        for my $c ( @$category_list ) {
            if ( lc $c->{categoryName} eq lc $cat ) {
                push @$post_categories, {categoryId=>$c->{categoryId} }
            }
        }
    }

    my $username  = $self->username() or croak "no 'username' defined";
    my $password  = $self->password() or croak "no 'password' defined";
    $postid                          or croak "setPostCategories() usage error";

    return $self->call('mt.setPostCategories', $postid, $username, $password, $post_categories)
}











sub supportedMethods {
    my ($self) = @_;

    return $self->call('mt.supportedMethods')
}



sub publishPost {
    my ($self, $postid, $username, $password) = @_;

    $username = $self->username($username) or croak "no 'username' set";
    $password = $self->password($password)  or croak "no 'password' set";

    unless ( $postid ) {
        croak "publishPost() usage error"
    }

    return $self->call('mt.publishPost', $postid, $username, $password)
}





sub newPost {
    my ($self, $content, $publish) = @_;
    $publish = _mk_boolean($publish);

    my $blogid   = $self->blogId()   or croak "'blogId' is missing";
    my $username = $self->username() or croak "'username' is not set";
    my $password = $self->password() or croak "'password' is not set";

    unless ( $content && (ref($content) eq 'HASH') ) {
        croak "newPost() usage error"
    }

    return $self->call('metaWeblog.newPost', $blogid, $username, $password, $content, $publish)
}






sub editPost {
    my ($self, $postid, $content, $publish) = @_;
    $publish = _mk_boolean($publish);

    my $username = $self->username() or croak "'username' is not set";
    my $password = $self->password() or croak "'password' is not set";

    unless ( $content && (ref($content) eq 'HASH') ) {
        croak "newPost() usage error"
    }
    return $self->call('metaWeblog.editPost', $postid, $username, $password, $content, $publish)
}






sub deletePost {
    my ($self, $postid, $publish) = @_;
    $publish = _mk_boolean($publish);

    my $username = $self->username or croak "'username' not set";
    my $password = $self->password or croak "'password' not set";
    $postid                        or croak "deletePost() usage error";

    return $self->call('blogger.deletePost', "", $postid, $username, $password, $publish)
}




*upload = \&newMediaObject;
sub newMediaObject {
    my ($self, $filename, $name, $type) = @_;

    my $blogid   = $self->blogId()   or croak "'blogId' is missing";
    my $username = $self->username() or croak "'username' is not set";
    my $password = $self->password() or croak "'password' is not set";

    unless ( $filename ) {
        croak "newMediaObject() usage error";
    }

    my $blob = undef;
    if ( ref $filename ) {
        $blob = $$filename;
        $filename = undef;

    } else {
        unless(open(FH, $filename)) {
            $errstr = "couldn't open $filename: $!";
            return undef
        }
        local $/ = undef;
        $blob = ; close(FH);
    }

    if ( $filename && !$name ) {
        require File::Basename;
        $name = File::Basename::basename($filename);
    }

    unless ( $name ) {
        croak "newMediaObject() usage error: \$name is missing"
    }

    my %content_hash = (
         bits    => XMLRPC::Data->type(base64 => $blob),
         name    => $name,
         type    => $type || ""
    );

    return $self->call('metaWeblog.newMediaObject', $blogid, $username, $password, \%content_hash)
}










sub dump {
  my $self = shift;

  require Data::Dumper;
  my $d = new Data::Dumper([$self], [ref $self]);
  return $d->Dump();
}



package MovableType;
@MovableType::ISA = ('Net::MovableType');


package MT;
@MT::ISA = ('Net::MovableType');


1;
__END__