File Coverage

blib/lib/WWW/phpBB.pm

Criterion	Covered	Total	%
statement	36	1013	3.5
branch	0	438	0.0
condition	0	273	0.0
subroutine	12	51	23.5
pod	8	37	21.6
total	56	1812	3.0

package WWW::phpBB;

use strict;
use warnings;
no warnings qw(uninitialized);
use WWW::Mechanize;
use Compress::Zlib;
use HTML::TokeParser::Simple;
use Time::Local;
use DBI();
use Carp;
use POSIX ":sys_wait_h";
use Encode;
use HTML::Entities;

require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT_OK = ();
our @EXPORT = qw();
our $VERSION = '0.09';
my $children; # number of spawned processes

# defaults
my %default = (
    db_compression => 0,
    max_rows => 60,
    months => [qw(jan feb mar apr may jun jul aug sep oct nov dec)],
    post_date_format => qr/(\w+)\s+(\d+),\s+(\d+)\s+(\d+):(\d+)\s+(\w\w)/i,
    post_date_pos => [qw(month_name day_of_month year hour minutes am_pm)],
    reg_date_format => qr/(\d+)\s+(\w+)\s+(\d+)/i,
    reg_date_pos => [qw(day_of_month month_name year)],
    forum_link_regex => qr/f=(\d+)/,
    topic_link_regex_p => qr/viewtopic.*p=(\d+)/,
    topic_link_regex_t => qr/viewtopic.*t=(\d+)/,
    topic_link1 => "viewtopic.php",
    topic_link2 => "t=%d&postorder=asc",
    alternative_page_number_regex_forum => qr//,
    alternative_page_number_regex_topic => qr//,
    quote_string => "wrote",
    max_tries => 50,
    db_empty => [qw(users categories forums topics posts posts_text vote_desc vote_results groups user_group)],
    bbcode_uid => '48d712e388',
    db_insert => 1,
    update_overwrite => 0,
    verbose => 0,
    profile_info => 1,
    profile_string_occupation => "occupation",
    profile_string_msn => "msn messenger",
    max_children => 1,
    smiles => {
	icon_biggrin => ':D',
	icon_smile => ':)',
	icon_sad => ':(',
	icon_surprised => ':o',
	icon_eek => ':shock:',
	icon_confused => ':?',
	icon_cool => '8)',
	icon_lol => ':lol:',
	icon_mad => ':x',
	icon_razz => ':P',
	icon_redface => ':oops:',
	icon_cry => ':cry:',
	icon_evil => ':evil:',
	icon_twisted => ':twisted:',
	icon_rolleyes => ':roll:',
	icon_wink => ':wink:',
	icon_exclaim => ':!:',
	icon_question => ':?:',
	icon_idea => ':idea:',
	icon_arrow => ':arrow:',
	icon_neutral => ':|',
	icon_mrgreen => ':mrgreen:',
    },
);
# mysql tables as arrays of hashes
for (qw(categories forums topics users posts posts_text vote_desc vote_results groups user_group)) {
    $default{$_} = [];
}


package WWW::phpBB;

##################
# main functions #
##################

our %ok_field; # for accessors

for (qw(
    base_url
    db_host
    db_user
    db_passwd
    db_database
    db_prefix
    forum_user
    forum_passwd
    db_compression
    max_rows
    months
    post_date_format
    post_date_pos
    reg_date_format
    reg_date_pos
    forum_link_regex
    topic_link_regex_p
    topic_link_regex_t
    topic_link1
    topic_link2
    alternative_page_number_regex_forum
    alternative_page_number_regex_topic
    quote_string
    max_tries
    db_empty
    db_insert
    max_children
    verbose
    profile_info
)) { $ok_field{$_}++ };

sub AUTOLOAD {
    my $self = shift;
    my $attr = our $AUTOLOAD;
    $attr =~ s/.*:://;
    return unless $attr =~ /[^A-Z]/;
    croak "invalid attribute method: ->$attr( )" unless $ok_field{$attr};
    $self->$attr = shift if @_;
    $self->$attr;
}

sub new {
    my $self = {};
    bless($self, shift);
    if (@_) {
	my %args = @_;
	@$self{keys %args} = values %args;
    }

    # defaults
    while (my ($key, $value) = each %default) {
	$self->{$key} = $value unless exists $self->{$key};
    }

    # croak if the mandatory arguments are missing
    for (qw(base_url db_host db_user db_passwd db_database db_prefix)) {
	croak "you must specify a $_" unless exists $self->{$_};
    }

    # init
    $self->{mmech} = WWW::Mechanize->new(stack_depth => 1);
    $self->{mmech}->agent_alias('Linux Mozilla');
    #$self->{mmech}->add_header('Accept-Encoding' => 'gzip; deflate');
    for (1..$self->{max_tries}) {
	$self->{mmech}->get($self->{base_url});
	last if $self->{mmech}->success && $self->{mmech}->status == 200;
	print "Error fetching the start page (try $_ out of $self->{max_tries})\n";
    }
    croak "gave up...\n" unless $self->{mmech}->success && $self->{mmech}->status == 200;

    $self->{dbh} = DBI->connect("DBI:mysql:database=$self->{db_database};host=$self->{db_host};mysql_compression=$self->{db_compression}",
	$self->{db_user}, $self->{db_passwd}, {AutoCommit => 1, RaiseError => 1});
    unless ($self->{update_overwrite}) {
	$self->{dbh}->do("CREATE TABLE IF NOT EXISTS $self->{db_prefix}" . "topics_trans "
	    . "(new mediumint(8) unsigned NOT NULL,"
	    . "orig mediumint(8) unsigned NOT NULL,"
	    . "PRIMARY KEY (new) )");
	$self->{dbh}->do("CREATE TABLE IF NOT EXISTS $self->{db_prefix}" . "posts_trans "
	    . "LIKE $self->{db_prefix}" . "topics_trans");
    }

    $self;
}

sub forum_login_raw {
    my $self = shift;
    if (!exists $self->{forum_user} || !exists $self->{forum_passwd}) {
    	print "can't login without a forum_user and forum_passwd\n";
	return;
    }
    if ($self->{verbose}) {
    	print "logging in...";
    }
    for (1..$self->{max_tries}) {
	#$self->{mmech}->form_number(1);
	$self->{mmech}->field('username', $self->{forum_user});
	$self->{mmech}->field('password', $self->{forum_passwd});
	$self->{mmech}->click();
	if ($self->{mmech}->success && $self->{mmech}->status == 200) {
      	    if ($self->{verbose}) {
	  	print "\n";
            }
	    last;
	}
	print "Error logging in (try $_ out of $self->{max_tries})\n";
    }
    croak "gave up...\n" unless $self->{mmech}->success && $self->{mmech}->status == 200;
}

# wrapper for forum_login_raw() that retries in case of errors
sub forum_login {
    my $self = shift;
    for (1..$self->{max_tries}) {
        eval {
            $self->forum_login_raw(@_);
            1;
        } and last;
	    print "failed (try $_ out of $self->{max_tries})\n";
        sleep(1)
    }
}

sub forum_logout_raw {
    my $self = shift;
    return unless exists $self->{forum_user} && exists $self->{forum_passwd};
    if ($self->{verbose}) {
    	print "logging out...";
    }
    for (1..$self->{max_tries}) {
	$self->{mmech}->follow_link(url_regex => qr/logout/);
	if ($self->{mmech}->success && $self->{mmech}->status == 200) {
      	    if ($self->{verbose}) {
	  	print "\n";
            }
	    last
	}
	print "Error logging out (try $_ out of $self->{max_tries})\n";
    }
    croak "gave up...\n" unless $self->{mmech}->success && $self->{mmech}->status == 200;
    # reset the base_uri
    $self->{mmech}->get($self->{base_url})
}

# wrapper for forum_logout_raw() that retries in case of errors
sub forum_logout {
    my $self = shift;
    for (1..$self->{max_tries}) {
        eval {
            $self->forum_logout_raw(@_);
            1;
        } and last;
	    print "failed (try $_ out of $self->{max_tries})\n";
        sleep(1)
    }
}

sub get_categories_and_forums {
    my $self = shift;
    my $parse;
    $parse = HTML::TokeParser::Simple->new( \$self->{mmech}->content );
    $parse->unbroken_text( 1 );
    my $token;
    my $cat_order;
    my $rows;
    my $frows;

    while ($token = $parse->get_token) {
	next unless $token->get_attr('class') eq 'catLeft';
	my %row;
	my $cat_id;
	# cat_id
	$token = $parse->get_token until $token->is_start_tag('a') || $token == 0;
	$token->get_attr('href') =~ /c=(\d+)/;
	$row{cat_id} = $cat_id = $1;
	# cat_title
	$token = $parse->get_token until $token->is_text && $token->as_is =~ /\S/;
	$row{cat_title} = $token->as_is;
	# cat_order
	$cat_order += 10;
	$row{cat_order} = $cat_order;
	# store
	push @{$self->{categories}}, \%row;

	# get the forums
	my $forum_order;
	while ($token = $parse->get_token) {
	    last if $parse->peek =~ /catLeft/;
	    next unless $token->is_start_tag('a') && $token->get_attr('class') eq 'forumlink';
	    my %row;
	    # auth
	    $row{auth_post} = 1;
	    $row{auth_reply} = 1;
	    $row{auth_edit} = 1;
	    $row{auth_delete} = 1;
	    $row{auth_vote} = 1;
	    $row{auth_pollcreate} = 1;
	    $row{auth_sticky} = $row{auth_announce} = $row{auth_attachments} = 3;
	    # forum_id
	    $token->get_attr('href') =~ $self->{forum_link_regex};
	    $row{forum_id} = $1;
	    # cat_id
	    $row{cat_id} = $cat_id;
	    # forum_name
	    $token = $parse->get_token until $token->is_text && $token->as_is =~ /\S/;
	    $row{forum_name} = $token->as_is;
	    # forum_desc
	    $token = $parse->get_token;
	    $token = $parse->get_token until $token->is_text && $token->as_is =~ /\S/
	      || $token->is_end_tag('td');
	    $row{forum_desc} = $token->as_is if $token->is_text;
	    $row{forum_desc} =~ s/ //g;
	    # forum_topics
	    $token = $parse->get_token until $token->is_start_tag('td');
	    $token = $parse->get_token until $token->is_text && $token->as_is =~ /\S/;
	    $row{forum_topics} = $token->as_is;
	    # forum_posts
	    $token = $parse->get_token until $token->is_start_tag('td');
	    $token = $parse->get_token until $token->is_text && $token->as_is =~ /\S/;
	    $row{forum_posts} = $token->as_is;
	    # forum_last_post_id
	    $token = $parse->get_token until $token->is_start_tag('a')
	      && $token->get_attr('href') =~ $self->{topic_link_regex_p}
	      || $token->is_end_tag('tr');
	    $row{forum_last_post_id} = $1 if $token->is_start_tag('a');
	    # forum_order
	    $forum_order += 10;
	    $row{forum_order} = $forum_order;
	    # store
	    push @{$self->{forums}}, \%row;
	}
    }
    if ($self->{db_insert}) {
	$self->insert_array($self->{categories}, "categories");
	$self->insert_array($self->{forums}, "forums");
    }
}

# $_[0]=$forum_id, $_[1]=$page_number
sub get_topics {
    my $self = shift;
    my ($forum_id, $page_number) = @_;
    my $success;
    my $rows;
    # make a copy of the $mech object
    my $mech = {%{$self->{mmech}}};
    bless $mech, "WWW::Mechanize";
    my $url = $self->compute_url("viewforum.php", "f=$forum_id");
    for (1..$self->{max_tries}) {
        eval {
	    $mech->get($url);
	    1;
	} or next;
	last if $mech->success && $mech->status == 200;
	print "Failed to enter forum_id $forum_id (try $_ out of $self->{max_tries})\n";
    }
    return unless $mech->success && $mech->status == 200;
    # cycle through pages
    my $pages = $self->number_of_pages($mech, 'forum');
    # get just one page ?
    if (defined $page_number) {
	if (-@$pages <= $page_number && $page_number < @$pages) {
	    $pages = [ $$pages[$page_number] ];
	} else { return }
    }
    #print " pages: ", join(", ", @$pages);
    for ( @$pages ) {
	my $url = $mech->uri;
	$url = $self->forum_url_for_page($url, $forum_id, $_);
	#print $url, "\n";
	for (1..$self->{max_tries}) {
	    eval {
		$mech->get($url);
		1;
	    } or next;
	    last if $mech->success && $mech->status == 200;
	    print "Failed to enter a page of forum_id $forum_id (try $_ out of $self->{max_tries})\n";
	}
	next unless $mech->success && $mech->status == 200;
	# extract topic info
	my $parse;
	$parse = HTML::TokeParser::Simple->new( \$mech->content );
	$parse->unbroken_text( 1 );
	my $token;
	$token = $parse->get_token;
	$token = $parse->get_token until (!defined $token || $token->get_attr('class') eq 'forumline');
	$token = $parse->get_token until $token->is_end_tag('tr');
	while ($token = $parse->get_token) {
	    last if $token->is_end_tag('table');
	    next unless $token->is_start_tag('tr');
	    $token = $parse->get_token until $token->is_start_tag('td');
	    last unless $token->get_attr('class') =~ /row/;
	    my %row;
	    # forum_id
	    $row{forum_id} = $forum_id;
	    # topic_type
	    $token = $parse->get_token until $token->is_start_tag('img')
	      || $token->is_end_tag('td');
	    last if $token->is_end_tag('td');
	    $row{topic_type} = 1 if $token->get_attr('src') =~ /sticky/;
	    $row{topic_type} = 2 if $token->get_attr('src') =~ /announce/;
	    # topic_id
	    $token = $parse->get_token until $token->is_start_tag('a')
	      && $token->get_attr('href') =~ $self->{topic_link_regex_t};
	    $row{topic_id} = $1;
	    # topic_title
	    $token = $parse->get_token until $token->is_text
	      && $token->as_is =~ /\S/;
	    $row{topic_title} = $token->as_is;
	    # topic_replies
	    $token = $parse->get_token until $token->is_start_tag('td');
	    $token = $parse->get_token until $token->is_text
	      && $token->as_is =~ /^(\d+)$/;
	    $row{topic_replies} = $1;
	    # topic_poster
	    $token = $parse->get_token until $token->is_start_tag('td');
	    while ($token = $parse->get_token) {
		last if $token->is_end_tag('td');
		if ($token->is_start_tag('a')) {
		    $row{topic_poster} = $1
		      if $token->is_start_tag('a')
		      && $token->get_attr('href') =~ /viewprofile.*u=(\d+)/;
		    last;
		}
		if ( ! exists $row{topic_poster}
		    && $token->is_text
		    && $token->as_is =~ /\S/ ) {
			my $username = $token->as_is;
			for (@{$self->{users}}) {
			    if ($_->{username} eq $username) {
				$row{topic_poster} = $_->{user_id};
				last;
			    }
			}
		    }
	    }
	    $row{topic_poster} = -1 unless exists $row{topic_poster};
	    # topic_views
	    $token = $parse->get_token until $token->is_start_tag('td');
	    $token = $parse->get_token until (!defined $token || ($token->is_text && $token->as_is =~ /^(\d+)$/));
	    $row{topic_views} = $1;
	    # topic_last_post_id
	    $token = $parse->get_token until $token->is_start_tag('a')
	      && $token->get_attr('href') =~ $self->{topic_link_regex_p};
	    $row{topic_last_post_id} = $1;

	    # manage the same topic appearing on more pages (like announcements)
	    my $unique = 1;
	    for (@{$self->{topics}}) {
		if ( $_->{topic_id} == $row{topic_id} ) {
		    $unique = 0;
		    last;
		}
	    }
	    # check also the db to see if it's the shadow of a moved topic
	    if ($unique && ! defined $page_number) {
		my $sth = $self->{dbh}->prepare("SELECT topic_id FROM $self->{db_prefix}"
		    . "topics WHERE topic_id=$row{topic_id}" );
		$sth->execute;
		if ($sth->fetch) {
		    $unique = 0;
		}
	    }

	    push @{$self->{topics}}, \%row if $unique;
	}
    }
}

