Net::Blogger::Engine::Slash::slashcode - Adds support for the Slashcode SOAP API.

Net-Blogger documentation Contained in the Net-Blogger distribution.

Index

Code Index:

NAME

Top

Net::Blogger::Engine::Slash::slashcode - Adds support for the Slashcode SOAP API.

SYNOPSIS

Top

There is none since this is the black box you're not supposed to look in.

Please docs for consult Net::Blogger::Engine::Slash.

DESCRIPTION

Top

Adds support for the Slashcode SOAP API.

OBJECT METHODS

Top

$pkg->Proxy()

Return the URI of the Slashcode XML-RPC proxy

$pkg->Transport

Just returns SOAP by default

SLASHCODE SOAP METHODS

Top

$pkg->add_entry(\%args)

Valid arguments are

Releases prior to Net::Blogger 0.85 accepted a list of arguments rather than a reference. Version 0.85+ are backwards compatible.

Returns a postid or false.

$pkg->get_entry($id)

Returns a hash ref whose keys are :

$pkg->get_entries($offset)

Returns an array of hashrefs (see docs for get_entry), or false.

$pkg->modify_entry($id,\%args)

Returns a postid or false.

$pkg->delete_entry($id)

Returns true or false.

VERSION

Top

1.0

DATE

Top

$Date: 2005/03/26 19:29:08 $

AUTHOR

Top

Aaron Straup Cope

TO DO

Top

SEE ALSO

Top

Net::Blogger::Engine::Slash

http://use.perl.org/~pudge/journal/3294

LICENSE

Top

Copyright (c) 2002-2005, Aaron Straup Cope. All Rights Reserved.

This is free software, you may use it and distribute it under the same terms as Perl itself.

Net-Blogger documentation Contained in the Net-Blogger distribution. 
{


package Net::Blogger::Engine::Slash::slashcode;
use strict;

use Exporter;
use Digest::MD5 'md5_hex';
use HTTP::Cookies;
use URI;

use Net::Blogger::Engine::Base;

$Net::Blogger::Engine::Slash::slashcode::VERSION   = '1.0';

@Net::Blogger::Engine::Slash::slashcode::ISA       = qw ( Net::Blogger::Engine::Base );
@Net::Blogger::Engine::Slash::slashcode::EXPORT    = qw ();
@Net::Blogger::Engine::Slash::slashcode::EXPORT_OK = qw ();

sub Transport {
  return "SOAP";
}

sub Proxy {
  my $self  = shift;
  my $proxy = shift;

  if ($proxy) {
    $self->{'_cookie'} = undef;
    $self->{'_client'} = undef;

    $self->{'_Proxy'} = $proxy;
  }

  return (
	  $self->{'_Proxy'},
	  cookie_jar => $self->_setUserCookie(),
	  );
}


sub add_entry {
  my $self = shift;
  my $args = (ref($_[0]) eq "HASH") ? shift : { @_ };

  my $call = $self->_Client()->call(
				    "add_entry",
				    $self->_Type(string=>$args->{"subject"}),
				    $self->_Type(string=>$args->{"body"}),
				   );

  return ($call) ? $call->result() : return 0;
}


sub get_entry {
  my $self = shift;

  my $call = $self->_Client()->call(
				    "get_entry",
				    $self->_Type(int=>$_[0]),
				   );

  return ($call) ? $call->result() : return 0;
}


sub get_entries {
  my $self = shift;

  my $call = $self->_Client()->call("get_entries",
				    $self->_Type(string=>$self->Username()),
				    $self->_Type(int=>$_[0]),
				   );

  return ($call) ? $call->result() : return 0;
}


sub modify_entry {
  my $self   = shift;
  my $postid = shift;
  my $args   = (ref($_[0]) eq "HASH") ? shift : { @_ };

  my $call = $self->_Client()->call("modify_entry",
				    $self->_Type(int=>$postid),
				    $self->_Type(string=>$args->{"subject"}),
				    $self->_Type(string=>$args->{"body"}),
				   );

  return ($call) ? $call->result() : return 0;
}


sub delete_entry {
  my $self = shift;

  my $call = $self->_Client()->call("delete_entry",
				    $self->_Type(int=>$_[0]),
				   );

  return ($call) ? $call->result() : return 0;
}

sub _setUserCookie {
  my $self = shift;

  if (! $self->{'_cookie'}) {
    my $cookie = join("::",$self->Username(),md5_hex($self->Password()));

    $cookie =~ s/(.)/sprintf("%%%02x", ord($1))/ge;
    $cookie =~ s/%/%25/g;
    $self->{'_cookie'} = HTTP::Cookies->new()->set_cookie(0,
							  user=>$cookie,
							  '/',
							  URI->new($self->{'_Proxy'})->host(),
							 ),
  }

  return $self->{'_cookie'};
}


return 1;

}