File Coverage

blib/lib/Logfile/SFgate.pm
Criterion Covered Total %
statement 30 30 100.0
branch 11 12 91.6
condition n/a
subroutine 4 4 100.0
pod 0 2 0.0
total 45 48 93.7


line stmt bran cond sub pod time code
1             # -*- Mode: Perl -*-
2             # SFgate.pm --
3             # ITIID : $ITI$ $Header $__Header$
4             # Author : Ulrich Pfeifer
5             # Created On : Mon Mar 25 09:59:37 1996
6             # Last Modified By: Ulrich Pfeifer
7             # Last Modified On: Fri Jun 12 10:09:26 1998
8             # Language : Perl
9             # Update Count : 35
10             # Status : Unknown, Use with caution!
11             #
12             # (C) Copyright 1996, Universität Dortmund, all rights reserved.
13             #
14             # $Locker: pfeifer $
15             # $Log: SFgate.pm,v $
16             # Revision 0.1.1.1 1996/04/01 09:36:21 pfeifer
17             # patch8: New. Only extracts databases currently.
18             #
19              
20             package Logfile::SFgate;
21             require Logfile::Base;
22 1     1   547 use strict;
  1         1  
  1         33  
23 1     1   5 use vars qw(@ISA);
  1         1  
  1         418  
24              
25             @ISA = qw ( Logfile::Base ) ;
26              
27              
28             sub next {
29 20     20 0 21 my $self = shift;
30 20         41 my $fh = $self->{Fh};
31 20         22 my ($date, $Hour, @Databases, $Queries);
32 20 50       39 unless (@Databases) {
33 20         39 *S = $fh;
34 20         21 LINE: while (1) {
35 38 100       69 return undef if (eof(S));
36 37         183 my $line = ;
37 37         62 $date = substr($line,0,14);
38 37         135 ($Hour) = ($line =~ /\s(\d\d):\d\d/);
39 37 100       83 next LINE if length($line) < 24;
40 36         123 my ($pid, $host, $request) = split ' ', substr($line,24);
41 36         50 my $field;
42 36         85 for $field (split /\&/, $request) {
43 196         387 my ($field, $value) = split /=/, $field;
44 196 100       410 if ($field eq 'database') {
45 21         35 push (@Databases, $value);
46             }
47             }
48 36 100       116 last LINE if @Databases;
49             }
50 19         30 $Queries = 1/@Databases;
51            
52             }
53 19         98 Logfile::Base::Record->new(Database => shift @Databases,
54             Queries => $Queries,
55             Date => $date,
56             Hour => $Hour,
57             );
58             }
59              
60             sub norm {
61 57     57 0 83 my ($self, $key, $val) = @_;
62              
63 57 100       99 if ($key eq 'Database') {
64 19         68 (split '/', $val)[-1];
65             } else {
66 38         102 $val;
67             }
68             }
69              
70             1;