/[cvs]/nfo/perl/libs/Data/Rap/Metadata.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Rap/Metadata.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by joko, Tue Feb 18 15:35:49 2003 UTC revision 1.6 by jonen, Tue Aug 10 13:59:48 2004 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.6  2004/08/10 13:59:48  jonen
6    ##  + bugfix(use of Storable): the FreeBSD port of Perl 5.8.4 uses 64 bits
7    ##
8    ##  Revision 1.5  2004/06/20 23:00:23  joko
9    ##  minor fix: now creates cache-file in same directory where rap.xml is
10    ##
11    ##  Revision 1.4  2004/06/20 16:12:24  joko
12    ##  + sub indexTargets
13    ##  modified getTargetDetails to use cached target details
14    ##
15    ##  Revision 1.3  2003/03/29 07:13:19  joko
16    ##  better exception handling if target was not found in xml
17    ##
18    ##  Revision 1.2  2003/02/20 20:04:35  joko
19    ##  renamed methods
20    ##  - refactored xml-specific code to Data::Storage::Handler::XML
21    ##
22  ##  Revision 1.1  2003/02/18 15:35:49  joko  ##  Revision 1.1  2003/02/18 15:35:49  joko
23  ##  + initial commit  ##  + initial commit
24  ##  ##
# Line 15  use warnings; Line 32  use warnings;
32    
33    
34  use Data::Dumper;  use Data::Dumper;
35  use XML::Parser;  use DesignPattern::Object;
36  use XML::Parser::EasyTree;  use Storable;
37  use XML::XPath;  use File::Basename qw( dirname );
38  #$XML::Parser::Easytree::Noempty=0;  
39  #use XML::Simple;  # NEW 2004-08-05: needed at FreeBSD perl>=5.4.3
40    # read http://lists.freebsd.org/pipermail/freebsd-ports/2004-June/013169.html
41    # or more detailed at 'perldoc Storable'
42    $Storable::interwork_56_64bit = 1;
43    
44  sub getTargetMetadata {  sub accessMetadata {
45    my $self = shift;    my $self = shift;
46    my $target = shift;  
47    #my $result = $self->queryXml("*/target[\@name=\"$target\"]", keyattr => [qw( name )], forcearray => 1);    # create instance of storage object once
48    my $keyattr = {    if (!$self->{__rap}->{metadbengine}) {
49      topic => 'name',      $self->{__rap}->{metadbengine} =
50      taskdef => 'name',        DesignPattern::Object->fromPackage('Data::Storage::Handler::XML', filename => $self->{__rap}->{filename} );
51      target => 'name',    }
52    };    
53    #my $result = $self->queryXml("*/target[\@name=\"$target\"]", keyattr => $keyattr, forcearray => 1);    return $self->{__rap}->{metadbengine};
54    $self->queryXml("*/target[\@name=\"$target\"]");  
   #return $self->_queryXml($self->{filename}, "target");  
   #print Dumper($result);  
   #return $result->{target};  
   #return $result->{target}->{$target};  
   #return $result;  
   $self->xml2easytree();  
   return $self->{payload};  
55  }  }
56    
57  sub readXmlOverview {  sub getTargetList {
58    my $self = shift;    my $self = shift;
59    
60    $self->log( "Reading Job Database from XML.", 'notice' );    $self->log( "Reading database of targets (dot) from XML.", 'notice' );
61    
62    #$self->{payload} = XMLin($self->{filename});    # prepare access to metadata (assure instantiated storage handle)
63    #my $result = $self->queryXml("*/target", forcearray => 1);    my $mdbe = $self->accessMetadata();
   #my $result = $self->queryXml("*/target", keyattr =>[]);  
   $self->queryXml("*/target", keyattr => [qw( name )] );  
   $self->xml2simplehash();  
   #return $result;  
     
 }  
   
   sub queryXml {  
     my $self = shift;  
     my $xpq = shift;  
     my $options = shift;  
64    
65      $self->log( "_queryXml( xpq='$xpq' ) ", 'info' );    $mdbe->sendQuery("*/target");
66      $mdbe->circumflex('result');  
67    
68      my $file = $self->{filename};    # checks  
69            if ($mdbe->isEmpty) {
70      if (! -e $file) {        $self->log("XML metadata was empty.", 'critical');
       $self->log("file not found: '$file'", 'error');  
71        return;        return;
72      }      }
73      
74      # trace
75        #print Dumper($self->{buffer});
76        #exit;
77    
78      # behaviour
79        #$self->xml2simplehash();
80        my $tree = $mdbe->toEasyTree();
81      #return $result;
82      
83      # trace
84        #print Dumper($tree);
85        #exit;
86      
87      # build result
88        my @targets;
89        foreach my $entry (@{$tree->{content}}) {
90          my $description = $entry->{content}->[0]->{content}->[0]->{content};
91          push @targets, { name => $entry->{attrib}->{name}, description => $description };
92        }
93    
94      #print "file: $file", "\n";    return \@targets;
95      #print "xpq: $xpq", "\n";    
96        }
     # filter nodes by xpath-query  
       my $xp = XML::XPath->new( filename => $file );  
       my $nodeset = $xp->find($xpq);  
       
     # build result xml  
       my $buffer;  
       foreach my $node ($nodeset->get_nodelist) {  
         $buffer .= XML::XPath::XMLParser::as_string($node) . "\n\n";  
       }  
       #$buffer .= '';  
       #$buffer = "<result>$buffer</result>";  
       
     # trace  
       #print $buffer, "\n";  
   
     $self->{buffer} = $buffer;  
       
   }  
