1 |
## ------------------------------------------------------------------------- |
2 |
## $Id: Sync.pm,v 1.16 2003/02/09 04:56:03 joko Exp $ |
3 |
## Copyright (c) 2003 Andreas Motl <andreas.motl@ilo.de> |
4 |
## This library is free software. You can redistribute it and/or modify it |
5 |
## under the same terms as Perl itself. |
6 |
## ------------------------------------------------------------------------- |
7 |
## $Log: Sync.pm,v $ |
8 |
## ------------------------------------------------------------------------- |
9 |
|
10 |
|
11 |
package Log::Report; |
12 |
|
13 |
use strict; |
14 |
use warnings; |
15 |
|
16 |
use base qw( Class::Smart ); |
17 |
|
18 |
=pod |
19 |
|
20 |
=head1 Todo |
21 |
|
22 |
o some methods encapsulating output |
23 |
o output to: |
24 |
x Data::Dumper format |
25 |
o plain text |
26 |
o some xml with defined/configurable dtd/schema |
27 |
o look at Term::Report and PDF::Report or similar |
28 |
|
29 |
=cut |
30 |
|
31 |
|
32 |
use Data::Dumper; |
33 |
use Tie::IxHash; |
34 |
use shortcuts qw( now ); |
35 |
use shortcuts::files qw( s2f ); |
36 |
|
37 |
# Incorporate core of "->toXml" into Data::Storage::Handler::XML. |
38 |
#use XML::Simple; |
39 |
#use XML::Writer; |
40 |
use XML::Dumper; |
41 |
|
42 |
# package global to count calls per instantiation / lifetime to make filename more unique |
43 |
my $closecount = 0; |
44 |
|
45 |
|
46 |
sub _init { |
47 |
my $self = shift; |
48 |
return if $self->{_INITIALIZED}; |
49 |
$self->{_INITIALIZED}++; |
50 |
$self->{data} = { |
51 |
request => [], |
52 |
response => [], |
53 |
statistics => [], |
54 |
}; |
55 |
} |
56 |
|
57 |
sub add_statistics { |
58 |
my $self = shift; |
59 |
#my $data = \@_; |
60 |
#$self->{data}->{statistics} ||= []; |
61 |
$self->_init(); |
62 |
push @{$self->{data}->{statistics}}, @_; |
63 |
} |
64 |
|
65 |
sub add_result { |
66 |
my $self = shift; |
67 |
#my $data = \@_; |
68 |
#$self->{data}->{response} ||= []; |
69 |
$self->_init(); |
70 |
push @{$self->{data}->{response}}, @_; |
71 |
} |
72 |
|
73 |
sub add_question { |
74 |
my $self = shift; |
75 |
#my $data = \@_; |
76 |
#$self->{data}->{request} ||= []; |
77 |
$self->_init(); |
78 |
push @{$self->{data}->{request}}, @_; |
79 |
} |
80 |
|
81 |
sub get { |
82 |
my $self = shift; |
83 |
return $self->{data}; |
84 |
} |
85 |
|
86 |
sub set { |
87 |
my $self = shift; |
88 |
$self->{data} = shift; |
89 |
} |
90 |
|
91 |
sub clear { |
92 |
my $self = shift; |
93 |
# Clear / reset buffer. |
94 |
$self->set(undef); |
95 |
} |
96 |
|
97 |
sub toDumper { |
98 |
my $self = shift; |
99 |
return Dumper($self->get()); |
100 |
} |
101 |
|
102 |
sub toXml { |
103 |
my $self = shift; |
104 |
# FIXME: This writes a msg to STDERR if undef is included inside the output data structure. |
105 |
|
106 |
# hash2xml for quick report generation purposes |
107 |
# Incorporate core functionality (essence of this) into Data::Storage::Handler::XML. |
108 |
|
109 |
# V1 - via expand and XML::Simple |
110 |
#use Data::Mungle::Transform::Deep qw( expand ); |
111 |
#my $exp = expand($self->get(), { define => 1 }); |
112 |
#print Dumper($exp); |
113 |
|
114 |
#delete *STDERR; |
115 |
#*STDERR = 0; |
116 |
#print Dumper($self->get()); |
117 |
#my $xml = XMLout( $self->get(), rootname => "report" ); |
118 |
#*STDERR = *STDOUT; |
119 |
|
120 |
=pod |
121 |
# V2 - via XML::Writer |
122 |
my $writer = XML::Writer->new(); |
123 |
$writer->xmlDecl("ISO-8859-1"); |
124 |
$writer->comment("Report generated on " . now() . "."); |
125 |
$writer->startTag("report"); |
126 |
#$writer->characters(); |
127 |
$writer->endTag("report"); |
128 |
$writer->end(); |
129 |
#$writer->close(); |
130 |
=cut |
131 |
|
132 |
# V3 - via XML::Dumper |
133 |
my $dumper = XML::Dumper->new(); |
134 |
my $xml = $dumper->pl2xml($self->get()); |
135 |
|
136 |
return $xml; |
137 |
} |
138 |
|
139 |
sub close { |
140 |
my $self = shift; |
141 |
|
142 |
$closecount++; |
143 |
|
144 |
# Determine which output to generate. |
145 |
my $content; |
146 |
if ($self->{xml}) { |
147 |
$content = $self->toXml(); |
148 |
} |
149 |
|
150 |
#print STDOUT $content, "\n"; |
151 |
|
152 |
# Write to file if attribute "name" and "basedir" is set. |
153 |
if ($self->{name} && $self->{basedir}) { |
154 |
my $stamp = now({ fs => 1 }); |
155 |
my $filename = $self->{basedir} . "/" . $self->{name} . "_" . $stamp . "_" . $closecount . ".xml"; |
156 |
s2f($filename, $content); |
157 |
} |
158 |
|
159 |
# Clear / reset buffer. |
160 |
$self->clear(); |
161 |
} |
162 |
|
163 |
1; |
164 |
|
165 |
__END__ |