Return to HarvestmetaHandler.pm CVS log

Up to [Repository] / foxridge-archiver

Annotation of foxridge-archiver/HarvestmetaHandler.pm, revision 1.4

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