Web::Scraper for perl 経由で www.whatismybrowser.com を使い、access_log にあるuser agentを分析

perl scriptとしては、以下の通り。

apacheのaccess_logに user agentが記載されていますが 最近のuser agent 文字列は複雑で、「結局、OSやブラウザは何?」となった為、 書いてみた。

これまで 同様のscriptを複数回、書いていますが、 最近では、www.whatismybrowser.com が良さそうなので、改めて

https://end0tknr.hateblo.jp/entry/20170901/1504248374

#!/usr/local/bin/perl
use strict;
use warnings;
use Encode;
use HTTP::Request::Common;
use LWP::UserAgent;
use Web::Scraper;
use Data::Dumper;


my $REGEXP = join(' ',
                  '^([^ ]*) ([^ ]*) ([^ ]*) \[([^]]*)\] "([^ ]*)(?: *([^ ]*)',
                  '*([^ ]*))?" ([^ ]*) ([^ ]*) "(.*?)" "(.*?)"');
my $GZIP_CMD = '/usr/bin/gzip';
my $USER_AGENT_STR = 'https://www.whatismybrowser.com/';
my $SCRAPER = scraper {
    process 'div.string-major',   'user_agent'  => 'TEXT';
};
my $AGENT_OS_CACHE = {};


main(@ARGV);

sub main {
    my (@log_gz_files) = @_;

    my $summary = {};
    
    for my $log_gz_file ( @log_gz_files ){
        my $gzip_cmd = "$GZIP_CMD -dc $log_gz_file";

        open my $fh, '-|', $gzip_cmd or die "fail open $gzip_cmd $!";
        while( my $log_line = <$fh>){
            chomp($log_line);

            my ($host, $ident, $user, $datetime, $method, $resource,
                $proto, $status, $bytes, $referer, $agent, $time) =
                    $log_line =~ /$REGEXP/o;
            
            next if( not $user or $user eq "-");
            # id=shm0623995,ou=user,o=sso,ou=services,... のような形式で
            # fanへaccessされるケースがある為
            if($user =~ /^id\=([^,]+)/o ){
               $user = $1;
            }


            my $user_agent;
            my $user_os;
            if(defined($AGENT_OS_CACHE->{$agent})){
                $user_agent = $AGENT_OS_CACHE->{$agent}->{agent};
                $user_os    = $AGENT_OS_CACHE->{$agent}->{os};
            } else {
                ($user_agent,$user_os)= short_name_from_user_anget($agent);
                $AGENT_OS_CACHE->{$agent}->{agent} = $user_agent;
                $AGENT_OS_CACHE->{$agent}->{os} =    $user_os;
            }
            
            my $agent_key = join("\t",$user, $user_agent,$user_os,$agent);
            print STDERR "$log_gz_file : $agent_key\n";
            $summary->{$agent_key} += 1;
        }
        
        close $fh or die "fail close $gzip_cmd $!";
    }

    
    for my $info_keys (sort keys %$summary ){
        print $info_keys,"\t$summary->{$info_keys}\n";
    }
}


sub short_name_from_user_anget {
    my ($user_agent_org) = @_;

    my $ua = LWP::UserAgent->new;
    $ua->agent($user_agent_org);
    $ua->timeout(10);

    my $response = $ua->get($USER_AGENT_STR);

    unless($response->is_success) {
        print STDERR $response->status_line;
        return "";
    }

    my $html_str = $response->content;
    my $scraper_res = $SCRAPER->scrape($html_str);

    my ($user_anget, $user_os) = split(/ on /,$scraper_res->{user_agent});
    
    return $user_anget, $user_os;
}