File Coverage

blib/lib/WWW/Mechanize/Plugin/phpBB.pm

Criterion	Covered	Total	%
statement	22	93	23.6
branch	0	16	0.0
condition	0	3	0.0
subroutine	8	14	57.1
pod	0	6	0.0
total	30	132	22.7

package WWW::Mechanize::Plugin::phpBB;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.02';

use Log::Log4perl qw(:easy);
use HTML::TreeBuilder;

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(url version));

###########################################
sub import {
###########################################
    # We need an empty import method, otherwise
    # the Module::Pluggable test suite breaks:
    #    # t/plugin.t
    #    use WWW::Mechanize::Pluggable helloworld=>"WORLD";
}

###########################################
sub init {
###########################################
    my($class, @args) = @_;

    no strict 'refs';

    for my $method (qw(login forums forum_enter topics post_remove)) {
        *{caller() . "::phpbb_$method"} = \&$method;
    }
}

###########################################
sub login {
###########################################
    my ($mech, $user, $password) = @_;

    if(!defined $user or !defined $password) {
        LOGDIE 'usage: ->login($user, $password)';
    }

    my $old_autocheck = $mech->{autocheck};
    $mech->{autocheck} = 1;

    DEBUG "Logging in as user '$user'";

    eval {
        DEBUG "Finding 'Login' link ";
        my $link = $mech->find_link(url_regex => qr/login\.php/);
        die "Cannot find login.php link" unless defined $link;

        my $url = $link->url();

        DEBUG "Following link $url";
        $mech->follow_link(url => $url);

        DEBUG "Submitting login credentials for user '$user'";
        $mech->submit_form(
            fields => {
                username => $user,
                password => $password,
            },
            button => "login",
        );

        $link = $mech->find_link(
            url_regex => qr/\Qlogin.php?logout=true\E/);
        die "Login failed (wrong credentials?)" unless defined $link;
    };

    $mech->{autocheck} = $old_autocheck;

    if($@) {
        ERROR "$@";
        return undef;
    }

    INFO "Logged in as user '$user'";
}

###########################################
sub forums {
###########################################
    my ($mech) = @_;

    DEBUG "Finding all forums";

    my $forums = $mech->find_all_links(
            url_regex => qr/viewforum\.php|forumdisplay.php/ );

    DEBUG "Found forums ",
          join(", ", map { '"' . $_->text() . '"' } @$forums), ".";

    return $forums;
}

###########################################
sub forum_enter {
###########################################
    my ($mech, $rex) = @_;

    for my $forum (@{ forums($mech) }) {
        if($forum->text() =~ /$rex/) {
            INFO "Entering Forum ", $forum->text();
            $mech->get($forum->url());
            return 1;
        }
    }

    ERROR "Cannot find forum matching $rex";

    return undef;
}

###########################################
sub topics {
###########################################
    my ($mech) = @_;

    DEBUG "Scraping topics from ", $mech->uri();

        # Scrape the topics and their links from a forum page
    my $tree = HTML::TreeBuilder->new();

    $tree->parse($mech->content()) or
        LOGDIE "Cannot parse forum HTML from ", $mech->uri();

    my @topics = $tree->look_down(
        _tag  =>  "span",
        class => "topictitle",
    );

    my $topics_seen = {};
    my $topics_all  = [];

    for my $topic (@topics) {
        my $a = $topic->content()->[0];
        my $count = $topic->parent()->right()->as_text();

        my $url = URI::URL->new($a->attr('href'), $mech->uri());

            # Throw away session ID
        my %form = $url->query_form();
        delete $form{sid};
        $url->query_form(%form);

        next if exists $topics_seen->{$form{t}};

        my $this_topic = { url   => $url->abs->as_string(),
                           text  => $a->as_text(),
                           count => $count,
                         };

        $topics_seen->{$form{t}}++;
        push @$topics_all, $this_topic;
    }

    $tree->delete();

    DEBUG "Found topics ",
          join(", ",
          map { '"' . $_->{text} . ' (' . $_->{count} . ')"' } @$topics_all),
          ".";

    return $topics_all;
}

###########################################
sub post_remove {
###########################################
    my ($mech, $post_id) = @_;

    DEBUG "Removing post $post_id";

        # Find delete link
    my $link = $mech->find_link(url_regex => qr/\Qmode=delete&p=$post_id\E/);

    LOGDIE "Cannot find delete link for posting $post_id" unless defined $link;
    DEBUG "Going to ", $link->url();
    $mech->follow_link(url => $link->url());

        # Confirm
    DEBUG "Confirming delete";
    $mech->submit_form(
        button => "confirm",
    );
}

1;

__END__