package Apache::LogRegex;
{
  $Apache::LogRegex::VERSION = '1.52';
}

use strict;
use warnings;

sub new {
    my ( $class, $format ) = @_;

	die "Apache::LogRegex->new() takes 1 argument" if scalar(@_) != 2;
	die "Apache::LogRegex->new() argument 1 (FORMAT) is undefined" if !defined($format);

    my $self = bless {}, $class;

    $self->{_format} = $format;

    $self->{_regex_string} = '';
    $self->{_regex_fields} = ();

    $self->_parse_format();

    return $self;
}

sub _parse_format {
    my ($self) = @_;

    chomp( $self->{_format} );
    $self->{_format} =~ s#[ \t]+# #;
    $self->{_format} =~ s#^ ##;
    $self->{_format} =~ s# $##;

    my @regex_elements;

    foreach my $element ( split ( ' ', $self->{_format} ) ) {
        my $quotes = ( $element =~ m/^\\\"/ ) ? 1 : 0;

        if ($quotes) {
            $element =~ s/^\\\"//;
            $element =~ s/\\\"$//;
        }

        push ( @{ $self->{_regex_fields} }, $self->rename_this_name($element) );

        my $x = '(\S*)';

        if ($quotes) {
			if($element eq '%r' or $element =~ m/{Referer}/ or $element =~ m/{User-Agent}/) {
				$x = qr/"([^"\\]*(?:\\.[^"\\]*)*)"/;
			}
			else {
            	$x = '\"([^\"]*)\"';
			}
        }
        elsif ( $element =~ m/^%.*t$/ ) {
            $x = '(\[[^\]]+\])';
        }
		elsif ( $element eq '%U' ) {
			$x = '(.+?)';
		}

        push ( @regex_elements, $x );
    }

	my $regex = join ( ' ', @regex_elements );
	$self->{_regex_string} = qr/^$regex\s*$/;
}

sub parse {
    my ( $self, $line ) = @_;

	die "Apache::LogRegex->parse() takes 1 argument" if scalar(@_) != 2;
	die "Apache::LogRegex->parse() argument 1 (LINE) is undefined" if !defined($line);

    chomp($line);

    my @temp = $line =~ m/$self->{_regex_string}/;

    return if scalar(@temp) == 0;

    my %data;
    @data{ @{ $self->{_regex_fields} } } = @temp;

    return %data;
}

sub names {
    my ($self) = @_;

	die "Apache::LogRegex->names() takes no argument" if scalar(@_) != 1;

    return ( @{ $self->{_regex_fields} } );
}

sub regex {
    my ($self) = @_;

	die "Apache::LogRegex->regex() takes no argument" if scalar(@_) != 1;

    return $self->{_regex_string};
}

sub rename_this_name {
    my ( $self, $name ) = @_;

    return $name;
}

1;

=head1 NAME

Apache::LogRegex - Parse a line from an Apache logfile into a hash

=head1 VERSION

version 1.52

=head1 SYNOPSIS

  use Apache::LogRegex;

  my $lr;

  eval { $lr = Apache::LogRegex->new($log_format) };
  die "Unable to parse log line: $@" if ($@);

  my %data;

  while ( my $line_from_logfile = <> ) {
      eval { %data = $lr->parse($line_from_logfile); };
      if (%data) {
          # We have data to process
      } else {
          # We could not parse this line
      }
  }

=head1 DESCRIPTION

=head2 Overview

Designed as a simple class to parse Apache log files. It will construct
a regex that will parse the given log file format and can then parse
lines from the log file line by line returning a hash of each line.

The field names of the hash are derived from the log file format. Thus if
the format is '%a %t \"%r\" %s %b %T \"%{Referer}i\" ...' then the keys of
the hash will be %a, %t, %r, %s, %b, %T and %{Referer}i.

Should these key names be unusable, as I guess they probably are, then subclass
and provide an override rename_this_name() method that can rename the keys
before they are added in the array of field names.

=head1 SUBROUTINES/METHODS

=head2 Constructor

=over 4

=item Apache::LogRegex->new( FORMAT )

Returns a Apache::LogRegex object that can parse a line from an Apache
logfile that was written to with the FORMAT string. The FORMAT
string is the CustomLog string from the httpd.conf file.

=back

=head2 Class and object methods

=over 4

=item parse( LINE )

Given a LINE from an Apache logfile it will parse the line and
return a hash of all the elements of the line indexed by their
format. If the line cannot be parsed an empty hash will be
returned.

=item names()

Returns a list of field names that were extracted from the data. Such as
'%a', '%t' and '%r' from the above example.

=item regex()

Returns a copy of the regex that will be used to parse the log file.

=item rename_this_name( NAME )

Use this method to rename the keys that will be used in the returned hash.
The initial NAME is passed in and the method should return the new name.

=back

=head1 CONFIGURATION AND ENVIRONMENT

Perl 5

=head1 DIAGNOSTICS

The various custom time formats could be problematic but providing that
they are encased in '[' and ']' all should be fine.

=over 4

=item Apache::LogRegex->new() takes 1 argument

When the constructor is called it requires one argument. This message is
given if more or less arguments were supplied.

=item Apache::LogRegex->new() argument 1 (FORMAT) is undefined

The correct number of arguments were supplied with the constructor call,
however the first argument, FORMAT, was undefined.

=item Apache::LogRegex->parse() takes 1 argument

When the method is called it requires one argument. This message is
given if more or less arguments were supplied.

=item Apache::LogRegex->parse() argument 1 (LINE) is undefined

The correct number of arguments were supplied with the method call,
however the first argument, LINE, was undefined.

=item Apache::LogRegex->names() takes no argument

When the method is called it requires no arguments. This message is
given if some arguments were supplied.

=item Apache::LogRegex->regex() takes no argument

When the method is called it requires no arguments. This message is
given if some arguments were supplied.

=back

=head1 BUGS

None so far

=head1 FILES

None

=head1 SEE ALSO

mod_log_config for a description of the Apache format commands

=head1 THANKS

Peter Hickman wrote the original module and maintained it for
several years. He kindly passed maintainership on just prior to
the 1.51 release. Most of the features of this module are the
fruits of his work. If you find any bugs they are my doing.

=head1 AUTHOR

Original code by Peter Hickman <peterhi@ntlworld.com>

Additional code by Andrew Kirkpatrick <ubermonk@gmail.com>

=head1 LICENSE AND COPYRIGHT

Original code copyright (c) 2004-2006 Peter Hickman. All rights reserved.

Additional code copyright (c) 2013 Andrew Kirkpatrick. All rights reserved.

This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.

=cut
