Return to HarvestmetaHandler.pm CVS log

Up to [Repository] / foxridge-archiver

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

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.2     ! casties    11: use lib '/usr/local/mpiwg/archive_devel';
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
                     48:     my $name = $$el{'LocalName'};
                     49:     $name = $$el{'Name'} unless ($name);
                     50:     #logger('DEBUG', "  name: $name");
                     51:     # assemble attributes string
                     52:     $currAttrib ="";
1.2     ! casties    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\" ";
1.1       casties    58:     }
1.2     ! casties    59:     $currAttrib = sstrip($currAttrib);
1.1       casties    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
1.2     ! casties    69:     logger('DEBUG', "endelem: $self, $$el{'LocalName'}") if ($debugElem);
1.1       casties    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*$//;
1.2     ! casties    82:     if (($currText)||($currAttrib)) {
1.1       casties    83:    # put pair in elements array
                     84:    push @elements, [$elem, $currText, $currAttrib];
1.2     ! casties    85:    logger('DEBUG', "  elem: $elem = $currText ($currAttrib)") if ($debugCont);
1.1       casties    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
1.2     ! casties    97:     logger('DEBUG', "characters: $self, $char") if ($debugElem);
1.1       casties    98:     # add to current content
                     99:     $currText .= $$char{'Data'};
1.2     ! casties   100:     logger('DEBUG', " Text: $currText") if ($debugCont);
1.1       casties   101: }
                    102: 
                    103: 
                    104: 1;