File Coverage

blib/lib/WWW/Mixi/OO/TableListPage.pm

Criterion	Covered	Total	%
statement	15	81	18.5
branch	0	32	0.0
condition			n/a
subroutine	5	16	31.2
pod	7	7	100.0
total	27	136	19.8

# -*- 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: TableListPage.pm 100 2005-02-04 19:19:55Z topia $
# $URL: file:///usr/minetools/svnroot/mixi/trunk/WWW-Mixi-OO/lib/WWW/Mixi/OO/TableListPage.pm $
package WWW::Mixi::OO::TableListPage;
use strict;
use warnings;
use URI;
use URI::QueryParam;
use base qw(WWW::Mixi::OO::ListPage);

=head1 NAME

WWW::Mixi::OO::TableListPage - WWW::Mixi::OO's Table style List Pages base class

=head1 SYNOPSIS

  package WWW::Mixi::OO::Foo;
  use base qw(WWW::Mixi::OO::TableListPage);
  # some implementations...

=head1 DESCRIPTION

table style list pages base class.

=head1 METHODS

=over 4

=cut

=item parse

see parent class (L),
and some implementation class.

=item parse_navi_prev

=item parse_navi_current

=item parse_navi_next

parse previous(or current, or next) navigation.

see some implementation class.

=back

=head1 METHODS MAYBE IMPLEMENTATION AT SUBCLASS

=over 4

=item parse_title

parse title message. return scalar or array of scalar.

=cut

sub parse {
    my $body = shift->parse_body;
    return () unless defined $body;
    return @$body;
}

foreach (qw(prev current next)) {
    eval <<"END";
  sub parse_navi_$_ \{
      my \$this = shift;
      my \$navi = \$this->parse_navi;
      return () unless defined \$navi;
      return () unless defined \$navi->{$_};
      return \$navi->{$_};
  \}
END
}

=back

=head1 INTERNAL METHODS

these methods used from internal (such as subclass).

=over 4

=item parse_table

=item parse_navi

=item parse_body

cached parser methods for _parse_table, _parse_navi, _parse_body.

=cut

__PACKAGE__->mk_cached_parser(qw(table navi body));

=item _parse_table

  # subclass
  sub _parse_table {
      my $this = shift;
      return $this->SUPER::_parse_table(@_) if @_ == 1; # overridable

      my %options = @_;
      $this->SUPER::_parse_table(qr/.../);
  }

return main table.

=cut

sub _parse_table {
    my $this = shift;

    my $part = $this->parse_extract_parts(shift);
    return () unless defined $part;

    # split to each tables
    $this->_split_tables($part);
    return $part;
}

=item _split_tables

  # subclass
  sub _split_tables {
      my ($this, $part) = @_;
      my @tables = /(...)/g;

      # set tables
      $this->cache->{tables} = \@tables;

      # set indecies to tables...
      $this->cache->{indecies}->{title} = 0;
      $this->cache->{indecies}->{navi} = 1;
      $this->cache->{indecies}->{body} = 2;
  }

split main tables to some parts.

=cut

sub _split_tables {
    my ($this, $part) = @_;

    my $maybe_attrs_regex = $this->regex_parts->{html_maybe_attrs};
    my @tables = $this->extract_balanced_html_parts(
	element => 'table',
	text => $part);
    $this->cache->{tables} = \@tables;
    $this->cache->{indecies}->{title} = 0;
    if (@tables > 2) {
	# remove no-need footer
	pop(@tables);
	$this->cache->{indecies}->{navi} = 1;
	$this->cache->{indecies}->{body} = 2;
    } else {
	$this->cache->{indecies}->{body} = 1;
    }
}

=item parse_table_item_with_index

  # call from subclass
  sub _parse_foo {
      my ($this, %options) = @_;
      my $part = $this->parse_table_item_with_index(0);
      return () unless defined $part;
      # ...
      return $1;
  }

return split part with index. (maybe useless)

=cut

sub parse_table_item_with_index {
    my $this = shift;
    $this->parse_table;
    return $this->cache->{tables}->[shift];
}

=item parse_table_item

  # call from subclass
  sub _parse_body {
      my ($this, %options) = @_;
      my $part = $this->parse_table_item('body');
      return () unless defined $part;
      # ...
      return $1;
  }

return split part with keyword.

=cut

sub parse_table_item {
    my $this = shift;
    $this->parse_table;
    my $index = $this->cache->{indecies}->{+shift};
    if (defined $index) {
	return $this->cache->{tables}->[$index];
    }
}

=item parse_table_items

  # call from subclass
  my $table_count = $this->parse_table_items;

return split parts count. (maybe useless)

=cut

sub parse_table_items {
    my $this = shift;
    $this->parse_table;
    return scalar @{$this->cache->{tables}};
}

sub _parse_navi {
    my $this = shift;
    my $part = $this->parse_table_item('navi');
    return () unless defined $part;
    my $maybe_attrs_regex = $this->regex_parts->{html_maybe_attrs};
    my $non_metas_regex = $this->regex_parts->{non_metas};
    my $regex = qr|

	(?:($non_metas_regex)  )?
	($non_metas_regex)
	(?:  ($non_metas_regex))?

	    |iox;
    return () unless $part =~ m/$regex/;
    $this->_parse_navi_link('prev', $1, $2) if defined $1;
    $this->_parse_navi_link('next', $4, $5) if defined $4;

    my $navi_cache = $this->cache->{navi}->{current} = {};
    $navi_cache->{subject} = $3;
    if ($3 =~ /(\d+)\D+(\d+)/) {
	$navi_cache->{start} = $1;
	$navi_cache->{end} = $2;
    }
    return $this->cache->{navi};
}

=item _parse_navi_link

  # call from subclass
  my %datas = $this->_parse_navi_link('current', 'href="..."', 'next page');

standard navigation link parser.

=cut

sub _parse_navi_link {
    my ($this, $genre, $attr, $value) = @_;
    my $link = $this->html_anchor_to_uri($attr);
    my $data = $this->cache->{navi}->{$genre} = {
	link => $link,
	$this->analyze_uri($link),
    };
    $data->{subject} = $this->rewrite($value);
    if ($value =~ /(\d+)/) {
	$data->{count} = $1;
    }
}


1;

__END__