File Coverage

blib/lib/WWW/MobileCarrierJP/Softbank/Display.pm

Criterion	Covered	Total	%
statement	12	41	29.2
branch	0	2	0.0
condition			n/a
subroutine	4	7	57.1
pod			n/a
total	16	50	32.0

package WWW::MobileCarrierJP::Softbank::Display;

use utf8;
use charnames ':full';
use List::Util qw/first/;
use WWW::MobileCarrierJP::Declare;

parse_one(
    urls    => ['http://creation.mb.softbank.jp/mc/terminal/terminal_info/terminal_display.html'],
    xpath   => q(//div[@class='terminaltable']/table/tr[ not(@bgcolor="#cccccc") and count(child::td) != 1 and position() >= 3 ]),
    scraper => scraper {
        col 1 => 'model'              => 'TEXT';
        col 2 => 'browser_pixels'     => [ 'TEXT', \&_parse_pixels_table ];
        col 3 => 'browser_characters' => [ 'TEXT', \&_parse_characters_table ];
        col 4 => 'appli_pixels'       => [ 'TEXT', \&_parse_appli_pixels_table ];
        col 5 => 'appli_fontsize'     => [ 'TEXT', \&_parse_appli_pixels_table ];
        col 6 => 'widget'             => [ 'TEXT', \&_parse_pixels_table ];
        col 7 => 'widget_homescreen'  => [ 'TEXT', \&_parse_pixels_table ];
        col 8 => 'flash'              => [
            'TEXT',
            sub {
                /(\d+)\s*x\s*(\d+)/ or return undef;
                +{ width => $1, height => $2 };
              }
        ];
    },
);

# [{orientation}]\nwidth x height
sub _parse_pixels_table {
    my $text = shift;
    my @result;
    $text =~ s/\s//g;
    return if ($text eq "\N{MULTIPLICATION SIGN}");
    while ( $text =~ s/\[([^\]])+\](\d+)x(\d+)// ) {
        push @result,
          {
            orientation => $1,
            width       => $2,
            height      => $3,
          };
    }
    \@result;
}

# [{orientation}]\n({size}:{width}x{height}\n)+
sub _parse_characters_table {
    my $text = shift;
    my @result;
    $text =~ s/\s//g;
    while ( $text =~ s/\[([^\]]+)\]((?:(?:[^:\[]+:)?\d+x\d+(?:\([^)]+\))?)+)// ) {
        my $mode  = $1;
        my $table = $2;
        my @fontsize_table;
        while ( $table =~ s/(?:([^:]+):)?(\d+)x(\d+)(?:\(([^)]+)\))?// ) {
            push @fontsize_table,
              {
                size_label => $1,
                cols       => $2,
                rows       => $3,
                extra      => $4,
              };
        }
        push @result,
          {
            orientation => $mode,
            size_table => \@fontsize_table,
          };
    }
    \@result;
}

# [{orientation}]\n({width}x{height}\n)+
sub _parse_appli_pixels_table {
    my $text = shift;
    my @result;
    $text =~ s/\s//g;
    while ( $text =~ s/\[([^\]]+)\]((?:[^\d\[]+\d+x\d+)+)// ) {
        my $mode  = $1;
        my $table = $2;
        my @size_table;
        while ( $table =~ s/(\D+)(\d+)x(\d+)?// ) {
            push @size_table,
              {
                resolution => $1,
                width      => $2,
                height     => $3,
              };
        }
        push @result,
          {
            orientation => $mode,
            size_table => \@size_table,
          };
    }
    \@result;
}

1;

__END__