#!/usr/bin/perl -wT
#use strict;
my $debuganon = 0;
my $debugauth = 0;
use CGI::Carp qw(fatalsToBrowser);
#
# TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2005 Martin at Cleaver.org
# Copyright (C) 2005-2006 TWiki Contributors
#
# 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. For
# more details read LICENSE in the root of this distribution.
#
# 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.
#
# As per the GPL, removal of this notice is prohibited.

=pod
Examination of a TWikiRoot/bin/ finds that the files are practically identical.

This script goes one step further: it replaces the whole of the bin
directory with a single CommonFrontEndCgiScript. It checks PATH_INFO,
extracts the op, (e.g. op=view) and rewrites PATH_INFO without the
op. (op was named verb in my original proposal). It then looks up 
the op using the table below to work out which TWiki::UI:: method to call,
and delegates control.

This implementation eliminates all the bin scripts: the URL changes from
    * bin/view to bin/twiki/view and
    * bin/edit to bin/twiki/edit . This redirects to:  
       * bin/edit to bin/twikiauth/edit 

This leads the way for a general method for e.g. plugins requiring bin

I suspect that I've just reimplemented the core of CGI::Application, but
we'll see.

I have not yet considered what to do about setlib.cfg, etc.

=cut





BEGIN {
    # Set default current working directory (needed for mod_perl)
    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
        chdir $1;
    }
    # Set library paths in @INC, at compile time
    unshift @INC, '.';
    require 'setlib.cfg';
}
use TWiki::UI;

my %ops = (
	     'attach' => [ "TWiki::UI::Upload", "attach", 1 ],
	     'changes' => [ "TWiki::UI::Changes", "changes", 0 ],
	     'edit' => [ "TWiki::UI::Edit", "edit", 1 ],
	     'manage' => [ "TWiki::UI::Manage", "manage", 1 ],
	     'oops' => [ "TWiki::UI::Oops", "oops_cgi", 0 ],
	     'passwd' => [ "TWiki::UI::Register", "passwd_cgi", 0 ],
	     'preview' => [ "TWiki::UI::Preview", "preview", 0 ],
	     'rdiff' => [ "TWiki::UI::RDiff", "diff", 0 ],
	     'register' => [ "TWiki::UI::Register", "register_cgi", 0 ],
	     'rename' => [ "TWiki::UI::Manage", "rename", 1 ],
	     'resetpasswd' => [ "TWiki::UI::Register", "resetPassword", 0 ],
	     'save' => [ "TWiki::UI::Save", "save", 1 ],
	     'search' => [ "TWiki::UI::Search", "search", 0 ],
	     'statistics' => [ "TWiki::UI::Statistics", "statistics", 0 ],
	     'upload' => [ "TWiki::UI::Upload", "upload", 1 ],
	     'view' => [ "TWiki::UI::View", "view", 0 ],
	     'viewfile' => [ "TWiki::UI::View", "viewfile", 1 ]
	   );

my $op;
my $originalpathinfo = $ENV{PATH_INFO};
($ENV{PATH_INFO}, $op) = take_op($ENV{PATH_INFO});
my ($lib, $entrypoint, $needauth) = find_op($op);
#print "E: $entrypoint\n";

my $script = $ENV{SCRIPT_URI};
my $inauth = $script =~ m!bin/twikiauth!;
my $debug = $inauth ? $debugauth : $debuganon;
my $remoteuser = $ENV{REMOTE_USER};

print "Content-type: text/html\n\n" if $debug;
if ($entrypoint eq "") {
    html_error();
} else {
    html_diagnose($op, $lib, $entrypoint, $needauth, %ENV) if $debug; 
    print "<LI>needauth = $needauth; inauth = $inauth; remoteuser = $remoteuser\n" if $debug;

    if ($needauth) {
	if (!$inauth) {
	    if (!defined($remoteuser)) {
		print "<LI>remoteuser: ".$remoteuser if $debug;
		my $authscript = $script;
		$authscript =~ s!bin/twiki/!bin/twikiauth/!;
#	    $authscript .= $originalpathinfo; # "/".$op."&path=".$ENV{PATH_INFO};
		print "<h2>Redirecting to $authscript</h2>\n" if $debug;
		use CGI;
		my $query = new CGI;
		print $query->redirect($authscript);
		exit 0;
	    }
	}
    }

    {
	no strict 'subs';
	eval "TWiki::UI::run(\'$lib\', \'$entrypoint\')"; # unless $debug;
    };
    if ($@) {
	die "couldn't run ${lib}::${entrypoint} $debug\n\t$@";
    }
}

=pod
Currently this only takes the hardcoded table of inbuilt TWikiOps.
However, there is nothing to stop us adding a syntax:
    /view => ...
    /plugins => delegate according to some table
    /bunch-of-legacy-files

Now we just need to determine how to carve out the ops namespace.
=cut
sub find_op {
    my $op = shift;
    my $ref = $ops{$op};
    my ($lib, $entrypoint, $needauth) = @$ref;
    print "A: $lib, $entrypoint, $needauth\n" if $debug;
    return ($lib, $entrypoint, $needauth);
}

sub take_op {
    my $path = shift;
    $path =~ m!/(.*?)/.*!;
    my $op = $1;
    $path =~ s!/$op!!;
    #$op =~ s!/.*?!!;
    #print "P: ".$path."\n";
    #print "O: $op\n";
    return ($path, $op);
}

sub html_error {
    print "<html><head><title>TWiki</title></head>\n";
    print "<body>\n";
    print "<h1>".$op." is not valid</h1>\n";
    print "<LI>".show_ops("\n<LI>");
    print "</body></html>\n";
}

sub html_diagnose {
    my ($op, $lib, $entrypoint, $needauth, %ENV) = @_;

    print "<H1> For '$op'- running ${lib}::${entrypoint}</H1>";
    print "<h2>".join("\n<LI>",@INC)."</h2>";
    print "<h2>auth=$needauth</h2>\n";
    foreach my $key (sort keys %ENV) {
	print "<LI> $key = $ENV{$key}\n";
    }
}

sub show_ops {
    my ($delim) = @_;
    for my $key (sort keys %ops) {
	print $delim, $key;
    }
}
