#!/usr/bin/perl -w # # Copyright © 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: bt01.pl 307 2000-02-29 14:35:03Z horst $ # package htBib_bt ; use lib "." ; use strict ; use diagnostics ; use CGI qw(-compile :all); use MLDBM 'DB_File' ; use IO::File ; use Fcntl ; use Text::BibTeX; use tex_entities ; use format_entry ; use htbib_util ; use htbib_auth ; use read_config ; my %config = (); read_config::read_config( \%config, "./.htBib" ) ; my $dbs_dir = $ENV{DOCUMENT_ROOT} . "/" . $config{root_directory} . "/dbs/" ; my ($entry, $entry_type) ; my ($bibfile) ; use HTML::Entities ; print header ; #print header(-expires=>'now') ; #print "Content-type: text/html\n\n"; my $counter = 0 ; my $topic = param("topic") || '' ; my $dbs = param("dbs") || '' ; my $key = param("key") ; my $author = param("author") || '' ; my $comment = param("comment") || '' ; my $new_db = param("new_db") || '' ; my $submit = param("submit") || '' ; print <<'BLOCK'; htBib BLOCK if (open (HEADER, "./.header")) { print while
; close HEADER ; print_heading( $topic ) ; print "
\n" ; } else { print_heading( $topic ) ; print "
\n" ; print "
\n" ; } my $home_title = $config{home_title} || 'Home' ; print " [$home_title]\n" ; print "
" ; print "
" ; my $error = 0 ; #print "

submit: $submit

\n" ; my $fh ; if ($submit eq "create") { unless ($new_db) { print "

Action $submit: unable to comply. You have to specify a database name. Just type it into the field labeled "Database".

\n" ; } else { if ($fh = IO::File->new( "<" . $dbs_dir . $new_db . ".bib" )) { print "

Sorry: unable to create database $new_db. A database with this name already exists!

\n" ; } else { unless ($fh = IO::File->new( $dbs_dir . $new_db . ".bib", O_WRONLY | O_CREAT ) ) { print "

Ooops: unable to create database $new_db. This should not happen. Something is wrong. Please contact the system administrator " . $config{admin_name} . ".

\n" ; } else { $fh->close() ; } } } } elsif ($submit eq "delete") { unless (unlink $dbs_dir . $new_db . ".bib") { if ($fh = IO::File->new( "<" . $dbs_dir . $new_db . ".bib" )) { print "

Ooops: unable to delete database $new_db. This should not happen. Something is wrong. Please contact the system administrator " . $config{admin_name} . ".

\n" ; $fh->close() ; } else { print "

Oops: unable to delete database $new_db.\n" ; print "The database $new_db probably does not exist.

\n" ; } } } print "

Available databases:

\n" ; print "\n" ; my @databases = htbib_util::available_databases( $dbs_dir ) ; my $database = '' ; foreach $database (@databases) { print "\n" ; print "\n" ; } print "
$databaseEditShow
\n" ; print <<"EOF" ;

Database:

EOF print "
" ; print "
" ; print " [$home_title]\n" ; if (open (FOOTER, "./.footer")) { print "
" ; print while
; close FOOTER ; } else { print "
" ; print "
" ; print "
" ; print $config{copyright} ; print "
" ; } print " " ; print "" ; 1;