r1797 - in packages/libparse-syslog-perl/trunk: . debian lib/Parse t
Joachim Breitner
nomeata at costa.debian.org
Thu Dec 29 21:59:54 UTC 2005
Author: nomeata
Date: 2005-12-29 21:59:52 +0000 (Thu, 29 Dec 2005)
New Revision: 1797
Added:
packages/libparse-syslog-perl/trunk/META.yml
packages/libparse-syslog-perl/trunk/t/dst.t
packages/libparse-syslog-perl/trunk/t/io-stringy.t
packages/libparse-syslog-perl/trunk/t/metalog-parsed
packages/libparse-syslog-perl/trunk/t/metalog-syslog
packages/libparse-syslog-perl/trunk/t/metalog.t
Modified:
packages/libparse-syslog-perl/trunk/Changes
packages/libparse-syslog-perl/trunk/MANIFEST
packages/libparse-syslog-perl/trunk/debian/changelog
packages/libparse-syslog-perl/trunk/lib/Parse/Syslog.pm
packages/libparse-syslog-perl/trunk/t/filetail.t
Log:
new upstream version, build-problems
Modified: packages/libparse-syslog-perl/trunk/Changes
===================================================================
--- packages/libparse-syslog-perl/trunk/Changes 2005-12-29 21:54:35 UTC (rev 1796)
+++ packages/libparse-syslog-perl/trunk/Changes 2005-12-29 21:59:52 UTC (rev 1797)
@@ -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/trunk/MANIFEST
===================================================================
--- packages/libparse-syslog-perl/trunk/MANIFEST 2005-12-29 21:54:35 UTC (rev 1796)
+++ packages/libparse-syslog-perl/trunk/MANIFEST 2005-12-29 21:59:52 UTC (rev 1797)
@@ -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)
Copied: packages/libparse-syslog-perl/trunk/META.yml (from rev 1796, packages/libparse-syslog-perl/branches/upstream/current/META.yml)
Modified: packages/libparse-syslog-perl/trunk/debian/changelog
===================================================================
--- packages/libparse-syslog-perl/trunk/debian/changelog 2005-12-29 21:54:35 UTC (rev 1796)
+++ packages/libparse-syslog-perl/trunk/debian/changelog 2005-12-29 21:59:52 UTC (rev 1797)
@@ -1,3 +1,9 @@
+libparse-syslog-perl (1.05-1) unstable; urgency=low
+
+ * New upstream release (Closes: bug#343237)
+
+ -- Joachim Breitner <nomeata at debian.org> Thu, 29 Dec 2005 22:54:43 +0100
+
libparse-syslog-perl (1.03-1) unstable; urgency=low
* Adopted by Debian Perl Group
Modified: packages/libparse-syslog-perl/trunk/lib/Parse/Syslog.pm
===================================================================
--- packages/libparse-syslog-perl/trunk/lib/Parse/Syslog.pm 2005-12-29 21:54:35 UTC (rev 1796)
+++ packages/libparse-syslog-perl/trunk/lib/Parse/Syslog.pm 2005-12-29 21:59:52 UTC (rev 1797)
@@ -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
Copied: packages/libparse-syslog-perl/trunk/t/dst.t (from rev 1796, packages/libparse-syslog-perl/branches/upstream/current/t/dst.t)
Modified: packages/libparse-syslog-perl/trunk/t/filetail.t
===================================================================
--- packages/libparse-syslog-perl/trunk/t/filetail.t 2005-12-29 21:54:35 UTC (rev 1796)
+++ packages/libparse-syslog-perl/trunk/t/filetail.t 2005-12-29 21:59:52 UTC (rev 1797)
@@ -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;
};
Copied: packages/libparse-syslog-perl/trunk/t/io-stringy.t (from rev 1796, packages/libparse-syslog-perl/branches/upstream/current/t/io-stringy.t)
Copied: packages/libparse-syslog-perl/trunk/t/metalog-parsed (from rev 1796, packages/libparse-syslog-perl/branches/upstream/current/t/metalog-parsed)
Copied: packages/libparse-syslog-perl/trunk/t/metalog-syslog (from rev 1796, packages/libparse-syslog-perl/branches/upstream/current/t/metalog-syslog)
Copied: packages/libparse-syslog-perl/trunk/t/metalog.t (from rev 1796, packages/libparse-syslog-perl/branches/upstream/current/t/metalog.t)
More information about the Pkg-perl-cvs-commits
mailing list