File Coverage

blib/lib/WWW/Mixi/OO.pm

Criterion	Covered	Total	%
statement	12	43	27.9
branch	0	20	0.0
condition	0	3	0.0
subroutine	4	6	66.6
pod	1	1	100.0
total	17	73	23.2

# -*- cperl -*-
# copyright (C) 2005 Topia . all rights reserved.
# This is free software; you can redistribute it and/or modify it
#   under the same terms as Perl itself.
# $Id: OO.pm 110 2005-02-05 10:48:57Z topia $
# $URL: file:///usr/minetools/svnroot/mixi/trunk/WWW-Mixi-OO/lib/WWW/Mixi/OO.pm $
package WWW::Mixi::OO;
use strict;
use warnings;
use WWW::Mixi::OO::Session;
use constant session_class => 'WWW::Mixi::OO::Session';
our $VERSION = 0.03;

=head1 NAME

WWW::Mixi::OO - LWP::UserAgent based Mixi Access Helper Module
(WWW::Mixi compatible class)

=head1 SYNOPSIS

  use WWW::Mixi::OO;
  my $mixi = WWW::Mixi::OO->new('[e-mail]', 'password');
  $mixi->login;
  my $res = $mixi->page('home');
  print $res->content;
  my @friends = $mixi->page('list_friend')->fetch;

=head1 DESCRIPTION

mixi (L) is a social network service in Japan.

This module provides L compatible interface.
use L for real L's interface.

=head1 METHODS

=over 4

=cut

# WWW::Mixi's methods
# parse_*, get_*
#     => WWW::Mixi::OO::*, isa WWW::Mixi::OO::Page
# rewrite(callback_rewrite), escape, unescape, remove_tag,
# convert_login_time, absolute_url
#     => WWW::Mixi::OO::Util
# save_cookies, load_cookies, login, is_logined, is_login_required, session,
# new, absolute_linked_url, post, get, set_content
#     => WWW::Mixi::OO::Session
# refresh => not found!


=item new

  my $mixi = WWW::Mixi::OO->new(
                 $email, $password,
                 [-rewrite => \&rewriter]);

WWW::Mixi::OO constructor.

=cut

sub new {
    my ($class, $email, $password, %opt) = @_;

    # necessary parameters
    Carp::croak('WWW::Mixi mail address required') unless $email;
    Carp::croak('WWW::Mixi password required') unless $password;
    $opt{rewriter} = delete $opt{-rewrite} if exists $opt{-rewrite};

    my $session = $class->session_class->new(
	email => $email,
	password => $password,
	encoding => 'euc-jp',
	%opt);

    my $this = {
	session => $session,
    };

    bless $this, $class;
    return $this;
}

sub AUTOLOAD {
    my $this = shift;
    my $session = $this->{session};
    our $AUTOLOAD;
    $_ = $AUTOLOAD;

    # convert name
    s/url/uri/g;

    if (/^(parse|get)_(calendar)(_[^_]+)?$/ or # calendar & calendar_next
	    /^(parse|get)_([^_]+_[^_]+)(_[^_]+)?$/) { # foo_bar & ...
	# parse or get
	my ($main_method, $pagename, $sub_method) = ($1, $2, $3);
	$sub_method = '' unless defined $sub_method;

	if (@_ > 0) {
	    if ($main_method eq 'get') {
		my $url = shift;
		if ($url eq 'refresh') {
		    $session->refresh_content;
		} else {
		    $session->set_content($url);
		}
		$main_method = 'parse';
	    } else {
		# has response
		die 'not implemented yet!';
	    }
	}
	if ($sub_method =~ /^(next|previous)$/) {
	    # to navi_{next,prev}
	    $sub_method = 'navi_' . substr($sub_method, 0, 4);
	}
	my $page = $session->page($pagename);
	my $method = "$main_method$sub_method";
	$page->$method(@_);
    } elsif (/^session$/) {
	$session->session_id(@_);
    } else {
	# last resort: send to session
	$session->$_(@_);
    }
}

1;
__END__