#!/usr/bin/perl -w # # Copyright (C) 1999 Horst Tellioglu, All Rights Reserved # # This library is free software; you can redistribute it and/or modify it # under the terms of the GNU Library General Public License as published by # the Free Software Foundation; either version 2 of the License, or (at your # option) any later version. # This library is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public # License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # $Id: bl04.pl 425 2002-02-27 17:12:56Z horst $ # package htBib_bl ; use strict ; no strict 'refs'; use diagnostics ; use CGI qw(-compile :all); use Text::BibTeX; use tex_entities ; #qw(encode_entities); use format_entry ; use htbib_util ; use htbib_auth ; my ($entry, $entry_type) ; use read_config ; my %config ; read_config::read_config( \%config ) ; my $dbs_dir = $ENV{DOCUMENT_ROOT} . "/" . $config{root_directory} . "/dbs/" ; my ($bibfile) ; my $counter = 0 ; my $topic = param("topic") || '' ; my $comment = param("comment") || '' ; my $dbs = param("dbs") || '' ; my $key = param("key") || '' ; use HTML::Entities ; my ($rc_auth, $user, $sent_pw) = check_authentification( $config{"AuthUserFile"} ) ; #use MLDBM 'DB_File' ; use MLDBM qw(DB_File Storable ) ; my $value = ""; my %COMMENT = (); my $db = $dbs_dir . $dbs . "_comment.dbm" ; my $db_entry = {}; my $title = $config{title} || 'htBib' ; print header(-expires=>'now') ; print '' ; print '' ; print ' ' ; print " $title" ; print ' ' ; print ' ' ; print ' ' ; print ' ' ; print ' ' ; # DEBUG #print "db: $db
" ; unless (tie (%COMMENT, 'MLDBM', $db)){ print "

Can't open comment database '$db'!

\n"; print "\n" ; exit ; } else { # print "key: " . $key . "
\n" ; $db_entry = $COMMENT{$key} ; # retrieve from database ; # print "db_entry: $db_entry
\n" ; } #print "Content-type: text/html\n\n"; if (open (HEADER, "./.header")) { print while

; close HEADER ; print_heading( $topic ) ; print "

\n" ; } else { print_heading( $topic ) ; print " " ; print "

Publication:

" ; $bibfile = new Text::BibTeX::File "./dbs/" . $dbs . ".bib"; while ($entry = new Text::BibTeX::Entry $bibfile) { next unless $entry->parse_ok ; $counter++ ; next unless ($entry->key eq $key); print "

\n" ; print " $counter. " ; do_format( $entry ) ; print "\n

\n" ; # last ; } $bibfile->close ; my %IMAGES = (); my $book_image = "" ; unless (tie (%IMAGES, 'MLDBM', $dbs_dir . $dbs . "_images.dbm")) { print "Can't open IMAGES database '" . $dbs_dir . $dbs . "_images.dbm'!" ; } # error handling!!!! $book_image = $IMAGES{$key} ; # retrieve image if ($book_image) { $IMAGES{$key} = $book_image ; # retrieve image if ($IMAGES{$key}) { print "\n

\n $\"(Picture$ \n

\n" ; # retrieve image } } my %SYNOPSIS = (); my $synopsis = "" ; # tie (%SYNOPSIS, 'MLDBM', $dbs_dir . $dbs . "_synopsis.dbm") ; unless (tie (%SYNOPSIS, 'MLDBM', $dbs_dir . $dbs . "_synopsis.dbm")) { print "Can't open SYNOPSIS database '" . $dbs_dir . $dbs . "_synopsis.dbm'!" ; } #### error handling!!!! if (exists $SYNOPSIS{$key}) { print "

Synopsis: $SYNOPSIS{$key}\n

" ; # retrieve synopsis if ($rc_auth) { print "

[Edit]" ; print " [Delete]\n" ; if ($config{show_kommerz}) { print " [Edit Shop Links]" ; } print " [Edit Image]" ; print "

\n" ; } } else { print "

\n" ; # print " Currently this publication has no synopsis." ; if ($rc_auth) { print " Feel free to " ; print "add a synopsis." ; if ($config{show_kommerz} and $rc_auth) { print "
[Edit Shop Links]" ; } print " [Edit Image]" ; } print "\n

\n" ; } print "

\n" ; print "We'd love for you to " ; print "add an annotation for this book." ; print "

\n" ; if ($config{show_kommerz}) { ### # display shop links my %KOMMERZ = (); my $kommerz = "" ; unless (tie (%KOMMERZ, 'MLDBM', $dbs_dir . $dbs . "_kommerz.dbm")) { print "

Can't open KOMMERZ database " ; print $dbs_dir . $dbs . "_kommerz.dbm!

" ; } # error handling!!!! $kommerz = $KOMMERZ{$key} ; # retrieve kommerz if ($kommerz) { print " \n" ; } untie %KOMMERZ ; } ### # my $author = "" ; my $annotation = "" ; my @annotation_authors = [] ; #while ( ($key, $value) = each %COMMENT) # { # print "

\n" ; # $db_entry = $COMMENT{$key} ; # retrieve from database ; # print "
key" . $key . "
\n" ; # print "
annotations\n" ; # @annotation_authors = keys %$db_entry ; # print "length: " . scalar( @annotation_authors ) ; # if (@annotation_authors) { # foreach $author (@annotation_authors) # { # print "
annotation>\n"; # print "
author" ; # print $db_entry->{$author}{"author"} . "\n" ; # print "
\n" ; # $value = $db_entry->{$author}{"annotation"} ; # print "
comment" . $value . "
\n" ; # print "
\n"; # } # } # else # { # } # print "
\n" ; # print "

\n\n\n" ; # } @annotation_authors = keys %$db_entry ; #print "annotation_authors: " . scalar( @annotation_authors ) . "
\n"; if (@annotation_authors) { print"

Annotations:

\n" ; print"

\n" ; $counter = 0 ; foreach $author (@annotation_authors) { if ($counter > 0) { print "

\n" ; } $counter++ ; print "

" . $db_entry->{$author}{"author"} . ":

\n" ; # $value = HTML::Entities::encode_entities( # $db_entry->{$author}{"annotation"} # ) ; # $value =~ s/\ \n\ /<\/p>\n

/g ; $value = $db_entry->{$author}{"annotation"} ; # $value =~ s/\ \n\ /<\/p>\n

/g ; # print "

" . $value . "

" ; print $value . "\n" ; if ($rc_auth) { print "

\n" ; print " [Add]\n" ; print " [Edit]" ; print " [Delete]

\n" ; } } } else { if ($rc_auth) { print"

Annotations:

\n" ; print"

Sorry. Currently this publication has no annotations. Feel free to " ; print "add an annotation.

\n" ; } } print"

\n" ; # annotation untie %COMMENT ; #untie %SYNOPSIS ; #untie %IMAGES ; print " " ; print while

" ; print "

" ; print $config{copyright} ; print "

\n" ; } print " \n" ; print "\n" ;