File Coverage

blib/lib/Labyrinth/Metadata.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Labyrinth::Metadata;
2              
3 2     2   8370 use warnings;
  2         4  
  2         64  
4 2     2   7 use strict;
  2         4  
  2         53  
5              
6 2     2   8 use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT @EXPORT_OK);
  2         3  
  2         206  
7             $VERSION = '5.31';
8              
9             =head1 NAME
10              
11             Labyrinth::Metadata - Metadata Management for Labyrinth.
12              
13             =cut
14              
15             # -------------------------------------
16             # Export Details
17              
18             require Exporter;
19             @ISA = qw(Exporter);
20              
21             %EXPORT_TAGS = (
22             'all' => [ qw( MetaSearch MetaSave MetaGet MetaCloud MetaTags ) ]
23             );
24              
25             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
26             @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
27              
28             #----------------------------------------------------------------------------
29             # Libraries
30              
31 2     2   11 use Labyrinth::Audit;
  2         3  
  2         259  
32 2     2   78 use Labyrinth::Globals;
  0            
  0            
33             use Labyrinth::DBUtils;
34             use Labyrinth::Variables;
35              
36             use HTML::TagCloud;
37              
38             #----------------------------------------------------------------------------
39             # Variables
40              
41             # type: 0 = optional, 1 = mandatory
42             # html: 0 = none, 1 = text, 2 = textarea
43              
44             my %fields = (
45             title => { type => 1, html => 1 },
46             tagline => { type => 0, html => 1 },
47             );
48              
49             #----------------------------------------------------------------------------
50             # Public Interface Functions
51              
52             =head1 FUNCTIONS
53              
54             =over 4
55              
56             =item MetaSearch(%hash)
57              
58             Provides the IDs for the given metadata search. The sqlkeys are one or more
59             keys into the phrasebook. Requires a hash of parameters:
60              
61             keys => \@sqlkeys
62             meta => \@metadata
63             full => 1
64             limit => $limit
65             order => $order
66             sort => $sort_order
67              
68             'key' and 'meta' are mandatory, all other key/value pairs are optional. If
69             'full' is provided with a non-zero value, a full text search is performed. If
70             a limit is given then only that number of records will be returned if more are
71             available. In order to suitably sort the records you can porovide the ORDER BY
72             string via the 'order' hash key.
73              
74             =item MetaSave
75              
76             Records the metadata with the given sqlkey for the name record id.
77              
78             =item MetaGet
79              
80             Gets the metadata for the given id.
81              
82             =item MetaCloud
83              
84             Returns the XHTML snippet to display a Metadata Tag Cloud.
85              
86             =item MetaTags
87              
88             Returns the list of tags attributed to a entry type and section ids.
89              
90             =back
91              
92             =cut
93              
94             sub MetaSearch {
95             my %hash = @_;
96              
97             my $keys = $hash{'keys'} || return ();
98             my $meta = lc join(",", map {"'$_'"} @{$hash{meta}});
99             my $data = lc join("|", @{$hash{meta}});
100             my $full = $hash{'full'} || 0;
101              
102             LogDebug("MetaSearch: keys=[@$keys], meta=[$meta], full=$full");
103              
104             return () unless(@$keys && $meta);
105              
106             my $where = $hash{'where'} ? "AND $hash{'where'}" : '';
107             my $limit = $hash{'limit'} ? "LIMIT $hash{'limit'}" : '';
108             my $order = $hash{'order'} ? "ORDER BY $hash{'order'}" : '';
109              
110             my %res;
111             for my $key (@$keys) {
112             if($full) {
113             # full text searching
114             my @rs = $dbi->GetQuery('hash',"MetaDetail$key",{meta=>$meta, data => $data, where => $where, limit => $limit, order => $order});
115             for(@rs) {$res{$_->{id}} = $_};
116             } else {
117             my @rs = $dbi->GetQuery('hash',"MetaSearch$key",{meta=>$meta, data => $data, where => $where, limit => $limit, order => $order});
118             for(@rs) {$res{$_->{id}} = $_};
119             }
120             }
121              
122             my @res;
123             if($hash{'order'}) {
124             if($hash{'order'} eq 'createdate') {
125             @res = map {$res{$_}} sort {int($res{$a}->{createdate}) <=> int($res{$b}->{createdate})} keys %res;
126             } else {
127             @res = map {$res{$_}} sort {$res{$a}->{$hash{'order'}} cmp $res{$b}->{$hash{'order'}}} keys %res;
128             }
129             } else {
130             @res = map {$res{$_}} keys %res;
131             }
132              
133             if($hash{'sort'} && $hash{'sort'} =~ /^desc/) {
134             @res = reverse @res;
135             }
136              
137             if($hash{'limit'}) {
138             splice(@res,$hash{'limit'});
139             }
140              
141             return @res;
142             }
143              
144             sub MetaSave {
145             my $id = shift || return;
146             my $keys = shift || return;
147             my @meta = @_;
148              
149             LogDebug("MetaSave: $id,[@meta]");
150              
151             my $count = 0;
152             for my $key (@$keys) {
153             $dbi->DoQuery("MetaDelete$key",$id);
154             $dbi->DoQuery("MetaUpdate$key",$id,lc($_)) for(@meta);
155             $count += scalar(@meta);
156             }
157              
158             return $count;
159             }
160              
161             sub MetaGet {
162             my ($id,$key) = @_;
163              
164             if($id && $key) {
165             my @meta;
166             my @rows = $dbi->GetQuery('array',"MetaGet$key",$id);
167             if(@rows) {
168             push @meta, $_->[1] for(@rows);
169             return @meta if(wantarray);
170             return join(" ",sort @meta);
171             }
172             }
173              
174             return () if(wantarray);
175             return;
176             }
177              
178             sub MetaCloud {
179             my %hash = @_;
180              
181             my $key = $hash{'key'} || return;
182             my $sectionid = $hash{'sectionid'} || return;
183             my $actcode = $hash{'actcode'} || return;
184              
185             my $path = $settings{'urlmap-'.$actcode} || "$tvars{cgipath}/pages.cgi?act=$actcode&data=";
186              
187             my $cloud = HTML::TagCloud->new(levels=>10);
188             my @rsa = $dbi->GetQuery('hash',"MetaCloud$key",{ids => $sectionid});
189             for(@rsa) {
190             $cloud->add($_->{metadata}, $path . $_->{metadata}, $_->{count});
191             }
192              
193             my $html = $cloud->html();
194             while($html =~ m!(()!) {
195             my ($href,$link1,$link2) = ($1,$2,$3);
196             $html =~ s!$href!$link1$link2" title="Meta search for '$link2'">!sgi;
197             }
198              
199             return $html;
200             }
201              
202             sub MetaTags {
203             my %hash = @_;
204              
205             my $key = $hash{'key'} || return;
206             my $sectionid = $hash{'sectionid'} || return;
207              
208             my @rows = $dbi->GetQuery('hash',"MetaCloud$key",{ids => $sectionid});
209             my @tags = map {$_->{metadata}} @rows;
210             return @tags;
211             }
212              
213             1;
214              
215             __END__