Codebase list libhttp-browserdetect-perl / eba11af
RT #48727: Fixed version bug for Safari >4.0. Added "KHTML, like Gecko" exclusion and updated tests. Also added TODO with some suggestions. Robin Smidsrød 14 years ago
4 changed file(s) with 112 addition(s) and 24 deletion(s). Raw diff Collapse all Expand all
+5
-0
Changes less more
00 Revision history for Perl extension HTTP::BrowserDetect.
1
2 1.02 ???
3 - Fixed RT #48727 (Robin Smidsrod)
4 - Made "KHTML, like Gecko" not match gecko
5 - Properly detect Safari version >4.0
16
27 1.01 2009-10-20
38 - Switched to Module::Build from ExtUtils::MakeMaker
+6
-0
TODO less more
0 - Test script can be cleaned up quite a lot by using the match/no_match for
1 all boolean tests.
2 (Robin Smidsrød - 2009-10-20)
3
4 - Consider getting more UA strings from http://www.user-agents.org/.
5 (Robin Smidsrød - 2009-10-20)
+23
-12
lib/HTTP/BrowserDetect.pm less more
123123
124124 # Mozilla browsers
125125
126 $tests->{GECKO} = (index($ua,"gecko") != -1);
126 $tests->{GECKO} = (index($ua,"gecko") != -1) && (index($ua, "khtml, like gecko") == -1 );
127127 $tests->{FIREFOX} = (index($ua,"firefox") != -1) ||
128128 (index($ua,"firebird") != -1) ||
129129 (index($ua,"iceweasel") != -1) ||
130130 (index($ua,"phoenix") != -1);
131131
132132 $tests->{CHROME} = (index($ua,"chrome") != -1);
133 $tests->{SAFARI} = (index($ua,"safari") != -1) || (index($ua,"applewebkit") != -1);
133 $tests->{SAFARI} = ( (index($ua,"safari") != -1) || (index($ua,"applewebkit") != -1) )
134 && (index($ua,"chrome") == -1);
134135
135136 # Chome Version
136137 if ($tests->{CHROME}) {
145146 }
146147 # Safari Version
147148 elsif ($tests->{SAFARI}) {
148 my ($safari_build, $safari_minor);
149 ($safari_build,$safari_minor) = ($ua =~ /
149 if ( index($ua,"version/") != -1 ) {
150 ($major,$minor) = ( $ua =~ m{
151 version/
152 ( [^.]* ) # Major version number is everything before first dot
153 \. # The first dot
154 ( [^.]* ) # Minor version number is digits after first dot
155 }x );
156 }
157 else {
158 my ($safari_build, $safari_minor);
159 ($safari_build,$safari_minor) = ($ua =~ /
150160 safari
151161 \/
152162 ( [^.]* ) # Major version number is everything before first dot
153163 (?: # The first dot
154164 ( \d* ))? # Minor version number is digits after first dot
155165 /x);
156 # in some obscure cases, extra characters are captured by the regex
157 # like: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 UP.Link/6.3.1.15.0
158 $safari_build =~ s{ [^\d] }{}gxms;
159
160 $major = int($safari_build / 100);
161 $minor = int($safari_build % 100) / 100;
162 $beta = $safari_minor;
163 #print "major=$major minor=$minor beta=$beta\n";
166 # in some obscure cases, extra characters are captured by the regex
167 # like: Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413 UP.Link/6.3.1.15.0
168 $safari_build =~ s{ [^\d] }{}gxms;
169
170 $major = int($safari_build / 100);
171 $minor = int($safari_build % 100) / 100;
172 $beta = $safari_minor;
173 #print "major=$major minor=$minor beta=$beta\n";
174 }
164175
165176 }
166177
+78
-12
t/01-detect.t less more
298298 undef,
299299 ["mac", "macppc", "icab"],
300300 ],
301 ["Konqueror/1.1.2", "1.1", 1, 0.1, undef, undef, undef, ["konqueror"]],
301 [
302 "Konqueror/1.1.2",
303 "1.1",
304 1,
305 0.1,
306 undef,
307 undef,
308 undef,
309 [
310 "konqueror"
311 ],
312 [
313 "robot", # RT #30705
314 ],
315 ],
302316 [
303317 "Lotus-Notes/4.5 ( OS/2 )",
304318 "4.5",
533547 "winnt",
534548 "winvista",
535549 "chrome",
550 ],
551 [
536552 "safari",
553 "gecko",
554 ],
555 ],
556 # RT #48727
557 [
558 "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US) AppleWebKit/530.19.2 (KHTML, like Gecko) Version/4.0.2 Safari/530.19.1",
559 "4.0",
560 4,
561 0,
562 "Safari",
563 "WinVista",
564 undef,
565 [
566 "windows",
567 "win32",
568 "winnt",
569 "winvista",
570 "safari",
571 ],
572 [
537573 "gecko",
538574 ],
539575 ],
545581 "Safari",
546582 "Mac OS X",
547583 undef,
548 ["mac", "macosx", "macppc", "safari", "gecko"],
584 [
585 "mac",
586 "macosx",
587 "macppc",
588 "safari",
589 ],
590 [
591 "gecko",
592 ],
549593 ],
550594 [
551595 "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/106.2 (KHTML, like Gecko) Safari/100.1",
555599 "Safari",
556600 "Mac OS X",
557601 undef,
558 ["mac", "macosx", "macppc", "safari", "gecko"],
602 [
603 "mac",
604 "macosx",
605 "macppc",
606 "safari",
607 ],
608 [
609 "gecko",
610 ],
559611 ],
560612 [
561613 "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/74 (KHTML, like Gecko) Safari/74",
565617 "Safari",
566618 "Mac OS X",
567619 undef,
568 ["mac", "macosx", "macppc", "safari", "gecko"],
620 [
621 "mac",
622 "macosx",
623 "macppc",
624 "safari",
625 ],
626 [
627 "gecko",
628 ],
569629 ],
570630 [
571631 "BlackBerry7730/3.7.1 UP.Link/5.1.2.5",
698758 "Safari",
699759 undef,
700760 undef,
701 ["safari", "gecko"],
761 [
762 "safari",
763 ],
764 [
765 "gecko",
766 ],
702767 ],
703768 [
704769 "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9) Gecko/2008062901 IceWeasel/3.0",
768833 );
769834
770835 foreach my $test ( @tests ) {
771 my ( $ua, $version, $major, $minor, $browser, $os, $other, $system, ) = @{$test};
836 my ( $ua, $version, $major, $minor, $browser, $os, $other, $match, $no_match ) = @{$test};
772837 my $detected = HTTP::BrowserDetect->new( $ua );
773838 diag( $detected->user_agent );
774839
782847 ok( $detected->$os, $os ) if $os;
783848 }
784849
785 foreach my $type ( @{$system} ) {
786 ok( $detected->$type, $type );
850 foreach my $type ( @{ $match } ) {
851 ok( $detected->$type, "$type should match" );
787852 }
788853
854 # Test that $ua doesn't match a specific method
855 foreach my $type ( @{ $no_match } ) {
856 ok( !$detected->$type, "$type matches, but shouldn't" );
857 }
858
789859 #diag( dump $test );
790860
791861 }
792
793 # RT #30705
794 my $parsed = HTTP::BrowserDetect->new("Konqueror/1.1.2");
795 ok( !$parsed->robot, "Konqueror is not a bot" );