Parse-HTTP-UserAgent

 view release on metacpan or  search on metacpan

lib/Parse/HTTP/UserAgent/Base/IS.pm  view on Meta::CPAN

    my $has_safari  = grep { index( lc $_, 'safari'  ) != NO_IMATCH  } @{ $others };
    if ( $has_android && $has_safari ) {
        return 1;
    }
    if (   @{ $others } == 0
        && @{ $thing  }  > 0
        && $thing->[-1]
        && index( $thing->[-1], 'AppleWebKit' ) != NO_IMATCH
    ) {
        # More stupidity: ua string is missing a closing paren
        my($part, @rest) = split m{(AppleWebKit)}xms, $thing->[-1];
        $thing->[-1] = $part;
        @{ $others } =  map   { $self->trim( $_ ) }
                        split m{ (\QKHTML, like Gecko\E) }xms,
                        join  q{}, @rest;
        return 1;
    }
    return;
}

sub _is_ff {
    my($self, $extra) = @_;
    return if ! $extra || ! $extra->[1];
    my $moz_with_name = $extra->[1] eq 'Mozilla' && $extra->[2];

lib/Parse/HTTP/UserAgent/Base/Parsers.pm  view on Meta::CPAN

    my $is_30 =    $extra
                && $extra->[0]
                && index( $extra->[0], 'AppleWebKit' ) != NO_IMATCH;
    my($maxthon, $msie, @buf);

    if ( $is_30 ) {
        # yay, new nonsense with the new version
        my @new;
        for my $i (0..$#others) {
            if ( index( $others[$i], 'Maxthon') != NO_IMATCH ) {
                @new        = split m{\s+}xms, $others[$i];
                $maxthon    = shift @new;
                $extra    ||= [];
                unshift @{ $extra }, shift @new;
                $others[$i] = '';
                last;
            }
        }
        @others = grep { $_ } @others, @new;
        $self->_parse_safari( $moz, $thing, $extra, @others );
        $self->[UA_NAME] = 'Maxthon';

lib/Parse/HTTP/UserAgent/Base/Parsers.pm  view on Meta::CPAN

    $self->[UA_DOTNET]      = [ @{ $dotnet } ] if @{$dotnet};

    if ( $extras->[0] && $extras->[0] eq 'Mac_PowerPC' ) {
        $self->[UA_OS] = shift @{ $extras };
    }

    my $real_version;
    my @buf;
    foreach my $e ( @{ $extras } ) {
        if ( index( $e, 'Trident/' ) != NO_IMATCH ) {
            my($tk_name, $tk_version) = split m{[/]}xms, $e, 2;
            $self->[UA_TOOLKIT] = [ $tk_name, $tk_version ];
            if ( $tk_name eq 'Trident' && $tk_version ) {
                if ( $tk_version eq '7.0' && $self->[UA_VERSION_RAW] ne '11.0' ) {
                    # more stupidity (compat mode)
                    $self->[UA_ORIGINAL_NAME]    = 'MSIE';
                    $self->[UA_ORIGINAL_VERSION] = 11;
                }
                elsif ( $tk_version eq '6.0' && $self->[UA_VERSION_RAW] ne '10.0') {
                    # more stupidity (compat mode)
                    $self->[UA_ORIGINAL_NAME]    = 'MSIE';

lib/Parse/HTTP/UserAgent/Base/Parsers.pm  view on Meta::CPAN

        # remove junk
        @{$extra} = grep { $_ ne 'like' && $_ ne 'Gecko' } @{ $extra };
    }
    else {
        $extra = [];
    }

    my($version);
    while ( my $e = shift @{ $thing } ) {
        if (  index($e, 'rv:' ) != NO_IMATCH ) {
            $version = (split m{rv:}xms, $e )[1] ;
            next;
        }
        push @{ $extra }, $e;
    }

    $self->_parse_msie( undef, $thing, $extra, 'MSIE', $version) || return;

    if ( $self->[UA_TOUCH] && $self->[UA_EXTRAS] ) {
        # version 10+
        my @extras = map {

lib/Parse/HTTP/UserAgent/Base/Parsers.pm  view on Meta::CPAN

    if ( ! $extra
        && $others[0]
        && index( $others[0], 'AppleWebKit' ) != NO_IMATCH
    ) {
        $extra = [ shift @others ];
        $self->[UA_PARSER] = 'android:paren_fixer';
    }
    $self->[UA_TOOLKIT] = [ split RE_SLASH, $extra->[0] ] if $extra;
    my(@extras, $is_phone);

    my @junkions = map { split m{\s+}xms } @others;
    foreach my $junk ( @junkions ) {
        if ( $junk eq 'Mobile' ) {
            $is_phone = 1;
            next;
        }
        if ( index( $junk, 'Version' ) != NO_IMATCH ) {
            my(undef, $v) = split RE_SLASH, $junk;
            $self->[UA_VERSION_RAW] = $v; # looks_like_number?
            next;
        }

lib/Parse/HTTP/UserAgent/Base/Parsers.pm  view on Meta::CPAN

    return 1;
}

sub _generic_moz_thing {
    my($self, $moz, $t, $extra, $compatible, @others) = @_;
    return if ! @{ $t };
    my($mname, $mversion, @rest) = split RE_CHAR_SLASH_WS, $moz;
    return if $mname eq 'Mozilla' || $mname eq 'Emacs-W3';

    if ( index( $mname, 'Nokia' ) != NO_IMATCH ) {
        my($device, $num, $os, $series, @junk) = split m{[\s]+}xms,
                                                    $self->[UA_STRING_ORIGINAL];
        if (   $device
            && $num
            && $os
            && $series
            && index( $os, 'SymbianOS' ) != NO_IMATCH
        ) {
            return $self->_parse_symbian(
                        join ';', $os, "$series $device", join(q{ }, @junk, $num)
                    );

lib/Parse/HTTP/UserAgent/Base/Parsers.pm  view on Meta::CPAN

    $self->[UA_VERSION_RAW] = $version || 0;
    $self->[UA_EXTRAS]      = @parts ? [ @parts ] : undef;
    $self->[UA_PARSER]      = 'moz_only';
    $self->[UA_ROBOT]       = 1 if ! $self->[UA_VERSION_RAW];

    return 1;
}

sub _parse_symbian {
    my($self, $raw) = @_;
    my($os, $series_device, @rest) = split m{[;]\s?}xms, $raw;

    return if ! $os || ! $series_device;

    my($series, $device) = split m{[\s]+}xms, $series_device;

    return if ! $device;

    my @extras = map { split m{[\s]+}xms, $_ } @rest;

    @{ $self }[ UA_NAME, UA_VERSION_RAW ] = split RE_SLASH, $series, 2;
    $self->[UA_OS]     = $os;
    $self->[UA_DEVICE] = $device;
    $self->[UA_EXTRAS] = @extras ? [ @extras ] : undef;
    $self->[UA_MOBILE] = 1;
    $self->[UA_PARSER] = 'symbian';

    return 1;
}

sub _parse_hotjava {
    my($self, $moz, $thing, $extra, $compatible, @others) = @_;
    my $parsable            = shift @{ $thing };
    my($name, $version)     = split RE_SLASH, $moz;
    $self->[UA_NAME]        = 'HotJava';
    $self->[UA_VERSION_RAW] = $version || 0;
    if ( $parsable ) {
        my @parts = split m{[\[\]]}xms, $parsable;
        if ( @parts > 2 ) {
            @parts = map { $self->trim( $_ ) } @parts;
            $self->[UA_OS]     = pop @parts;
            $self->[UA_LANG]   = pop @parts;
            $self->[UA_EXTRAS] = @parts ? [ @parts ] : undef;
        }
    }
    return 1;
}

t/db.pl  view on Meta::CPAN

}

sub database {
    my $opt = shift || {};
    my @buf;
    my $tests = merge_files();
    my $id    = 0;
    foreach my $test ( split RE_SEPTOR, $tests ) {
        next if ! $test;
        my $raw = trim( strip_comments( $test ) ) || next;
        my($string, $frozen) = split m{ \n }xms, $raw, 2;
        push @buf, {
            string => $string,
            struct => $frozen && $opt->{thaw} ? { thaw( $frozen ) } : $frozen,
            id     => ++$id,
        };
    }
    return @buf;
}

sub merge_files {

t/db.pl  view on Meta::CPAN

    $s =~ s{ \A \s+    }{}xms;
    $s =~ s{    \s+ \z }{}xms;
    return $s;
}

sub strip_comments {
    my $s = shift;
    return $s if ! $s;
    my $buf = q{};
    my $file;
    foreach my $line ( split m{ \n }xms, $s ) {
        chomp $line;
        next if ! $line;
        if ( my @m = $line =~ m{ \A [#] (.+?)? \z }xms ) {
            next if ! $m[0]; # line only had a hash and nothing else
            if ( my @f = $m[0] =~ m{ \A \Q$COMMENT\E (.+?) \z }xms ) {
                $file = trim( $f[0] );
            }
            if ( my @n = $m[0] =~ m{ \A TODO: \s? (.+?) \z }xms ) {
                push @todo, [ $file, $n[0] ];
            }