package MailLogParser::Line;

########## Confixx(R) 3.0 Professional ############
####### Copyright SWsoft, Inc. 2004-2005 ##########
#### http://www.sw-soft.com - info@sw-soft.com ####

# $id: Line.pm, v 1.0 2003/10/16 $

=head1 NAME

MailLogParser::Line - Класс для анализа строки log-файла smtp-сервера

=head1 SYNOPSIS

$line= MailLogParser::Line->new;

open(LOG,'< /var/log/maillog');
while (<LOG>){
  chomp;
  $line->parseline($_);
  print "Type:\t".$line->type."\n";
  print "GID:\t".$line->gid."\n";
}
close(LOG);

=head1 DESCRIPTION

Класс реализует разбор строки log-файла smtp-сервера.
На первом этапе ( parseline ) выделяет время, тип и групповой идентификатор строки
Содержит процедуры для дальнейшего анализа строки

=over 4

=item new

создает новый экземпляр класса и возвращает указатель на него
 
=item parseline( $string )

принимает в качестве аргумента строку log-файла.
Заполняет параметры: ltime, stime, mon, smon, mday, 
		yday, hour, host, type, gid, uid
Остаток строки сохраняет в tail

=item parsesuffix( [$string] )

postfix и sendmail в конце строки log-файла приписывают дополнительную информацию, заключая ее в круглые скобки.
Если аргумент не указан, то используется параметр tail
процедура вырезает эту информацию из строки, возвращает ее в качестве результата
Остаток строки сохраняется в tail

=item parseprefix( [$sep], [$string] )

вырезает из начала строки $string или параметра tail подстроки заканчивающиеся $sep
(по умолчанию ':')
Вырезанные подстроки срхраняются в параметре prefixes
Остаток строки сохраняется в параметр tail 
Возвращает указатель на массив префиксов

=item prefixes

возвращает указатель на массив префиксов

=extrprefix ( [$sep], [$string] )

вырезает один префикс из строки $string или параметра tail
возврашает его в качестве рузультата
остаток строки записывает в параметр tail

=item parsetail( [$coma], [$eq], [$string] )

Разбирает строку $string или если не указана, то параметр tail.
строка делиться на части с помощью $coma (по умолчанию ',')
подстроки разбираются на пары ключ - значение с помощью $eq (по умолчанию '=')
Получивщейся ассоциативный массив сохраняется в параметре attr
Возвращается указатель на этот массив

=item attr( $key )

Возвращает значение ассоциативного массива по ключу $key

=item tail

возврашает значение параметра tail

=item ltime

возвращает локальное время анализируемой строки

=item stime

возвращает подстроку времени в виде 'HH:MM:SS' 

=item mon

возвращает номер месяца

=item smon

возвращает строку с названием месяца

=item mday

возвращает номер дня в месяце

=itme yday

возвращает номер дня в году

=itme hour

возвращает час

=item host

возвращает сетевое имя компьютера

=item type

возвращает тип log-файла: sendmail, postfix, qmail

=item gid

возвращает групповой идентификатор строки

=item uid

возвращает индивидуальный идентификатор записи для qmail

=item totext

возвращает отладочную информацию об объекте

=back

=cut


use Exporter;
use Time::Local;

my (%monthNums,$class);

BEGIN {
  @ISA = ('Exporter');
  @EXPORT=qw(&parseline &parsetail &ltime &yday &hour
	     &host &type &gid &tail &totext &attr &prefixes
	     &parseprefix &parsesuffix &stime &mon &smon &mday
	     &uid &extrprefix &new );

  %monthNums = qw (
	Jan  0 Feb  1 Mar  2 Apr  3 May  4 Jun  5
	Jul  6 Aug  7 Sep  8 Oct  9 Mon 10 Dec 11 );

  $class = "MailLogParser::Line";

}


use strict('vars');

sub new {
  my $class = shift;
  my $self = {};
  
  bless($self, $class);
  
  $self->{_yday}=0;
  $self->{_hour}=0;
  $self->{_host}='localhost';
  $self->{_type}=undef;
  $self->{_gid}=undef;
  $self->{_uid}=undef;
  $self->{_tail}='';
  $self->{_ltime}=undef;
  $self->{_attr}=undef;
  $self->{_prefix}=();
  $self->{_suffix}='';
  $self->{_stime}='';
  ($self->{_mon},$self->{_year})=(localtime)[4,5];;
  $self->{_smon}='';
  $self->{_mday}='';
  
  return $self;
}

sub gid {
  my $self = shift;
  return $self->{_gid};
}

sub uid {
  my $self = shift;
  return $self->{_uid};
}

sub year {
  my $self = shift;
  return $self->{_year};
}

sub stime {
  my $self = shift;
  return $self->{_stime};
}

sub smon {
  my $self = shift;
  return $self->{_smon};
}

sub mon {
  my $self = shift;
  return $self->{_mon};
}

sub mday {
  my $self = shift;
  return $self->{_mday};
}

sub yday {
  my $self = shift;
  return $self->{_yday};
}
sub hour {
  my $self = shift;
  return $self->{_hour};
}
sub host {
  my $self = shift;
  return $self->{_host};
}
sub type {
  my $self = shift;
  return $self->{_type};
}
sub id {
  my $self = shift;
  return $self->{_id};
}
sub tail {
  my $self = shift;
  return $self->{_tail};
}

sub ltime {
  my $self = shift;
  return $self->{_ltime};
}
sub suffix {
  my $self = shift;
  return $self->{_suffix};
}

