← Back to branch summary

~evergreen-bugs/evergreen/rel_3_11

« back to all changes in this revision

Viewing changes to OpenSRF/src/perlmods/OpenSRF/Utils/LogServer.pm

  • Committer: phasefx
  • Date: 2005-02-04 22:08:15 UTC
  • Revision ID: git-v1:940e152e588a9b1c1b4f18cbbecf46691cb2f58c
Initial revision


git-svn-id: svn://svn.open-ils.org/ILS/trunk@2 dcc99617-32d9-48b4-a31d-7c20da2025e4

Show diffs side-by-side

added added

removed removed

Lines of Context:
OpenSRF/src/perlmods/OpenSRF/Utils/LogServer.pm
 
1
package OpenSRF::Utils::LogServer;
 
2
use strict; use warnings;
 
3
use base qw(OpenSRF);
 
4
use IO::Socket::INET;
 
5
use FileHandle;
 
6
use OpenSRF::Utils::Config;
 
7
use Fcntl;
 
8
use Time::HiRes qw(gettimeofday);
 
9
use OpenSRF::Utils::Logger;
 
10
 
 
11
=head2 Name
 
12
 
 
13
OpenSRF::Utils::LogServer
 
14
 
 
15
=cut
 
16
 
 
17
=head2 Synopsis
 
18
 
 
19
Networ Logger
 
20
 
 
21
=cut
 
22
 
 
23
=head2 Description
 
24
 
 
25
 
 
26
=cut
 
27
 
 
28
 
 
29
 
 
30
our $config;
 
31
our $port;
 
32
our $bufsize = 4096;
 
33
our $proto;
 
34
our @file_info;
 
35
 
 
36
 
 
37
sub DESTROY {
 
38
        for my $file (@file_info) {
 
39
                if( $file->handle ) {
 
40
                        close( $file->handle );
 
41
                }
 
42
        }
 
43
}
 
44
 
 
45
 
 
46
sub serve {
 
47
 
 
48
        $config = OpenSRF::Utils::Config->current;
 
49
 
 
50
        unless ($config) { throw OpenSRF::EX::Config ("No suitable config found"); }
 
51
 
 
52
        $port = $config->system->log_port;
 
53
        $proto = $config->system->log_proto;
 
54
 
 
55
 
 
56
        my $server = IO::Socket::INET->new(
 
57
                LocalPort       => $port,
 
58
                Proto                   => $proto )
 
59
        or die "Error creating server socket : $@\n"; 
 
60
 
 
61
 
 
62
 
 
63
        while ( 1 ) {
 
64
                my $client = <$server>;
 
65
                process( $client );
 
66
        }
 
67
 
 
68
        close( $server );
 
69
}
 
70
 
 
71
sub process {
 
72
        my $client = shift;
 
73
        my @params = split(/\|/,$client);
 
74
        my $log = shift @params;
 
75
 
 
76
        if( (!$log) || (!@params) ) {
 
77
                warn "Invalid logging params: $log\n";
 
78
                return;
 
79
        }
 
80
 
 
81
        # Put |'s back in since they are stripped 
 
82
        # from the message by 'split'
 
83
        my $message;
 
84
        if( @params > 1 ) {
 
85
                foreach my $param (@params) {
 
86
                        if( $param ne $params[0] ) {
 
87
                                $message .= "|";
 
88
                        }
 
89
                        $message .= $param;
 
90
                }
 
91
        }
 
92
        else{ $message = "@params"; }
 
93
 
 
94
        my @lines = split( "\n", $message );
 
95
        my $time = format_time();
 
96
 
 
97
        my $fh;
 
98
 
 
99
        my ($f_obj) = grep { $_->name eq $log } @file_info;
 
100
 
 
101
        unless( $f_obj and ($fh=$f_obj->handle) ) {
 
102
                my $file = $config->logs->$log;
 
103
 
 
104
                sysopen( $fh, $file, O_WRONLY|O_APPEND|O_CREAT ) 
 
105
                        or warn "Cannot sysopen $log: $!";
 
106
                $fh->autoflush(1);
 
107
 
 
108
                my $obj = new OpenSRF::Utils::NetLogFile( $log, $file, $fh );
 
109
                push @file_info, $obj;
 
110
        }
 
111
 
 
112
        foreach my $line (@lines) {
 
113
                print $fh "$time $line\n" || die "$!";
 
114
        }
 
115
 
 
116
}
 
117
 
 
118
sub format_time {
 
119
        my ($s, $ms) = gettimeofday();
 
120
        my @time = localtime( $s );
 
121
        $ms = substr( $ms, 0, 3 );
 
122
        my $year = $time[5] + 1900;
 
123
        my $mon = $time[4] + 1;
 
124
        my $day = $time[3];
 
125
        my $hour = $time[2];
 
126
        my $min = $time[1];
 
127
        my $sec = $time[0];
 
128
        $mon = "0" . "$mon" if ( length($mon) == 1 );
 
129
        $day = "0" . "$day" if ( length($day) == 1 );
 
130
        $hour = "0" . "$hour" if ( length($hour) == 1 );
 
131
        $min = "0" . "$min" if (length($min) == 1 );
 
132
        $sec = "0" . "$sec" if (length($sec) == 1 );
 
133
 
 
134
        my $proc = $$;
 
135
        while( length( $proc ) < 5 ) { $proc = "0" . "$proc"; }
 
136
        return "[$year-$mon-$day $hour:$min:$sec.$ms $proc]";
 
137
}
 
138
 
 
139
 
 
140
package OpenSRF::Utils::NetLogFile;
 
141
 
 
142
sub new{ return bless( [ $_[1], $_[2], $_[3] ], $_[0] ); }
 
143
 
 
144
sub name { return $_[0]->[0]; }
 
145
sub file { return $_[0]->[1]; }
 
146
sub handle { return $_[0]->[2]; }
 
147
 
 
148
 
 
149
1;