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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Tue Aug 10 13:59:48 2004 UTC (19 years, 10 months ago) by jonen
Branch: MAIN
CVS Tags: HEAD
Changes since 1.5: +8 -1 lines
+ bugfix(use of Storable): the FreeBSD port of Perl 5.8.4 uses 64 bits

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

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