sub totext {
  my $self = shift;
  my $ret='';
  my ($akey,$aval); 
  while( my($key,$value) = each(%$self)){
	if ($key eq '_attr' && defined $value){
	  $ret.="attributes:\n";
	  while ( ($akey,$aval) = each(%$value)){
		$ret.="\t$akey\t=\t$aval\n";
	  }
	}elsif($key eq '_prefix' && defined $value){
	  $ret.="prefixes:\n";
	  foreach $aval (@$value){
		$ret.="\t$aval\n";
	  }
	} else {
	  $ret.="$key\t=>\t$value\n";
	}  
  } 
  return $ret;
}

sub parseline {
  my $self = shift;
  if (@_){
    my $in=shift;
    my ($prefix,$type,$tail,$ltime,$right,$id,$year,$uid);

    $self->{_prefix}=undef; ## clean prefixes
	
    if ($in =~ /^(.+?)\s+(\S+):\s+(.+)$/){
      $prefix = $1;
      $type = $2;
      $tail = $3;
	  
      my ($curMonth,$curYear)=(localtime)[4,5];
	  
      my ($mon,$dd,$time,$host)=split(' ',$prefix);
      $self->{_stime}=$time;
      $self->{_smon}=$mon;
      $self->{_mday}=$dd;
      $mon=$monthNums{$mon};
      $self->{_mon}=$mon;
      my ($hour,$min,$sec)=split(/:/,$time);
      $year= ($mon>$curMonth)? $curYear-1:$curYear;
      $self->{_year}=$year;
      $ltime=timelocal($sec,$min,$hour,$dd,$mon,$year);
      $self->{_ltime}=$ltime;
      $self->{_yday}=(localtime $ltime)[7];
      $self->{_hour}=$hour;
      $self->{_host}=$host;
	  
      ($type,$right)=split(/\[/,$type);
      if ($right){
		($id)=split(/\]/,$right);
      }
      ($type,$right)=split(/\//,$type);
      $self->{_type}=$type;
      if ($type =~ /sendmail/  ) {
	if ( $tail =~ /^\s*(\w+):\s+(.+)/){
	  $id=$1;
	  $tail=$2;
	  if ($id !~ /\d/){
	    $id='';
	  }
	}
      }
      elsif ($type =~ /postfix/) {
	if ( $tail =~ /^\s*(\w+):\s+(.+)/){
	  $id=$1;
	  $tail=$2;
	  if ($id !~ /\d+/){
	    $id='';
	  }
	}else {
	  undef $id;
	}
      }
      elsif ($type =~ /qmail/){
	if ( $tail =~ /^\s*(\d+)\.(\d+)\s+(.+)/){
	  $uid="$1\.$2";
	  $tail=$3;
	  if ( $tail =~ /msg\s+(\d+)[\s|:]+/ || $tail =~ /msg\s+(\d+)$/){
	    $id=$1;
	  }else{
	    undef $id;
	  }
	  $self->{_uid}=$uid;
	}
      }
      $self->{_gid}=$id;
      $self->{_tail}=$tail;
    }
  }
  return $self->{_tail};
}

sub parsetail {
  my $self = shift;
  my $coma = shift || ',';
  my $eq = shift || '=';
  my $in = shift || $self->tail;
  
  my %ret;
  
  $self->{_tail}=$in;
    
  my (@kvs,$kv,$cnt,$key,$value);

  if (!$eq || $in=~/$eq/){
    if ($in=~/$coma/){
      @kvs= split(/$coma\s*/, $in);
    }else {
      @kvs = split (' ',$in);
    }
    if ($eq eq $coma){
      foreach $kv (@kvs){
	if ($cnt){
	  $ret{$key}=$kv;
	  $cnt=0;
	}else{
	  $key = $kv;
	  $cnt=1;
	}
      }
    }else{
      foreach  $kv (@kvs) {
	($key,$value)=split(/\s*$eq\s*/,$kv,2);
	$ret{$key}=$value;
      }
    }
    $self->{_attr}=\%ret;
  }
  return \%ret;
}

sub parseprefix {
  my $self = shift;
  my $sep = shift || ':';
  my $in=shift||$self->{_tail};
  
  $self->{_prefix}=undef;
  while ($in =~ /^\s*(\S+?)\s*$sep\s?(.*)/){
	push @{$self->{_prefix}},$1;
	$in = $2;
  }
  $self->{_tail}=$in;
  return $self->{_prefix};
}

sub prefixes {
  my $self = shift;
  return $self->{_prefix};
}

sub extrprefix {
  my $self = shift;
  my $sep = shift || ':';
  my $in = shift || $self->{_tail};
  my $prefix='';

  if ($in =~ /^\s*(.+?)$sep\s?(.*)/){
    $prefix = $1;
    push @{$self->{_prefix}},$prefix;
    $self->{_tail} = $2;
  }

  return $prefix;
}

sub parsesuffix {
  my $self = shift;
  my $in;
  
  if (@_){
	$in=shift;
  } else {
	$in=$self->{_tail};
  }
  if ($in =~ /(.*)\((.*?)\)\s*$/){
	$self->{_suffix}=$2;
	$in=$1;
  }  
  else {
	$self->{_suffix}='';
  }
  $self->{_tail}=$in;
  return $self->{_suffix};
}

sub attr {
  my $self = shift;
  if (defined $self->{_attr}){
	my $key = shift;
	my $ptrAttr = $self->{_attr};
	return $ptrAttr->{$key};
  }
}

1;

