#!/opt/perl-5.004/bin/perl -w
#
# $Id: newdoc.pl,v 1.4 1997/06/20 09:58:09 gnats Exp $
#
#
# DESCRIPTION: newdoc.pl - a tool to control creating and editing documents
#	for a solution database
#
# URL: none yet
#
# AUTHOR: Cord Beermann (cord@Wunder-Nett.org)
#
# Thanks to: Ralf Begemann (begemann@cc.fh-lippe.de)
#            Gerold Meerkoetter (gerold@noc.fh-lippe.de)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program 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 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# A Perl script is "correct" if it gets the job done before your boss fires
# you.
# ('Programming Perl Second Edition' by Larry Wall, Tom Christiansen
#   & Randal. L. Schwartz)
#
# Bugs and shortcomings
# none yet
#
# Todo
# * write instructions
#
### Configuration ###
#
$WEBROOT='/var/infosystems/www/webroot';
$DBROOT='/fhl/dvz/loesungen';
$KW_FILE_DB= $WEBROOT . $DBROOT . '/.kw_file.db';
$TEMPLATE= $WEBROOT . $DBROOT . '/.vorlage';
#
### End of Configuration ###

# Initialize Variables
use vars qw ! $WEBROOT $DBROOT $DESTFILE %kwdb %fdb ! ;

# include perl-modules
use POSIX;
use GDBM_File;
use File::Copy;
use File::Basename;
use String::Approx qw( amatch );

# print usage statement if no files given
unless ($#ARGV > -1) {
    print("Usage: $0 file [file ...]\n");
    exit(0);
}

