#!/usr/bin/perl -wT
#
# $Id: w3mbookmark,v 1.3 2007/02/05 08:18:52 izumi Exp $
#
#

use strict;

package BookMarker;

BEGIN {
    $ENV{IFS} = " \t\n";
    $ENV{PATH} = "/bin:/usr/bin";
    delete $ENV{ENV};
    delete $ENV{BASH_ENV};

    use IO::Handle;
    use Fcntl qw(:DEFAULT :seek);
    # import O_* and SEEK_*
}

my %Entities = (
    '&' => '&',
    '<', => '&lt;',
    '>', => '&gt;',
    '"', => '&quot;',
);

my $Chars = join '', keys %Entities;

sub END_SECTION() { "<!--End of section (do not delete this comment)-->\n"; }

=cut

# FIXME: gettextize here
my %Text = (
    BKMARK_TITLE => "ブックマークの登録",
    BKMARK_ADD => "登録",
    DEFAULT_SECTION => "未分類",
);

=cut

my %Text = (
    BKMARK_TITLE => "Register to my bookmark",
    BKMARK_ADD => "ADD",
    DEFAULT_SECTION => "Miscellaneous",
);

#
# General functions
#

sub FormUnescape($)
{
    local $_ = shift;

    tr/+/ /;
    s/%([\dA-Fa-f]{2})/pack('H2', $1)/ge;
    $_;
}

sub HTMLEscape($)
{
    local $_ = shift;

    s/([\Q$Chars\E])/$Entities{$1}/g;

    $_;
}

sub CopyFile($$)
{
    my $ifh = shift;
    my $ofh = shift;

    my $size = 0;
    my $buf;
    while (read($ifh, $buf, 1024)) {
	print $ofh $buf;
	$size += length($buf);
    }

    $size;
}

sub ExpandPath($)
{
    my $path = shift;

    if ($path =~ /^~/) {
	my $pos = index($path, '/');
	my $user = ($pos > 0)? substr($path, 1, $pos+1): substr($path, 1);
	my $home = undef;
	if ($user ne '') {
	    $home = (getpwnam($user))[7];
	} else {
	    $home = $ENV{HOME};
	}
	if (defined($home)) {
	    if ($pos > 0) {
		substr($path, 0, $pos, $home);
	    } else {
		$path = $home;
	    }
	}
    }

    $path;
}


#
# Class constructor
#
sub new($@)
{
    my $pkg = shift;

    my $this = {
	stage => 'header',	# header => content
	args => { },
    };

    bless $this, $pkg;

    $this->initialize();

    $this;
}

sub initialize($)
{
    my $this = shift;

    $this->checkMethod();
    $this->parseInput();

    $this->validateCookie($this->{args}{cookie}[0]);
}

sub checkMethod($)
{
    my $this = shift;

    # Allow only POST
    if (!exists $ENV{REQUEST_METHOD}) {
	$this->fatalError("REQUEST_METHOD does not exist\n");
    } elsif ($ENV{REQUEST_METHOD} ne 'POST') {
	$this->fatalError(qq|Invalid REQUEST_METHOD: "$ENV{REQUEST_METHOD}"\n|);
	exit;
    }
}

sub parseInput($)
{
    my $this = shift;

    if (!exists $ENV{CONTENT_LENGTH}) {
	$this->fatalError("CONTENT_LENGTH does not exist\n");
    }
    $ENV{CONTENT_LENGTH} =~ /^(\d+)$/;
    my $length = $1;
    unless (defined($length)) {
	$this->fatalError(qq|Invalid CONTENT_LENGTH: "$ENV{CONTENT_LENGTH}"\n|);
    }

    my $query = undef;
    read(STDIN, $query, $length);
    if (length($query) != $length) {
	$this->fatalError("Content-Length mismatch: CONTENT_LENGTH=$length, but real length=",
		length($query), "\n");
    }

    my $args = $this->{args};
    foreach (split /[&;]/, $query) {
	my ($k, $v) = map {&FormUnescape($_)} split /=/, $_, 2;
	unless (exists($args->{$k})) {
	    $args->{$k} = [ ];
	}
	# accumulate duplicated values
	push @{$args->{$k}}, $v;
    }
}

sub fatalError($@)
{
    my $this = shift;

    if ($this->{stage} eq 'header') {
	print "Content-Type: text/plain\r\n";
	$this->endHeader();
    }
    print "Error: ", @_;

    exit;
    # NOTREACHED
}

