1: #
2: # SAX handler for harvestmeta
3: #
4:
5: package HarvestmetaHandler;
6:
7: use strict;
8:
9: use base qw(XML::SAX::Base);
10:
11: use lib '/usr/local/mpiwg/archive';
12: use MPIWGStor;
13:
14: my $debugElem = 0;
15: my $debugCont = 0;
16:
17: my @currElemPath;
18: my $currElem;
19: my $currText;
20: my $currAttrib;
21: my @elements;
22:
23: sub getData {
24: return @elements;
25: }
26:
27: sub start_document {
28: my ($self, $doc) = @_;
29: # process document start event
30: logger('DEBUG', "startdoc: $self, $doc") if ($debugElem);
31: @currElemPath = ();
32: $currElem = "";
33: $currText = "";
34: $currAttrib ="";
35: @elements = ();
36: }
37:
38: sub start_element {
39: my ($self, $el) = @_;
40: # process element start event
41: logger('DEBUG', "startelem: $self, $$el{'LocalName'}") if ($debugElem);
42: # check if the last element needs to be finished
43: if ($currElem) {
44: my $elem = join "/", @currElemPath;
45: push @elements, [$elem, "", $currAttrib];
46: }
47: # element name is either LocalName or Name
48: my $name = $$el{'LocalName'};
49: $name = $$el{'Name'} unless ($name);
50: #logger('DEBUG', " name: $name");
51: # assemble attributes string
52: $currAttrib ="";
53: foreach my $attr (values %{$$el{'Attributes'}}) {
54: my $key = $$attr{'LocalName'};
55: $key = $$attr{'Name'} unless ($key);
56: my $val = $$attr{'Value'};
57: $currAttrib .= "$key=\"$val\" ";
58: }
59: $currAttrib = sstrip($currAttrib);
60: # start element name
61: push @currElemPath, $name;
62: $currElem = $name;
63: $currText = "";
64: }
65:
66: sub end_element {
67: my ($self, $el) = @_;
68: # process element end event
69: logger('DEBUG', "endelem: $self, $$el{'LocalName'}") if ($debugElem);
70: # check element name
71: my $name = $$el{'LocalName'};
72: $name = $$el{'Name'} unless ($name);
73: my $lastag = $currElemPath[$#currElemPath];
74: if ($lastag ne $name) {
75: logger('ERROR', "closing tag '$lastag' doesn't match '$name'!");
76: }
77: # assemble element path
78: my $elem = join "/", @currElemPath;
79: # strip whitespace from element content
80: $currText =~ s/^\s*//;
81: $currText =~ s/\s*$//;
82: if (($currText)||($currAttrib)) {
83: # put pair in elements array
84: push @elements, [$elem, $currText, $currAttrib];
85: logger('DEBUG', " elem: $elem = $currText ($currAttrib)") if ($debugCont);
86: }
87: # end element name
88: pop @currElemPath;
89: $currElem = "";
90: $currText = "";
91: $currAttrib ="";
92: }
93:
94: sub characters {
95: my ($self, $char) = @_;
96: # process character data event
97: logger('DEBUG', "characters: $self, $char") if ($debugElem);
98: # add to current content
99: $currText .= $$char{'Data'};
100: logger('DEBUG', " Text: $currText") if ($debugCont);
101: }
102:
103:
104: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>