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

package Labyrinth::Metadata;

use warnings;
use strict;

use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT @EXPORT_OK);
$VERSION = '5.31';

=head1 NAME

Labyrinth::Metadata - Metadata Management for Labyrinth.

=cut

# -------------------------------------
# Export Details

require Exporter;
@ISA = qw(Exporter);

%EXPORT_TAGS = (
    'all' => [ qw( MetaSearch MetaSave MetaGet MetaCloud MetaTags ) ]
);

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT    = ( @{ $EXPORT_TAGS{'all'} } );

#----------------------------------------------------------------------------
# Libraries

use Labyrinth::Audit;
use Labyrinth::Globals;
use Labyrinth::DBUtils;
use Labyrinth::Variables;

use HTML::TagCloud;

#----------------------------------------------------------------------------
# Variables

# type: 0 = optional, 1 = mandatory
# html: 0 = none, 1 = text, 2 = textarea

my %fields = (
    title       => { type => 1, html => 1 },
    tagline     => { type => 0, html => 1 },
);

#----------------------------------------------------------------------------
# Public Interface Functions

=head1 FUNCTIONS

=over 4

=item MetaSearch(%hash)

Provides the IDs for the given metadata search. The sqlkeys are one or more
keys into the phrasebook. Requires a hash of parameters:

  keys  => \@sqlkeys
  meta  => \@metadata
  full  => 1
  limit => $limit
  order => $order
  sort  => $sort_order

'key' and 'meta' are mandatory, all other key/value pairs are optional. If
'full' is provided with a non-zero value, a full text search is performed. If
a limit is given then only that number of records will be returned if more are
available. In order to suitably sort the records you can porovide the ORDER BY
string via the 'order' hash key.

=item MetaSave

Records the metadata with the given sqlkey for the name record id.

=item MetaGet

Gets the metadata for the given id.

=item MetaCloud

Returns the XHTML snippet to display a Metadata Tag Cloud.

=item MetaTags

Returns the list of tags attributed to a entry type and section ids.

=back

=cut

sub MetaSearch {
    my %hash = @_;

    my $keys = $hash{'keys'} || return ();
    my $meta = lc join(",", map {"'$_'"} @{$hash{meta}});
    my $data = lc join("|", @{$hash{meta}});
    my $full = $hash{'full'} || 0;

    LogDebug("MetaSearch: keys=[@$keys], meta=[$meta], full=$full");

    return ()   unless(@$keys && $meta);

    my $where = $hash{'where'} ? "AND $hash{'where'}" : '';
    my $limit = $hash{'limit'} ? "LIMIT $hash{'limit'}" : '';
    my $order = $hash{'order'} ? "ORDER BY $hash{'order'}" : '';

    my %res;
    for my $key (@$keys) {
        if($full) {
            # full text searching
            my @rs = $dbi->GetQuery('hash',"MetaDetail$key",{meta=>$meta, data => $data, where => $where, limit => $limit, order => $order});
            for(@rs) {$res{$_->{id}} = $_};
        } else {
            my @rs = $dbi->GetQuery('hash',"MetaSearch$key",{meta=>$meta, data => $data, where => $where, limit => $limit, order => $order});
            for(@rs) {$res{$_->{id}} = $_};
        }
    }

    my @res;
    if($hash{'order'}) {
        if($hash{'order'} eq 'createdate') {
            @res = map {$res{$_}} sort {int($res{$a}->{createdate}) <=> int($res{$b}->{createdate})} keys %res;
        } else {
            @res = map {$res{$_}} sort {$res{$a}->{$hash{'order'}} cmp $res{$b}->{$hash{'order'}}} keys %res;
        }
    } else {
        @res = map {$res{$_}} keys %res;
    }

    if($hash{'sort'} && $hash{'sort'} =~ /^desc/) {
        @res = reverse @res;
    }

    if($hash{'limit'}) {
        splice(@res,$hash{'limit'});
    }

    return @res;
}

sub MetaSave {
    my $id   = shift || return;
    my $keys = shift || return;
    my @meta = @_;

    LogDebug("MetaSave: $id,[@meta]");

    my $count = 0;
    for my $key (@$keys) {
        $dbi->DoQuery("MetaDelete$key",$id);
        $dbi->DoQuery("MetaUpdate$key",$id,lc($_)) for(@meta);
        $count += scalar(@meta);
    }

    return $count;
}

sub MetaGet {
    my ($id,$key) = @_;

    if($id && $key) {
        my @meta;
        my @rows = $dbi->GetQuery('array',"MetaGet$key",$id);
        if(@rows) {
            push @meta, $_->[1] for(@rows);
            return @meta    if(wantarray);
            return join(" ",sort @meta);
        }
    }

    return ()   if(wantarray);
    return;
}

sub MetaCloud {
    my %hash = @_;

    my $key       = $hash{'key'}       || return;
    my $sectionid = $hash{'sectionid'} || return;
    my $actcode   = $hash{'actcode'}   || return;

    my $path = $settings{'urlmap-'.$actcode} || "$tvars{cgipath}/pages.cgi?act=$actcode&data=";

    my $cloud = HTML::TagCloud->new(levels=>10);
    my @rsa = $dbi->GetQuery('hash',"MetaCloud$key",{ids => $sectionid});
    for(@rsa) {
        $cloud->add($_->{metadata}, $path . $_->{metadata}, $_->{count});
    }

    my $html = $cloud->html();
    while($html =~ m!(()!) {
        my ($href,$link1,$link2) = ($1,$2,$3);
        $html =~ s!$href!$link1$link2" title="Meta search for '$link2'">!sgi;
    }

    return $html;
}

sub MetaTags {
    my %hash = @_;

    my $key       = $hash{'key'}       || return;
    my $sectionid = $hash{'sectionid'} || return;

    my @rows = $dbi->GetQuery('hash',"MetaCloud$key",{ids => $sectionid});
    my @tags = map {$_->{metadata}} @rows;
    return @tags;
}

1;

__END__