xnd has asked for the wisdom of the Perl Monks concerning the following question:

Hello all!

I have a file named "users.ini" wich contains lines like this:

name1:password:accesslevel
name2:password:accesslevel etc

and a directory with logs like this: L0328000.log, L0328001.log, L0328002.log etc.

So what i need is a perl script that takes name1 from users.ini, searches it in all the logs and then prints the last time that name connected. Then takes name2, does the same thing and so on. And then, sorts the lines by date and writes them in a html or txt file.. doesn't really matter.

Oh, and the logs contain lines like this:
L 03/30/2006 - 11:59:17: "name1<62><STEAM_ID_LAN><>" connected, address "192.168.1.1:27005"
And this is the code i have so far but it doesn't work properly:
#!/usr/bin/perl -w
use Env;

$LOGDIR="/hlds/cstrike/logs";
$USERS="/hlds/cstrike/addons/adminmod/config/users.ini";

$search='\bconnected, address\b' ;


open USERS, "<$USERS" or die "cannot open $USERS:$!";

while (<USERS>) {
        chomp;
        push @users,  ((split /:/)[0]);
}
print "search:@users\n";



@ARGV = <$LOGDIR/*.log> ;
while (<ARGV>) {
        next unless /$search/o;
        s/L//;
        s/<.*>//;
        s/$search//o;
        s/ /:/;
        s/ - /-/;
        #print;
        my $nm = name_match( (split)[1]);
        next unless $nm;
        # print "$nm=>$_" if $nm;
        my ($time, $name, $addy) = split;
        my $stamp = fix_time ($time);
        #print "[$stamp]\n";

        my $rec = "$stamp $time $name";

        if (exists $R{$nm}) {
               my $t = (split " ", $R{$nm})[0];
               # print "if ( $stamp < $t ) \n";
               if ( $stamp < $t ) {
                 $R{$nm} = $rec;
               }
        } else {
                $R{$nm} = $rec;
        }

}
print "--------------------------\n";
@values = sort values %R;
foreach $v (@values) {
        print STDOUT (split /:/, $v, 2)[1];
        print "\n";
}

# compare names, log names may have attributes; like
sub name_match {
        my $nm = shift;
        $nm =~ tr/"//d;

        foreach $user (@users) {
                return $user if $nm =~ /$user/;
        }
        return "";
}

# convert time from  'L: MM/DD/YYYY - hh:mm:ss' to YYYYMMDDhhmmss
# which makes time comparison a doddle
sub fix_time {
        local $_ = shift;
        s/.//;
        tr/://d;
        my($date, $time) = split /-/;
        my ($m, $d, $y) = split "/", $date;

        return "$y$m$d$time";
}

[download]

Any help would be very much apreciated. Thank you!

Replies are listed 'Best First'.
Re: A pretty simple perl script..
by GrandFather (Saint) on Mar 30, 2006 at 21:46 UTC

    Most likely your basic problem is if ( $stamp < $t ) { which finds the oldest login time for each user.

    A somewhat cleaned up test version of your code that doesn't require external files is offered below:

    use strict;
use warnings;

my $search='\bconnected, address\b' ;
my @users = qw(name1 name2);
my %R;

print "search: @users\n";

while (<DATA>) {
    next unless /$search/o;
    s/L /:/;
    s/<.*>//;
    s/$search//o;
    s/ - /-/;

    my ($time, $name, $addy) = split;
    my $cleanName = name_match ($name);
    next unless $cleanName;

    my $nTime = fix_time ($time);
    my $rec = "$nTime $time $name";

    if (! exists $R{$cleanName}) {
        $R{$cleanName} = $rec;
        next;
    }

    my ($t) = $R{$cleanName} =~ /^(\d+)/;
    $R{$cleanName} = $rec if $nTime > $t;
}

print "--------------------------\n";
my @values = sort values %R;
foreach my $v (@values) {
    print STDOUT (split /:/, $v, 2)[1];
    print "\n";
}

# compare names, log names may have attributes; like
sub name_match {
    my $cleanName = shift;
    $cleanName =~ tr/"//d;

    foreach my $user (@users) {
        return $user if $cleanName =~ /$user/;
    }

    return "";
}

# convert time from  'L: MM/DD/YYYY - hh:mm:ss' to YYYYMMDDhhmmss
# which makes time comparison a doddle
sub fix_time {
        local $_ = shift;
        s/.//;
        tr/://d;
        my($date, $time) = split /-/;
        my ($m, $d, $y) = split "/", $date;

        return "$y$m$d$time";
}

__DATA__
L 03/30/2006 - 11:59:17: "name1" connected, address "192.168.1.1:27005
+"
L 03/30/2006 - 11:59:18: "name3" connected, address "192.168.1.1:27005
+"
L 03/30/2006 - 12:29:17: "name2" connected, address "192.168.1.1:27005
+"
L 03/30/2006 - 12:30:17: "name1" connected, address "192.168.1.1:27005
+"
L 03/30/2006 - 12:45:17: "name4" connected, address "192.168.1.1:27005
+"

    [download]

    Prints:

    search: name1 name2
--------------------------
03/30/2006-12:29:17: "name2"
03/30/2006-12:30:17: "name1"

    [download]
    DWIM is Perl's answer to Gödel
[reply]
[d/l]
[select]
      "doesn't work properly" = it showes some names last connected two weeks or something like that but i know for sure that those names last connected yesterday and even today.

      anyway, i forgot to mention something. let's say that name1 decides to join the server using nickname "PERL - name1". He is still recognised by the server as an admin and i would like the script to do the same
      Here is some data: 

      L 03/31/2006 - 00:18:19: "smilE :) x3Oni<109><STEAM_ID_LAN><>" connect
+ed, address "82.78.68.195:27005"
L 03/31/2006 - 00:19:40: "smilE :) Ramon<110><VALVE_ID_LAN><>" connect
+ed, address "86.55.92.11:27005"
L 03/31/2006 - 00:23:06: "smilE :) Ramon<111><VALVE_ID_LAN><>" connect
+ed, address "86.55.92.11:27005"
L 03/31/2006 - 00:33:50: "smilE :) Ramon<112><VALVE_ID_LAN><>" connect
+ed, address "86.55.92.11:27005"
L 03/31/2006 - 00:35:09: "mT - Loly<113><STEAM_ID_LAN><>" connected, a
+ddress "81.24.24.209:27005"
L 03/31/2006 - 00:35:31: "mT - Mini^Me<114><STEAM_ID_LAN><>" connected
+, address "81.196.153.50:27005"
L 03/31/2006 - 00:36:42: "mT - Grasutza<115><STEAM_ID_LAN><>" connecte
+d, address "81.24.24.207:27005"
L 03/31/2006 - 00:38:05: "rrr<116><VALVE_ID_LAN><>" connected, address
+ "82.208.167.71:27005"
L 03/31/2006 - 00:38:35: "rrr<117><VALVE_ID_LAN><>" connected, address
+ "82.208.167.71:27005"
L 03/31/2006 - 00:41:03: "mT - kdt<118><STEAM_ID_LAN><>" connected, ad
+dress "82.76.231.13:27005"
L 03/31/2006 - 01:18:03: "smilE :) x3Oni<119><STEAM_ID_LAN><>" connect
+ed, address "82.78.68.195:27005"
L 03/31/2006 - 01:28:18: "astralis[mix] . bullet[A]<120><VALVE_ID_LAN>
+<>" connected, address "86.106.193.40:27005"
L 03/31/2006 - 01:28:43: "astralis[mix] . BNj-_-<121><STEAM_ID_LAN><>"
+ connected, address "81.24.24.227:27005"
L 03/31/2006 - 01:30:10: "astralis[mix] . sUIFTI-_^<122><VALVE_ID_LAN>
+<>" connected, address "84.247.25.70:27005"
L 03/31/2006 - 01:31:30: "astralis[mix] . AD0n<123><STEAM_ID_LAN><>" c
+onnected, address "85.120.80.131:27005"

      [download]


      and users.ini:
      x30ni:password:131071
Ramon:password:131071
Loly:password:131071
Mini:password:131071
Grasutza:password:131071
bullet:password:131071
Ad0n:password:131071

      [download]
[reply]
[d/l]
[select]

        Sample code using the data you provided. Note that the required parameters are being extracted using a regex rather than split and that the name search code now uses index rather than a regex.

        use strict;
use warnings;

my $search='\bconnected, address\b' ;
my @users = qw(x3Oni Ramon Loly Mini Grasutza bullet Ad0n);

my %R;

print "search: @users\n";

while (<DATA>) {
    next unless /$search/o;
    s/L /:/;
    s/<.*>//;
    s/$search//o;
    s/ - /-/;

    my ($time, $name, $addy) = m!([-\d/:]*)\s*"([^"]*)"[^"]*"([^"]*)!;
    my $cleanName = name_match ($name);
    next unless $cleanName;

    my $nTime = fix_time ($time);
    my $rec = "$nTime $time $name";

    if (! exists $R{$cleanName}) {
        $R{$cleanName} = $rec;
        next;
    }

    my ($t) = $R{$cleanName} =~ /^(\d+)/;
    $R{$cleanName} = $rec if $nTime > $t;
}

print "--------------------------\n";
my @values = sort values %R;
foreach my $v (@values) {
    print STDOUT (split /:/, $v, 2)[1];
    print "\n";
}

# compare names, log names may have attributes; like
sub name_match {
    my $test = shift;
    $test =~ tr/"//d;

    for (@users) {
        my $pos = length ($test) - length;
        my $at = index ($test, $_);
        return $_ if $pos == $at;
    }

    return "";
}

# convert time from  'L: MM/DD/YYYY - hh:mm:ss' to YYYYMMDDhhmmss
# which makes time comparison a doddle
sub fix_time {
        local $_ = shift;
        s/.//;
        tr/://d;
        my($date, $time) = split /-/;
        my ($m, $d, $y) = split "/", $date;

        return "$y$m$d$time";
}

__DATA__
L 03/31/2006 - 00:18:19: "smilE :) x3Oni<109><STEAM_ID_LAN><>" connect
+ed, address "82.78.68.195:27005"
L 03/31/2006 - 00:19:40: "smilE :) Ramon<110><VALVE_ID_LAN><>" connect
+ed, address "86.55.92.11:27005"
L 03/31/2006 - 00:23:06: "smilE :) Ramon<111><VALVE_ID_LAN><>" connect
+ed, address "86.55.92.11:27005"
L 03/31/2006 - 00:33:50: "smilE :) Ramon<112><VALVE_ID_LAN><>" connect
+ed, address "86.55.92.11:27005"
L 03/31/2006 - 00:35:09: "mT - Loly<113><STEAM_ID_LAN><>" connected, a
+ddress "81.24.24.209:27005"
L 03/31/2006 - 00:35:31: "mT - Mini^Me<114><STEAM_ID_LAN><>" connected
+, address "81.196.153.50:27005"
L 03/31/2006 - 00:36:42: "mT - Grasutza<115><STEAM_ID_LAN><>" connecte
+d, address "81.24.24.207:27005"
L 03/31/2006 - 00:38:05: "rrr<116><VALVE_ID_LAN><>" connected, address
+ "82.208.167.71:27005"
L 03/31/2006 - 00:38:35: "rrr<117><VALVE_ID_LAN><>" connected, address
+ "82.208.167.71:27005"
L 03/31/2006 - 00:41:03: "mT - kdt<118><STEAM_ID_LAN><>" connected, ad
+dress "82.76.231.13:27005"
L 03/31/2006 - 01:18:03: "smilE :) x3Oni<119><STEAM_ID_LAN><>" connect
+ed, address "82.78.68.195:27005"
L 03/31/2006 - 01:28:18: "astralis[mix] . bullet[A]<120><VALVE_ID_LAN>
+<>" connected, address "86.106.193.40:27005"
L 03/31/2006 - 01:28:43: "astralis[mix] . BNj-_-<121><STEAM_ID_LAN><>"
+ connected, address "81.24.24.227:27005"
L 03/31/2006 - 01:30:10: "astralis[mix] . sUIFTI-_^<122><VALVE_ID_LAN>
+<>" connected, address "84.247.25.70:27005"
L 03/31/2006 - 01:31:30: "astralis[mix] . AD0n<123><STEAM_ID_LAN><>" c
+onnected, address "85.120.80.131:27005"

        [download]

        Prints:

        search: x3Oni Ramon Loly Mini Grasutza bullet Ad0n
--------------------------
03/31/2006-00:33:50: smilE :) Ramon
03/31/2006-00:36:42: mT - Grasutza
03/31/2006-00:38:35: rrr
03/31/2006-01:18:03: smilE :) x3Oni

        [download]

        I'm sure you understand now that you can replace the <DATA> with <FileHandleOfYourChoice> and that the contents of the users array can be filled from an external file too.

        DWIM is Perl's answer to Gödel
[reply]
[d/l]
[select]
Re: A pretty simple perl script..
by wedgef5 (Scribe) on Mar 30, 2006 at 21:40 UTC
    I'm far from an expert, but I see lots of problems here. First, it'd be helpful if you were to tell us how the code is failing, not just that it's failing. Are you getting an error or just incorrect output?

    @ARGV = <$LOGDIR/*.log>;

    [download]
    Not sure why you're putting your file globbing results in @ARGV. The preferable way is to use the glob function. Personally, I'd do something like... 
    my @fileList = glob($LOGDIR/*.log);
while (@fileList) {
...
}

    [download]

    s/L//;

    [download]
    Are you sure you want to remove all 'L's? What if someone's name has an 'L' in it? How about...
    s/^L\s+//;

    You should always try to use strict too.

    I hope I don't come across as overly harsh, but this script needs some cleaning up. There are many more issues. These are a few that jumped out at me right away.

[reply]
[d/l]
[select]

      Actually the code only removes the first 'L' on the line. A /g flag is required to remove them all.

      DWIM is Perl's answer to Gödel
[reply]
Re: A pretty simple perl script..
by zshzn (Hermit) on Mar 30, 2006 at 21:37 UTC
    It would be nice to know how exactly it doesn't work properly. Being that I may not have such logs to test on. Additionally there are a number of things anyone could point out that could potentially be issues, but without a knowledge of what happens I'm not brave enough to predict. If nothing else, I'll suggest cleaner code with strict and lexical filehandles, and watch out for weak regex.
[reply]
Re: A pretty simple perl script..
by Anonymous Monk on Mar 31, 2006 at 00:28 UTC
    You wanted simple so this may give you some ideas: 
    #!/usr/bin/perl
use warnings;
use strict;


my $LOGDIR = '/hlds/cstrike/logs';
my $USERS  = '/hlds/cstrike/addons/adminmod/config/users.ini';

my $search = qr/\bconnected, address\b/;


my @users = do {
    open my $U, $USERS or die "cannot open $USERS:$!";
    local $/;
    <$U> =~ /^[^:]+/mg;
    };

print "search:@users\n";

my $user_pattern = qr/\b(@{[
    join '|', map "\Q$_", reverse sort @users
    ]})\b/;

my %R;
@ARGV = <$LOGDIR/*.log>;
while ( <> ) {
    next unless /
        (\d\d)\D+(\d\d)\D+(\d{4})\D+(\d\d)\D+(\d\d)\D+(\d\d):
        .+?
        $user_pattern
        .+?
        $search
        /x;
    @{ $R{ $7 } }{ qw/date line/ } = ( "$3$1$2$4$5$6", $_ )
        if not exists $R{ $7 }{ date }
            or $R{ $7 }{ date } lt "$3$1$2$4$5$6";
    }


print "--------------------------\n",
    sort map $_->{ line },
    values %R;

__END__

    [download]
[reply]
[d/l]
      Thank you for your reply!
      When i run that code, it prints search: names to search and that's all. It doesn't print anything else :|
      Thanks!
[reply]
        When I tested it on the data that you provided it printed all the lines that matched the user names.
[reply]
Re: A pretty simple perl script..
by xnd (Initiate) on Mar 30, 2006 at 23:33 UTC
    Thanks GrandFather!
    But i need it to use external files because logs dir is 1.8GB in size and users.ini has 190 entries. i can't manually add each one of them..

    Any other way i can make it to work?
    Thank you!
[reply]

      He wasn't advocating putting all the data in your script. It is easier to test scripts with the data embeded. Then when you are sure its working right, then connect to the actual data file instead.


      ___________
      Eric Hodges
[reply]

Back to Seekers of Perl Wisdom