# $_[0]=$page_number
sub get_users_raw {
    my $self = shift;
    if ($self->{verbose}) {
    	print "getting users...\n";
    }
    my ($page_number) = @_;
    my $success;
    my $rows;

    $self->get_new_admin();
    # make a copy of the $mech object
    my $mech = {%{$self->{mmech}}};
    bless $mech, "WWW::Mechanize";
    my $url = $self->compute_url("memberlist.php", "");
    for (1..$self->{max_tries}) {
	$mech->get($url);
	last if $mech->success && $mech->status == 200;
	print "Failed to enter memberlist (try $_ out of $self->{max_tries})\n";
    }
    return unless $mech->success && $mech->status == 200;
    # cycle through pages
    my $pages = $self->number_of_pages($mech);
    # get just one page ?
    if (defined $page_number) {
	if (-@$pages <= $page_number && $page_number < @$pages) {
	    $pages = [ $$pages[$page_number] ];
	} else { return }
    }
    for ( @$pages ) {
	my $url = $mech->uri;
	$url =~ s/&$//;
	$url = $self->memberlist_url_for_page($url, $_);

	for (1..$self->{max_tries}) {
	    $mech->get($url);
	    last if $mech->success && $mech->status == 200;
	    print "Failed to enter a page of the memberlist (try $_ out of $self->{max_tries})\n";
	}
	next unless $mech->success && $mech->status == 200;
	# extract memberlist info
	my $parse;
	$parse = HTML::TokeParser::Simple->new( \$mech->content );
	$parse->unbroken_text( 1 );
	my $token;
	$token = $parse->get_token;
	$token = $parse->get_token until $token->is_start_tag('table')
	  && $token->get_attr('class') eq 'forumline';
	$token = $parse->get_token until $token->is_end_tag('tr');
	while ($token = $parse->get_token) {
	    #print "|>", $parse->peek(7), "<|\n";
	    next unless $token->is_start_tag('tr');
	    $token = $parse->get_token until $token->is_start_tag('td');
	    my %row;
	    # various default fields
	    $row{user_sig_bbcode_uid} = $self->{bbcode_uid};
	    $row{user_style} = 1;
	    $row{user_lang} = 'english';
	    $row{user_viewemail} = 0;
	    $row{user_attachsig} = 1;
	    $row{user_allowhtml} = 0;
	    $row{user_notify} = 0;
	    $row{user_notify_pm} = 1;
	    $row{user_popup_pm} = 1;
	    # user_id
	    $token = $parse->get_token until !defined $token || ($token->is_start_tag('a') && $token->get_attr('href') =~ /viewprofile.*u=(\d+)(\D|$)/);
	    last if !defined $token;
	    $row{user_id} = $1;
	    # username
	    $token = $parse->get_token until $token->is_text
	      && $token->as_is =~ /\S/;
	    $row{username} = $token->as_is;
        die "the destination forum's admin has the same username as one user from the scraped forum ($row{username})! aborting...\n" if $row{username} eq $self->{new_admin_username};
	    #print $row{username}, "\n";
	    # user_email
	    $token = $parse->get_token until $token->is_start_tag('td');
	    while ($token = $parse->get_token) {
		last if $token->is_end_tag('td');
		if ($token->is_start_tag('a') && $token->as_is =~ /mailto:([^"]+)\"/) {
		    $row{user_email} = $1;
		}
	    }
	    # user_from
	    $token = $parse->get_token until $token->is_start_tag('td');
	    my $td_count = 0;
	    while ($token = $parse->get_token) {
		$td_count++ if $token->is_start_tag('td');
		$td_count-- if $token->is_end_tag('td');
		last if $td_count < 0;
		if ($token->is_text
		    && $token->as_is !~ /^( )+$/
		    && $token->as_is =~ /\S/) {
			$row{user_from} = $token->as_is;
		    }
	    }
	    # user_regdate
	    $token = $parse->get_token until $token->is_text
	      && $token->as_is =~ /\S/;
	    #print $token->as_is(), "\n";
	    $row{user_regdate} = $self->parse_date($token->as_is, $self->{reg_date_format},
		$self->{reg_date_pos});
	    # user_posts
	    $token = $parse->get_token until $token->is_text
	      && $token->as_is =~ /^(\d+)$/;
	    $row{user_posts} = $1;
	    # user_website
	    while ($token = $parse->get_token) {
		last if $token->is_end_tag('tr');
		if ($token->is_start_tag('a')
		    && $token->get_attr('target') eq "_userwww") {
			$row{user_website} = $token->get_attr('href');
		    }
	    }
	    #while( my ($k, $v) = each %row ) {
	     #print "$k : $v\n";
	    #}
	    #print "\n";

	    if($self->{profile_info}) {
            # get profile info
            if ($self->{verbose}) {
                print "getting the profile info for '$row{username}'\n";
            }
            # make a copy of the $mech object in order to get the profile page
            my $p_mech = {%{$mech}};
            bless $p_mech, "WWW::Mechanize";
            my $urlp = $self->compute_url("profile.php", "mode=viewprofile&u=$row{user_id}");
            for (1..$self->{max_tries}) {
                $p_mech->get($urlp);
                last if $p_mech->success && $p_mech->status == 200;
                print "Failed to enter profile (try $_ out of $self->{max_tries})\n";
            }
            next unless $p_mech->success && $p_mech->status == 200;
            my $p_parse;
            $p_parse = HTML::TokeParser::Simple->new( \$p_mech->content );
            $p_parse->unbroken_text( 1 );
            my $p_token;
            $p_token = $p_parse->get_token;
            $p_token = $p_parse->get_token until $p_token->get_attr('class')
              eq 'forumline';
            $p_token = $p_parse->get_token until $p_token->get_attr('class')
              =~ /row/ && $p_token->is_start_tag('td');
            # user_avatar
            while ($p_token = $p_parse->get_token) {
                last if $p_token->is_end_tag('td');
                if ($p_token->is_tag('img')) {
                    $row{user_avatar} = $p_token->get_attr('src');
                    (my $b_url = $p_mech->uri) =~ s%^(.*/).*$%$1%;
                    $row{user_avatar} = $b_url . $row{user_avatar} if $row{user_avatar} !~ m%^http://%;
                    $row{user_avatar_type} = 2;
                    last;
                }
            }
            #print "$row{username} - $row{user_avatar}\n";
            # user_occ
            #for (1..5) {
                #$p_token = $p_parse->get_token;
                #$p_token = $p_parse->get_token until $p_token->is_start_tag('tr');
            #}
            #$p_token = $p_parse->get_token until $p_token->is_end_tag('td');
            #$p_token = $p_parse->get_token until $p_token->is_text
              #&& $p_token->as_is !~ /^\s+$|^( )+$/
              #|| $p_token->is_end_tag('tr');
            $p_token = $p_parse->get_token until $p_token->is_text && $p_token->as_is =~ /^$self->{profile_string_occupation}:/i;
            $p_token = $p_parse->get_token until $p_token->is_start_tag('span');
            $p_token = $p_parse->get_token until $p_token->is_text;
            $row{user_occ} = $p_token->as_is if $p_token->as_is !~ /^\s+$|^( )+$/;
            # user_interests
            $p_token = $p_parse->get_token until $p_token->is_end_tag('tr');
            $p_token = $p_parse->get_token until $p_token->is_end_tag('td');
            $p_token = $p_parse->get_token until $p_token->is_text
              && $p_token->as_is !~ /^\s+$|^( )+$/
              || $p_token->is_end_tag('tr');
            $row{user_interests} = $p_token->as_is if $p_token->is_text;
            # user_msnm
            #$p_token = $p_parse->get_token until $p_token->is_start_tag('table');
            #for (1..3) {
                #$p_token = $p_parse->get_token;
                #$p_token = $p_parse->get_token until $p_token->is_start_tag('tr');
            #}
            #$p_token = $p_parse->get_token until $p_token->is_end_tag('td');
            #$p_token = $p_parse->get_token until $p_token->is_text
              #&& $p_token->as_is !~ /^\s+$|^( )+$/
              #|| $p_token->is_end_tag('tr');
            $p_token = $p_parse->get_token until $p_token->is_text && $p_token->as_is =~ /^$self->{profile_string_msn}:/i;
            $p_token = $p_parse->get_token until $p_token->is_start_tag('span');
            $p_token = $p_parse->get_token until $p_token->is_text;
            $row{user_msnm} = $p_token->as_is if $p_token->as_is !~ /^\s+$|^( )+$/;
            # user_yim
            $p_token = $p_parse->get_token until $p_token->is_end_tag('tr');
            $p_token = $p_parse->get_token until $p_token->is_end_tag('td');
            $p_token = $p_parse->get_token until $p_token->is_start_tag('a')
              && $p_token->get_attr('href') =~ /target=(.+?)(&|$)/
              || $p_token->is_end_tag('tr');
            $row{user_yim} = $1 if $p_token->is_start_tag('a');
            # user_aim
            $p_token = $p_parse->get_token until $p_token->is_end_tag('tr');
            $p_token = $p_parse->get_token until $p_token->is_end_tag('td');
            $p_token = $p_parse->get_token until $p_token->is_start_tag('a')
              && $p_token->get_attr('href') =~ /screenname=(.+?)(&|$)/
              || $p_token->is_end_tag('tr');
            $row{user_aim} = $1 if $p_token->is_start_tag('a');
            # user_icq
            $p_token = $p_parse->get_token until $p_token->is_end_tag('tr');
            $p_token = $p_parse->get_token until $p_token->is_end_tag('td');
            $p_token = $p_parse->get_token until $p_token->is_start_tag('a')
              && $p_token->get_attr('href') =~ /icq\.com.*=(\d+?)(&|$)/
              || $p_token->is_end_tag('tr');
            $row{user_icq} = $1 if $p_token->is_start_tag('a');
	    }
	    #while( my ($k, $v) = each %row ) {
	     #print "$k : $v\n";
	    #}
	    #print "\n";

	    push @{$self->{users}}, \%row;
	    if ($self->{db_insert} && ++$rows >= $self->{max_rows}) {
		$self->insert_array($self->{users}, "users");
		@{$self->{users}} = ();
	    }

	}
    }
    if ($self->{db_insert}) {
	$self->insert_array($self->{users}, "users");
	@{$self->{users}} = ();
    }
    $self->create_groups;
}

# wrapper for get_users_raw() that retries in case of errors
sub get_users {
    my $self = shift;
    for (1..$self->{max_tries}) {
        eval {
            $self->get_users_raw(@_);
            1;
        } and last;
	    print "failed (try $_ out of $self->{max_tries})\n";
        sleep(1)
    }
}

# $_[0]=$topic_id, $_[1]=$page_number
sub get_posts {
    my $self = shift;
    my ($topic_id, $page_number) = @_;
    my $success;
    my ($url, $url1, $url2);
    if ($self->{verbose}) {
    	print "getting the posts from topic #$topic_id\n";
    }
    # make a copy of the $mech object
    my $mech = {%{$self->{mmech}}};
    bless $mech, "WWW::Mechanize";
    $url1 = $self->{topic_link1};
    $url1 = sprintf($url1, $topic_id) if $url1 =~ m/%d/;
    $url2 = $self->{topic_link2};
    $url2 = sprintf($url2, $topic_id) if $url2 =~ m/%d/;
    $url = $self->compute_url($url1, $url2);
    for (1..$self->{max_tries}) {
        eval {
	    $mech->get($url);
	    1;
	} or next;
	last if $mech->success && $mech->status == 200;
	print "Failed to enter topic_id $topic_id (try $_ out of $self->{max_tries})\n";
    }
    return unless $mech->success && $mech->status == 200;
    # cycle through pages
    my $pages = $self->number_of_pages($mech, 'topic');
    # get just one page ?
    if (defined $page_number) {
	if (-@$pages <= $page_number && $page_number < @$pages) {
	    $pages = [ $$pages[$page_number] ];
	} else { return }
    }
    for ( @$pages ) {
	my $url = $mech->uri;
	$url = $self->topic_url_for_page($url, $topic_id, $_);
	for (1..$self->{max_tries}) {
	    eval {
		$mech->get($url);
		1;
	    } or next;
	    last if $mech->success && $mech->status == 200;
	    print "Failed to enter a page of topic_id $topic_id (try $_ out of $self->{max_tries})\n";
	}
	next unless $mech->success && $mech->status == 200;
	$self->get_posts_from_page($mech, $topic_id, $_);
    }
    # get last_post_id only if scraping the full topic or just the last page
    unless (defined $page_number && $page_number != -1) {
	for (@{$self->{topics}}) {
	    if ($_->{topic_id} == $topic_id) {
		$_->{topic_last_post_id} = $self->{posts}[-1]{post_id};
		last;
	    }
	}
    }
    if ($self->{db_insert}) {
	$self->insert_array($self->{posts}, "posts");
	$self->insert_array($self->{posts_text}, "posts_text");
	$self->insert_array($self->{vote_desc}, "vote_desc");
	$self->insert_array($self->{vote_results}, "vote_results");
	@{$self->{posts}} = ();
	@{$self->{posts_text}} = ();
	@{$self->{vote_desc}} = ();
	@{$self->{vote_results}} = ();
    }
}

sub get_posts_from_page {
    my $self = shift;
    my ($mech, $topic_id, $start_from) = @_;
    my $parse;
    $parse = HTML::TokeParser::Simple->new( \$mech->content );
    $parse->unbroken_text( 1 );
    my $token;
    my $rows;
    my %v_row;

    $token = $parse->get_token;
    $token = $parse->get_token until $token->get_attr('class') eq 'forumline';
    for (1..2) {
	$token = $parse->get_token;
	$token = $parse->get_token until $token->is_start_tag('tr');
    }
    my $counter;
    while (1) {
	$token = $parse->get_token;
	$counter++ if $token->is_start_tag('tr');
	$counter-- if $token->is_end_tag('tr');
	last if $counter < 0;
	# get the poll only on the first page
	if ($token->is_start_tag('table') && $start_from == 0) {
	    #################
	    ## it's a poll ##
	    #################
	    for (@{$self->{topics}}) {
		if ($_->{topic_id} == $topic_id) {
		    # topic_vote
		    $_->{topic_vote} = 1;
		    last;
		}
	    }
	    # topic_id
	    $v_row{topic_id} = $topic_id;
	    # vote_id
	    $v_row{vote_id} = ++$self->{vote_id};
	    # vote_text
	    $token = $parse->get_token until $token->is_text
	      && $token->as_is =~ /\S/;
	    $v_row{vote_text} = $token->as_is;
	    # @{$self->{vote_results}}
	    my $vote_option_id;
	    $token = $parse->get_token until $token->is_start_tag('table');
	    my $counter2;
	    while (1) {
		my %vr_row;
		$token = $parse->get_token;
		$counter2++ if $token->is_start_tag('table');
		$counter2-- if $token->is_end_tag('table');
		last if $counter2 < 0;
		next unless $token->is_start_tag('td');
		$token = $parse->get_token until $token->is_text
		  && $token->as_is =~ /\S/
		  && $token->as_is !~ / /
		  && $token->as_is !~ /^\s+$/;
		$vr_row{vote_id} = $self->{vote_id};
		$vr_row{vote_option_text} = $token->as_is;
		$vr_row{vote_option_id} = ++$vote_option_id;
		push @{$self->{vote_results}}, \%vr_row;
		my $counter3;
		while (1) {
		    $token = $parse->get_token;
		    if ($token->is_start_tag('tr')) {
			$counter++;
			$counter3++;
		    }
		    if ($token->is_end_tag('tr')) {
			$counter--;
			$counter3--;
		    }
		    last if $counter3 < 0;
		}
		# print "|>", $parse->peek(7), "<|\n";
	    }
	    push @{$self->{vote_desc}}, \%v_row;
	}
    }

    while ( $token = $parse->get_token ) {
	last if $token->get_attr('class') eq 'catBottom';
	# post_username
	next unless $token->get_attr('class') eq 'name';
	$token = $parse->get_token until $token->is_text;
	my $post_username = $token->as_is;
	# post_id
	$token = $parse->get_token until $token->is_start_tag('a')
	  && $token->get_attr('href') =~ $self->{topic_link_regex_p};
	my %row;
	$row{post_id} = $1;
	# topic_id
	$row{topic_id} = $topic_id;
	# forum_id
	for (@{$self->{topics}}) {
	    if ($_->{topic_id} == $topic_id) {
		$row{forum_id} = $_->{forum_id};
		last;
	    }
	}
	# post_time
	$token = $parse->get_token until $token->is_text
	  && $token->as_is =~ /\S/;
	$row{post_time} = $self->parse_date($token->as_is, $self->{post_date_format},
	    $self->{post_date_pos});
	if (@{$self->{posts}} && $row{post_time} <= $self->{posts}[-1]->{post_time}) {
	    $row{post_time} = $self->{posts}[-1]->{post_time} + 1
	}

	## fill some @{$self->{topics}} and @{$self->{vote_desc}} fields ##
	# just for the first page
	if ($start_from == 0) {
	    for (@{$self->{topics}}) {
		if ($_->{topic_id} == $topic_id) {
		    # topic_first_post_id
		    $_->{topic_first_post_id} = $row{post_id}
		    unless $_->{topic_first_post_id};
		    # vote_start and topic_time
		    $v_row{vote_start} = $_->{topic_time} = $row{post_time}
		    unless $_->{topic_time};
		    last;
		}
	    }
	}

        # @{$self->{posts_text}}
	my %t_row;
	# post_subject
	$token = $parse->get_token;
	$token = $parse->get_token until $token->is_text
	  && $token->as_is =~ /\S: (.*)$/;
	$t_row{post_subject} = $1;
	# post_id
	$t_row{post_id} = $row{post_id};
	# bbcode_uid
	$t_row{bbcode_uid} = $self->{bbcode_uid};
	# post_text
	$token = $parse->get_token until $token->is_start_tag('tr');
	$token = $parse->get_token;
	$token = $parse->get_token until $token->is_start_tag('tr');
	my $text;
	my $tr_count; # keep a track of
	while ($token = $parse->get_token) {
	    $tr_count++ if $token->is_start_tag('tr');
	    $tr_count-- if $token->is_end_tag('tr');
	    last if $tr_count < 0;
	    $text .= $token->as_is;
	}
	## bbcode
	$text = ${ $self->html_to_bbcode(\$text, 1) };
    # take care of HTML entities
    $text = decode_entities($text);
    $text = encode_entities($text);

	$t_row{post_text} = $text;
	# poster_id
	$token = $parse->get_token until $token->is_start_tag('table');
	while ($token = $parse->get_token) {
	    last if $token->is_end_tag('table');
	    if ($token->is_start_tag('a') && $token->get_attr('href')
		=~ /viewprofile.*u=(\d+)/) {
		    $row{poster_id} = $1;
		    last;
		}
	}
	# anonymous?
	unless ( exists $row{poster_id}) {
	    $row{poster_id} = -1;
	    $row{post_username} = $post_username;
	}

	push @{$self->{posts}}, \%row;
	push @{$self->{posts_text}}, \%t_row;
	if ($self->{db_insert} && ++$rows == $self->{max_rows}) {
	    $rows = 0;
	    # keep the last post
	    my $lastpost = pop @{$self->{posts}};
	    $self->insert_array($self->{posts}, "posts");
	    @{$self->{posts}} = ();
	    # put it back
	    push @{$self->{posts}}, $lastpost;

	    $self->insert_array($self->{posts_text}, "posts_text");
	    @{$self->{posts_text}} = ();
	}
    }
}

sub update_users_raw {
    my $self = shift;
    $self->{db_insert} = 0;
    my $page = -1;
    my @new;
    # max user_id
    my $sth = $self->{dbh}->prepare("SELECT MAX(user_regdate) AS regdate FROM $self->{db_prefix}" . "users");
    $sth->execute;
    $sth->bind_columns(\my ($max_regdate));
    $sth->fetch;
    MLOOP: while (1) {
	@{$self->{users}} = ();
	$self->get_users($page);
	last unless @{$self->{users}};
	for (reverse @{$self->{users}}) {
	    if ($_->{user_regdate} < $max_regdate) { # get out
		last MLOOP;
	    } elsif ($_->{user_regdate} == $max_regdate) {
		$sth = $self->{dbh}->prepare("SELECT user_id, username FROM $self->{db_prefix}"
		    . "users WHERE user_regdate=$max_regdate");
		$sth->execute;
		$sth->bind_columns(\my ($user_id, $username));
		while ($sth->fetch) {
		    if ($_->{user_id} == $user_id && $user_id != 1) {
			if ($_->{username} ne $username) {
			    # this user was deleted
			    $self->{dbh}->do("DELETE FROM $self->{db_prefix}" . "users WHERE user_id=$user_id");
			    $self->{dbh}->do("UPDATE $self->{db_prefix}"
				. "posts SET poster_id=-1, post_username="
				. $self->{dbh}->quote($_->{username})
				. " WHERE poster_id=$user_id");
			    push @new, $_;
			}
			last;
		    }
		}
	    } else { # insert
		push @new, $_;
	    }
	}
	$page--;
    }
    $self->insert_array(\@new, 'users');
    $self->create_groups;
}

# wrapper for update_users_raw() that retries in case of errors
sub update_users {
    my $self = shift;
    for (1..$self->{max_tries}) {
        eval {
            $self->update_users_raw(@_);
            1;
        } and last;
	    print "failed (try $_ out of $self->{max_tries})\n";
        sleep(1)
    }
}

sub update_topics {
    my $self = shift;
    my ($forum_id) = @_;
    my @modified_topics;
    my $page = 0;
    PAGE: while (1) {
	@{$self->{topics}} = ();
	$self->get_topics($forum_id, $page);
	last unless @{$self->{topics}};
	for (@{$self->{topics}}) {
	    my $sth = $self->{dbh}->prepare("SELECT post_time FROM $self->{db_prefix}"
		. "posts WHERE post_id=" . $_->{topic_last_post_id});
	    $sth->execute;
	    $sth->bind_columns(\my $post_time);
	    if ($sth->fetch) {
		# we have the last_post_id, but it can be a new post with the id of a deleted one
		if ($post_time >= $self->{last_timestamp}) {
		    push @modified_topics, $_;
		} elsif ($_->{topic_type} == 0) {
		    # normal topic - it won't appear on more pages
		    last PAGE;
		}
	    } else {
		# new topic
		push @modified_topics, $_;
	    }
	}
	$page++;
    }
    @{$self->{topics}} = @modified_topics;
}

sub update_topics_insert {
    my $self = shift;
    my ($t) = @_;
    unless ($self->{update_overwrite}) {
	my $sth = $self->{dbh}->prepare("SELECT topic_title FROM $self->{db_prefix}"
	    . "topics WHERE topic_id=" . $t->{topic_id});
	$sth->execute;
	$sth->bind_columns(\my $topic_title);
	if ($sth->fetch && $topic_title ne $t->{topic_title}) {
	    # it was probably deleted, create a new one
	    my $topic_id;
	    my $sth = $self->{dbh}->prepare("SELECT MAX(topic_id) FROM $self->{db_prefix}" . "topics");
	    $sth->execute;
	    $sth->bind_columns(\$topic_id);
	    $sth->fetch;
	    $topic_id++;
	    $self->{dbh}->do("REPLACE $self->{db_prefix}" . "topics_trans "
		. "SET new=$topic_id, orig=" . $t->{topic_id});
	    $t->{topic_id} = $topic_id;
	}
    }
    $self->insert_array([$t], 'topics');
}

sub update_posts {
    my $self = shift;
    my ($topic_id) = @_;
    my @new_posts;
    my @new_posts_text;
    my $page = -1;
    my $last_post_id; # that was used for a post
    my $sth = $self->{dbh}->prepare("SELECT MAX(post_id) FROM $self->{db_prefix}" . "posts");
    $sth->execute;
    $sth->bind_columns(\$last_post_id);
    $sth->fetch;

    PAGE: while (1) {
	@{$self->{posts}} = ();
	@{$self->{posts_text}} = ();
	$self->get_posts($topic_id, $page);
	last unless @{$self->{posts}};
	##$self->print_AoH($self->{posts});
	POST: for (reverse 0..$#{$self->{posts}}) {
	    my $sth;
	    last PAGE if $self->{posts}[$_]{post_time} < $self->{last_timestamp};
	    # don't get the posts that appeared betwen scraping the topic
	    # and scraping the posts, because it will mess up
	    # our last_timestamp at the next update
	    for my $t (@{$self->{topics}}) {
		if ($t->{topic_id} == $topic_id) {
		    next POST if $self->{posts}[$_]{post_id} > $t->{topic_last_post_id};
		    last;
		}
	    }

	    my ($in_table, $in_orig, $in_new);
	    my $new_id;

	    $sth = $self->{dbh}->prepare("SELECT post_id FROM $self->{db_prefix}"
		. "posts WHERE post_id=" . $self->{posts}[$_]{post_id});
	    $sth->execute;
	    if ($sth->fetch) {
		# we have that id
		$in_table = 1;
	    }
	    unless ($self->{update_overwrite}) {
		$sth = $self->{dbh}->prepare("SELECT new FROM $self->{db_prefix}"
		    . "posts_trans WHERE new=" . $self->{posts}[$_]{post_id});
		$sth->execute;
		if ($sth->fetch) {
		    # it's in the translation table, as a new id
		    $in_new = 1;
		}
		$sth = $self->{dbh}->prepare("SELECT new FROM $self->{db_prefix}"
		    . "posts_trans WHERE orig=" . $self->{posts}[$_]{post_id});
		$sth->execute;
		$sth->bind_columns(\$new_id);
		if ($sth->fetch) {
		    $in_orig = 1;
		}
	    }

	    if ($in_table) {
		# could be already scraped, check post_text
		my $against_id = $self->{posts}[$_]{post_id};
		if ($in_orig) {
		    # could be deleted, check against new_id
		    $against_id = $new_id;
		}
		unless ($in_new && ! $in_orig) {
		    # compare text
		    $sth = $self->{dbh}->prepare("SELECT post_text FROM $self->{db_prefix}"
			. "posts_text WHERE post_id=$against_id");
		    $sth->execute;
		    $sth->bind_columns(\my $post_text);
		    if ($sth->fetch) {
			# already scraped
			last PAGE if $post_text eq $self->{posts_text}[$_]{post_text};
		    }
		}
		unless ($self->{update_overwrite}) {
		    # set and record a new post_id
		    $last_post_id++;
		    $self->{dbh}->do("REPLACE $self->{db_prefix}" . "posts_trans "
			. "SET new=$last_post_id, orig=" . $self->{posts}[$_]{post_id});
		    $self->{posts_text}[$_]{post_id} = $self->{posts}[$_]{post_id} = $last_post_id;
		}
	    }

	    push @new_posts, $self->{posts}[$_];
	    push @new_posts_text, $self->{posts_text}[$_];
	}
	$page--;
    }
    ##$self->print_AoH(\@new_posts);
    @{$self->{posts}} = @new_posts;
    @{$self->{posts_text}} = @new_posts_text;
}

sub update_posts_insert {
    my $self = shift;
    my $sth;

    for (@{$self->{posts}}) {
	unless ($self->{update_overwrite}) {
	    # coordinate topic_id
	    my $new_topic_id;
	    $sth = $self->{dbh}->prepare("SELECT new FROM $self->{db_prefix}"
		. "topics_trans WHERE orig=" . $_->{topic_id});
	    $sth->execute;
	    $sth->bind_columns(\$new_topic_id);
	    if ($sth->fetch) {
		$_->{topic_id} = $new_topic_id;
	    }
	}

    }

    $self->insert_array($self->{posts}, 'posts');
    $self->insert_array($self->{posts_text}, 'posts_text');
}

####################
# helper functions #
####################

sub empty_tables {
    my $self = shift;
    for (@{$self->{db_empty}}) {
	if ($_ eq 'users') {
	    my $sth = $self->{dbh}->prepare("SELECT * FROM $self->{db_prefix}" . "users WHERE user_id=1");
	    $sth->execute;
	    $self->{dbh}->do("UPDATE $self->{db_prefix}" . "users SET user_id=1 WHERE user_id=2")
	      unless $sth->fetch;
	    $self->{dbh}->do("DELETE FROM $self->{db_prefix}" . "users WHERE user_id!=1 AND user_id!=-1");
	} elsif($_ eq 'groups') {
	    $self->{dbh}->do("DELETE FROM $self->{db_prefix}" . "groups WHERE group_id>2");
	} elsif($_ eq 'user_group') {
	    $self->{dbh}->do("DELETE FROM $self->{db_prefix}" . "user_group WHERE group_id>2");
	} else {
	    $self->{dbh}->do("DELETE FROM " . $self->{db_prefix} . $_);
	}
    }
}

# $_[0]=$array_ref, $_[1]=$table
sub insert_array {
    my $self = shift;
    my ($aref, $table) = @_;
    for my $row (@$aref) {
	my $query;
	my @cols = keys %$row;
	for (my $i = 0; $i < @cols; $i++) {
	    $query .= ',' if $i;
	    $query .= "$cols[$i]=" . $self->{dbh}->quote($$row{$cols[$i]});
	}
	$query = "INSERT $self->{db_prefix}$table SET " . $query . " ON DUPLICATE KEY UPDATE " . $query;
	eval {
	    $self->{dbh}->do($query);
	};
	croak ("$query\n$@\n") if $@;
	##print "$query\n";
    }
}

# $_[0]=$mech
# returns an array ref with page numbers
sub number_of_pages {
    my $self = shift;
    my ($mech, $type) = @_;
    my %page;
    $page{0} = 1;
    my $success;
    (my $url_ident = $mech->uri) =~ s%.*/(.*?)\?.*%$1%;
    $success = $mech->find_all_links(url_regex => qr/^${url_ident}.*start=\d+/);
    if (@$success) {
        for(@$success) {
            $_->url =~ /start=(\d+)(\D|$)/;
            $page{$1} = 1;
            #print $_->url . " : '$1'\n"
        }
    } elsif($self->{alternative_page_number_regex_forum} ne qr// && $type eq 'forum') {
        $success = $mech->find_all_links(url_regex => $self->{alternative_page_number_regex_forum});
        if (@$success) {
            for(@$success) {
            $_->url =~ $self->{alternative_page_number_regex_forum};
            $page{$1} = 1;
            }
        }
    } elsif($self->{alternative_page_number_regex_topic} ne qr// && $type eq 'topic') {
        $success = $mech->find_all_links(url_regex => $self->{alternative_page_number_regex_topic});
        if (@$success) {
            for(@$success) {
            $_->url =~ $self->{alternative_page_number_regex_topic};
            $page{$1} = 1;
            }
        }
    }
    # fill in missing pages
    my @page_keys = sort {$a <=> $b} keys %page;
    if (scalar(@page_keys) > 1) {
        my $per_page = $page_keys[1] - $page_keys[0];
        for(my $p=$page_keys[0]; $p<=$page_keys[-1]; $p+=$per_page) {
            $page{$p} = 1;
        }
    }
    # return array ref
    [sort {$a <=> $b} keys %page];
}

sub forum_url_for_page {
	my $self = shift;
	my ($url, $forum_id, $page) = @_;

	$url =~ s/&start=\d+//;
	$url .= "&start=$page";
	return $url;
}

sub topic_url_for_page {
	my $self = shift;
	my ($url, $topic_id, $page) = @_;

	$url =~ s/&start=\d+//;
	$url .= "&start=$page";
	return $url;
}

sub memberlist_url_for_page {
	my $self = shift;
	my ($url, $page) = @_;

	$url =~ s/&start=\d+//;
	$url .= "&start=$page";
	return $url;
}

# $_[0]=string_ref, $_[1]=$prepare_html
sub html_to_bbcode {
    my $self = shift;
    my ($html, $prepare_html) = @_;
    if ($prepare_html) {
	## discard excess whitespace
	$$html =~ s/\s{2,}/ /g; # trim spaces
	$$html =~ s/(>|^)\s+(<|$)/$1$2/smg; # delete whitespace between tags
	$$html =~ s/\n//g; # no need for that
	## replace  with \n
	$$html =~ s()(\n)isg;
    }
    my $text;
    my @close_tag; # push and pop them as they come along (LIFO)
    my $parse;
    $parse = HTML::TokeParser::Simple->new( $_[0] );
    $parse->unbroken_text( 1 );
    my $token;
    while ($token = $parse->get_token) {
	if ($token->is_start_tag('span')) {
	    if ($token->get_attr('style') eq 'font-weight: bold') {
		$text .= "[b:$self->{bbcode_uid}]";
		push @close_tag, "[/b:$self->{bbcode_uid}]";
	    } elsif ($token->get_attr('style') eq 'font-style: italic') {
		$text .= "[i:$self->{bbcode_uid}]";
		push @close_tag, "[/i:$self->{bbcode_uid}]";
	    } elsif ($token->get_attr('style') eq 'text-decoration: underline') {
		$text .= "[u:$self->{bbcode_uid}]";
		push @close_tag, "[/u:$self->{bbcode_uid}]";
	    } elsif ($token->get_attr('style') =~ 'color: (.*)$') {
		$text .= "[color=$1:$self->{bbcode_uid}]";
		push @close_tag, "[/color:$self->{bbcode_uid}]";
	    } elsif ($token->get_attr('style') =~ 'font-size: (\d*)px') {
		$text .= "[size=$1:$self->{bbcode_uid}]";
		push @close_tag, "[/size:$self->{bbcode_uid}]";
	    } else { # some other  we don't care about
		push @close_tag, "";
	    }
	} elsif ($token->is_end_tag('span')) {
	    $text .= pop @close_tag;
	} elsif ($token->is_start_tag('table')) { # quote or code
	    #print "|>", $parse->peek(7), "<|\n";
	    $token = $parse->get_token until $token->is_start_tag('td');
	    #$token = $parse->get_token until $token->is_text && $token->as_is =~ /^(.*?) ?$self->{quote_string}:$/s;
	    my $author = '';
	    while($token = $parse->get_token) {
	    	if($token->is_text && $token->as_is =~ /^(.*?) ?$self->{quote_string}:$/s) {
		    #print $token->as_is, "\n";
		    $author = $1;
		    last;
		} elsif($token->is_end_tag('td')) {
		    last;
		}
	    }
	    #print $author, "\n";
	    $token = $parse->get_token until $token->is_start_tag('td');
	    #print "test\n";
	    if ($token->get_attr('class') eq 'quote') {
		if ($author eq '') {
		    $text .= "[quote:$self->{bbcode_uid}]";
		} else {
		    $text .= "[quote:$self->{bbcode_uid}=\"$author\"]";
		}
		push @close_tag, "[/quote:$self->{bbcode_uid}]";
	    } elsif ($token->get_attr('class') eq 'code') {
		$text .= "[code:$self->{bbcode_uid}]";
		push @close_tag, "[/code:$self->{bbcode_uid}]";
	    }
	    my $counter;
	    my $in_table;
	    while ($token = $parse->get_token) {
		$counter++ if $token->is_start_tag('td');
		$counter-- if $token->is_end_tag('td');
		last if $counter < 0;
		$in_table .= $token->as_is;
	    }
	    # catch the bbcode inside
	    $text .= ${ $self->html_to_bbcode(\$in_table) };
	    $text .= pop @close_tag;
	} elsif ($token->is_start_tag('ul')) {
	    $text .= "[list:$self->{bbcode_uid}]";
	    push @close_tag, "[/list:u:$self->{bbcode_uid}]";
	} elsif ($token->is_end_tag('ul')) {
	    $text .= pop @close_tag;
	} elsif ($token->is_start_tag('ol')
	    && $token->get_attr('type') eq '1') {
		$text .= "[list=1:$self->{bbcode_uid}]";
		push @close_tag, "[/list:o:$self->{bbcode_uid}]";
	    } elsif ($token->is_start_tag('ol')
		&& $token->get_attr('type') eq 'a') {
		    $text .= "[list=a:$self->{bbcode_uid}]";
		    push @close_tag, "[/list:o:$self->{bbcode_uid}]";
		} elsif ($token->is_end_tag('ol')) {
		    $text .= pop @close_tag;
		} elsif ($token->is_start_tag('li')) {
		    $text .= "[*:$self->{bbcode_uid}]";
		} elsif ($token->is_tag('img')) {
		    # check for smiles
		    my $is_smile;
		    my $src = $token->get_attr('src');
		    for (keys %{$self->{smiles}}) {
			if ( $src =~ /\/$_\.gif/ ) {
			    $text .= $self->{smiles}{$_};
			    $is_smile = 1;
			    last;
			}
		    }
		    unless ($is_smile) {
			# a simple image
			$text .= "[img:$self->{bbcode_uid}]"
			  . $token->get_attr('src')
			  . "[/img:$self->{bbcode_uid}]";
		    }
		} elsif ($token->is_start_tag('a')) {
		    if ($token->get_attr('href') =~ /mailto:/) {
			push @close_tag, "";
			next;
		    }
		    $text .= "[url="
		      . $token->get_attr('href')
		      . "]";
		    push @close_tag, "[/url]";
		} elsif ($token->is_end_tag('a')) {
		    $text .= pop @close_tag;
		} elsif ($token->is_text) {
		    $text .= $token->as_is;
		}
    }
    \$text;
}

# $_[0]=$string, $_[1]=$date_format_regex, $_[2]=$date_pos_arrray-ref
sub parse_date {
    my $self = shift;
    my ($str, $date_format, $date_pos) = @_;
    my %date_vars;
    my %month_number;
    for( my $i=0; $i<@{$self->{months}}; $i++ ) {
	$month_number{$self->{months}[$i]} = $i;
    }

    $_ = $str;
    return 0 unless /$date_format/i;
    my @res = /$date_format/i;
    for (my $i = 0; $i < @res; $i++) {
	$date_vars{$$date_pos[$i]} = $res[$i];
    }

    # strip leading zero
    for (qw(seconds minutes hour day_of_month)) {
	$date_vars{$_} =~ s/^0(\d)/$1/ if exists $date_vars{$_};
    }

    # AM/PM
    if (exists $date_vars{am_pm}) {
	$date_vars{hour} += 12 if $date_vars{am_pm} =~ /pm/i
	  && $date_vars{hour} != 12;
	$date_vars{hour} -= 12 if $date_vars{am_pm} =~ /am/i
	  && $date_vars{hour} == 12;
    }
    # month name
    $date_vars{mon} = $month_number{lc substr($date_vars{month_name}, 0, 3)}
    if exists $date_vars{month_name};
    # month
    $date_vars{mon} = $date_vars{month} - 1 if exists $date_vars{month};
    # get rid of warnings
    for (qw(seconds minutes day_of_month mon year)) {
	$date_vars{$_} = 0 unless exists $date_vars{$_};
    }
    $date_vars{hour} = 12 unless exists $date_vars{hour};
    # return timestamp
    timelocal( $date_vars{seconds}, $date_vars{minutes}, $date_vars{hour},
	$date_vars{day_of_month}, $date_vars{mon}, $date_vars{year} );
}

# $_[0]=$array_ref
sub print_AoH {
    my $self = shift;
    my $AoHr = $_[0];
    print scalar @$AoHr, " elements:\n";
    for my $row (@$AoHr) {
	print "==>";
	for (sort keys %$row) {
	    print "\t$_ => \"$row->{$_}\"\n";
	}
	print "\n";
    }
}

sub update_forum_first_last_post {
    my $self = shift;
    my ($forum_id) = @_;
    for (qw(ASC DESC)) {
	$self->{dbh}->do( "UPDATE $self->{db_prefix}" . "forums SET forum_last_post_id="
	    . "(SELECT p.post_id FROM $self->{db_prefix}" . "posts p, "
	    . "$self->{db_prefix}" . "topics t "
	    . "WHERE p.topic_id = t.topic_id "
	    . "AND t.forum_id =$forum_id "
	    . "ORDER BY p.post_time $_, p.post_id $_ "
	    . "LIMIT 1) WHERE forum_id=$forum_id");
    }
}

sub get_last_timestamp {
    my $self = shift;
    my $sth = $self->{dbh}->prepare("SELECT MAX(post_time) FROM $self->{db_prefix}" . "posts");
    $sth->execute;
    $sth->bind_columns(\$self->{last_timestamp});
    $sth->fetch;
}

sub get_new_admin {
    my $self = shift;
    my $sth = $self->{dbh}->prepare("SELECT user_id, username FROM $self->{db_prefix}" . "users ORDER BY user_id DESC LIMIT 1");
    $sth->execute;
    $sth->bind_columns(\$self->{new_admin_id}, \$self->{new_admin_username});
    $sth->fetch;
}

sub create_groups {
    my $self = shift;
    my $sth = $self->{dbh}->prepare("SELECT user_id FROM $self->{db_prefix}users WHERE user_id NOT IN ( SELECT user_id FROM $self->{db_prefix}user_group )");
    $sth->execute;
    my @row;
    while(@row = $sth->fetchrow_array) {
        #print "$row[0]\n";
        my $gsth = $self->{dbh}->prepare("INSERT INTO $self->{db_prefix}groups SET group_description='Personal User'");
        $gsth->execute;
        my $group_id = $gsth->{mysql_insertid};
        my $ugsth = $self->{dbh}->prepare("INSERT INTO $self->{db_prefix}user_group SET group_id=?, user_id=?, user_pending=0");
        $ugsth->execute($group_id, $row[0]);
    }
}

sub compute_url {
    my $self = shift;
    my ($url1, $url2) = @_;
    my $url;
    ($url = $self->{mmech}->uri) =~ s%^(.*)/.*?(\?)|$%$1/$url1$2%;
    if ($url =~ /\?/) {
	$url .= "&";
    } else {
	$url .= "?";
    }
    $url .= $url2;
}

sub reaper {
    while (waitpid(-1, WNOHANG) > 0) {
	$children--;
    }
    $SIG{CHLD} = \&reaper;
}
$SIG{CHLD} = \&reaper;

# takes a function reference as argument
# remember to "wait for 1..$children;" after the loop
sub parallelize {
    my $self = shift;
    my ($func_ref) = @_;
    if($self->{max_children} < 2) {
        # avoid forking when parallelism is not requested (workaround for a windoze bug)
	    &$func_ref;
    } else {
        if ($children < $self->{max_children}) { # fork a subprocess
            if (my $pid = fork) {
                # parent
                $children++;
                if ($children == $self->{max_children}) {
                    wait;
                    $children--;
                }
            } else {
                # child
                croak "can't fork" if undef $pid;
                # the db link was destroyed by forking. create it again
                $self->{dbh}{InactiveDestroy} = 1;
                $self->{dbh} = DBI->connect("DBI:mysql:database=$self->{db_database};host=$self->{db_host};mysql_compression=$self->{db_compression}",
                    $self->{db_user}, $self->{db_passwd}, {AutoCommit => 1, RaiseError => 1});
                # run function
                &$func_ref;
                exit;
            }
        }
    }
}

#########################
# integrating functions #
#########################

sub scrape_forum_common_raw {
    my $self = shift;
    if ($self->{verbose}) {
    	print "getting categories and forums...";
    }
    $self->get_categories_and_forums();
    if ($self->{verbose}) {
    	print "\n";
    }
    for (@{$self->{forums}}) {
    	if ($self->{verbose}) {
      	    print "getting the topics from forum #", $_->{forum_id}, "\n";
    	}
    	$self->get_topics( $_->{forum_id} );
    	for (@{$self->{topics}}) {
	    $self->parallelize(
		sub {
		    $self->get_posts( $_->{topic_id} );
		    $self->insert_array([$_], "topics");
		}
	    );
    	}
    	@{$self->{topics}} = ();
    }
    #wait for 1..$children;
    1 while waitpid(-1, WNOHANG)>0; # reaps childs
    $self->update_forum_first_last_post($_->{forum_id}) for @{$self->{forums}};
}

# wrapper for scrape_forum_common_raw() that retries in case of errors
sub scrape_forum_common {
    my $self = shift;
    for (1..$self->{max_tries}) {
        eval {
            $self->scrape_forum_common_raw(@_);
            1;
        } and last;
	    print "failed (try $_ out of $self->{max_tries})\n";
        sleep(1)
    }
}

sub update_forum_common_raw {
    my $self = shift;
    $self->{db_insert} = 0;
    if ($self->{verbose}) {
    	print "getting categories and forums...";
    }
    $self->get_categories_and_forums();
    if ($self->{verbose}) {
    	print "\n";
    }
    $self->insert_array($self->{categories}, 'categories');
    $self->insert_array($self->{forums}, 'forums');
    $self->get_last_timestamp();
    for (@{$self->{forums}}) {
	if ($self->{verbose}) {
	    print "updating topics from forum #", $_->{forum_id}, "\n";
	}
	$self->update_topics($_->{forum_id});
    	for (@{$self->{topics}}) {
    	    $self->update_posts($_->{topic_id});
    	    $self->update_topics_insert($_);
    	    $self->update_posts_insert();
    	}
    	@{$self->{topics}} = ();
	$self->update_forum_first_last_post($_->{forum_id});
    }
}

# wrapper for update_forum_common_raw() that retries in case of errors
sub update_forum_common {
    my $self = shift;
    for (1..$self->{max_tries}) {
        eval {
            $self->update_forum_common_raw(@_);
            1;
        } and last;
	    print "failed (try $_ out of $self->{max_tries})\n";
        sleep(1)
    }
}


1;
__END__