LIMILIC

案にもなってない

ちょっと変えた@20090610

diff --git a/lib/WWW/MobileCarrierJP/DoCoMo/Display.pm b/lib/WWW/MobileCarrierJP/DoCoMo/Display.pm
index ae4310f..b5d1510 100644
--- a/lib/WWW/MobileCarrierJP/DoCoMo/Display.pm
+++ b/lib/WWW/MobileCarrierJP/DoCoMo/Display.pm
@@ -13,17 +13,27 @@ sub scrape {
     $html =~ s/(?:\r?\n)+/\n/g;
     $html =~ s/μ/myu/g;
     my $re = _regexp();
+    my $opt_re = _opt_regexp();
+    chomp $opt_re;
     my $map;
     while ( $html =~ /$re/igs ) {
-        my ( $model, $width, $height, $color, $depth ) = ( $1, $2, $3, $4, $5 );
-
-        push @$map, {
+        my ( $model, $width, $height, $opt, $color, $depth ) = ( $1, $2, $3, $4, $5, $6 );
+        my %ret = (
             model    => $model,
             width    => $width,
             height   => $height,
             is_color => $color eq 'カラー',
             depth    => $depth,
-        };
+        );
+
+        my ($vga_width, $vga_height) = ( '', '' );
+        if ( $opt =~ /$opt_re/is ) {
+            $ret{vga_width} = $width;
+            $ret{vga_height} = $height;
+            $ret{width} = $1;
+            $ret{height} = $2;
+        }
+        push @$map, \%ret;
     }
     $map;
 }
@@ -46,11 +56,18 @@ sub _regexp {
 <td><span class="txt">.*?(?:</span></td>)?
 <td><span class="txt">.*?(?:</span></td>)?
 <td><span class="txt">.*?(\d+)×(\d+).*?</span></td>
-<td>.*?</td>
+(<td>.*?</td>)
 <td><span class="txt">(白黒|カラー)(?:.*?)(\d+)(?:色|階調)</span></td>
 RE
 }
 
+sub _opt_regexp {
+    return <<'RE';
+<td><span class="txt">.*?(\d+)×(\d+).*?</span></td>
+<td>.*?</td>
+RE
+}
+
 1;
 __END__
 
diff --git a/t/020_docomo/03_docomo_displaymap.t b/t/020_docomo/03_docomo_displaymap.t
index a7591de..0931d82 100644
--- a/t/020_docomo/03_docomo_displaymap.t
+++ b/t/020_docomo/03_docomo_displaymap.t
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 6;
+use Test::More tests => 7;
 use WWW::MobileCarrierJP::DoCoMo::Display;
 
 my $dat = WWW::MobileCarrierJP::DoCoMo::Display->scrape;
@@ -25,6 +25,16 @@ ck(
     width    => 240,
 );
 
+ck(
+    depth    => 16777216,
+    height   => 296,
+    is_color => 1,
+    model    => 'SH-05A',
+    width    => 240,
+    vga_width => 480,
+    vga_height => 592,
+);
+
 sub ck {
     my $phone = @_ == 1 ? $_[0] : {@_};
     is_deeply [grep { $phone->{model} eq $_->{model} } @$dat]->[0], $phone;