# import keyword-database into @keywordlist
tie(%kw_file_db, GDBM_File, $KW_FILE_DB, O_RDONLY, 0) or &error("open
    $KW_FILE_DB: $!\n");
@keywordlist = sort {"\l$a" cmp "\l$b"} (keys %kw_file_db);
untie(%kw_file_db);

# Run this loop once for each given file
foreach $file (@ARGV) {
    # check if the RCS-dir is still there and create it if not
    unless (-d dirname($file) . '/RCS') {
	mkdir(dirname($file) . '/RCS', 0755) or
	    &error('mkdir ' . dirname($file) . "/RCS: $!\n");
    }
    # check if the given file exists or not and print an appropriate message.
    if (-e $file) {
	$old = 1;
	print "$file existiert bereits. Bearbeiten? (j/n)\n";
    } else {
	print "Neue Datei $file erstellen? (j/n)\n";
    }
    # wait for user input and exit with a message if the user won't proceed
    defined($_ = <STDIN>) or &error("STDIN not found: $!");
    unless ($_ =~ /^[jJ]/) {
	print "Datei $file wurde nicht bearbeitet.\n";
	exit(0);
    }
    # check for a lockfile and exit with a message if it exists
    if (-e $file . '.lock') {
	print "$file wird bereits bearbeitet.\n";
	exit(1);
    }
    if ($old) {
	# copy the original file to file.lock
	copy($file, $file . '.lock') or &error("copy $file $file.lock: $!");
	# check the file out from the RCS for editing
	system('/opt/local/bin/co', '-l', $file) && &error("can't check out $file");
    } else {
	# copy the template to file.lock
	copy($TEMPLATE , $file . '.lock') or &error("copy $TEMPLATE $file.lock: $!");
	# get the title for the new document
	print "Bitte geben Sie den Titel der zu erstellenden Seite ein:\n";
	chomp($title = <STDIN>) or &error("STDIN not found: $!");
	# print all known keywords
	$output = "\nBekannte Stichwoerter: ";
	foreach $keyword (@keywordlist) {
	    # Don't let a line be longer than 78 chars.
	    if (length ($output) + length($keyword) > 78) {
		print "$output\n";
		$output = "  $keyword, ";
	    } else {
		$output .= "$keyword, ";
	    }
	}
	print "$output\n\n";
	# get keywords for the new document
	print "Bitte geben Sie die Stichwoerter ein: (Mit Kommas getrennt)\n";
	chomp($keyword = <STDIN>) or &error("STDIN not found: $!");
	# initialize RCS for the new file
	system('/opt/local/bin/rcs', '-i', '-L', '-t-' . $title, $file) &&
	    &error("cannot initialize RCS for $file");
    }
    # get the login of the editor
    print "Bitte geben Sie Ihren Loginnamen ein:\n";
    chomp($login = <STDIN>) or &error("STDIN not found: $!");
    # get the Realname
    $name = (getpwnam($login))[6];
    # open Source and Destination File.
    open(SOURCE, $file . '.lock') or &error("open $file.lock: $!");
    open(DEST, ">$file") or &error("open $file: $!");
    # pipe Sourcefile through these filters
    while (<SOURCE>) {
	if ($old) {
	    # replace 
	    s|<A NAME=\"AUTOR\" HREF=\"/~[^~/]+/\">[^<>]*</a>|<A NAME=\"AUTOR\" HREF=\"/~$login/\">$name</a>|i;
	} else {
	    if ($title) {
		s|TITEL|$title|;
	    }
	    if ($login) {
		s|AUTOREMAIL|$login\@cc.fh-lippe.de|;
		s|AUTORURL|/~$login/|;
	    }
	    if ($keyword) {
		s|SCHLUESSELWORTE|$keyword|;
	    }
	    if ($name) {
		s|AUTORNAME|$name|;
	    }
	}
	# and print the result in the Destination File.
	print DEST;
    }
    # Done. Close the files.
    close(SOURCE);
    close(DEST);

    # infinite loop. start Editor, after quitting, check the edited file.
    #   If OK, exit loop
    while (1) {
	system($ENV{EDITOR}, $file) && &error("can't edit $file");
	last if (kwcheck($file) eq "OK");
    }
    # on Editing an old file ask for a comment.
    if ($old) {
	print "\nBitte geben Sie ein Warum und Was Sie in der Datei geaendert haben:\n";
    }
    # RCS: check the document in
    system('/opt/local/bin/ci', $file) && &error("cannot check in $file");
    @cannot = grep {not chmod 0555, $_} dirname($file) . '/RCS/' . basename($file) . ',v';
    &error("chmod 0555 @cannot: $!") if @cannot;
    # RCS: check out for reading
    system('/opt/local/bin/co', $file) && &error("cannot check out $file");
    # remove lockfile
    unlink <$file.lock> or &error("unlink $file.lock: $!");
}

# Subprogram if something fails.
# remove lockfile and print an errormessage.
sub error {
    my $error = shift(@_);
    unlink <$file.lock> or warn("unlink $file.lock: $!");
    print("$error\n");
    exit(1);
}

sub kwcheck {
    # get variable
    my $file = shift(@_);
    # open File for reading.
    open (FILE, $file) or &error("open $file: $!");
    # Read every line.
    LOOP: while (defined ($content = <FILE>)) {
	# store all after <head>-Tag
	if ($content =~ s#.*\<head\>##i) {
	    # if </head> is in the same line, exit LOOP
	    if ($content =~ s#\</head\>.*##i) {
		last LOOP;
	    } else {
		# read next line
		while ($content .= <FILE>) {
		    # if </head> is in it, exit LOOP
		    if ($content =~ s#\</head\>.*##i) {
			last LOOP;
		    }
		}
	    }
	}
    }
    # strip trailing, tailing and double spaces, LineFeeds .
    $content =~ s/\s+/ /g;
    $content =~ s/(^\s+|\s+$)//;
    $title = $content;
    # if there is no title, print a message, wait for keypress and return to main program
    unless ($title =~ s#.*\<TITLE\>([^\>\<]+)\</TITLE\>.*#$1#i) {
	print("kein Titel gefunden\n");
	<STDIN> or &error("STDIN not found: $!");
	close(FILE);
	return;
    }
    # if there are no keywords, print a message, wait for keypress and return to main program
    # throw all away except for the keywords
    unless ($content =~ m#.*\<META NAME=\"keywords\" CONTENT=\"([^\"]+)\">.*#i) {
	print("keine Schluesselwoerter gefunden\n");
	<STDIN> or &error("STDIN not found: $!");
	close(FILE);
	return;
    }
    # load array with keywords
    @keywords = split(/\s*,\s*/, $1);
    foreach $kw (@keywords) {
	$kw =~ s|^\s*||;
	$kw =~ s|\s*$||;
	# if spaces are in the keyword, print a message, wait for keypress and return to main program
	if ($kw =~ /[^\s]\s+[^\s]/) {
	    print "Schluesselwort '$kw' enthaelt Leerzeichen\n";
	    <STDIN> or &error("STDIN not found: $!");
	    close(FILE);
	    return;
	}
	# if keyword is shorter than 3 chars, print a message, wait for keypress and return to main program
	if (length($kw) < 2) {
	    print "Schluesselwort '$kw' ist zu kurz\n";
	    <STDIN> or &error("STDIN not found: $!");
	    close(FILE);
	    return;
	}
	# if keyword is not in the known keyword list, print a message.
	unless (grep /\b$kw\b/, @keywordlist) {
	    print "Schluesselwort '$kw' ist unbekannt.\n";
	    $output = "Aehnliche Stichwoerter: ";
	    # test if a keyword is similar to the unknown password
	    foreach (@keywordlist) {
		$keyword = $_;
		# if keyword is similar (case-insensitive, 15% changes possible) print it
		if (amatch($kw, [ 'i' , '15%' ] )) {
		    # Don't give output which is longer than 78 chars
		    if (length ($output) + length($keyword) > 78) {
			print "$output\n";
			$output = "  " . $keyword . ", ";
		    } else {
			$output .= $keyword . ", ";
		    }
		}
	    }
	    # print similar keywords
	    if ($output eq "Aehnliche Stichwoerter: ") {
		print "es wurden keine aehnlichen Stichwoerter gefunden.\n";
	    } else {
		print "$output\n\n";
	    }
	    # ask
	    print "Wirklich in die Datenbank aufnehmen? (j/n)\n";
	    defined($_ = <STDIN>) or &error("STDIN not found: $!");
	    if ($_ =~ /^[jJ]/) {
		# give message and add keyword to the database
		print "Schluesselwort '$kw' wurde aufgenommen.\n";
		push @keywordlist, $kw;
	    } else {
		close(FILE);
		return;
	    }
	}
    }
    close(FILE);
    # all OK, tell it to the main program
    return "OK";
}