#!perl
@ORIGARGV = @ARGV;

require "set.pl";
require "netserver.pl";
require "httpserver.pl";
require "file.pl";
require "configfile.pl";
require "stash.pl";
require "stashrefs.pl";

require "kittenwebrender.pl";
require "kittenwebreport.pl";

# external
sub commitpage { # rawpagedata, db, pagename
    my ($rawpagedata, $db, $pagename) = @_;
    my ($out,@refs,@orefs,@tmp);
    my (%pdb,%rdb,%idb);
    tie %pdb, STASH, $db, "page";
    # get all wikiwords from the page
    @refs = &KITTENWEB::RENDER::getrefs($rawpagedata);
    # sort them (should uniq them too...)
    @refs = sort @refs;
    # save the page itself
    $pdb{$pagename} = $rawpagedata;
    if ($@) {
	&HTML::print_status_page("commit of $pagename failed: $@");
	return;
    }
    untie %pdb;			# not out of scope yet
    # grab the old copy of the refs in this page
    tie %rdb, STASH, $db, "refs";
    @orefs = split(/:/,$rdb{$pagename});
    # save the new refs directly.
    $rdb{$pagename} =  join(":",@refs);
    untie %rdb;
    # worst case, just delete old and add new:
    # take all the wikiwords we used to reference and remove ourselves
    # take the old pages we don't ref any more, and nuke from them
    foreach (SET::subtract(\@orefs,\@refs)) {
	tie %idb, STASHREFS, $db, $_;
	delete $idb{$pagename};
	untie %idb;
    }
    # now get all of the words we newly reference
    foreach (SET::subtract(\@refs,\@orefs)) {
	tie %idb, STASHREFS, $db, $_;
	$idb{$pagename} = 1;
	untie %idb;
    }
    &HTML::print_status_page("$pagename committed");
}

# external
sub commitlink { # rawpagedata, db, pagename
    my ($rawpagedata, $db, $pagename) = @_;
    # save the page itself
    my (%ldb,$status);
    tie %ldb, STASH, $db, "link";
    $ldb{$pagename} =  $rawpagedata;
    $status = ($@?$status="commit of $pagename failed: $@"
	       :"$pagename committed");
    untie %ldb;
    return $status;
}

# external
sub printrefspage { # db, page name, pw data
    my($db,$pagename,$pw) = @_;
    my %idb;
    tie %idb, STASHREFS, $db, $pagename;
    &HTML::print_head("References to $pagename");
    print "<ul>\n";
    foreach (keys %idb) {
	print qq{<li><a href="lookup=$_$pw">$_</a>\n};
    }
    print "</ul>$HTML::tail\n";
    untie %idb;
}
sub printallpages { # db
    my($dbname) = @_;
    my ($out,@names);
    my %db;
    &HTML::print_head("All names in database $dbname");
    foreach $tag ("page", "link") {
	tie %db, STASH, $dbname, $tag;
	@names = keys %db;
	untie %db;
	print "<h2>${tag}s</h2>\n";
	print "<ul>\n";
	foreach (@names) {
	    print "<li>${\KITTENWEB::RENDER::replaceword($dbname,$_)}\n";
	}
	print "</ul>\n";
    }
    print $HTML::tail;
}

sub buildlookup { 
    my ($db,$obj,$pw) = @_; 
    my %pdb;
    tie %pdb, STASH, $db, "page";
    &HTML::print_head($obj);
    print &KITTENWEB::RENDER::renderpage($db, &KITTENWEB::RENDER::renderempty($pdb{$obj},$obj), $obj, $pw);
    print $HTML::tail;
    untie %pdb;
}
$HTTP::SERVER::subgetverbs = {
    "lookup" => \&buildlookup,
    "edit" => \&printeditpage,
    "editlinks" => \&printeditlinks,
    "refs" => \&printrefspage,
    "report" => \&KITTENWEB::REPORT::dumpreport,
};
$HTTP::SERVER::subgetpaths = {
    "/allpages" => \&printallpages, 
    "/" => sub { my $db = shift;
		 &HTML::print_head("kittenweb $db server");
		 print qq{
<p>
<a href="lookup=WikiTop">Top of Wiki Clone $db</a>
$HTML::tail
};
	     },
};

