1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
package Logger::Simple;
{
use strict;
use Carp;
use FileHandle;
use Fcntl qw(:flock);
use Time::HiRes qw/usleep/;
use vars qw /$VERSION $SEM $ms $SEMAPHORE $FILEHANDLE @HISTORY/;
use Object::InsideOut;
$ms=750_000;
$VERSION='2.0';
$SEM = ".LS.lock";
$SEMAPHORE=new FileHandle;
$FILEHANDLE=new FileHandle;
@HISTORY=();
my @Log :Field('Standard'=>'Log','Type'=>'LIST');
my @FileHandle :Field('Standard'=>'FileHandle','Type'=>'SCALAR');
my @Semaphore :Field('Standard'=>'Semaphore','Type'=>'SCALAR');
my @Error :Field('Standard'=>'Error','Type'=>'LIST');
my %init_args :InitArgs=(
'Log'=>{
'Regex' => qr/^Log$/i,
'Mandatory' => 1,
},
);
sub _init :Init{
my($self,$args)= @_;
if(exists($args->{'Log'})){
$self->set(\@Log,$args->{'Log'});
}
$self->set(\@FileHandle,$FILEHANDLE);
$self->set(\@Semaphore,$SEMAPHORE);
$self->open_log;
}
sub open_log{
my $self=shift;
my $FH=$self->get_FileHandle;
my $Log=$self->get_Log;
if(! open($FH,">>$Log")){
$self->write_error("Unable to open logfile\n");
return 0;
}
$FH->autoflush(1);
return 1;
}
sub write{
my($self,$msg)=@_;
my $FH=$self->get_FileHandle;
my $format="$0 : [".scalar (localtime)."] $msg";
## Fix to ignore locking on Win32
if($^O eq "MSWin32"){}else{
$self->lock();
}
if(! print $FH "$format\n"){
croak "Unable to write to log file: $!\n";
}
if($^O eq "MSWin32"){}else{
$self->unlock();
}
$self->update_history($msg);
}
sub update_history{
my($self,$msg)=@_;
push @HISTORY,$msg;
}
sub retrieve_history{
my $self=shift;
if(wantarray){
return @HISTORY;
}else{
my $message=$HISTORY[$#HISTORY];
return $message;
}
}
sub lock{
my $self=shift;
if($^O eq "MSWin32"){ return 1; }
my $SM=$self->get_Semaphore;
open $SM,">$SEM"||die"Can't create lock file: $!\n";
flock($SM,LOCK_EX) or die"Can't obtain file lock: $!\n";
}
sub unlock{
my $self=shift;
my $SM=$self->get_Semaphore;
if(-e $SEM){
flock($SM,LOCK_UN);
close $SM;
$SM->autoflush(1);
if($^O eq "MSWin32"){
system "C:\\Windows\\System32\\cmd.exe \/c del $SEM";
}else{
unlink $SEM;
}
}
}
sub wait{
while(-e $SEM){
usleep $ms;
}
}
sub clear_history{
my $self=shift;
@HISTORY=();
}
}
1;
__END__
=head1 NAME
Logger::Simple - Implementation of the Simran-Log-Log and Simran-Error-Error modules
=head1 SYNOPSIS
use Logger::Simple;
my $log=Logger::Simple->new(LOG=>"/tmp/program.log");
my $x=5;my $y=4;
if($x>$y){
$log->write("\$x is greater than \$y");
}
=head1 DESCRIPTION
=over 5
=item new
C<< my $log=Logger::Simple->new(LOG=>"/tmp/logfile"); >>
The new method creates the Logger::Simple object as an inside-out object. The Log parameter
is a mandatory one that must be passed to the object at creation, or the object will fail.
Upon creation, this method will also call the open_log method which opens the log file.
=item write
C<< $log->write("This is an error message"); >>
This method will write a message to the logfile, and will update the internal
HISTORY array.
=item retrieve_history
C<< my @history = $log->retrieve_history; >>
C<< my $msg = $log->retrieve_history; >>
When called in scalar context, it will return the last message written to the
HISTORY array. When called in a list context, it will return the entire HISTORY
array
=item clear_history
C<< $log->clear_history; >>
This method will clear the internal HISTORY array
=back
=head1 EXPORT
None by default.
=head1 ACKNOWLEDGEMENTS
This module is based on the Simran::Log::Log and Simran::Error::Error
modules. I liked the principle behind them, but felt that the interface
could be a bit better.
My thanks also goes out once again to Damian Conway for Object Oriented Perl,
and also to Sam Tregar, for his book "Writing Perl Modules for CPAN". Both
were invaluable references for me.
I would also like to thank Jerry Heden for his Object::InsideOut module, which
I used to create this module.
=head1 AUTHOR
Thomas Stanley
Thomas_J_Stanley@msn.com
I can also be found on http://www.perlmonks.org as TStanley. You can also
direct any questions concerning this module there as well.
=head1 COPYRIGHT
=begin text
Copyright (C) 2002-2006 Thomas Stanley. All rights reserved. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself.
=end text
=begin html
Copyright E<copy> 2002-2006 Thomas Stanley. All rights reserved. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself.
=end html
=head1 SEE ALSO
perl(1).
Object::InsideOut
Simran::Log::Log
Simran::Error::Error
=cut
|
