#!/usr/bin/perl -T

# Copyright (C) 2007 王亮 <netcasper AT gmail DOT com>

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public Licence as published by
# the Free Software Foundation; either version 2, 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 Licence for more details.

package bookfinder;
use base qw(CGI::Application);

use HTML::Pager;
use CGI;
use CGI::Session;
use CGI::Session::Auth;
use File::Find;
use File::Basename;
use File::Spec::Functions qw(splitdir);
use URI::Escape;
use HTML::Entities;
use Regexp::Common;

use strict;
use warnings;

{
    my @books;
    # only show those two types of book
    my @search_pattern = (qr/\.(?:chm|pdf)$/i);

    sub get_book {
	@books;
    }

    sub find_book {
	for my $pattern (@search_pattern) {
	    return unless $_ =~ /$pattern/;
	}
	push @books, $_;
    }

    sub add_search_pattern {
	push @search_pattern, map { qr/\Q$_\E/i } @_;
    }
}

sub setup {
    my $self = shift;

    $self->start_mode('list');
    $self->mode_param('cmd');
    $self->run_modes
	(
	    list => 'main',
	    login => 'main',
	    logout => 'main',
	);

    my $session = new CGI::Session($self->query);
    $self->param('_session' => $session);

    my $auth = new CGI::Session::Auth
	({
	    CGI => $self->query,
	    Session => $session,
	});
    $self->param('_auth' => $auth);
    $auth->authenticate();

    $self->header_props(-cookies => $auth->sessionCookie(),
			-charset => 'utf-8');
}

sub main {
    my $self = shift;

    my $cgi = $self->query;
    my $session = $self->param('_session');
    my $auth = $self->param('_auth');
    if ($cgi->param('cmd') eq "logout") {
	$auth->logout();
	$session->clear('log_username');
    }
    else {
	$session->save_param($cgi, ['log_username']);
    }

    my $search_string = $cgi->param('search');

    # analyze search pattern
    my $search_hint = prepare_for_search($cgi, $search_string);

    # show book list
    my ($content, $title) = list_book($cgi);

    # construct search history
    my @search_history = get_search_history
	(
	    # Do NOT use $cgi->param('search') directly here.  It just
	    # disappears weirdly and you will never get your search
	    # history back correctly.
	    $search_string,
	    $session->param('search_history')
	);

    # save search history
    $session->param('search_history', \@search_history) if @search_history;

    my $loginout;
    if (! $auth->loggedIn) {
	$loginout = $cgi->start_form(-method=>"POST"
				     -action=>"?cmd=login")
	    . "username " . $cgi->textfield('log_username', undef, 10)
	    . " password " . $cgi->password_field('log_password', undef, 10)
	    . $cgi->submit("login") . $cgi->end_form;
    }
    else {
	$loginout = "hello " . $session->param('log_username') . ", "
	    . $cgi->a({href=>'?cmd=logout'}, "logout");
    }

    # construct web page
    return make_html($cgi, $loginout, $title,
		     $content, $search_hint, @search_history);
}

sub list_book {
    my $cgi = shift;

    find( { wanted => \&find_book, no_chdir => 1 }, '.');
    my $num_of_books = scalar get_book();
    my $pager = HTML::Pager->new (query => $cgi,
				  get_data_callback => \&list_book_callback,
				  rows => $num_of_books,
				  page_size => 25,
				  persist_vars => [ 'search' ],
			      );

    my $title = "Book List ($num_of_books)";
    return ($pager->output, $title);
}

sub prepare_for_search {
    my ($cgi, $search_string) = @_;

    # analyze search pattern
    my $unbalanced_quote;
    my @search_word = construct_search_word($search_string);
    if (@search_word) {
	add_search_pattern(@search_word);

	$unbalanced_quote = find_word_with_quote_char(\@search_word);
    }

    # construct search hint
    my $search_hint;
    if (defined $unbalanced_quote) {
	$search_hint = q{WARNING: unbalanced " char in word }
	    . $cgi->strong($cgi->em($unbalanced_quote));
    }
    else {
	$search_hint = join
	    (
		' ',
		map { if (/\s/) { qq{"$_"} } else { $_ } } @search_word
	    );
    }

    return $search_hint;
}

sub get_search_history {
    my ($string, $history) = @_;

    my @search_history;
    if (defined $history) {
	@search_history = @$history;
    }

    # add currect search string into history
    if ($string) {
	for my $item (@search_history) {
	    return @search_history if $item eq $string;
	}

	# save non-existing item into history
	push @search_history, $string;

	# keep only 5 history items at most
	shift @search_history if scalar @search_history > 5;
    }

    return @search_history;
}

sub make_html {
    my ($cgi, $loginout, $title, $content, $hint, @history) = @_;

    my $search = $cgi->start_form .
        'Book Search ' .
        $cgi->textfield('search') .
        $cgi->submit .
        $cgi->end_form;

    return $cgi->start_html($title) .
	$cgi->table({-border=>0, -width=>"100%"},
		    $cgi->Tr($cgi->td({-width=>"60%"}, $loginout),
			     $cgi->td($search),
			     $cgi->td($cgi->a({href=>"recent.cgi"}, "Recent books")))) .
	$cgi->hr .
	$cgi->p($hint) .
        $cgi->h3($title) .
        $content .
	$cgi->h3('Search History (' . scalar @history . ')') .
	(@history ? print_search_history($cgi, @history) : "") .
        $cgi->end_html;
}

sub print_search_history {
    my ($cgi, @history) = @_;

    $cgi->ul( $cgi->li(\@history) );
}

sub find_word_with_quote_char {
    my $words = shift;

    for my $w (@$words) {
	return $w if $w =~ m/(?:^|[^\\])(?:\\\\)*["]/;
    }

    return;
}

sub escape_special_char {
    my $string = shift;

    $string =~ s/\\([\\\"])/$1/g;
    return $string;
}

sub construct_search_word {
    my $search_string = shift;

    return unless $search_string;

    my @quoted_string;
    while ($search_string =~ s/$RE{delimited}{-delim=>'"'}{-keep}//) {
	push @quoted_string, escape_special_char($3);
    }

    my @search_word = split('\s+', $search_string);
    for my $w (@search_word) {
	$w = escape_special_char($w);
    }

    return (@search_word, @quoted_string);
}

sub list_book_callback {
    my ($offset, $rows) = @_;
    my @current_books;

    my @books = get_book();
    my $num_of_books = scalar @books;
    for my $b ($offset .. $offset + $rows - 1) {
	last if $b == $num_of_books;
	my $filename = $books[$b];
	$filename =~ s{^\./}{};

	my @dirs = splitdir(dirname($filename));
	my $path = join '/', map { uri_escape($_) } @dirs;
	my $title = basename($filename);
	my $url = "$path/" . uri_escape($title);

	if ($title =~ /^(?:ch(?:apter)?)?\d+\.(?:chm|pdf)$/i
		|| $filename =~ /Object-Oriented Construction/i) {
	    $title = $filename;
	}

	push @current_books, [ qq(<a href="$url">$title</a>) ];
    }
    return \@current_books;
}

1;

package main;

unless (caller()) {
    my $app = new bookfinder;
    $app->run();
}