sub endHeader($)
{
    my $this = shift;

    $this->{stage} = 'content';
    print "\r\n";
}

sub respond($)
{
    my $this = shift;

    my %args = ();
    while (my ($k, $v) = each(%{$this->{args}})) {
	$args{$k} = $v->[0];
    }

    # Should I expand path?
    $args{bmark} =~ /^(.+)$/;
    my %conf = (bmark => &ExpandPath($1));

    if ($args{mode} eq 'panel') {
	$this->printPanel(\%conf, \%args);
    } elsif ($args{mode} eq 'register') {
	if ($this->appendEntry(\%conf, \%args)) {
	    print "Content-Type: text/plain\r\n";
	    print "X-Coment: text/plain\r\n";
	    print "w3m-control: BACK\r\n";
	    print "w3m-control: BACK\r\n";
	}
	$this->endHeader();
    }
}

sub validateCookie($$)
{
    my $this = shift;
    my $cookie = shift;

    my $fcookie = &LocalCookie();
    if (!defined($cookie) || !defined($fcookie)) {
	$this->fatalError("Missing local cookie: It may be an illegal invocation\n");
    } elsif ($cookie ne $fcookie) {
	$this->fatalError("Local cookie mismatch: It may be an illegal invocation\n");
    }

    1;
}

sub LocalCookie()
{
    my $cookie = undef;

    my $path = exists($ENV{LOCAL_COOKIE_FILE})? $ENV{LOCAL_COOKIE_FILE}: undef;

    if (defined($path)) {
	if (open(FH, "<", $path)) {
	    $cookie = <FH>;
	    chomp $cookie;
	    close FH;
	}
    }

    $cookie;
}

sub printPanel($$$)
{
    my $this = shift;
    my $conf = shift;
    my $args = shift;

    my %eargs = ();
    foreach my $k (qw(mode cookie title url section)) {
	$eargs{$k} = &HTMLEscape($args->{$k});
    }

    my $bookmark = $conf->{bmark};
    $eargs{bmark} = &HTMLEscape($bookmark);
    my $desc = $args->{description};
    $desc =~ s/^\s+//;
    $desc =~ s/^\s+$/\n/;
    $eargs{description} = &HTMLEscape($desc);

    # XXX: consider encoding issue
    print "Content-Type: text/html; charset=EUC-JP\r\n";
    $this->endHeader();

    print <<EOF;
<html>
<head>
<title>$Text{BKMARK_TITLE}</title>
</head>
<body>
<h1>$Text{BKMARK_TITLE}</h1>
<form method=POST action="file:///\$LIB/w3mbookmark">
<input type=hidden name=mode value=register>
<input type=hidden name=bmark value="$eargs{bmark}">
<input type=hidden name=cookie value="$eargs{cookie}">
<table cellpadding=0>
EOF

    if (open(FH, '<', $bookmark)) {
	print "<tr><td>Section:<td>";
	my $c = 0;
	while (<FH>) {
	    if (m#^\s*<h2>([^<]*)</h2>#) {
		my $sec = $1;
		if ($c == 0) {
		    print qq|<select name="section">\n|;
		}
		print qq|<option value="$sec">$sec\n|;
		$c++;
	    }
	}
	if ($c > 0) {
	    print "</select>\n";
	} else {
	    print " - (none)\n";
	}
	close FH;
    }

    print <<EOF;
<tr><td>New&nbsp;Section:<td><input type=text name=newsection size=60>
<tr><td>URL:<td><input type=text name=url value="$eargs{url}" size=60>
<tr><td>Title:<td><input type=text name=title value="$eargs{title}" size=60>
<tr><td valign=top>Description:<td><textarea name=description rows=8 cols=60>$eargs{description}
</textarea>
<tr><td><input type=submit value="$Text{BKMARK_ADD}">
</table>
</form>
</body>
</html>
EOF
}

