use WWW::MobileCarrierJP::DoCoMo::UserAgent; use WWW::MobileCarrierJP::DoCoMo::Display; use WWW::MobileCarrierJP::ThirdForce::UserAgent; use WWW::MobileCarrierJP::ThirdForce::HTTPHeader; use WWW::MobileCarrierJP::EZWeb::Model; use WWW::MobileCarrierJP::EZWeb::DeviceID; use Encode; use Data::Dumper; use warnings; no warnings 'all'; my $csv = 'ualist.csv'; unlink $csv; au_ua($csv); softbank_ua($csv); docomo_ua($csv); sub au_ua { my $csv = shift; # UA解析, htmlversion解析 my $useragent = WWW::MobileCarrierJP::EZWeb::Model->scrape; my $deviceid = WWW::MobileCarrierJP::EZWeb::DeviceID->scrape; my $ualist = {}; my $display = {}; # deviceid(=ua),model情報 for my $e (@$deviceid) { my $model = $e->{model}; $ualist->{$model} = $e->{device_id}; } # display情報 for my $e (@$useragent) { my $model = $e->{model_long}; $display->{$model} = { width => $e->{display_browsing}->{width}, height => $e->{display_browsing}->{height} }; } # 出力用に整形 my @result; for my $model ( sort keys %$display ) { my $ua = $ualist->{$model}; my $width = $display->{$model}->{width}; my $height = $display->{$model}->{height}; my $msg = encode( 'utf8', $model ); # なんだか同一機種内で複数UAがあるっぽい if ( ref $ua eq 'ARRAY' ) { for (@$ua) { push @result, qq!au,$msg,$_,$width,$height\n!; } } else { push @result, qq!au,$msg,$ua,$width,$height\n!; } } open my $fh, '>>', $csv; print $fh $_ for sort @result; close $fh; } sub softbank_ua { my $csv = shift; # UA解析, htmlversion解析 my $useragent = WWW::MobileCarrierJP::ThirdForce::UserAgent->scrape; my $httpheader = WWW::MobileCarrierJP::ThirdForce::HTTPHeader->scrape; my $ualist = {}; my $display = {}; # model,display,ua情報 for my $e (@$httpheader) { my $model = $e->{model}; my $ua = $e->{'x-jphone-name'}; $model =~ s![\x01-\x1f]+! !msxig; $model =~ s!
!!msxig; $model =~ s!\s+! !msxig; $model =~ s!\s+$!!msxig; $ua =~ s![\x01-\x1f]+! !msxig; $ua =~ s!
!!msxig; $ua =~ s!\s+! !msxig; $ua =~ s!\s+$!!msxig; if ( $e->{'x-jphone-display'} =~ /^(\d+)\*(\d+)$/ ) { $display->{$model} = { width => $1, height => $2 }; } $ualist->{$model} = $ua; } # 出力用に整形 my @result; for my $model ( sort keys %$display ) { my $ua = $ualist->{$model}; my $width = $display->{$model}->{width}; my $height = $display->{$model}->{height}; my $msg = encode( 'utf8', $model ); $msg =~ s/\xef\xbf\xbd\x55/Ⅱ/; # なんだか / で区切られているときは複数機種を表しているっぽいので補正する my @models = split '/', $msg; for my $m (@models) { $m =~ s!\s+$!!g; push @result, qq!softbank,$m,$ua,$width,$height\n!; } } open my $fh, '>>', $csv; print $fh $_ for sort @result; close $fh; } sub docomo_ua { my $csv = shift; # UA解析, htmlversion解析 my $useragent = WWW::MobileCarrierJP::DoCoMo::UserAgent->scrape; my $ualist = {}; # ua情報 for my $e (@$useragent) { my $model = uc $e->{model}; $ualist->{$model} = $e->{user_agent}; } # display情報 my $display = WWW::MobileCarrierJP::DoCoMo::Display->scrape; # 出力用に整形 my @result; for my $phone (@$display) { my $ua = $phone->{model}; my $width = $phone->{width}; my $height = $phone->{height}; my $model = uc $phone->{model}; $ua =~ s/-//; $model = $phone->{model}; $model =~ s!myu!μ!msxi; push @result, qq!docomo,$model,$ua,$width,$height\n!; # なんだか同一機種内で複数UA(枝番)があるっぽいので補正する if ( $ua =~ /(?:F|N|P|SH)0(?:5|6|7|8|9)A/ ) { my $ua2 = $ua . '2'; my $ua3 = $ua . '3'; push @result, qq!docomo,$model,$ua2,$width,$height\n!; push @result, qq!docomo,$model,$ua3,$width,$height\n!; } } open my $fh, '>>', $csv; print $fh $_ for sort @result; close $fh; }