/[cvs]/nfo/perl/libs/Data/Storage/Handler/XML.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Data/Storage/Handler/XML.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Fri Jun 6 03:58:13 2003 UTC (21 years, 1 month ago) by joko
Branch: MAIN
Changes since 1.3: +13 -4 lines
minor updates to logging

1 joko 1.1 ## ------------------------------------------------------------------------
2 joko 1.4 ## $Id: XML.pm,v 1.3 2003/05/13 08:08:17 joko Exp $
3 joko 1.1 ## ------------------------------------------------------------------------
4 joko 1.2 ## $Log: XML.pm,v $
5 joko 1.4 ## Revision 1.3 2003/05/13 08:08:17 joko
6     ## comments, todos
7     ##
8 joko 1.3 ## Revision 1.2 2003/02/21 07:58:48 joko
9     ## enhanced error detection
10     ##
11 joko 1.2 ## Revision 1.1 2003/02/20 20:20:54 joko
12     ## + initial commit
13     ##
14 joko 1.1 ## ------------------------------------------------------------------------
15    
16    
17     package Data::Storage::Handler::XML;
18    
19     use strict;
20     use warnings;
21    
22     use base qw(
23     DesignPattern::Object
24     DesignPattern::Logger
25     );
26    
27    
28     use Data::Dumper;
29     #use Data::Storage::Handler::File::Basic qw( s2f a2f f2s );
30     use XML::Simple;
31     use XML::Parser;
32     use XML::Parser::EasyTree;
33     use XML::XPath;
34 joko 1.3 # TODO: use XML::Writer and/or XML::ValidWriter
35 joko 1.1
36 joko 1.4
37     # get logger instance
38     my $logger = Log::Dispatch::Config->instance;
39    
40 joko 1.1 sub sendQuery {
41     my $self = shift;
42     my $xpq = shift;
43     my $options = shift;
44    
45 joko 1.2 $self->log( "xpq='$xpq'", 'debug' );
46 joko 1.1
47     # trace
48     #print Dumper($self);
49     #exit;
50    
51     my $file = $self->{filename};
52 joko 1.2
53     if (!$file) {
54 joko 1.4 $logger->error("No filename given.");
55 joko 1.2 return;
56     }
57 joko 1.1
58     if (! -e $file) {
59 joko 1.4 $logger->error("File not found: '$file'.");
60 joko 1.1 return;
61     }
62    
63     #print "file: $file", "\n";
64     #print "xpq: $xpq", "\n";
65 joko 1.4
66     $logger->info( __PACKAGE__ . "->sendQuery - File: $file, xpq: $xpq");
67    
68 joko 1.1 # filter nodes by xpath-query
69     my $xp = XML::XPath->new( filename => $file );
70     my $nodeset = $xp->find($xpq);
71    
72     # build result xml
73     my $buffer;
74     foreach my $node ($nodeset->get_nodelist) {
75     $buffer .= XML::XPath::XMLParser::as_string($node) . "\n\n";
76     }
77     #$buffer .= '';
78     #$buffer = "<result>$buffer</result>";
79    
80     # trace
81     #print $buffer, "\n";
82     #exit;
83    
84     $self->{buffer} = $buffer;
85    
86     }
87    
88     sub getResult {
89     my $self = shift;
90     return $self->{buffer};
91     }
92    
93     sub circumflex {
94     my $self = shift;
95     my $tag = shift;
96     # mungle result payload
97     $self->{buffer} = "<$tag>" . $self->{buffer} . "</$tag>" if $self->{buffer};
98     }
99    
100     sub isEmpty {
101     my $self = shift;
102     return not defined $self->{buffer};
103     }
104    
105     sub toEasyTree {
106     my $self = shift;
107    
108     $XML::Parser::EasyTree::Noempty = 1;
109 joko 1.3 # what about ...
110     #$XML::Parser::EasyTree::Latin = 1;
111     # ... instead of an otherwise required
112     # "expand" with proper utf8/latin-conversion
113     # parameters set?
114 joko 1.1
115     # convert xml data to native perl data structure
116     #my $parser = XML::Parser->new( Style => 'EasyTree', Handlers => { Char => sub { my $char = shift; print "char: ", Dumper($char), "\n"; } } );
117     #my $parser = XML::Parser->new( Style => 'EasyTree', Handlers => { Char => sub {} } );
118     my $parser = XML::Parser->new( Style => 'EasyTree' );
119     my $data = $parser->parse($self->{buffer});
120    
121     # trace
122     #print Dumper($data);
123     #exit;
124    
125     # FIXME!?
126     my $hash = $data->[0];
127    
128     # trace
129     #print Dumper($hash);
130     #exit;
131    
132     #$self->{payload} = $hash;
133     return $hash;
134    
135     }
136    
137     sub toSimpleTree {
138     my $self = shift;
139     #print $self->{buffer};
140     #exit;
141     #$self->{payload} = XMLin($self->{buffer});
142     return XMLin($self->{buffer});
143     }
144    
145    
146     1;
147     __END__

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed