Pm/Logger.pm
Copying Source is Forbidden
200 lines of code
1
package Logger;
2
3
#/
4
# a module to "log" things with
5
#/
6
7
use strict;
8
use warnings;
9
use CGI::Carp qw(fatalsToBrowser);
10
use Exporter;
11
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT);
12
use CGI;
13
14
$VERSION = 1.00;
15
@ISA = qw(Exporter);
16
17
@EXPORT = qw(
18
logadd
19
logretrieve
20
);
21
22
@EXPORT_OK = qw(
23
_tests
24
25
logadd
26
logdel
27
loglist
28
logretrieve
29
logwipe
30
);
31
32
##########################
33
34
use lib "./Pm";
35
36
##########################
37
38
my $DEBUG = 1;
39
40
########################
41
sub logadd($) {
42
#*
43
# adds a log entry
44
#
45
# hash keys are:
46
# ID, desc, doe, type, uri, uid,
47
# action_taken, action_taken_by_uid
48
# action_taken_date
49
#
50
# more keys MAY be added in the future
51
#*
52
my ($hashRef) = @_; # a reference to a hash
53
my $rv = 1; # assume it works
54
55
# validate the data
56
# ensure desc and type exist!
57
if (ref $hashRef eq "HASH") {
58
if ($hashRef->{desc} and
59
$hashRef->{type}) {
60
# insert the data to the log
61
$hashRef->{ID} = new_id(16);
62
$hashRef->{doe} = get_today("db");
63
my $sql = "insert into log values (";
64
$sql .= $Bc_sql::DB->quote($hashRef->{ID}) . ", ";
65
$sql .= $Bc_sql::DB->quote($hashRef->{desc}) . ", ";
66
$sql .= $Bc_sql::DB->quote($hashRef->{doe}) . ", ";
67
$sql .= $Bc_sql::DB->quote($hashRef->{type}) . ", ";
68
$sql .= $Bc_sql::DB->quote($hashRef->{uri}) . ", ";
69
$sql .= $Bc_sql::DB->quote($hashRef->{uid});
70
$sql .= ")";
71
72
if (not sql_execute($sql, "logadd")) {
73
$rv = -3; # failed to insert
74
}
75
} else {
76
$rv = -2; # supplied data is invalid
77
}
78
} else {
79
$rv = -1; # data is not a hash reference
80
}
81
82
return $rv; # 1 on success, or 0 (or less) on failure
83
#usage: my $val = logadd($hashedDataRef);
84
}
85
86
########################
87
sub logretrieve($) {
88
#*
89
# retrieves a log entry
90
#*
91
my ($id) = @_; # an ID to a log entry
92
my $sql = "select * from log where ID = " . $Bc_sql::DB->quote($id);
93
my $rv = sql_execute($sql, "logretrieve");
94
95
if (ref $rv ne "HASH") { $rv = 0; }
96
97
return $rv; # a hash reference, or 0 if log entry not found
98
#usage: my $logDataRef = logretrieve($id);
99
}
100
101
########################
102
sub logdel($) {
103
#*
104
# deletes a log entry
105
#*
106
my ($id) = @_; # an ID to a log entry
107
my $rv = 1; # assume success
108
my $sql = "delete from log where ID = " . $Bc_sql::DB->quote($id);
109
if (not sql_execute($sql, "logdel")) { $rv = 0; }
110
111
return $rv; # 1 on success, or 0 on failure
112
#usage: my $val = logdel($someval);
113
}
114
115
########################
116
sub logwipe() {
117
#*
118
# wipes all logged data
119
#*
120
#@_; # (no parameters)
121
my $rv = 1; # assume success
122
my $sql = "delete from log";
123
if (not sql_execute($sql, "logwipe")) { $rv = 0; }
124
125
return $rv; # 1 on success, or 0 on failure
126
#usage: my $val = logwipe();
127
}
128
129
########################
130
sub loglist() {
131
#*
132
# retrieves a list (an array) of log entry ID's
133
#*
134
#@_; # (no parameters)
135
my @arr = ();
136
137
my $sql = "select ID from log";
138
my $rv = sql_execute($sql, "loglist");
139
140
if (ref $rv eq "ARRAY") {
141
foreach my $elem (@$rv) { push @arr, $elem->{ID}; }
142
} elsif (ref $rv eq "HASH") {
143
push @arr, $rv->{ID};
144
}
145
146
return \@arr; # an array reference (can be empty)
147
#usage: my $logDataRef = loglist();
148
}
149
150
########################
151
sub _tests(;$) {
152
#*
153
# to test all <i>Pm::Logger</i> functions
154
#*
155
my ($extended) = @_; # show extended data (optional)
156
my $rv = "";
157
my %hash;
158
$hash{type} = "test entry";
159
$hash{desc} = "testing addlog(...)";
160
$rv .= "adding test entry to logger<br>\n";
161
$rv .= " $hash{type}<br>\n";
162
$rv .= " $hash{desc}<br>\n";
163
164
return $rv; # overrides tests
165
166
my $test = logadd(\%hash);
167
if ($test > 0) {
168
$rv .= "log entry added! ($test)<br>\n";
169
$test = loglist();
170
171
if (ref $test eq "ARRAY") {
172
if (@$test) {
173
$rv .= "found one or more log entries:<br>\n";
174
foreach my $elem (@$test) {
175
$rv .= " $elem<br>\n";
176
}
177
178
$rv .= "<br>\n";
179
$rv .= "showing data for first entry:<br>\n";
180
my $test2 = logretrieve(@$test[0]);
181
foreach my $key (sort keys %$test2) {
182
$rv .= " $key = $test2->{$key}<br>\n";
183
}
184
} else {
185
$rv .= "no log entries found<br>\n";
186
}
187
188
$rv .= "<br><br>\n";
189
} else {
190
$rv .= "not an array ref??<br>\n";
191
}
192
} else {
193
$rv .= "log entry not added!<br>\n";
194
}
195
196
return $rv; # 0 on failure, or a scalar
197
#usage: print _tests();
198
}
199
200
1;