File Coverage

blib/lib/WWW/Scraper/Yahoo360.pm

Criterion	Covered	Total	%
statement	156	239	65.2
branch	34	78	43.5
condition	9	14	64.2
subroutine	17	23	73.9
pod	11	12	91.6
total	227	366	62.0

#
# Ignorant Yahoo 360 blog scraper (blog.360.yahoo.com)
#
# $Id: Yahoo360.pm 168 2009-05-31 11:51:37Z cosimo $

package WWW::Scraper::Yahoo360;

use strict;
use warnings;

use Carp           ();
use Date::Parse    ();
use File::Slurp    ();
use HTTP::Date     ();
use JSON::XS       ();
use WWW::Mechanize ();

use constant BLOG_URL   => q{http://blog.360.yahoo.com/blog/};
use constant LOGIN_FORM => q{login_form};
use constant LOGIN_URL  => q{https://login.yahoo.com/config/login_verify2?.intl=us&.done=http%3A%2F%2Fblog.360.yahoo.com%2Fblog%2F%3F.login%3D1&.src=360};

our $DEBUG   = 0;
our $VERSION = '0.09';

sub new {
    my ($class, $args) = @_;
    $class = ref $class || $class || __PACKAGE__;
    my $self = $args;
    bless $self, $class;
}

# Fetches high-level blog information
sub blog_info {
    my ($self, $blog_page) = @_;

    if (! $blog_page) {
        $self->debug('Fetching blog main page');
        $blog_page = $self->blog_main_page();
        if (! $blog_page) {
            $self->debug('Failed to fetch blog main page');
            return;
        }
    }

    # Get sharing level
    # Your blog can be seen by  Public
    #
    # or:
    # Your blog can be seen by  Just me (private)
    # Your blog can be seen by  Friends
    #
    my $sharing = q{};
    if ($blog_page =~ m{Your blog can be seen by  ([\w\(\)\s]+)}m) {

        $sharing = lc $1;
        if ($sharing =~ m{just me}) {
            $sharing = 'private';
        }
        elsif ($sharing =~ m{friend}) {
            $sharing = 'friends';
        }

        $self->debug('Blog sharing found to be "', $sharing, '"');
    }
    else {
        $self->debug('Blog sharing string not found');
    }

    # Get title
    my $title = q{};
    if ($blog_page =~ m{([^<]+)Full Post View}m) {
        $title = $1;
        $self->debug('Blog title found to be "', $title, '"');
    }

    # Get number of posts
    #
    # 1 - 5 of 13 ...
    my $start =
    my $end   =
    my $count = 0;

    if ($blog_page =~ m{(\d+) \- (\d+) of (\d+)}m) {
        $start = $1;
        $end   = $2;
        $count = $3;
        $self->debug('Blog post counts found. Start:', $start, ' End:', $end, ' Count:', $count);
    }
    else {
        $self->debug('Blog post counts not found');
    }

    my $link = q{};
    if ($blog_page =~ m{My Blog}) {
        $link = $1;
        $self->debug('Blog URL found: ', $link);
    }
    else {
        $self->debug('Blog URL not found');
    }

    $title =~ s{^\s+}{};
    $title =~ s{\s+$}{};

    return {
        sharing => $sharing,
        title   => $title,
        start   => $start,
        end     => $end,
        count   => $count,
        link    => $link,
        lastBuildDate => HTTP::Date::time2str(),
        language => 'en-us',
    };

}

# Fetches the user's main blog page
sub blog_main_page {
    my ($self) = @_;

    my $mech = $self->mech();
    $mech->get(BLOG_URL);

    if ($mech->success()) {
        $self->debug('Blog main page downloaded successfully');
        return $mech->content();
    }

    $self->debug('Blog main page download failed');
    Carp::croak("Failed to retrieve blog main page");
}

# Builds the url to fetch a specific blog page
sub blog_page_url {
    my ($self, $link, $start, $per_page, $count) = @_;
    my $url = $link;
    my $last = $start + $per_page - 1;
    if ($last > $count) { $last = $count }
    $url .= '&l=' . $start;
    $url .= '&u=' . $last;
    $url .= '&mx=' . $count;
    $url .= '&lmt=' . $per_page;
    return $url;
}

sub debug {
    return unless $DEBUG;

    my ($self, @msg) = @_;
    print STDERR @msg, "\n";

    return;
}

# Logs in to Yahoo
sub login {
    my ($self) = @_;

    my $user = $self->{username};
    my $pass = $self->{password};

    my $mech = $self->mech();

    $mech->get(LOGIN_URL);

    $mech->submit_form(
        form_name => LOGIN_FORM,
        fields    => {
            login => $user,
            passwd => $pass,
            '.persistent' => 'y',
        },
        button    => '.save',
    );

    # Not sure how to make this more robust
    my $next_page = $mech->content();
    if ($next_page =~ m{Invalid ID or password}) {
        $self->debug('Login to Yahoo service failed for user "', $user, '"');
        return;
    }

    my $ok = $mech->success();

    if ($ok) {
        $self->debug('Login to Yahoo service succeeded');
    }
    else {
        $self->debug('Login to Yahoo service failed. Unknown reason?');
    }

    return $ok;
}

# Dumps last accessed page content to STDOUT
sub dump {
    my ($self) = @_;
    print $self->mech->content();
}

# Retrieves all comments in the user's blog
sub get_blog_comments {
    my ($self, $posts) = @_;

    if (! $posts) {
        return;
    }

    my @comments;

    for my $post (@{$posts}) {

        # No comments, don't fetch them
        if ($post->{comments} == 0) {
            $self->debug('No comments for post ', $post->{title});
            next;
        }

        #print qq{Found $post->{comments} comments for blog post "$post->{title}"\n};

        if (my $post_comm = $self->get_blogpost_comments($post)) {
            $self->debug('Got ', scalar(@{ $post_comm }), ' comments for post ', $post->{title});
            push @comments, @{ $post_comm };
        }

    }

    return \@comments;
}

# Retrieves all comments to a single blog post
sub get_blogpost_comments {
    my ($self, $post, $page) = @_;

    # If we didn't get a pre-saved html page, get it now
    if (! $page) {
        $self->mech->get($post->{link});
        $page = $self->mech->success
            ? $self->mech->content()
            : q{};
    }

    if (! $page) {
        warn "ERROR fetching blogpost comments for $post->{title}\n";
        return;
    }

    my @comments;

    while ($page =~ m{}mg) {

        my $comment = {
            'user-profile' => $1,
            username => $2,
            link => $post->{link},
        };

        # Comments can span multiple lines
        # but are always enclosed between  and
        if ($page =~ m{(.*?)}sg) {
            $comment->{comment} = $1;
            $comment->{comment} =~ s{^\s+}{};
            $comment->{comment} =~ s{\s+$}{};
        }

        if ($page =~ m{([^<]+)\s*<}mg) {
            $comment->{date} = $1;
            $comment->{date} =~ s{^\s+}{};
            $comment->{date} =~ s{\s+$}{};
            $comment->{date} = $self->parse_date($comment->{date});
        }

        $self->debug(
            'Found comment "', $comment->{comment},
            '" by "', $comment->{username}, '"'
        );

        push @comments, $comment;
    }

    $self->debug('Found ', scalar(@comments), ' comments to blog post ', $post->{link});

    return \@comments;
}

# Gets all blog posts by a user
sub get_blog_posts {
    my ($self, $blog_page, %overrides) = @_;

    $self->debug("Start parsing of blog posts");

    if (! $blog_page) {
        $self->debug("Downloading of main blog page");
        $blog_page ||= $self->blog_main_page();
        $self->debug("Download complete");
    }
    else {
        $self->debug("Blog main page was already supplied. No need to download.");
    }

    my $blog_info = $self->blog_info($blog_page);

    for (keys %overrides) {
        $blog_info->{$_} = $overrides{$_};
    }

    my $link  = $blog_info->{link};
    my $start = $blog_info->{start};
    my $count = $blog_info->{count};
    my $end_page = $blog_info->{end};
    my $end_blog = $start + $count - 1;
    my $per_page = $end_page - $start + 1;

    my @posts = ();

    $self->debug("Parsing posts ($start .. $end_blog)");

    # Prevent endless loops
    if ($start > $end_page) {
        $start = $end_page;
    }

    for (my $n = $start; $n <= $end_blog; ) {

        $self->debug(
            'Reading post n. ', $n,
            ' end_of_page:', $end_page,
            ' end_of_blog:', $end_blog,
        );

        # Fetch next page and continue
        if ($n >= $end_page && $end_page < $end_blog) {

            my $next_page_url = $self->blog_page_url(
                $link, $end_page + 1, $per_page, $count
            );

            $end_page += $per_page;

            $self->mech->get($next_page_url);
            $self->debug('Next url is:', $next_page_url);

            $blog_page = $self->mech->content();
            if (! $blog_page) {
                $self->debug('Failed to read url: ', $next_page_url);
                last;
            }

        }

	my $found_posts = 0;

        while ($blog_page =~ m{([^<]+)}gm) {

            # Blog post title
            my $title = $1;
            my $post = {
                title => $1,
                description => ''
            };

            $self->debug('Found new blog post "', $title, '" (', $n, ')');

            $found_posts = 1;

            # Main picture of the blog post
            if ($blog_page =~ m{(.*?)}gsmc) {
                my $pic = $1;
                $pic =~ s{^\s*}{}mx;
                $pic =~ s{\s*$}{}mx;
                if ($pic) {
                    $post->{description} = '' . $pic . '';
                    $self->debug('    Image: ', substr($pic, 0, 30), '...');
                }
            }

            # Blog post content
            # Read until the end of line (there might be multiple s)
            if ($blog_page =~ m{(.*)}gmc) {
                $post->{description} .= $1;
                $self->debug('    Content: ', substr($1, 0, 30), '...');
            }

            # Tags
            if ($blog_page =~ m{
                $post->{tags} = $1;
                $self->debug('    Tags: ', $1);
            }

            # Date of post
            if ($blog_page =~ m{([^<]+)Edit}gm) {
                $post->{pubDate} = HTTP::Date::time2str($self->parse_date($1));
                $self->debug('    Date: ', $1);
            }

            # Permanent link
            if ($blog_page =~ m{Permanent Link}gm) {
                $post->{link} = $1;
                $self->debug('    Permalink: ', $1);
            }

            # No. of comments
            if ($blog_page =~ m{(\d+) Comments?}gm) {
                $post->{comments} = $1;
                $self->debug('    Comments: ', $1);
            }

            push @posts, $post;

            $n++;

        }

        if (not $found_posts) {
            last;
	}

    }

    return \@posts;

}

# Mechanize object accessor
sub mech {
    my ($self) = @_;
    if (! exists $self->{_mech}) {
        $self->{_mech} = WWW::Mechanize->new();
    }
    return $self->{_mech};
}

# Tries to parse a date in the Yahoo 360 format
sub parse_date {
    my ($self, $date) = @_;

    $date =~ s{^\s+}{};
    $date =~ s{\s+$}{};

    if ($date =~ m{^ (\w{3})\w+ \s (\w{3})\w* \s (\d+), \s (\d+) \s - \s (\d+):(\d+)([ap]m) \s \((.*)\) \s* $}x) {
        my $dow   = $1;
        my $month = $2;
        my $day   = $3;
        my $year  = $4;
        my $hours = $5;
        my $mins  = $6;
        my $ampm  = uc $7;
        my $tz    = uc $8;

        # Indochina time zone is not recognized by Date::Parse
        if ($tz eq 'ICT') {
            $tz = 'UTC+07';
        }

        if ($ampm eq 'AM' && $hours == 12) {
            $hours = 0;
        }
        elsif ($ampm eq 'PM' && $hours != 12) {
            $hours += 12;
            if ($hours > 23) {
                $hours -= 24;
            }
        }

        my $time = "$hours:$mins:00";

        # Wed, 16 Jun 94 07:29:35 CST
        $date = "$day $month $year $time $tz";

        #arn "# Converted to [$date]\n";

    }

    my $epoch = Date::Parse::str2time($date);
    #arn "# str2time($date) returns ($epoch)\n";

    return $epoch;
}

1;

__END__