File Coverage

blib/lib/Logfile/Cern.pm

Criterion	Covered	Total	%
statement	13	27	48.1
branch	5	20	25.0
condition			n/a
subroutine	1	2	50.0
pod	0	2	0.0
total	19	51	37.2

#!/usr/local/ls6/bin/perl
#                              -*- Mode: Perl -*-
# Cern.pm --
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Mon Mar 25 09:59:37 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Thu May 23 15:09:04 1996
# Language        : Perl
# Update Count    : 11
# Status          : Unknown, Use with caution!
#
# (C) Copyright 1996, Universität Dortmund, all rights reserved.
#
# $Locker: pfeifer $
# $Log: Cern.pm,v $
# Revision 0.1.1.4  1997/01/20 09:07:30  pfeifer
# patch15: -w fix by Hugo van der Sanden.
#
# Revision 0.1.1.3  1996/05/23 14:16:28  pfeifer
# patch11: Removed site specific stuff. Added limit to level 3 for urls.
#
# Revision 0.1.1.2  1996/03/27 14:41:35  pfeifer
# patch6: Renamed Tools::Logfile to Logfile.
#
# Revision 0.1.1.1  1996/03/26 13:50:04  pfeifer
# patch2: Renamed module to Logfile and Logfile.pm to
# patch2: Logfile/Base.pm
#
# Revision 0.1  1996/03/25 10:52:16  pfeifer
# First public version.
#
#

package Logfile::Cern;
require Logfile::Base;

@ISA = qw ( Logfile::Base ) ;

sub next {
    my $self = shift;
    my $fh = $self->{Fh};

    *S = $fh;
    my ($line,$host,$user,$pass,$rest,$date,$req,$code,$bytes);
    while (defined ($line = )) {
        ($host,$user,$pass,$rest) = split ' ', $line, 4;
        next unless $rest;
        ($rest =~ s!\[([^\]]+)\]\s*!!) && ($date = $1);
        ($rest =~ s!\"([^\"]+)\"\s*!!) && ($req = (split ' ', $1)[1]);
        ($code, $bytes) = split ' ', $rest;
        last if $date;
    }
    return undef unless $date;
    # print "($host,$user,$pass,$date,$req,$code,$bytes)\n";
    #print $line unless $req;
    Logfile::Base::Record->new(Host  => $host,
                          Date  => $date,
                          File  => $req,
                          Bytes => $bytes,
                          );
}

sub norm {
    my ($self, $key, $val) = @_;

    if ($key eq File) {
        $val =~ s/\?.*//;           # remove that !!!
        $val = '/' unless $val;
        $val =~ s/\.\w+$//;
        $val =~ s!%([\da-f][\da-f])!chr(hex($1))!eig;
        $val =~ s!~(\w+)/.*!~$1!;
        # proxy
        $val =~ s!^((http|ftp|wais)://[^/]+)/.*!$1!;
        # confine to depth 3
        my @val = split /\//, $val;
        $#val = 2 if $#val > 2;
        #printf STDERR "$val => %s\n", join('/', @val) || '/';
        join('/', @val) || '/';
    } elsif ($key eq Bytes) {
        $val =~ s/\D.*//;
    } else {
        $val;
    }
}

1;