#!/usr/bin/perl -w

## 
## anno.cgi
## CGI componante for blosxom's annotate plugin
## 
## gilbert <jong@jong.org>
## $Id: anno.cgi,v 1.7 2003/04/22 07:35:12 jong Exp jong $
## 
## Copyright (c) 2003 Jon Gilbert, Erin Norton, Danny O'Brien.
## anno.cgi comes with ABSOLUTELY NO WARRANTY.
## This is free software, and you are welcome to redistribute it
## under certain conditions; see http://www.jong.org/annotate/ 
## for details.
## 

## Put this (the annotate CGI) into a directory that your webserver 
## thinks is a CGI directory. If you don't know how to do this, 
## ask your administrator (if *you* are the administrator, I 
## recommend a good book. or a change of careers.)
## Fill out the configuration below. Note that whatever user 
## this CGI runs as (typically nobody) will need write access 
## to the files in $PLUGIN_STATE_DIRECTORY. 
## 

#################################################
## BASIC CONFIGURATION
#################################################
## 
## $REPOSITORY_DIRECTORY
## fully-qualified path to the directory of entries on the server.
##     This defines where your entries are stored. It will 
##     get overwritten by the CGI parameter RD
##     if it exists.  If you're certian this will never need 
##     to be changed, you can put it here, so that you won't 
##     have to worry about setting it in the plugin.
## Example: 
## my $REPOSITORY_DIRECTORY = "/usr/local/blogs/some_blog_name";

my $REPOSITORY_DIRECTORY = "";


## $PLUGIN_STATE_DIRECTORY 
## fully-qualified path to the directory where your plugin 
## state is
## 	This is where blosxom thinks your plugin state directory 
## 	is. Find it in $plugin_state.
## Example: 
## my $PLUGIN_STATE_DIRECTORY = "/usr/local/blogs/plugins/state";

my $PLUGIN_STATE_DIRECTORY = "";


## $CSS_URL
## URL of the CSS file to include in the CGI
##    If you've got a custom CSS directive, you can put 
##    the URL of it here, and it will get prepended to 
##    all CGI output. If you don't have a CSS for your, 
##    blog, then leave this blank.

my $CSS_URL = "";

## $RETURN_URL
## URL that the EU will be returned to after a successful annotation.
## 	Note that $0 will try to figure out what url will be used. 
## 	Failing that, it'll look for the CGI param RETR_URL, if it 
## 	exists.  Failing that, it'll use this. If none of these are 
## 	available, the user will not be redirected anywhere. 

my $RETURN_URL = "http://www.domain.org/blog/";

## $DEBUG
## Set this to 1 if you think things are going wacky. 

my $DEBUG = 0;

#################################################
##
## That's it. You shouldn't have to change anything 
## below this line.
##
#################################################


$| = 1;
use strict;
use CGI;
use HTML::Parser qw();
$CGI::HEADERS_ONCE = 1;
my $q = new CGI;

my $RD = $q->param('RD') || $REPOSITORY_DIRECTORY;
&error($q,"Missing or empty REPOSITORY_DIRECTORY setting.") 
	unless ($RD);
&error($q,"Repository directory at '$RD' doesn't exist or isn't writable") 
	unless (-d $RD );

my $PL_STATE = $q->param('PL_STATE') || $PLUGIN_STATE_DIRECTORY;
&error($q,"Missing or empty PLUGIN_STATE_DIRECTORY setting.")
	unless (-d $PL_STATE);

## this is where we (and theplugin) store our annotates. 
my $AN_DIR = $PL_STATE . $CGI::SL . "annotate";
unless (-d $AN_DIR) {
	mkdir( $AN_DIR, 0755 ) || &error($q,"Unable to make annotate repository at '$AN_DIR': $!");
} ## endunless

my $C_URL = $q->param('CSS_URL') || $CSS_URL;

my $ENTRY = $q->param('ENTRY');
&error($q,"Missing entry name or ID. Check your plugin syntax.")
	if (!$ENTRY);

my $F_ENTRY = $RD . $CGI::SL . $ENTRY;
$F_ENTRY .= ".txt" unless ($F_ENTRY =~ /\.txt$/xio);
&error($q,"No such blog entry '$F_ENTRY', or incorrect parameters for update.")
	unless (-r $F_ENTRY);
&error($q,"Can't update entry '$ENTRY': $! ($?)")
	unless (-w $F_ENTRY);

## we should be good to go from here.
my @F_STAT = stat($F_ENTRY);

## read in the entry. 
my($SUBJECT,@ENTRY) = read_entry($F_ENTRY);

my $SELF_URL = $q->url(
	-path_info=>1,
	-query=>1,
);

