#!/usr/local/bin/perl

# $Id: diversity_view,v 1.2 2006/01/30 15:35:13 kycl4rk Exp $

use strict;
use CGI;
use Data::Dumper;
use Fcntl;
use File::Spec::Functions;
use Geo::Coordinates::DecimalDegrees;
use Gramene::Config;
use Gramene::Page;
use Template;
use Gramene::Utils qw( pager commify similarity_search );
use Lingua::EN::Inflect qw( PL );
use Readonly;

use lib '/opt/GDPDM/lib';
use GDPDM::Config qw( get_config );
use GDPDM::CDBI;
use GDPDM::Utils qw( table_name_to_class );

Readonly my $VERSION        => sprintf "%d.%02d", 
                               q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
Readonly my $ITEMS_PER_PAGE => 25;

delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';

use vars qw( @Objects @DBs );

@Objects        = GDPDM::CDBI->represented_tables;
@DBs            = GDPDM::Config->available_databases;
my $q           = CGI->new;
my $output_type = 'text/html';

my ( $t, $Page, $html );
eval { 
    $Page            ||= Gramene::Page->new( Apache->request );
    my $cfile        = Gramene::Config->new;
    my $config       = $cfile->get('diversity');
    my $template_dir = $config->{'template_dir'};
    $t               = Template->new( 
        INCLUDE_PATH => $template_dir,
        WRAPPER      => 'wrapper2.tmpl',
        VARIABLES    => {
            cgi          => $q,
            gramene_page => $Page,
            objects      => \@Objects,
            dbs          => \@DBs,
        },
        FILTERS      => {
            decimal2dm   => sub {
                my $decimal = shift;
                my ( $d, $m ) = decimal2dm( $decimal );
                return "$d&deg; $m'";
            },
        }
    );

    my $db_name = $q->param('db_name') || $q->cookie('db_name') || '';
    my $action  = $q->param('action')  || 'home';
    my $db      = GDPDM::CDBI->db_Main( $db_name );

    $q->param( 'db_name', $db_name );

    if ( $action eq 'list' ) {
        my @search_objects = $q->param('object') || @Objects;
        my $search_value   = $q->param('search_for')   || '';
        my $related_to     = $q->param('related_to')   || '';
        my $order_by       = $q->param('order_by')     || '';
        my $where          = $q->param('where')        || '';

        my $search_results = search( 
            db             => $db,
            search_objects => \@search_objects, 
            search_value   => $search_value,
            related_to     => $related_to,
            where          => $where,
            order_by       => $order_by,
            search_type    => $q->param('search_type') || '',
        );

        $t->process(
            'list.tmpl',
            {
                search_results => $search_results
            },
            \$html
        ) or $html = $t->error;
    }
    elsif ( $action eq 'view' ) {
        my $object    = $q->param('object') or die 'No object name';
        my $id        = $q->param('id')     or die 'No id';
        my $class     = table_name_to_class( $object )     
                        or die "Invalid object ($object)";
        my @columns   = $class->columns('Ordered');
        my $item      = $class->retrieve( $id ) or die "Bad id '$id'"; 
        my %has_a     = meta_parse( $class->meta_info('has_a') );
        my $has_many  = $class->meta_info('has_many');

        my @link_baskets;
        LINK_TABLE:
        for my $link_table ( keys %$has_many ) {
            my $link_class   = table_name_to_class( $link_table );
            my $fk_field     = $has_many->{$link_table}{'args'}{'foreign_key'};
            my @link_columns = $link_class->columns('Essential');
            my %link_has_a   = meta_parse( $link_class->meta_info('has_a') );

            my $entries_per_page = 10;
            my $pager            = $link_class->pager( $entries_per_page, 1 );
            my @items            = $pager->search( $fk_field => $id );

            next LINK_TABLE if scalar @items == 0;

            my $url = $q->param('url') . "?action=list&object=$link_table"
                    . "&where=$fk_field:" . $item->id;

#            my ( $p, $junk ) = pager(
#                count            => $pager->total_entries,
#                url              => $url,
#                entries_per_page => $entries_per_page,
#                current_page     => $q->param('page_no') || 1,
#                object_name      => $item_name,
#            );

            push @link_baskets, {
                object          => $link_table,
                items           => \@items,
                pager           => $pager,
                pager_url       => $url,
#                pager_item_name => $item_name,
                columns         => \@link_columns,
                has_a           => \%link_has_a,
                url             => $url,
            };
        }

        my $view_template =  "view-${object}.tmpl";
        my $template      = -e catfile( $template_dir, $view_template )
                             ? $view_template : 'view.tmpl';

        $t->process(
            $template,
            {
                item         => $item,
                columns      => \@columns,
                has_a        => \%has_a,
                link_baskets => \@link_baskets,
            },
            \$html
        ) or $html = $t->error;
    }
    else {
        $t->process( 'home.tmpl', {}, \$html ) or $html = $t->error;
    }
};

#
# Error handler
#
if ( $@ ) {
    if ( $t ) {
        $t->process(
            'error.tmpl',
            {
                title   => 'Error',
                err_msg => $@,
            },
            \$html
        ) or $html = $t->error;
    }
    else {
        $html = $@;
    }
}

my %headers = ( -content_type => $output_type );

if ( $q->param('db_name') ) {
    $headers{'-cookie'} = $q->cookie( 
        -name  => 'db_name',
        -value => $q->param('db_name'),
    );
}

print $q->header( %headers ), $html;
exit 0;