sub doeditlinks {
    my ($database, $tag, $pw, $content) = @_;

    delete ${$content}{"pw"};
    &HTML::print_head("updating links in $tag");
    print "<ul>";
    for (keys %{$content}) {
	if($_ !~ /^$KITTENWEB::RENDER::WikiWord$/) {
	    print "<li> $_ not a valid page name\n";
	} elsif(${$content}{$_} ne $_) {
	    if(&commitlink(${$content}{$_}, $database, $_) =~ /failed/) {
		print "<li> $_ failed\n";
	    } else {
		print "<li> $_ committed\n";
	    }
	}
    }
    print "</ul>";
    print $HTML::tail;
}

sub doedit {
    my ($database, $tag, $pw, $content) = @_;
    if (defined(${$content}{"makelink"})) {
       my %pdb;
       tie %pdb, STASH, $database, "page";
       if (exists $pdb{$tag}) {
	   &HTML::print_status_page("link $tag failed - already a valid page");
       } else {
	   &HTML::print_status_page(&commitlink(${$content}{"body"},
				    $database, $tag));
       }
       untie %pdb;
   } else {
       &commitpage(${$content}{"body"}, $database, $tag);
   }
}

sub printeditpage { # db, page name, pw data
    my($db,$pagename,$pw) = @_;
    $pw =~ s/^&pw=// if defined $pw;
    my %pdb;
    tie %pdb, STASH, $db, "page";
    
    &HTML::print_head("Editing $pagename");
    print "edit the text area below, and submit to change<p>\n";
    &HTML::textform("page", "rows=9 cols=60",
		    &KITTENWEB::RENDER::rendersafe(&KITTENWEB::RENDER::renderempty($pdb{$pagename},$pagename)),
		    (exists $pdb{$pagename}?"":qq{<hr><input type="submit" value="create as URL" name="makelink">}).($pw?qq{<input type=password name=pw value=$pw>}:""));
    print qq{$HTML::tail};
}

# external
sub printeditlinks { # db, page name, pw data
    my($db,$pagename,$pw) = @_;
    $pw =~ s/^&pw=//;

    my (@names,$onelink);
    my (%pdb,%ldb);
    tie %pdb, STASH, $db, "page";
    @names = &KITTENWEB::RENDER::getrefs($pdb{$pagename});
    @names = grep(!exists $pdb{$_}, @names);
    untie %pdb;
    &HTML::print_head("Editing links on $pagename");
    print qq{<form method="POST"><dl>\n};
    tie %ldb, STASH, $db, "link";
    for (@names) {
	print qq{<dt>$_ <dd><input name="$_" value="};
	print $onelink = $ldb{$_}?$ldb{$_}:$_;
	print qq{" type="url" size=};
	print 5+length($onelink);
	print qq{>\n};
    }
    untie %ldb;
    print qq{</dl>
<input type="submit" value="accept changes">
 <input type="reset" value="punt changes">};
    print qq{<input type=password name=pw value=$pw>} if $pw;
    print qq{</form>$HTML::tail};
}

$HTTP::SERVER::subpostverbs = {
    "editlinks" => \&doeditlinks,
    "edit" => \&doedit,
};

sub HTTP::SERVER::checkpassword { #  database tag content{pw}
    my($db,$tag,$pw) = @_;
    return 1 if !defined $master_password;
    return 1 if $pw eq $master_password;
    return 0;
}

$CONFIGFILE::configverbs = {
    "password" => sub { $main::master_password = shift; },
    "nopassword" => sub { undef $main::master_password; },
    "database" => sub { my $args = shift;
			$args =~ m/^([^ ]*) +(.*)$/;
			$HTTP::SERVER::dbpaths{$1} = &FILE::expand_path($2);
			print "database $1: $HTTP::SERVER::dbpaths{$1}\n";
		    },
};

sub main {
    &CONFIGFILE::readconfig($conffile);
    &HTTP::SERVER::serverloop($port);
}

die "usage: $0 conffile portnumber" if @ARGV < 1;
$conffile = shift;
$port = 7999;
$port = shift if (@ARGV > 0);
$master_password = "foo";

&main;