if ($q->param('_w')) {
	## write the change
	unless ( write_new_annotate(
		link_index => $q->param('_l'), 
		url => $q->param('_link'),
		title => $q->param('_title') || undef,  
		fn => ($q->param('_fn') || $ENTRY), 
		word => $q->param('_word'),
		)) {
		&error($q, "I went to generate the new entry, ",
			"and got nothing! Not good!")
	} ## endunless
	
	&my_start_html($q,
		"Updated.",
		($q->param('RETR_URL') || $RETURN_URL || undef),
	);
	print <<EOF;
You're done. Hooray.<br>
EOF
	print $q->end_html;
	exit 0;
	
} elsif ($q->param('_l')) {
	## we've got the text to link to, now prompt for the URL.
	&my_start_html($q, "Enter your URL");
	print "<form method=post action=",$q->url(),">\n";
	foreach my $k ($q->param()) {
		print "<input type=hidden name=\"$k\" value=\"";
		print $q->param($k);
		print "\">\n";
	} ## endforeach
	print <<EOF;
<input type=hidden name="_w" value="$$">
<p>
Now, enter the URL you want to associate with that block of text, 
and click Ok. <br>
<input type=text name="_link" value="http://"> <input type=submit value="Ok"><br>
<p>
You can have an optional title to go in the href here.<br>
<input type=text name="_title"> <br>
<p>
<!-- input type=checkbox name="_p" value="1" checked>Check here to preview 
your annotation.<br -->
<p>
</form>
EOF
	print $q->end_html;
	exit 0;
	
} else {
	## show the entry, linked, and prep for URL prompting.
	&my_start_html($q,'Some Editing Title');
	print <<EOF;
<blockquote><i>
Select from the entry below the word which you want to annotate to.
Note that you cannot annotate the subject of the entry. Also note 
that you're probably going to see the end mail-to text; you probably 
don't want to annotate that. <br>
Be aware that if a link in the original story encompasses more than 
one word, you will only be able to annotate <u>after</u> that link - 
you can't put an annotation in a linked phrase; it'll ruin 
continuity (or something).
</i></blockquote>
<p>
EOF
	print "<b>$SUBJECT</b>\n";
	print "<p>\n";
	
	my $word = '';
	my $got_a = 0;
	my $link = '';
	my $phrase = '';
	my %count_ary = ();
	for my $i (0..$#ENTRY) {
		my %r = %{ $ENTRY[$i] };
		
		if ($r{tag} > 0) {
			if ($r{text} =~ /^\<a\s+/gxio) {
				$got_a++;
				next;
			} elsif ($r{text} =~ /^\<\/a/gxio) {
				$got_a = 0;
				print $link;
				$phrase =~ s/\s+$/<\/a> /gxio;
				print $phrase; 
				$link = '';
				$phrase = '';
				$word = '';
			} else {
				print $r{text};
				next;
			}
		} ## endif
		
		$word = $r{text}; 
		$word =~ s/^\s+//gxio;
		$word =~ s/\s+$//gxio;
		if ($word eq "") {
			$phrase .= "$r{text}";
			next;
		}
		$count_ary{$word}++;
		
		$link = "<a href=\"$SELF_URL\;_l=$count_ary{$word}\;_word=$word\">";
		$phrase .= "$r{text} " unless 
			($r{tag} && 
			($r{text} =~ /^\<a\s+/gxio || $r{text} =~ /^\<\/a/gxio));
		
		if ( ($r{tag} && $r{text} =~ /^\<\/a/gxio) || $got_a < 1) {
			$got_a = 0;
			print $link;
			$phrase =~ s/\s+$/<\/a> /gxio;
			print $phrase;
			$phrase = '';
			$link = '';
			$word = '';
		} ## endif
	} ## endfor
	
	print "<p>\n";
	print $q->end_html;
	exit;
} ## endif

sub write_new_annotate {
	my(%arg) = (@_);
	foreach my $p (qw(link_index url word fn)) {
		&error($q,"Missing param: $p") unless
			($arg{$p});
	} 
	my $a_file = $AN_DIR . $CGI::SL . $arg{fn};
	if (!(open(AAD,">> $a_file"))) {
		&error($q,"Unable to open '$a_file' for writing: $!");
	} ## endif
	## write format of: 
	## 	word_num word url title
	print AAD join(' ', $arg{link_index}, $arg{word}, 
		$arg{url}, $arg{title}, "\n");
	close(AAD);
	return 1;
} ## endsub


sub read_entry {
	my $fqpn = shift;
	return undef unless ($fqpn);
	my @entry = ();
	my %ref = ();
	my $count = 1;
	my $p = HTML::Parser->new(
        	start_h   => [ sub { _arrayify( shift, \@entry, 1) }, "text" ],
	        end_h     => [ sub { _arrayify( shift, \@entry, 1) }, "text" ],
	        default_h => [ sub { _arrayify( shift, \@entry) }, "text" ],
	);
	
	if (!open(E,"< $fqpn")) {
		&error($q,"Can't read entry file at '$fqpn': $!\n");
	} ## endif
	my $subject = <E>;  chomp $subject;
	while (<E>) {
		$p->parse( $_ ) || &error($q,"Can't parse chunk o' HTML: $!");
	} ## endwhile
	close(E);
	
	## now, @entry should contain all the non-html text in the entry.
	return ($subject,@entry);
} ## endsub

sub _arrayify {
        my $t = shift;
        my $ref = shift;
        my $tag = shift;
        if ($tag) {
                my %r = (
                        text => $t,
                        tag => $tag,
                );
                push @$ref, \%r;
        } else {
                foreach my $w (split(/\s+/, $t)) {
                        my %r = (
                                text => $w,
                                tag => 0,
                        );
                        push @$ref, \%r;
                } ## endforeach
        } ## endif
} ## endsub


sub my_start_html {
	my $q = shift;
	my $title = shift || "Some kinda title.";
	my $redir = shift || undef;
	print $q->redirect( $redir ) if ($redir);
	print $q->header;
	print $q->start_html( 
                -title => $title,
                -BGCOLOR => 'white',
                -style => {'src' => ($C_URL || undef) },
        );
} ## endsub

sub error {
	my $q = shift;
	my $mesg = join(' ', @_) || "Unknown error.";
	&my_start_html($q,"W00t, Error!");
	print "An error happened. Too bad for you.\n<p>\n";
	print "<code>$mesg</code><br>\n";
	print $q->end_html;
	exit 1;
} ## endsub

sub debug {
	return unless ($DEBUG);
	print STDERR join(" ", @_, "\n");
} ## endsub

__END__