Hatori Kibble

Jo eh…

Wolke im Werkzeugkasten

leave a comment »

Heute habe ich etwas mit HTML::TagCloud herumgespielt…

Ich habe ein Modul für den hbz Werkzeugkasten geschrieben, welches die Suchbegriffe der letzten sieben Tage als Wolke darstellt:

Suchbegriffe als Wolke

Suchbegriffe als Wolke

Da nur Suchbegriffe dargestellt werden die auch Ergebnisse liefern, kann man das Ganze auch als inhaltliche Erschliessung durch die NutzerInnen sehen.

Technisch funktioniert das indem die einzelnen Suchworte mit dem Datum in einer Tabelle abgelegt werden. Der Perl-Code sieht so aus:

package Digilink::TagCloud;
use warnings;
use strict;
use HTML::TagCloud;
use URI::Escape;
use lib "/opt/digilink";
=head1 NAME
Digilink::TagCloud - The great new Digilink::TagCloud!
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
=head1 SYNOPSIS
Quick summary of what the module does.
Perhaps a little code snippet.
use Digilink::TagCloud;
my $foo = Digilink::TagCloud->new();
$foo->addTerm('hbz');
$foo->addTerm('wolke');
print $foo->output();
=head1 EXPORT
A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.
=head1 FUNCTIONS
=head2 new
Constructor
=cut
sub new {
my $Type= shift;
my %Param = @_;
my $Self = {};
foreach (qw(DBObject ConfigObject)) {
if ($Param{$_}) {
$Self->{$_} = $Param{$_};
} else {
die "Got no $_!";
}
}
bless ($Self, $Type);
return $Self;
}
=head2 addTerm(Term=>'')
schreibt einen neuen Term in die Datenbank
=cut
sub addTerm {
my $Self = shift;
my %p = @_;
my $statement = "INSERT into searchterms(term, s_date) values (";
my $sth = undef;
if (defined($p{Term})) {
$statement .= $Self->{DBObject}->{dbh}->quote($p{Term}).", NOW())";
eval{
$Self->{DBObject}->{dbh}->do($statement);
};
if ($@) {
die "Fehler beim Insert: $@!";
}
}
}
=head2 output()
liefert den HTML Code fuer die Wolke zurueck
=cut
sub output{
my $Self = shift;
my $statement = undef;
my $sth = undef;
my $term = undef;
my $anzahl = undef;
my $cloud = HTML::TagCloud->new;
my $url1 = "http://digilink.digibib.net/wk/links.pl?Sigel=HBZWK&View=search&LNG=de&submit=[Abschicken]&all=";
# Terme bekommen
$statement = <<EOS;
SELECT term, count(*) as anzahl
FROM searchterms
WHERE DATE_SUB(CURDATE(),INTERVAL 7 DAY) <= s_date
GROUP BY term
EOS
$sth=$Self->{DBObject}->{dbh}->prepare($statement)
or die "Kann $statement nicht vorbereiten: $!\n";
$sth->execute()
or die "Kann $statement nicht ausfuehren: $!\n";
$sth->bind_columns(\$term,\$anzahl);
while ( $sth->fetch() ) {
$cloud->add($term, $url1.&uri_escape($term), $anzahl);
}
$sth->finish();
return $cloud->html_and_css(50);
}
=head1 AUTHOR
Peter Mayr, C<< <mayr at hbz-nrw.de> >>
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Digilink::TagCloud
=head1 COPYRIGHT & LICENSE
Copyright 2009 Peter Mayr, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Digilink::TagCloud

Das ist vorerst nur ein Versuch, sobald das durch irgendwelche Spammer missbraucht wird, schalte ich dieses Feature wieder ab.

Written by Peter

Januar 31, 2009 um 10:30 pm

Veröffentlicht in DigiLink, Perl, Programmierung, Scripts

Tagged with , , , ,

Schreibe einen Kommentar

Trage deine Daten unten ein oder klicke ein Icon um dich einzuloggen:

WordPress.com-Logo

Du kommentierst mit Deinem WordPress.com-Konto. Abmelden / Ändern )

Twitter-Bild

Du kommentierst mit Deinem Twitter-Konto. Abmelden / Ändern )

Facebook-Foto

Du kommentierst mit Deinem Facebook-Konto. Abmelden / Ändern )

Google+ Foto

Du kommentierst mit Deinem Google+-Konto. Abmelden / Ändern )

Verbinde mit %s

%d Bloggern gefällt das: