r1795 - in packages/libparse-syslog-perl/branches/upstream/current:
. lib/Parse t
Joachim Breitner
nomeata at costa.debian.org
Thu Dec 29 21:54:29 UTC 2005
Author: nomeata
Date: 2005-12-29 21:54:28 +0000 (Thu, 29 Dec 2005)
New Revision: 1795
Added:
packages/libparse-syslog-perl/branches/upstream/current/META.yml
packages/libparse-syslog-perl/branches/upstream/current/t/dst.t
packages/libparse-syslog-perl/branches/upstream/current/t/io-stringy.t
packages/libparse-syslog-perl/branches/upstream/current/t/metalog-parsed
packages/libparse-syslog-perl/branches/upstream/current/t/metalog-syslog
packages/libparse-syslog-perl/branches/upstream/current/t/metalog.t
Modified:
packages/libparse-syslog-perl/branches/upstream/current/Changes
packages/libparse-syslog-perl/branches/upstream/current/MANIFEST
packages/libparse-syslog-perl/branches/upstream/current/lib/Parse/Syslog.pm
packages/libparse-syslog-perl/branches/upstream/current/t/filetail.t
Log:
Load /tmp/tmp.7LsY6e/libparse-syslog-perl-1.05 into
packages/libparse-syslog-perl/branches/upstream/current.
Modified: packages/libparse-syslog-perl/branches/upstream/current/Changes
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/Changes 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/Changes 2005-12-29 21:54:28 UTC (rev 1795)
@@ -1,11 +1,30 @@
Revision history for Perl extension Parse::Syslog.
+2005-12-26
+
+ * allow passing of a IO::Handle object to new
+ * ignore FreeBSD's [LOG_XXX] string (Artur Penttinen)
+ * fix timewarp during DST switch (reported by Anthony DeRobertis)
+
+2005-09-12
+
+ * allow : in hostname for IPv6 (Artur Penttinen)
+ * allow @ in hostname for syslog-ng (Mark Loeser)
+
+2004-07-11
+
+ * released 1.03
+ * support for metalog (based on code by Ralf Geschke)
+ * support FreeBSD's verbose logging
+
2004-01-19
+ * released 1.03
* do not allow future dates (if allow_future is not true)
2002-10-28
+ * released 1.02
* fix off-by-one-hour error when running during daylight saving time switch
2002-05-25
Modified: packages/libparse-syslog-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/MANIFEST 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/MANIFEST 2005-12-29 21:54:28 UTC (rev 1795)
@@ -8,6 +8,9 @@
t/linux.t
t/linux-syslog
t/linux-parsed
+t/metalog.t
+t/metalog-syslog
+t/metalog-parsed
t/misc.t
t/misc-parsed
t/misc-syslog
@@ -23,3 +26,6 @@
t/locale.t
t/locale-parsed
t/locale-syslog
+t/dst.t
+t/io-stringy.t
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libparse-syslog-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/META.yml 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/META.yml 2005-12-29 21:54:28 UTC (rev 1795)
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Parse-Syslog
+version: 1.05
+version_from: lib/Parse/Syslog.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libparse-syslog-perl/branches/upstream/current/lib/Parse/Syslog.pm
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/lib/Parse/Syslog.pm 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/lib/Parse/Syslog.pm 2005-12-29 21:54:28 UTC (rev 1795)
@@ -3,10 +3,11 @@
use Carp;
use Symbol;
use Time::Local;
+use IO::File;
use strict;
use vars qw($VERSION);
-$VERSION = '1.03';
+$VERSION = '1.05';
my %months_map = (
'Jan' => 0, 'Feb' => 1, 'Mar' => 2,
@@ -19,26 +20,53 @@
'oct' => 9, 'nov' =>10, 'dec' =>11,
);
-# year-increment algorithm: if in january, if december is seen, decrement year
-my $enable_year_decrement = 1;
+sub is_dst_switch($$$)
+{
+ my ($self, $t, $time) = @_;
+ # calculate the time in one hour and see if the difference is 3600 seconds.
+ # if not, we are in a dst-switch hour
+ # note that right now we only support 1-hour dst offsets
+
+ # cache the result
+ if(defined $self->{is_dst_switch_last_hour} and
+ $self->{is_dst_switch_last_hour} == $t->[3]<<5+$t->[2]) {
+ return @{$self->{is_dst_switch_result}};
+ }
+
+ # calculate a number out of the day and hour to identify the hour
+ $self->{is_dst_switch_last_hour} = $t->[3]<<5+$t->[2];
+
+ # let's see the timestamp in one hour
+ # 0: sec, 1: min, 2: h, 3: day, 4: month, 5: year
+ my $time_plus_1h = timelocal($t->[0], $t->[1], $t->[2]+1, $t->[3], $t->[4], $t->[5]);
+
+ if($time_plus_1h - $time > 4000) {
+ return 3600, $time-$time%3600+3600;
+ }
+ else {
+ return 0, undef;
+ }
+}
+
# fast timelocal, cache minute's timestamp
# don't cache more than minute because of daylight saving time switch
-my @str2time_last_minute;
-my $str2time_last_minute_timestamp;
# 0: sec, 1: min, 2: h, 3: day, 4: month, 5: year
-sub str2time($$$$$$$)
+sub str2time($$$$$$$$)
{
+ my $self = shift @_;
my $GMT = pop @_;
- if(defined $str2time_last_minute[4] and
- $str2time_last_minute[0] == $_[1] and
- $str2time_last_minute[1] == $_[2] and
- $str2time_last_minute[2] == $_[3] and
- $str2time_last_minute[3] == $_[4] and
- $str2time_last_minute[4] == $_[5])
+ my $lastmin = $self->{str2time_lastmin};
+ if(defined $lastmin and
+ $lastmin->[0] == $_[1] and
+ $lastmin->[1] == $_[2] and
+ $lastmin->[2] == $_[3] and
+ $lastmin->[3] == $_[4] and
+ $lastmin->[4] == $_[5])
{
- return $str2time_last_minute_timestamp + $_[0];
+ $self->{last_time} = $self->{str2time_lastmin_time} + $_[0];
+ return $self->{last_time} + ($self->{dst_comp}||0);
}
my $time;
@@ -49,10 +77,30 @@
$time = timelocal(@_);
}
- @str2time_last_minute = @_[1..5];
- $str2time_last_minute_timestamp = $time-$_[0];
+ # compensate for DST-switch
+ # - if a timewarp is detected (1:00 -> 1:30 -> 1:00):
+ # - test if we are in a DST-switch-hour
+ # - compensate if yes
+ if(!$GMT and !defined $self->{dst_comp} and
+ defined $self->{last_time} and
+ $self->{last_time}-$time > 1200 and
+ $self->{last_time}-$time < 3600)
+ {
+ my ($off, $until) = $self->is_dst_switch(\@_, $time);
+ if($off) {
+ $self->{dst_comp} = $off;
+ $self->{dst_comp_until} = $until;
+ }
+ }
+ if(defined $self->{dst_comp_until} and $time > $self->{dst_comp_until}) {
+ delete $self->{dst_comp};
+ delete $self->{dst_comp_until};
+ }
- return $time;
+ $self->{str2time_lastmin} = [ @_[1..5] ];
+ $self->{str2time_lastmin_time} = $time-$_[0];
+ $self->{last_time} = $time;
+ return $time+($self->{dst_comp}||0);
}
sub _use_locale($)
@@ -77,15 +125,22 @@
if(not defined $data{year}) {
$data{year} = (localtime(time))[5]+1900;
}
+ $data{type} = 'syslog' unless defined $data{type};
$data{_repeat}=0;
- if(ref $file eq 'File::Tail') {
- $data{filetail} = 1;
+ if(UNIVERSAL::isa($file, 'IO::Handle')) {
$data{file} = $file;
}
+ elsif(UNIVERSAL::isa($file, 'File::Tail')) {
+ $data{file} = $file;
+ $data{filetail}=1;
+ }
+ elsif(! ref $file) {
+ $data{file} = new IO::File($file, "<");
+ defined $data{file} or croak "can't open $file: $!";
+ }
else {
- $data{file}=gensym;
- open($data{file}, "<$file") or croak "can't open $file: $!";
+ croak "argument must be either a file-name or an IO::Handle object.";
}
if(defined $data{locale}) {
@@ -103,6 +158,27 @@
return bless \%data, $class;
}
+sub _year_increment($$)
+{
+ my ($self, $mon) = @_;
+
+ # year change
+ if($mon==0) {
+ $self->{year}++ if defined $self->{_last_mon} and $self->{_last_mon} == 11;
+ $self->{enable_year_decrement} = 1;
+ }
+ elsif($mon == 11) {
+ if($self->{enable_year_decrement}) {
+ $self->{year}-- if defined $self->{_last_mon} and $self->{_last_mon} != 11;
+ }
+ }
+ else {
+ $self->{enable_year_decrement} = 0;
+ }
+
+ $self->{_last_mon} = $mon;
+}
+
sub _next_line($)
{
my $self = shift;
@@ -111,11 +187,11 @@
return $f->read;
}
else {
- return <$f>;
+ return $f->getline;
}
}
-sub next($)
+sub _next_syslog($)
{
my ($self) = @_;
@@ -124,16 +200,19 @@
return $self->{_repeat_data};
}
- line: while(my $str = $self->_next_line()) {
+ my $file = $self->{file};
+ line: while(my $str = $self->_next_line) {
# date, time and host
$str =~ /^
- (\S{3})\s+(\d+) # date -- 1, 2
+ (\S{3})\s+(\d+) # date -- 1, 2
\s
- (\d+):(\d+):(\d+) # time -- 3, 4, 5
+ (\d+):(\d+):(\d+) # time -- 3, 4, 5
+ (?:\s<\w+\.\w+>)? # FreeBSD's verbose-mode
\s
- ([-\w\.]+) # host -- 6
+ ([-\w\.\@:]+) # host -- 6
\s+
- (.*) # text -- 7
+ (?:\[LOG_[A-Z]+\]\s+)? # FreeBSD
+ (.*) # text -- 7
$/x or do
{
warn "WARNING: line not in syslog format: $str";
@@ -143,24 +222,10 @@
my $mon = $months_map{$1};
defined $mon or croak "unknown month $1\n";
- # year change
- if($mon==0) {
- $self->{year}++ if defined $self->{_last_mon} and $self->{_last_mon} == 11;
- $enable_year_decrement = 1;
- }
- elsif($mon == 11) {
- if($enable_year_decrement) {
- $self->{year}-- if defined $self->{_last_mon} and $self->{_last_mon} != 11;
- }
- }
- else {
- $enable_year_decrement = 0;
- }
+ $self->_year_increment($mon);
- $self->{_last_mon} = $mon;
-
# convert to unix time
- my $time = str2time($5,$4,$3,$2,$mon,$self->{year}-1900,$self->{GMT});
+ my $time = $self->str2time($5,$4,$3,$2,$mon,$self->{year}-1900,$self->{GMT});
if(not $self->{allow_future}) {
# accept maximum one day in the present future
if($time - time > 86400) {
@@ -234,6 +299,80 @@
return undef;
}
+sub _next_metalog($)
+{
+ my ($self) = @_;
+ my $file = $self->{file};
+ line: while(my $str = $self->_next_line) {
+ # date, time and host
+
+ $str =~ /^
+ (\S{3})\s+(\d+) # date -- 1, 2
+ \s
+ (\d+):(\d+):(\d+) # time -- 3, 4, 5
+ # host is not logged
+ \s+
+ (.*) # text -- 6
+ $/x or do
+ {
+ warn "WARNING: line not in metalog format: $str";
+ next line;
+ };
+
+ my $mon = $months_map{$1};
+ defined $mon or croak "unknown month $1\n";
+
+ $self->_year_increment($mon);
+
+ # convert to unix time
+ my $time = $self->str2time($5,$4,$3,$2,$mon,$self->{year}-1900,$self->{GMT});
+
+ my $text = $6;
+
+ $text =~ /^
+ \[(.*?)\] # program -- 1
+ # no PID
+ \s+
+ (.*) # text -- 2
+ $/x or do
+ {
+ warn "WARNING: text line not in metalog format: $text ($str)";
+ next line;
+ };
+
+ if($self->{arrayref}) {
+ return [
+ $time, # 0: timestamp
+ 'localhost', # 1: host
+ $1, # 2: program
+ undef, # 3: (no) pid
+ $2, # 4: text
+ ];
+ }
+ else {
+ return {
+ timestamp => $time,
+ host => 'localhost',
+ program => $1,
+ text => $2,
+ };
+ }
+ }
+ return undef;
+}
+
+sub next($)
+{
+ my ($self) = @_;
+ if($self->{type} eq 'syslog') {
+ return $self->_next_syslog();
+ }
+ elsif($self->{type} eq 'metalog') {
+ return $self->_next_metalog();
+ }
+ croak "Internal error: unknown type: $self->{type}";
+}
+
1;
__END__
@@ -244,10 +383,7 @@
=head1 SYNOPSIS
- my $parser = Parse::Syslog->new( '/var/log/syslog'
- , year => 2001
- , locale => qw(de_CH ru_RU.koi8r)
- );
+ my $parser = Parse::Syslog->new( '/var/log/syslog', year => 2001);
while(my $sl = $parser->next) {
... access $sl->{timestamp|host|program|pid|text} ...
}
@@ -264,15 +400,47 @@
=head2 Constructing a Parser
-B<new> requires as first argument a file-name for the syslog-file to be parsed.
-Alternatively, you can pass a File::Tail object as first argument, in which
+B<new> requires as first argument a source from where to get the syslog lines. It can
+be:
+
+=over 4
+
+=item *
+
+a file-name for the syslog-file to be parsed.
+
+=item *
+
+a File::Tail object as first argument, in which
case the I<read> method will be called to get lines to process.
+=item *
+
+a file handle (GLOB-ref) for an already-opened syslog-file.
+
+=back
+
After the file-name (or File::Tail object), you can specify options as a hash.
The following options are defined:
=over 8
+=item B<type>
+
+Format of the "syslog" file. Can be one of:
+
+=over 8
+
+=item I<syslog>
+
+Traditional "syslog" (default)
+
+=item I<metalog>
+
+Metalog (see http://metalog.sourceforge.net/)
+
+=back
+
=item B<year>
Syslog files usually do store the time of the event without year. With this
@@ -414,6 +582,8 @@
2002-05-25 ds 1.01 added support for localized month names (uchum at mail.ru)
2002-10-28 ds 1.02 fix off-by-one-hour error when running during daylight saving time switch
2004-01-19 ds 1.03 do not allow future dates (if allow_future is not true)
+ 2004-07-11 ds 1.04 added support for type 'metalog'
+ 2005-12-24 ds 1.05 allow passing of a IO::Handle object to new
=cut
Added: packages/libparse-syslog-perl/branches/upstream/current/t/dst.t
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/t/dst.t 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/t/dst.t 2005-12-29 21:54:28 UTC (rev 1795)
@@ -0,0 +1,67 @@
+use lib 'lib';
+use Parse::Syslog;
+use IO::Scalar;
+use Test;
+
+BEGIN {
+ # only test if IO::Scalar is available
+ eval 'require IO::Scalar;' or do {
+ plan tests => 0;
+ warn "IO::Scalar not available: test skipped.\n";
+ exit;
+ };
+
+ plan tests => 16
+};
+
+# 00:00 01:00 01:00 02:00
+# ---|------|------|------|-----
+#
+
+my $data = <<END;
+Oct 30 00:59:53 ivr3 bla: bla
+Oct 30 01:09:53 ivr3 bla: bla
+Oct 30 01:19:53 ivr3 bla: bla
+Oct 30 01:29:53 ivr3 bla: bla
+Oct 30 01:39:53 ivr3 bla: bla
+Oct 30 01:49:53 ivr3 bla: bla
+Oct 30 01:59:58 ivr3 bla: bla
+Oct 30 01:59:58 ivr3 bla: bla
+Oct 30 01:00:00 ivr3 bla: bla
+Oct 30 01:00:04 ivr3 bla: bla
+Oct 30 01:10:04 ivr3 bla: bla
+Oct 30 01:20:04 ivr3 bla: bla
+Oct 30 01:30:04 ivr3 bla: bla
+Oct 30 01:40:04 ivr3 bla: bla
+Oct 30 01:50:04 ivr3 bla: bla
+Oct 30 02:00:04 ivr3 bla: bla
+END
+
+my $file = IO::Scalar->new(\$data);
+
+my $parser = Parse::Syslog->new($file);
+
+my @result = qw(
+1130626793
+1130627393
+1130627993
+1130628593
+1130629193
+1130629793
+1130630398
+1130630398
+1130630400
+1130630404
+1130631004
+1130631604
+1130632204
+1130632804
+1130633404
+1130634004
+);
+
+while(my $sl = $parser->next) {
+ ok($sl->{timestamp}, shift @result);
+}
+
+# vim: ft=perl
Modified: packages/libparse-syslog-perl/branches/upstream/current/t/filetail.t
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/t/filetail.t 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/t/filetail.t 2005-12-29 21:54:28 UTC (rev 1795)
@@ -2,7 +2,7 @@
use lib "lib";
BEGIN {
# only test if File::Tail is installed
- eval 'require File::Tail' or do {
+ eval 'require File::Tail;' or do {
plan tests => 0;
exit;
};
Added: packages/libparse-syslog-perl/branches/upstream/current/t/io-stringy.t
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/t/io-stringy.t 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/t/io-stringy.t 2005-12-29 21:54:28 UTC (rev 1795)
@@ -0,0 +1,48 @@
+use Test;
+use lib "lib";
+BEGIN {
+ # only test if IO::Scalar is available
+ eval 'require IO::Scalar;' or do {
+ plan tests => 0;
+ warn "IO::Scalar not available: test skipped.\n";
+ exit;
+ };
+
+ plan tests => 2
+};
+
+use Parse::Syslog;
+use IO::Scalar;
+
+my $data = <<END;
+Aug 12 06:55:06 hathi [LOG_NOTICE] sshd[1966]: error
+END
+
+my $file = IO::Scalar->new(\$data);
+
+my $parser = Parse::Syslog->new($file, year=>2001);
+
+ok(1);
+
+$sl = $parser->next;
+
+my $is = '';
+$is .= "time : ".(localtime($sl->{timestamp}))."\n";
+$is .= "host : $sl->{host}\n";
+$is .= "program : $sl->{program}\n";
+$is .= "pid : ".(defined $sl->{pid} ? $sl->{pid} : 'undef')."\n";
+$is .= "text : $sl->{text}\n";
+#print "$is";
+
+my $shouldbe = <<END;
+time : Sun Aug 12 06:55:06 2001
+host : hathi
+program : sshd
+pid : 1966
+text : error
+END
+
+ok($is, $shouldbe);
+
+# vim: ft=perl
+
Added: packages/libparse-syslog-perl/branches/upstream/current/t/metalog-parsed
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/t/metalog-parsed 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/t/metalog-parsed 2005-12-29 21:54:28 UTC (rev 1795)
@@ -0,0 +1,18 @@
+time : Fri Oct 1 11:30:56 2004
+host : localhost
+program : amavis
+pid : undef
+text : (23837-08) TIMING [total 1101 ms] - SMTP EHLO: 1 (0%), SMTP pre-MAIL: 0 (0%)
+
+time : Fri Oct 1 11:30:56 2004
+host : localhost
+program : postfix/smtp
+pid : undef
+text : 5FC753D3A6: to=<blabla at fwef>
+
+time : Fri Oct 1 11:30:59 2004
+host : localhost
+program : postfix/smtpd
+pid : undef
+text : disconnect from x
+
Added: packages/libparse-syslog-perl/branches/upstream/current/t/metalog-syslog
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/t/metalog-syslog 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/t/metalog-syslog 2005-12-29 21:54:28 UTC (rev 1795)
@@ -0,0 +1,3 @@
+Oct 1 11:30:56 [amavis] (23837-08) TIMING [total 1101 ms] - SMTP EHLO: 1 (0%), SMTP pre-MAIL: 0 (0%)
+Oct 1 11:30:56 [postfix/smtp] 5FC753D3A6: to=<blabla at fwef>
+Oct 1 11:30:59 [postfix/smtpd] disconnect from x
Added: packages/libparse-syslog-perl/branches/upstream/current/t/metalog.t
===================================================================
--- packages/libparse-syslog-perl/branches/upstream/current/t/metalog.t 2005-12-28 14:26:34 UTC (rev 1794)
+++ packages/libparse-syslog-perl/branches/upstream/current/t/metalog.t 2005-12-29 21:54:28 UTC (rev 1795)
@@ -0,0 +1,32 @@
+use Test;
+use lib "lib";
+BEGIN { plan tests => 4 };
+use Parse::Syslog;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+my $parser = Parse::Syslog->new("t/metalog-syslog", year=>2004, type=>'metalog');
+open(PARSED, "<t/metalog-parsed") or die "can't open t/metalog-parsed: $!\n";
+while(my $sl = $parser->next) {
+ my $is = '';
+ $is .= "time : ".(localtime($sl->{timestamp}))."\n";
+ $is .= "host : $sl->{host}\n";
+ $is .= "program : $sl->{program}\n";
+ $is .= "pid : ".(defined $sl->{pid} ? $sl->{pid} : 'undef')."\n";
+ $is .= "text : $sl->{text}\n";
+ $is .= "\n";
+ print "$is";
+
+ my $shouldbe = '';
+ $shouldbe .= <PARSED>;
+ $shouldbe .= <PARSED>;
+ $shouldbe .= <PARSED>;
+ $shouldbe .= <PARSED>;
+ $shouldbe .= <PARSED>;
+ $shouldbe .= <PARSED>;
+
+ ok($is, $shouldbe);
+}
+
+# vim: set filetype=perl:
More information about the Pkg-perl-cvs-commits
mailing list