Regexp-Log-0.06000755001750001750 011657025001 12454 5ustar00bookbook000000000000Regexp-Log-0.06/MANIFEST000444001750001750 31211657025001 13716 0ustar00bookbook000000000000Build.PL Changes lib/Regexp/Log.pm Makefile.PL MANIFEST This list of files README t/00basic.t t/10foo.t t/11bar.t t/20debug.t t/Bar.pm t/Foo.pm t/foo1.log t/foo2.log t/pod-coverage.t t/pod.t META.yml Regexp-Log-0.06/README000444001750001750 72211657025001 13452 0ustar00bookbook000000000000Regexp::Log ----------- This module is intented to simplify the process of writing regular expressions for parsing log files. Wouldn't it be nice to be able to feed your Apache or Squid LogFormat configuration string to a Perl object, put in the list of fields you want to capture, and ask the object to give you the adequate regular expression? This module makes it possible. You just have to write the adequate subclass, and put it on CPAN for others to use. Regexp-Log-0.06/Build.PL000444001750001750 61311657025001 14065 0ustar00bookbook000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Regexp::Log', license => 'perl', dist_author => 'Philippe "BooK" Bruhat ', dist_version_from => 'lib/Regexp/Log.pm', add_to_cleanup => ['Regexp-Log-*'], requires => { 'Test::More' => 0, }, ); $builder->create_build_script(); Regexp-Log-0.06/META.yml000444001750001750 74411657025001 14047 0ustar00bookbook000000000000--- abstract: 'A base class for log files regexp builders' author: - "Philippe \"BooK\" Bruhat " configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3607' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Regexp-Log provides: Regexp::Log: file: lib/Regexp/Log.pm version: 0.06 requires: Test::More: 0 resources: license: http://dev.perl.org/licenses/ version: 0.06 Regexp-Log-0.06/Makefile.PL000444001750001750 45011657025001 14542 0ustar00bookbook000000000000use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Regexp::Log', VERSION_FROM => 'lib/Regexp/Log.pm', PREREQ_PM => { 'Test::More' => 0 }, ABSTRACT_FROM => 'lib/Regexp/Log.pm', AUTHOR => "Philippe 'BooK' Bruhat ", PL_FILES => {}, ); Regexp-Log-0.06/Changes000444001750001750 164711657025001 14114 0ustar00bookbook000000000000Revision history for Perl extension Regexp::Log 0.06 Thu Nov 10 20:44:20 CET 2011 - Steffen Mueller fixed tests for compatibility with recent Perls 0.05 Sun Oct 3 18:31:22 CEST 2010 - new options added by Solli Moreira Honorio: + anchor_line: optionaly anchors the regexp with ^ and $ + modifiers: allow the use of modifiers (m, s, i and friends) 0.04 Thu Aug 11 22:03:39 CEST 2005 - Perl 5.6 and Perl 5.8 backtrack differently, which broke the tests for the debug option - now support Module::Build - 100% test coverage 0.03 Mon Mar 28 02:20:56 CEST 2005 - added t/pod.t and t/pod-coverage.t (for Kwalitee) 0.02 Wed Jan 21 12:39:34 CET 2004 - removed a useless /c in a s/// - small fix in a test 0.01 Fri Jan 17 16:21:04 CET 2003 - original version - this module is used as a base class for Regexp::Log::BlueCoat Regexp-Log-0.06/t000755001750001750 011657025001 12717 5ustar00bookbook000000000000Regexp-Log-0.06/t/20debug.t000444001750001750 242411657025001 14473 0ustar00bookbook000000000000use Test::More tests => 8; use t::Foo; use re 'eval'; my $foo = Regexp::Log::Foo->new(); # test the accessor ok( ! $foo->debug, "No debug by default" ); $foo->debug(1); ok( $foo->debug == 1 , "Debug set" ); @ARGV = ('t/foo1.log'); $foo->format("%a %b %c %d"); my @fields = $foo->capture; my $regexp = $foo->regexp; # swap errputs my $file = "t/.test.$$"; open OLDERR, ">&STDERR" or die "fatal: could not duplicate STDERR: $!"; close STDERR; open STDERR, "> $file" or die "fatal: could not open temporary errput file $file: $!"; # debug data should go to the file while(<>) { my %data; @data{@fields} = /$regexp/; } # put things back to normal close STDERR; open STDERR, ">&OLDERR" or die "fatal: could not duplicate STDERR: $!"; close(OLDERR); @ARGV = ($file); is( <>, "\n", "First line is empty" ); is( <>, "a b cs cn c d \n", "Debug for a match" ); is( <>, "a b cs cn c d \n", "Debug for a match" ); is( <>, "a b cs cn c d \n", "Debug for a match" ); # Perl 5.6 and Perl 5.8 backtrack differently! if ( $] >= 5.008 ) { is( <>, "a \n", "Debug for non-match" ); } else { is( <>, "a a \n", "Debug for non-match" ); } is( <>, "a b cs cn c d ", "Debug for a match" ); close ARGV; # cleanup files unlink $file or diag "Could not remove $file: $!"; Regexp-Log-0.06/t/pod.t000444001750001750 21411657025001 14000 0ustar00bookbook000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Regexp-Log-0.06/t/foo1.log000444001750001750 15411657025001 14403 0ustar00bookbook0000000000001 this h4cker/31337 foo 2 this cosmos/1999 foo 3 that perec/11 bar 67 thot line/0 baz 40 this beast/666 baz Regexp-Log-0.06/t/Bar.pm000444001750001750 121411657025001 14114 0ustar00bookbook000000000000package Regexp::Log::Bar; use base qw( Regexp::Log ); use vars qw( $VERSION %DEFAULT %FORMAT %REGEXP ); $VERSION = 0.01; # default values %DEFAULT = ( format => '%d %c %b', capture => [], _test => 13, ); # predefined format strings %FORMAT = ( ':default' => '%a %b %c', ); # the regexps that match the various fields # this is the difficult part %REGEXP = ( '%a' => '(?#=a)\\d+(?#!a)', '%b' => '(?#=b)th(?:is|at)(?#!b)', '%c' => '(?#=c)(?#=cs)\\w+(?#!cs)/(?#=cn)\\d+(?#!cn)(?#!c)', '%d' => '(?#=d)(?:foo|bar|baz)(?#!d)', ); sub _postprocess { my $self = shift; # some code here $self->{_test}++; } 1; Regexp-Log-0.06/t/00basic.t000444001750001750 12711657025001 14442 0ustar00bookbook000000000000use Test; BEGIN { plan tests => 1 } END { ok($loaded) } use Regexp::Log; $loaded++; Regexp-Log-0.06/t/Foo.pm000444001750001750 131111657025001 14131 0ustar00bookbook000000000000package Regexp::Log::Foo; use base qw( Regexp::Log ); use vars qw( $VERSION %DEFAULT %FORMAT %REGEXP ); $VERSION = 0.01; # default values %DEFAULT = ( format => '%d %c %b', capture => ['c'], ); # predefined format strings %FORMAT = ( ':default' => '%a %b %c', ); # the regexps that match the various fields # this is the difficult part %REGEXP = ( '%a' => '(?#=a)\\d+(?#!a)', '%b' => '(?#=b)th(?:is|at)(?#!b)', '%c' => '(?#=c)(?#=cs)\\w+(?#!cs)/(?#=cn)\\d+(?#!cn)(?#!c)', '%d' => '(?#=d)(?:foo|bar|baz)(?#!d)', ); sub _preprocess { my $self = shift; # multiple consecutive spaces in the format are compressed # to a single space $self->{_regexp} =~ s/ +/ /g; } 1; Regexp-Log-0.06/t/10foo.t000444001750001750 1000611657025001 14202 0ustar00bookbook000000000000use Test::More; use strict; use t::Foo; my $foo = Regexp::Log::Foo->new(); ok( ref($foo) eq 'Regexp::Log::Foo', "It's a Regexp::Log::Foo" ); # check defaults ok( $foo->format eq '%d %c %b', "Default format" ); my @capture = $foo->capture; ok( @capture == 1, "Default capture" ); ok( $capture[0] eq 'c', "Default captured field" ); ok( $foo->comments == 0, "Default comments" ); ok( $foo->anchor_line == 1, "Default anchor line"); ok( $foo->modifiers eq '', "Default modifiers" ); # check the anchor_line method $foo = Regexp::Log::Foo->new( format => '%a' ); my $_xism = qr// =~ /^\(\?\^/ ? "^" : "-xism"; ok( $foo->regexp eq qq/(?$_xism\:^(?:\\d+)\$)/, "Ok for default anchors" ); ok( $foo->anchor_line(0) == 0, "Disabling anchors for line" ); ok( $foo->regexp eq qq/(?$_xism\:(?:\\d+))/ , "Ok for disabled anchors" ); # check modifiers ok( $foo->modifiers('sim') eq q/sim/, "Ok to set modifiers" ); ok( $foo->regexp eq qq/(?$_xism\:(?sim:(?:\\d+)))/, "Modifiers configured" ); # check the format method $foo = Regexp::Log::Foo->new(); ok( $foo->format('%a %b %c') eq '%a %b %c', "Format return new value" ); ok( $foo->format eq '%a %b %c', "new format value is set" ); my $r = $foo->regexp; # check the format method with templates $foo = Regexp::Log::Foo->new( format => ':default' ); is( $foo->regexp, $r, "Same regexp with ':default' and '%a %b %c'"); # check the fields method my @fields = sort $foo->fields; my $i = 0; for (qw(a b c cn cs d)) { ok( $fields[ $i++ ] eq $_, "Found field $_" ); } # set the captures @fields = $foo->capture(':none'); ok( @fields == 0, "Capture :none" ); @fields = sort $foo->capture(qw( b cs )); ok( @fields == 2, "Capture only two fields" ); $i = 0; for (qw( b cs )) { ok( $fields[ $i++ ] eq $_, "Field $_ is captured" ); } $foo->format('%d %c %b'); @fields = sort $foo->capture(':all'); $i = 0; for (qw( b c cn cs d)) { ok( $fields[ $i++ ] eq $_, "Field $_ is captured by :all" ); } # the comments method ok( $foo->comments(1) == 1, "comments old value" ); ok( $foo->comments == 1, "comments new value" ); # the regexp method ok( $foo->regex eq $foo->regexp, "regexp() is aliased to regex()" ); $foo->comments(0); my $regexp = $foo->regexp; ok( $regexp !~ /\(\?\#.*?\)/, "No comment in regexp" ); $foo->comments(1); $foo->format('%d'); ok( @{ [ $foo->regexp =~ /(\(\?\#.*?\))/g ] } == 2, "2 comment for %d in regexp" ); $foo->format('%c'); ok( @{ [ $foo->regexp =~ /(\(\?\#.*?\))/g ] } == 6, "6 comments for %c in regexp" ); $foo->comments(0); # test the regex on real log lines @ARGV = ('t/foo1.log'); $foo->format("%a %b %c %d"); @fields = $foo->capture(":all"); $regexp = $foo->regexp; my %data; my @data = ( { a => 1, b => 'this', c => 'h4cker/31337', cs => 'h4cker', cn => 31337, d => 'foo' }, { a => 2, b => 'this', c => 'cosmos/1999', cs => 'cosmos', cn => 1999, d => 'foo' }, { a => 3, b => 'that', c => 'perec/11', cs => 'perec', cn => 11, d => 'bar' }, { a => undef, b => undef, c => undef, cs => undef, cn => undef, d => undef }, { a => 40, b => 'this', c => 'beast/666', cs => 'beast', cn => 666, d => 'baz' }, ); $i = 0; while (<>) { @data{@fields} = /$regexp/; is_deeply( \%data, $data[ $i++ ], "foo1.log line " . ( $i + 1 ) ); } # check that metacharacters are correctly handled @ARGV = ( 't/foo2.log' ); $foo->format('%a (%c) $ %d? [%b]'); @fields = $foo->capture(":all"); $regexp = $foo->regexp; @data = ( { a => 1, c => 'jay/123', cs => 'jay', cn => 123, d => 'foo', b => 'this' }, { a => 25, c => 'garden/87', cs => 'garden', cn => 87, d => 'bar', b => 'that' } ); $i = 0; while (<>) { @data{@fields} = /$regexp/; is_deeply( \%data, $data[ $i++ ], "foo2.log line " . ( $i + 1 ) ); } BEGIN { plan tests => 43 } Regexp-Log-0.06/t/foo2.log000444001750001750 6711657025001 14367 0ustar00bookbook0000000000001 (jay/123) $ foo? [this] 25 (garden/87) $ bar? [that] Regexp-Log-0.06/t/pod-coverage.t000444001750001750 25411657025001 15575 0ustar00bookbook000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Regexp-Log-0.06/t/11bar.t000444001750001750 31311657025001 14124 0ustar00bookbook000000000000use Test::More tests => 1; use strict; use t::Bar; my $bar = Regexp::Log::Bar->new; my $before = $bar->{_test}; my $re = $bar->regexp; is( $bar->{_test}, $before + 1, 'postprocessing code executed'); Regexp-Log-0.06/lib000755001750001750 011657025001 13222 5ustar00bookbook000000000000Regexp-Log-0.06/lib/Regexp000755001750001750 011657025001 14454 5ustar00bookbook000000000000Regexp-Log-0.06/lib/Regexp/Log.pm000444001750001750 3060311657025001 15712 0ustar00bookbook000000000000package Regexp::Log; use strict; use Carp; use vars qw( $VERSION ); $VERSION = 0.06; sub new { my $class = shift; no strict 'refs'; my $self = bless { debug => 0, comments => 0, anchor_line => 1, modifiers => '', %{"${class}::DEFAULT"}, @_ }, $class; # some initialisation code if ( my @capture = @{ $self->{capture} } ) { $self->{capture} = []; $self->capture(@capture); } return $self; } sub format { my $self = shift; $self->{format} = shift if @_; return $self->{format}; } sub capture { my $self = shift; # add the new tags to capture for (@_) { # special tags if ( $_ eq ':none' ) { $self->{capture} = [] } elsif ( $_ eq ':all' ) { $self->{capture} = [ $self->fields ]; } # normal tags else { push @{ $self->{capture} }, $_ } } my %capture = map { ( $_, 1 ) } @{ $self->{capture} }; $self->{capture} = [ keys %capture ] if @_; # compute what will be actually captured, in which order $self->_regexp; return grep { $capture{$_} } ( $self->{_regexp} =~ /\(\?\#=([-\w]+)\)/g ); } # this internal method actually computes the correct regular expression sub _regexp { my $self = shift; my $class = ref $self; $self->{_regexp} = $self->{format}; $self->{_regexp} =~ s/([\\|()\[\]{}^\$*+?.])/\\$1/g; $self->_preprocess if $self->can('_preprocess'); # accept predefined formats no strict 'refs'; $self->{format} = ${"${class}::FORMAT"}{ $self->{format} } if exists ${"${class}::FORMAT"}{ $self->{format} }; my $convert = join '|', reverse sort keys %{"${class}::REGEXP"}; $self->{_regexp} =~ s/($convert)/${"${class}::REGEXP"}{$1}/g; $self->_postprocess if $self->can('_postprocess'); } sub regexp { my $self = shift; $self->_regexp; my $regexp = $self->{_regexp}; my %capture = map { ( $_, 1 ) } @{ $self->{capture} }; # this is complicated, but handles multiple levels of imbrication my $pos = 0; while ( ( $pos = index( $regexp, "(?#=", $pos ) ) != -1 ) { ( pos $regexp ) = $pos; $regexp =~ s{\G\(\?\#=([-\w]+)\)(.*?)\(\?\#\!\1\)} { exists $capture{$1} ? "((?#=$1)$2(?#!$1))" : "(?:(?#=$1)$2(?#!$1))" }ex; $pos += 4; # oh my! a magic constant! } # for regexp debugging if ( $self->debug ) { $regexp =~ s/\(\?\#\!([-\w]+)\)/(?#!$1)(?{ print STDERR "$1 "})/g; $regexp =~ s/^/(?{ print STDERR "\n"})/; } # remove comments $regexp =~ s{\(\?\#[=!][^)]*\)}{}g unless $self->comments; # include anchors $regexp = qq{\^$regexp\$} if $self->anchor_line; # include modifiers $regexp = join '', '(?', $self->modifiers, ":$regexp)" if length $self->modifiers; # compute the regexp if ( $self->debug ) { use re 'eval'; $regexp = qr/$regexp/; } else { $regexp = qr/$regexp/ } return $regexp; } *regex = \®exp; sub fields { my $self = shift; my $class = ref $self; no strict 'refs'; return map { (/\(\?\#=([-\w]+)\)/g) } values %{"${class}::REGEXP"}; } for my $attr (qw( comments modifiers anchor_line debug )) { no strict 'refs'; *$attr = sub { my $self = shift; $self->{$attr} = shift if @_; return $self->{$attr}; }; } 1; __END__ =head1 NAME Regexp::Log - A base class for log files regexp builders =head1 SYNOPSIS my $foo = Regexp::Log::Foo->new( format => 'custom %a %b %c/%d', capture => [qw( host code )], ); # the format() and capture() methods can be used to set or get $foo->format('custom %g %e %a %w/%s %c'); $foo->capture(qw( host code )); # this is necessary to know in which order # we will receive the captured fields from the regexp my @fields = $foo->capture; # the all-powerful capturing regexp :-) my $re = $foo->regexp; while (<>) { my %data; @data{@fields} = /$re/; # no need for /o, it's a compiled regexp # now munge the fields ... } =head1 DESCRIPTION Regexp::Log is a base class for a variety of modules that generate regular expressions for performing the usual data munging tasks on log files that cannot be simply split(). The goal of this module family is to compute regular expressions based on the configuration string of the log. Please note that there is I you can do with Regexp::Log! Use one of its derived classes! =head1 METHODS The following methods are available, and form the general API for the derived classes. Please note that all the accessors return the new value, if used to set. =over 4 =item new( %args ) Return a new Regexp::Log object. A list of key-value pairs can be given to initialise the object. The default arguments are: format - the format of the log line capture - the name of the fields to capture with the regexp (given as an array ref) comments - leave the (?#=name) ... (?#!name) comments in the regexp anchor_line - include begin (^) and end ($) anchor in the regexp modifiers - include the modifiers into regexp Other arguments (and the corresponding accessors) can be defined in derived classes. =item format( $formatstring ) This accessor sets or gets the format string used as a template to generate the log-matching regexp. This is usually the configuration line of the log-generating software. =item capture( @fields ) Add the elements of @fields to the list of fields that the regular expression should capture (if possible). The method returns the list of actually captured fields, B. The special tags C<:none> and C<:all> can be used to capture none or all of the fields. C<:none> can also be used to reset a capture list, as shown in the following example: my $log = Regexp::Log::Foo->new( format => $format ); # create a regexp that will capture gmttime and host $log->capture(qw( gmttime host )); my $re1 = $log->regexp; # captures gmttime and host # add username to the list of captured fields $log->capture(qw( username )); my $re2 = $log->regexp; # captures gmttime, host and username # start afresh and capture username and uri $log->capture(qw( :none username uri )); my $re3 = $log->regexp; # captures username and uri When used to set, this method returns the I list of captured fields, in capture order. =item regexp( ) Return a computed regular expression, computed from the data given to the Regexp::Log object, and ready to be used in a script. =item regex( ) regex() is an alias for the regexp() method. =item fields( ) This method return the list of all the fields that can be captured. For complex subclasses making a lot of modifications in _preprocess() and _postprocess(), the result may not be accurate. The result of fields() is therefore given for information only. =item comments( $bool ) Accessor for the C attribute. Comments are removed by default. =item modifiers( $modifiers ) Sets the modifiers that govern how the pattern behaves (for versions of Perl up to 5.9 or so, these are C). By default no flags are enabled. =item anchor_line( $bool ) The resulting pattern will be have the C<^> and C<$> line boundary assertions at the beginning and end of the pattern, respectively, when the value is true. Set to 0 to disable. =item debug( $bool ); Get/set regexp debug mode. If C is set, each time a field (or subfield) is matched, its name (followed by a space) is printed on STDERR. A newline is printed at the beginning of the search. This lets you see where the regexp backtracks, and watch all its attempts to match something. Useful but usually I verbose. This is mainly useful when writing a new Regexp::Log subclass. =back =head1 SUBCLASSES This section explains how to create new subclasses of Regexp::Log. =head2 Package template To implement a Regexp::Log::Foo class, you need to create a package that defines the appropriate class variables, as in the following example (this is the complete code for Regexp::Log::Foo!): package Regexp::Log::Foo; use base qw( Regexp::Log ); use vars qw( $VERSION %DEFAULT %FORMAT %REGEXP ); $VERSION = 0.01; # default values %DEFAULT = ( format => '%d %c %b', capture => [ 'c' ], ); # predefined format strings %FORMAT = ( ':default' => '%a %b %c', ); # the regexps that match the various fields # this is the difficult part %REGEXP = ( '%a' => '(?#=a)\d+(?#!a)', '%b' => '(?#=b)th(?:is|at)(?#!b)', '%c' => '(?#=c)(?#=cs)\w+(?#!cs)/(?#=cn)\d+(?#!cn)(?#!c)', '%d' => '(?#=d)(?:foo|bar|baz)(?#!d)', ); # Note that the three hashes (%DEFAULT, %FORMAT and %REGEXP) # MUST be defined, even if they are empty. # the _regexp field is an internal field used as a template # by the regexp() # the _preprocess method is used to modify the format string # before the fields are expanded to their regexp value sub _preprocess { my $self = shift; # multiple consecutive spaces in the format are compressed # to a single space $self->{_regexp} =~ s/ +/ /g; } # the _postprocess method is used to modify the format string # after the fields are expanded to their regexp value 1; Please note that the _preprocess() and _postprocess() method should only modify the C<_regexp> attribute. The comments are removed after _postprocess() is run, if C is set to a false value. =head2 Some explanations on the regexp format You may have noticed the presence of C<(?#...)> regexp comments in the previous example. These are used by Regexp::Log to identify the different parts of the log line and compute a regular expression that can capture them. These comments work just like HTML tags: C<(?#=bar)> marks the beginning of a field named I, and C<(?#!bar)> marks the end of the field. You'll also notice that C<%c> is split in two subfields: C and C, which have their own tags. Consider the following example script: my $log = Regexp::Log::Foo->new( format => ':default', capture => [ qw( c cn ) ], ); my $re = $log->regexp; my @fields = $log->capture(); while(<>) { my @data; @data{@fields} = (/$re/g); # some more code } The %data hash will have two keys: C and C, even though C already holds the information in C. This gives log mungers a lot of flexibility in what they can get from their log lines, with no added work. Lazyness is a virtue. B =over 4 =item * Since Regexp::Log handles all the capturing parentheses by itself, there must not be any capturing parentheses in any regexp template of a derived class. If there are capturing parentheses in the values of %REGEXP, named captures I. =item * All the regexp comments that let the Regexp::Log classes find the named captures must be stored in %REGEXP values. Even if you are using a complex process to create the final regexp (have a look at Regexp::Log::BlueCoat source code), you I put the special regexp comments in %REGEXP. =back =head2 Changing the subclasse default behaviour If a subclass that is available from CPAN is buggy or incomplete, or does not exactly fit your log files, it's very easy to add to a Regexp::Log subclass from within your scripts. Imagine that the C<%d> element of our Regexp::Log::Foo module is incomplete, because it does not match the string C that appears occasionaly (maybe the Regexp::Log::Foo developper didn't know?). Or that you patched the Foo software so that your own version creates non-standard log files. After emailing the patch to the author, you can temporarily fix your script by adding the following line: $Regexp::Log::Foo::REGEXP{'%d'} = '(?#=d)(?:fu|foo|bar|baz)(?#!d)' That is to say, by replacing the C<%d> entry in the subclass' %REGEXP hash. =head1 BUGS Probably. Most of them should be in the derived classes, though. The F test file fails with Perl 5.6.0 and 5.6.1. I have no idea why, but it may be linked to the use of the C<(?{ ... })> regexp construct in the debugging code. =head1 AUTHOR Philippe 'BooK' Bruhat Ebook@cpan.orgE. =head1 LICENCE This module is free software; you can redistribute it or modify it under the same terms as Perl itself. =cut