[PATCH 12/14] weblog request and referer regexs were too greedy, and the referer and client regex's where in the wrong order (RT#34063) and (RT#72334) Wes Brown <wes [...] smellycat.com> and pawal [...] blipp.co

From: Sven Dowideit <[email protected]>

---
 AnyData/Format/Weblog.pm |   24 +++++++++++-------------
 Changes                  |    2 ++
 t/fixed.tbl              |    8 +++++++-
 t/weblog.t               |   42 ++++++++++++++++++++++++++++++++++++++++++
 t/weblog.tbl             |    1 +
 5 files changed, 63 insertions(+), 14 deletions(-)
 create mode 100644 t/weblog.t
 create mode 100644 t/weblog.tbl

diff --git a/AnyData/Format/Weblog.pm b/AnyData/Format/Weblog.pm
index 0c89da8..339623f 100644
--- a/AnyData/Format/Weblog.pm
+++ b/AnyData/Format/Weblog.pm
@@ -61,12 +61,11 @@ all rights reserved
 
 =cut
 
-
 use strict;
 use AnyData::Format::Base;
 use vars qw( @ISA $DEBUG $VERSION);
 @AnyData::Format::Weblog::ISA = qw( AnyData::Format::Base );
-$DEBUG = 0;
+$DEBUG                        = 0;
 
 $VERSION = '0.06';
 
@@ -74,9 +73,9 @@ sub new {
     my $class = shift;
     my $self = shift || {};
     $self->{col_names} =
-        'remotehost,username,authuser,date,request,status,bytes,client,referer';
-    $self->{record_sep} = "\n";
-    $self->{key} = 'datestamp';
+      'remotehost,username,authuser,date,request,status,bytes,referer,client';
+    $self->{record_sep}      = "\n";
+    $self->{key}             = 'datestamp';
     $self->{keep_first_line} = 1;
     return bless $self, $class;
 }
@@ -84,21 +83,20 @@ sub new {
 sub read_fields {
     print "PARSE RECORD\n" if $DEBUG;
     my $self = shift;
-    my $str  = shift || return undef;
+    my $str = shift || return undef;
     $str =~ s/^\s+//;
     $str =~ s/\s+$//;
     return undef unless $str;
-    my(@row) = $str =~
-        /^(\S*) (\S*) (\S*) \[([^\]]*)\] "(.*)" (\S*) (\S*)\s*(.*)$/;
+    my (@row) =
+      $str =~ /^(\S*) (\S*) (\S*) \[([^\]]*)\] "(.*?)" (\S*) (\S*)\s*(.*)$/;
     return undef unless defined $row[0];
-    my($client,$referer) = $row[7] =~ /^(.*) (\S*)$/;
+    my ( $referer, $client ) = $row[7] =~ /^(.*?)\s(.*)$/;
     $client  ||= '';
     $referer ||= '';
-    ($row[7],$row[8])=($client,$referer);
+    ( $row[7], $row[8] ) = ( $referer, $client );
+
     # $row[3] =~ s/\s*-\s*(\S*)$//; # hide GMT offset on datestamp
-    return @row
+    return @row;
 }
 1;
 
-
-
diff --git a/Changes b/Changes
index 9593473..e09929f 100644
--- a/Changes
+++ b/Changes
@@ -11,6 +11,8 @@ version 0.11, released  Aug 2012
  * Fix spelling errors (debian) Ansgar Burchardt <[email protected]>
  * adColumn $distinct_flag not handled (RT#6248 & RT#6251) John D. Lima
  * writing fields containing 0 with AnyData::Format::Fixed (RT#8671) <elodie+cpan [...] pasteur.fr>
+ * weblog request and referer regexs were too greedy, and the referer and client regex's where in the wrong order (RT#34063) and (RT#72334) Wes Brown <wes [...] smellycat.com> and pawal [...] blipp.com
+ * 
 
 version 0.10, released 19 April 2004
 
diff --git a/t/fixed.tbl b/t/fixed.tbl
index aeac94d..02ffb63 100644
--- a/t/fixed.tbl
+++ b/t/fixed.tbl
@@ -1 +1,7 @@
-country, code australia au germany de france fr switzerlandch broken 0 broken2 0
+country,code
+australia  au
+germany    de
+france     fr
+switzerlandch
+broken     0
+broken2     0
diff --git a/t/weblog.t b/t/weblog.t
new file mode 100644
index 0000000..2d494e6
--- /dev/null
+++ b/t/weblog.t
@@ -0,0 +1,42 @@
+#!/usr/local/bin/perl -wT
+use strict;
+use warnings;
+
+use Test::More;
+plan tests => 10;
+
+use AnyData;
+
+my $table = adTie( 'Weblog', 't/weblog.tbl', 'r', {} );
+
+ok( 1 == adRows($table), "Failed rows" );
+
+#remotehost,username,authuser,date,request,status,bytes,client,referer
+#12.34.56.78 - - [13/Mar/2008:07:38:53 +0100] "GET /creeper/image HTTP/1.1" 200 252 "http://www.example.com/" "Mozilla/5.0 (Windows; U; Windows NT 6.0; sv-SE; rv:1.8.1.12) Gecko/20080201 Firefox/2.0.0.12"
+
+my $row = each %$table;
+ok( '12.34.56.78'                 eq $row->{remotehost}, 'remotehost' );
+ok( '-'                           eq $row->{username},   'username' );
+ok( '-'                           eq $row->{authuser},   'authuser' );
+ok( '13/Mar/2008:07:38:53 +0100'  eq $row->{date},       'date' );
+ok( 'GET /creeper/image HTTP/1.1' eq $row->{request},    'request' );
+ok( '200'                         eq $row->{status},     'status' );
+ok( '252'                         eq $row->{bytes},      'bytes' );
+ok(
+'"Mozilla/5.0 (Windows; U; Windows NT 6.0; sv-SE; rv:1.8.1.12) Gecko/20080201 Firefox/2.0.0.12"'
+      eq $row->{client},
+    'client ' . $row->{client}
+);
+ok( '"http://www.example.com/"' eq $row->{referer},
+    'referer: ' . $row->{referer} );
+
+#write test
+#TODO: looks like writing a weblog is broken
+#print STDERR "\n---\n";
+#print STDERR adExport( $table, 'Weblog', undef, {  } );
+#print STDERR "\n---\n";
+#ok(
+#    <<'HERE' eq adExport( $table, 'Weblog', undef, {  } ), 'export weblog format' );
+#HERE
+
+__END__
diff --git a/t/weblog.tbl b/t/weblog.tbl
new file mode 100644
index 0000000..54e379f
--- /dev/null
+++ b/t/weblog.tbl
@@ -0,0 +1 @@
+12.34.56.78 - - [13/Mar/2008:07:38:53 +0100] "GET /creeper/image HTTP/1.1" 200 252 "http://www.example.com/" "Mozilla/5.0 (Windows; U; Windows NT 6.0; sv-SE; rv:1.8.1.12) Gecko/20080201 Firefox/2.0.0.12"
-- 
1.7.10.4