Initial revision
[OpenSRF.git] / 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;