File Coverage

blib/lib/WWW/Mixi/OO/TableHistoryListPage.pm
Criterion Covered Total %
statement 15 47 31.9
branch 0 14 0.0
condition n/a
subroutine 5 10 50.0
pod 1 1 100.0
total 21 72 29.1


)|xio; \s*\s*
line stmt bran cond sub pod time code
1             # -*- cperl -*-
2             # copyright (C) 2005 Topia . all rights reserved.
3             # This is free software; you can redistribute it and/or modify it
4             # under the same terms as Perl itself.
5             # $Id: TableHistoryListPage.pm 94 2005-02-04 12:39:28Z topia $
6             # $URL: file:///usr/minetools/svnroot/mixi/trunk/WWW-Mixi-OO/lib/WWW/Mixi/OO/TableHistoryListPage.pm $
7             package WWW::Mixi::OO::TableHistoryListPage;
8 2     2   12 use strict;
  2         4  
  2         62  
9 2     2   11 use warnings;
  2         4  
  2         51  
10 2     2   10 use URI;
  2         4  
  2         42  
11 2     2   12 use URI::QueryParam;
  2         5  
  2         64  
12 2     2   10 use base qw(WWW::Mixi::OO::TableListPage);
  2         5  
  2         1702  
13              
14             =head1 NAME
15              
16             WWW::Mixi::OO::TableHistoryListPage - WWW::Mixi::OO's
17             Table style History List Pages base class
18              
19             =head1 SYNOPSIS
20              
21             package WWW::Mixi::OO::Foo;
22             use base qw(WWW::Mixi::OO::TableHistoryListPage);
23             # some implementations...
24              
25             =head1 DESCRIPTION
26              
27             log style list pages base class.
28              
29             =head1 METHODS
30              
31             =over 4
32              
33             =cut
34              
35             =item parse_title
36              
37             title parser: return scalar or array of scalar.
38              
39             =cut
40              
41             sub parse_title {
42 0     0 1   my $this = shift;
43 0           my $part = $this->parse_table_item('title');
44 0           my $sp_or_nbsp = qr/(?:\s+| )/o;
45 0 0         return () unless defined $part;
46 0           my @parts;
47 0 0         return () unless @parts = $part =~ m|(.+)
48             (?>(?:$sp_or_nbsp+\*\*\*$sp_or_nbsp+(.*?))?
49 0           @parts = map $this->rewrite($_), grep defined, @parts;
50 0 0         return (wantarray) ? (@parts) : $parts[0];
51             }
52              
53             sub _parse_table {
54 0     0     my $this = shift;
55 0 0         return $this->SUPER::_parse_table(@_) if @_ == 1; # overridable
56              
57 0           my $attr_regex = $this->regex_parts->{html_attr};
58 0           my $attrval_regex = $this->regex_parts->{html_attrval};
59 0           my $maybe_attrs_regex = $this->regex_parts->{html_maybe_attrs};
60 0           $this->SUPER::_parse_table(
61             qr|\s*
62            
63             (?>.*?)\s*
64            
\s*(.+)\s*
65            
(?>.*?)\s* 66             |oisx); 67             } 68               69             sub _parse_body { 70 0     0     my $this = shift; 71 0           my $part = $this->parse_table_item('body'); 72 0 0         return () unless defined $part; 73 0           my $maybe_attrs_regex = $this->regex_parts->{html_maybe_attrs}; 74 0           my $regex = qr|(.*?)\s* 75             \s*(?>(.*?))\s+ 76             \((.*)\)\s*|oisx; 77 0           my ($date, $anchor, $title, $name); 78             return [map { 79 0 0         if (($date, $anchor, $title, $name) = /$regex/) {   0             80 0           $anchor = $this->html_anchor_to_uri($anchor); 81 0           my $data = { 82             link => $anchor, 83             $this->analyze_uri($anchor), 84             date => $this->convert_time($date), 85             time => $this->convert_time($date), 86             name => $this->rewrite($name), 87             $this->_parse_body_subject($title), 88             }; 89 0           $data; 90             } else { 91 0           (); 92             } 93             } $part =~ m|(.*?)|oisxg]; 94             } 95               96             =item _parse_body_subject 97               98             standard body subject parser, only rewrite. 99               100             =cut 101               102             sub _parse_body_subject { 103 0     0     my ($this, $subject) = @_; 104 0           (subject => $this->rewrite($subject)); 105             } 106               107             =item _parse_body_subject_with_count 108               109             # subclass 110             sub _parse_body_subject { 111             shift->_parse_body_subject_with_count(@_); 112             } 113               114             alternate body subject parser, with count. 115               116             such as: 'foobar (10)' to C<< (subject => 'foobar', count => 10) >>. 117               118             =cut 119               120             sub _parse_body_subject_with_count { 121 0     0     my ($this, $subject) = @_; 122               123 0 0         if ($subject =~ /^(.*) \((\d+)\)\s*$/so) { 124 0           (subject => $this->rewrite($1), 125             count => $2); 126             } else { 127 0           (subject => $this->rewrite($subject)); 128             } 129             } 130               131             1; 132               133             __END__