# ----------------------------------------------------
sub search {
    my %args           = @_;
    my $db             = $args{'db'};
    my $search_objects = $args{'search_objects'};
    my $search_value   = $args{'search_value'};
    my $related_to     = $args{'related_to'};
    my $where          = $args{'where'};
    my $order_by       = $args{'order_by'};
    my $search_type    = $args{'search_type'} || 'regular';

    $search_value =~ s/%/*/g; # change SQL wildcard to asterisk for FULLTEXT

    my $sql = sprintf(
        qq[
            select record_id 
            from   gdpdm_search
            where  table_name=?
            and    match(record_text) against ('%s'%s)
        ],
        $search_value,
        $search_value =~ /[*+.><()~"'-]/ ? ' in boolean mode' : ''
    );

    my $entries_per_page = @$search_objects > 1 ? 10 : $ITEMS_PER_PAGE;
    my @baskets;

    OBJECT:
    for my $object ( @$search_objects ) {
        my @items;
        my $class   = table_name_to_class( $object );
        my @columns = $class->columns('Essential');
        my %has_a   = meta_parse( $class->meta_info('has_a') );

        my $url 
            = $q->url . "?action=list&object=$object"
            . "&related_to=$related_to"
            . "&search_for=$search_value";

        my $item_name = class_name_to_display_name( $object );
        my $num_found;

        my $pager;
        if ( $search_value ) {
            my $matches = [];
            if ( $search_type eq 'similarity' ) {
                my $data = $db->selectall_arrayref(
                    'select * from gdpdm_search where table_name=?',
                    { Columns => {} },
                    ( $object )
                );

                if ( @$data ) {
                    $matches = [ map { $_->{'record_id'} } @{
                        similarity_search(
                            data          => $data,
                            search_fields => [ 'record_text' ],
                            search_values => [ $search_value ],
                            threshold     => 0.3,
                        )
                    } ];
                }
            }
            else {
                $matches = $db->selectcol_arrayref( $sql, {}, $object );
            }

            next OBJECT if !@$matches;
        
            for my $id ( @$matches ) {
                my $item = $class->retrieve( $id );
                push @items, $item;
            }

            if ( $order_by ) {
                @items = sort { 
                    $a->{ $order_by } cmp $b->{ $order_by } 
                } @items;
            }

            $pager = Data::Page->new( scalar @items, $ITEMS_PER_PAGE, 1 );
            @items = $pager->splice( \@items );

#            $num_found = scalar @items;
#
#            my ( $p, $data ) = pager(
#                data             => \@items,
#                url              => $url,
#                entries_per_page => $entries_per_page,
#                current_page     => $q->param('page_no') || 1,
#                object_name      => $item_name,
#            );
#
#            @items = @$data;
#            $pager = $p;
        }
        elsif ( $related_to =~ / \A (\w+) [:] (\d+) \Z /xms ) {
            my ( $table, $id ) = ( $1, $2 );
            my $class          = table_name_to_class( $table );
            my $related_object = $class->retrieve( $id );
            @items             = $related_object->get_related( $object );

            if ( $order_by ) {
                @items = sort { 
                    $a->{ $order_by } cmp $b->{ $order_by } 
                } @items;
            }
            
            $pager = Data::Page->new( scalar @items, $ITEMS_PER_PAGE, 1 );
            @items = $pager->splice( \@items );
        }
        else {
            $pager = $class->pager( $ITEMS_PER_PAGE, $q->param('page') || 1 );

            my %params;

            if ( $where ) {
                my ( $where_field, $where_value ) = split /:/, $where;
                $params{ $where_field } = $where_value;
            }

#            if ( $order_by ) {
#                $params{'order_by'} = $order_by;
#            }

            if ( %params ) {
                @items = $pager->search( %params, { order_by => $order_by });
            }
            else {
                if ( $order_by ) {
                    @items = $pager->retrieve_all_sorted_by( $order_by );
#                    my %p = ( order_by => $order_by );
#                    if ( $order_by =~ /([^.]+)[.](.+)/ ) {
#                        $p{'prefetch'} = $1;
#                    }
#                    @items = $pager->retrieve_all( \%p );
                }
                else {
                    @items = $pager->retrieve_all;
                }
            }

#            $num_found = $pgr->total_entries;
#            my ( $p, $junk ) = pager(
#                count            => $num_found,
#                url              => $url,
#                entries_per_page => $entries_per_page,
#                current_page     => $q->param('page_no') || 1,
#                object_name      => $item_name,
#            );
#
#            $pager = $p;
        }

        push @baskets, {
            object    => $object,
            items     => \@items,
            pager     => $pager,
            pager_url => $url,
            pager_item_name => $item_name,
            columns   => \@columns,
            has_a     => \%has_a,
#            num_found => $num_found,
        };
    }

    return \@baskets;
}

sub class_name_to_display_name {
    my $item_name = shift;
    $item_name    =~ s/^[a-z]{3}_//;
    $item_name    =~ s/_/ /g;
    $item_name    = ucfirst PL( $item_name );
    return $item_name;
}

sub meta_parse {
    my $meta = shift;
    my %return;
    while ( my ( $fk_field, $meta ) = each %$meta ) {
        my $fk_class = $meta->{'foreign_class'};
        $return{ $fk_field } = $fk_class->table;
    }

    return %return;
}

__END__

# ----------------------------------------------------

=pod

=head1 NAME

diversity_view - CGI interface to GDPDM schema

=head1 DESCRIPTION

A simple CGI viewer for the GDPDM schema.

=head1 SEE ALSO

CGI, GDPDM::CDBI.

=head1 AUTHOR

Ken Youens-Clark E<lt>kclark@cshl.eduE<gt>.

=head1 COPYRIGHT

Copyright (c) 2006 Cold Spring Harbor Laboratory

This library is free software;  you can redistribute it and/or modify 
it under the same terms as Perl itself.

=cut