sub appendEntry($$$)
{
    my $this = shift;
    my $conf = shift;
    my $args = shift;

    my %rec = %$args;
    $rec{section} = &sectionName(\%rec);

    my $bookmark = $conf->{bmark};
    my $added = 0;
    my ($origfh, $tmpfh) = $this->backupFile($bookmark);
    if (defined($origfh)) {
	# Emptify the original file.
	truncate($origfh, 0);
	$added = &addBookmarkEntry($tmpfh, $origfh, \%rec);
	close $tmpfh;
	close $origfh;
	if ($added) {
	    # Successfully added. Should we delete the backup file?
	    # unlink $bookmark . '~';
	} else {
	    # Bookmark not added; perhaps the bookmark file is ill-formed.
	    # In this case, a new bookmark will be appeneded.
	}
    }

    unless ($added) {
	if (open(FH, '>>', $bookmark)) {
	    &writeBookmark(\*FH, \%rec);
	    close FH;
	} else {
	    $this->fatalError(qq|Can't appened to bookmark "$bookmark": |, $!, "\n");
	}
    }

    1;
}

sub sectionName($)
{
    my $rec = shift;

    my $sec = $rec->{section};
    if (exists($rec->{newsection}) && $rec->{newsection} ne '') {
	$sec = $rec->{newsection};
    }

    if ($sec eq '') {
	$sec = $Text{DEFAULT_SECTION};
    }

    $sec;
}

sub backupFile($)
{
    my $this = shift;
    my $path = shift;

    my ($origfh, $tmpfh) = (undef, undef);

    my $bkup = $path . '~';

    if (open(OFH, '+<', $path)) {
	if (sysopen(TFH, $bkup, O_RDWR|O_CREAT|O_TRUNC, 0600)) {
	    # backup the original file
	    &CopyFile(\*OFH, \*TFH);
	    TFH->flush;
	    # rewind file position
	    seek(TFH, 0, SEEK_SET);
	    seek(OFH, 0, SEEK_SET);
	    ($origfh, $tmpfh) = (\*OFH, \*TFH);
	} else {
	    close OFH;
	    $this->fatalError(qq|Can\'t create backup file "$bkup": |, $!, "\n");
	}
    } else {
	# Perhaps the file does not exist.
    }

    ($origfh, $tmpfh);
}

sub addBookmarkEntry($$$)
{
    my $ifh = shift;
    my $ofh = shift;
    my $rec = shift;

    my $delimiter = "<h2>" . &HTMLEscape($rec->{section}) . "</h2>\n";
    my $entry = &entryString($rec);
    my $found = 0;
    my $added = 0;
    while (<$ifh>) {
	next if ($_ =~ /^$/); # skip empty line

	if ($_ eq $delimiter) {
	    # Append in this section
	    $found = 1;
	}
	if ($found && !$added) {
	    s/^\s+//;
	    if ($_ eq END_SECTION) {
		print $ofh $entry;
		$added = 1;
		$found = 0;
	    }
	}
	if (!$added && $_ eq "</body>\n") {
	    print $ofh $delimiter, "<ul>\n", $entry, END_SECTION, "</ul>\n";
	    $added = 1;
	}
	print $ofh $_;
    }

    $added;
}

sub entryString($)
{
    my $rec = shift;

    my $title = $rec->{title};
    if ($title eq '') {
	$title = '(none)';
    }
    my $entry = qq|<LI><A HREF="| . &HTMLEscape($rec->{url})
		    . qq|">| . &HTMLEscape($title) . qq|</A>\n|;
    if (defined($rec->{description})) {
	my $desc = $rec->{description};
	$desc =~ s/\s*$/\n/;
	if ($desc !~ /^\s*$/) {
	    $entry .= ' - ';
	    $entry .= &HTMLEscape($desc);
	}
    }

    $entry;
}

sub writeBookmark($$)
{
    my $fh = shift;
    my $rec = shift;

    my $stat = 0;

    print $fh "<html><head><title>Bookmarks</title></head>\n";
    print $fh "<body>\n";
    print $fh qq|<h1>Bookmarks</h1>\n|;
    print $fh qq|<h2>|, &HTMLEscape($rec->{section}), qq|</h2>\n|;
    print $fh qq|<ul>\n|;
    print $fh &entryString($rec);
    print $fh END_SECTION;
    print $fh "</ul>\n</body>\n";
    print $fh "</html>\n";

    $stat;
}

package main;

#open(STDERR, ">&STDOUT");
my $cgi = new BookMarker();
$cgi->respond();
exit;

__DATA__
print LOG "--------------------\n";
print LOG $_, "\n" foreach @ARGV;
print LOG "--------------------\n";
foreach (sort keys %ENV) {
    print LOG "$_=", $ENV{$_}, "\n";
}
print LOG "---- STDIN ----------------\n";
while (<STDIN>) {
    print LOG $_;
}
print LOG "\n";
close LOG;
exit;