97    
98    
99  sub xml2easytree {  sub getTargetDetails {
100    my $self = shift;    my $self = shift;
101      # convert xml data to native perl data structure    my $target = shift;
102        my $parser = XML::Parser->new( Style => 'EasyTree', Handlers => { Char => sub {} } );    my $options = shift;
103        my $data = $parser->parse($self->{buffer});    
104      # check cache and return result from there
105      my $hash = $data->[0];    if (my $result = $self->{cache}->{targets}->{$target} and not $options->{force}) {
106            return $result;
107      # trace    }
108        #print Dumper($hash);    
109        #exit;    # get metadata for single task from storage
110      my $mdbe = $self->accessMetadata();
111      $self->{payload} = $hash;    $mdbe->sendQuery("*/target[\@name=\"$target\"]");
112      
113      # FIXME: this is wrong behaviour! upper statement should return a proper
114      # result, which itself (already) has the method 'isEmpty' or similar...
115      if ($mdbe->isEmpty()) {
116        $self->log( "Target '$target' not found.", 'notice' );
117        return;
118      }
119      
120      my $tree = $mdbe->toEasyTree();
121      
122      # trace
123      #print Dumper($tree);
124      #exit;
125      
126      return $tree;
127  }  }
128    
129  sub xml2simplehash {  sub indexTargets {
130    my $self = shift;    my $self = shift;
131    $self->{payload} = XMLin($self->{buffer});    my $options = shift;
132      
133      # determine filename for cache-file
134      my $filename = 'rap.xml.cache';
135      if (my $rapfile = $self->{__rap}->{filename}) {
136        if (my $path = dirname($rapfile)) {
137          $filename = $path . '/' . $filename;
138        }
139      }
140      
141      if ($options->{build}) {
142        $self->log("Building index of Targets", 'notice');
143        # clear cache
144        delete $self->{cache}->{targets};
145        my $list = $self->getTargetList();
146        foreach my $target (@$list) {
147          $self->log("Reading target: $target->{name}", 'info');
148          my $details = $self->getTargetDetails($target->{name}, { force => 1 });
149          $self->{cache}->{targets}->{$target->{name}} = $details;
150        }
151        store $self->{cache}->{targets}, $filename;
152        
153      } elsif ($options->{load}) {
154        if (not -e $filename) {
155          return;
156        }
157        if ($self->{cache}->{targets} = retrieve($filename)) {
158          return 1;
159        }
160      
161      } else {
162        $self->log("Please call with options build or load", 'warning');
163      
164      }
165  }  }
166    
167  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed