#!/usr/local/bin/perl

# $Id: markers,v 1.7 2007/05/22 19:38:19 kclark Exp $

=head1 NAME

markers2_admin - CGI interface for curating markers2

=head1 DESCRIPTION

Stanard web admin tool.

=head1 SEE ALSO

CGI, perl.

=head1 AUTHOR

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

=head1 COPYRIGHT

Copyright (c) 2005 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

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

use strict;
use CGI;
use Data::Dumper;
use Gramene::Config;
use Gramene::CDBI::Markers;
use Gramene::Marker::DB;
use Gramene::Utils qw( commify pager get_logger 
    table_name_to_gramene_cdbi_class);
use Template;

use vars qw[ $VERSION ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;

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

my %dispatch = (
    home                       => \&home,   
    browse_analyses            => \&browse_analyses,
    browse_analytical_correspondence_types            
                               => \&browse_analytical_correspondence_types,
    browse_germplasm           => \&browse_germplasm,
    browse_libraries           => \&browse_libraries,
    browse_map_types           => \&browse_map_types,
    browse_marker_types        => \&browse_marker_types,
    browse_map_sets            => \&browse_map_sets,
    browse_populations         => \&browse_populations,
    browse_species             => \&browse_species,
    browse_synonym_types       => \&browse_synonym_types,
    browse_xref_types          => \&browse_xref_types,
    create_analysis            => \&create_analysis,
    create_analytical_correspondence_type
                               => \&create_analytical_correspondence_type,
    create_analytical_correspondence_type_form 
                               => \&show_action_form,
    create_analysis_form       => \&show_action_form,
    create_germplasm_form      => \&create_germplasm_form,
    create_germplasm           => \&create_germplasm,
    create_map_set             => \&create_map_set,
    create_map_set_form        => \&create_map_set_form,
    create_map_type            => \&create_map_type,
    create_map_type_form       => \&show_action_form,
    create_marker              => \&create_marker,
    create_marker_form         => \&create_marker_form,
    create_marker_synonym      => \&create_marker_synonym,
    create_marker_type_form    => \&show_action_form,
    create_marker_type         => \&create_marker_type,
    create_species_form        => \&show_action_form,
    create_species             => \&create_species,
    create_synonym_type        => \&create_synonym_type,
    create_synonym_type_form   => \&show_action_form,
    create_xref                => \&create_xref,
    create_xref_form           => \&create_xref_form,
    create_xref_type_form      => \&show_action_form,
    create_xref_type           => \&create_xref_type,
    edit_analysis              => \&edit_analysis,
    edit_analytical_correspondence_type 
                               => \&edit_analytical_correspondence_type,
    edit_germplasm             => \&edit_germplasm,
    edit_library               => \&edit_library,
    edit_map                   => \&edit_map,
    edit_map_set               => \&edit_map_set,
    edit_map_type              => \&edit_map_type,
    edit_marker                => \&edit_marker,
    edit_marker_type           => \&edit_marker_type,
    edit_marker_synonym        => \&edit_marker_synonym,
    edit_species               => \&edit_species,
    edit_species_form          => \&show_action_form,
    edit_synonym_type          => \&edit_synonym_type,
    edit_xref                  => \&edit_xref,
    edit_xref_type             => \&edit_xref_type,
    delete_correspondence      => \&delete_correspondence,
    delete_germplasm           => \&delete_germplasm,
    delete_map_type            => \&delete_map_type,
    delete_mapping             => \&delete_mapping,
    delete_marker              => \&delete_marker,
    delete_marker_synonym      => \&delete_marker_synonym,
    delete_marker_type         => \&delete_marker_type,
    delete_species             => \&delete_species,
    delete_xref                => \&delete_xref,
    delete_xref_type           => \&delete_xref_type,
    search                     => \&search,
    set_marker_display_synonym => \&set_marker_display_synonym,
    transfer_mapping           => \&transfer_mapping,
    view_analysis              => \&view_analysis,
    view_analytical_correspondence_type              
                               => \&view_analytical_correspondence_type,
    view_germplasm             => \&view_germplasm,
    view_library               => \&view_library,
    view_map                   => \&view_map,
    view_map_set               => \&view_map_set,
    view_map_type              => \&view_map_type,
    view_marker_type           => \&view_marker_type,
    view_marker                => \&view_marker,
    view_population            => \&view_population,
    view_species               => \&view_species,
    view_synonym_type          => \&view_synonym_type,
    view_xref                  => \&view_xref,
    view_xref_type             => \&view_xref_type,
);

my $q = CGI->new;
my ( $t, $html );

eval {
    my $action = $q->param('action') || 'home';
    my $cfile  = Gramene::Config->new;
    my $config = $cfile->get('markers');
    my $mdb    = Gramene::Marker::DB->new;
    $t         = Template->new( 
        INCLUDE_PATH => join(':',
            $config->{'template_dir'} . '/admin',
            $config->{'template_dir'}
        ),
        WRAPPER      => 'wrapper.tmpl',
        FILTERS      => { commify => \&commify },
    );
    my $subref = $dispatch{ $action } or die "'$action' is not a valid action";
    $subref->( $mdb, $q, $t );
};

if ( my $err = $@ ) {
    if ( $t ) {
        process_template( 
            $t, 'error.tmpl', 
            { 
                title        => 'Error', 
                cgi          => $q,
                errmsg       => $err,
            }
        );
    }
    else {
        print $q->header('text/plain'), $err;
    }
}
exit(0);

# -------------------------------------------------------------
sub browse_analyses {
    my ( $mdb, $q, $t ) = @_;

    my $analyses = $mdb->get_all_analyses( $q->Vars );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $analyses,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $analyses  = $data;
    $pager = $p;

    process_template( 
        $t, 
        'browse-analyses.tmpl',
        {
            cgi      => $q,
            analyses => $analyses,
            title    => 'Browse Analyses',
            pager    => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_analytical_correspondence_types {
    my ( $mdb, $q, $t ) = @_;

    my $types = $mdb->get_all_analytical_correspondence_types( $q->Vars );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $types,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );

    $types  = $data;
    $pager = $p;

    process_template( 
        $t, 
        'browse-analytical-correspondence-types.tmpl',
        {
            cgi   => $q,
            types => $types,
            title => 'Browse Analitical Correspondence Types',
            pager => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_germplasm {
    my ( $mdb, $q, $t ) = @_;

    my $germplasm  = $mdb->get_all_germplasm( $q->Vars );
    my $db         = $mdb->db;
    my $species    = $db->selectall_arrayref(
        q[
            select   distinct s.species_id, s.species
            from     species s, germplasm g
            where    s.species_id=g.species_id
            order by s.species
        ],
        { Columns => {} }
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $germplasm,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $germplasm = $data;
    $pager     = $p;

    process_template( 
        $t, 
        'browse-germplasm.tmpl',
        {
            cgi       => $q,
            germplasm => $germplasm,
            title     => 'Browse Germplasm',
            pager     => $pager,
            species   => $species,
        },
    );
}

# -------------------------------------------------------------
sub browse_libraries {
    my ( $mdb, $q, $t ) = @_;

    my $libraries  = $mdb->get_all_libraries( $q->Vars );
    my $db         = $mdb->db;
    my $species    = $db->selectall_arrayref(
        q[
            select   distinct s.species_id, s.species
            from     species s, library l
            where    s.species_id=l.species_id
            order by s.species
        ],
        { Columns => {} }
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $libraries,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $libraries = $data;
    $pager     = $p;

    process_template( 
        $t, 
        'browse-libraries.tmpl',
        {
            cgi       => $q,
            libraries => $libraries,
            title     => 'Browse Libraries',
            pager     => $pager,
            species   => $species,
        },
    );
}

# -------------------------------------------------------------
sub browse_map_sets {
    my ( $mdb, $q, $t ) = @_;

    my $map_sets = $mdb->get_all_map_sets( $q->Vars );

    my $db = $mdb->db;
    my $species = $db->selectall_arrayref(
        q[
            select   distinct s.species_id, s.species
            from     species s, map_set ms
            where    s.species_id=ms.species_id
            order by s.species
        ],
        { Columns => {} }
    );

    my $map_types = $db->selectall_arrayref(
        q[
            select   distinct mt.map_type_id, mt.map_type
            from     map_type mt, map_set ms
            where    mt.map_type_id=ms.map_type_id
            order by mt.map_type
        ],
        { Columns => {} }
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $map_sets,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $map_sets = $data;
    $pager    = $p;

    process_template( 
        $t, 
        'browse-map-sets.tmpl',
        {
            cgi       => $q,
            map_sets  => $map_sets,
            title     => 'Browse Map Sets',
            pager     => $pager,
            species   => $species,
            map_types => $map_types,
        },
    );
}

# -------------------------------------------------------------
sub browse_populations {
    my ( $mdb, $q, $t ) = @_;

    my $populations = $mdb->get_all_populations( 
        order_by => $q->param('order_by') 
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $populations,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $populations  = $data;
    $pager = $p;

    process_template( 
        $t, 
        'browse-populations.tmpl',
        {
            cgi         => $q,
            populations => $populations,
            title       => 'Browse Populations',
            pager       => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_map_types {
    my ( $mdb, $q, $t ) = @_;

    my $map_types = $mdb->get_all_map_types( 
        order_by => $q->param('order_by') 
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $map_types,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $map_types = $data;
    $pager     = $p;

    process_template( 
        $t, 
        'browse-map-types.tmpl',
        {
            cgi       => $q,
            map_types => $map_types,
            title     => 'Browse Map Types',
            pager     => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_marker_types {
    my ( $mdb, $q, $t ) = @_;

    my $marker_types = $mdb->get_all_marker_types( 
        order_by => $q->param('order_by') 
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $marker_types,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $marker_types = $data;
    $pager        = $p;

    process_template( 
        $t, 
        'browse-marker-types.tmpl',
        {
            cgi          => $q,
            marker_types => $marker_types,
            title        => 'Browse Marker Types',
            pager        => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_species {
    my ( $mdb, $q, $t ) = @_;

    my $species = $mdb->get_all_species( $q->Vars );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $species,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $species = $data;
    $pager   = $p;

    process_template( 
        $t, 
        'browse-species.tmpl',
        {
            cgi     => $q,
            species => $species,
            title   => 'Browse Species',
            pager   => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_synonym_types {
    my ( $mdb, $q, $t ) = @_;

    my $order_by = $q->param('order_by') || 'synonym_type';

    my @synonym_types = $mdb->retrieve_all_sorted_by_SynonymType( $order_by );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $pager, $data ) = pager(
        data             => \@synonym_types,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );

    process_template( 
        $t, 
        'browse-synonym-types.tmpl',
        {
            cgi           => $q,
            synonym_types => $data,
            title         => 'Browse Synonym Types',
            pager         => $pager,
        },
    );
}

# -------------------------------------------------------------
sub browse_xref_types {
    my ( $mdb, $q, $t ) = @_;

    my $xref_types = $mdb->get_all_xref_types( 
        order_by => $q->param('order_by') 
    );

    my $pager;
    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $xref_types,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $xref_types = $data;
    $pager      = $p;

    process_template( 
        $t, 
        'browse-xref-types.tmpl',
        {
            cgi        => $q,
            xref_types => $xref_types,
            title      => 'Browse XRef Types',
            pager      => $pager,
        },
    );
}

# -------------------------------------------------------------
sub create_analysis {
    my ( $mdb, $q, $t ) = @_;

    my @errors;
    my $analysis_name   = $q->param('analysis_name') 
                          or push @errors, 'No analysis name';
    my $type            = $q->param('type') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_analysis_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $analysis_id = $mdb->find_or_create_analysis( $analysis_name );

        $mdb->update_analysis( $q->Vars );

        return $q->redirect( $q->url . '?action=browse_analyses' );
    }
}

# -------------------------------------------------------------
sub create_analytical_correspondence_type {
    my ( $mdb, $q, $t ) = @_;

    my @errors;
    my $type        = $q->param('type') or push @errors, 'No type';
    my $description = $q->param('description') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_analytical_correspondence_type_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $Type = 
        Gramene::CDBI::Markers::AnalyticalCorrespondenceType->find_or_create(
            type => $type,
        );

        $Type->description( $description ) if $description;
        $Type->update;

        return $q->redirect( 
            $q->url . '?action=browse_analytical_correspondence_types' 
        );
    }
}

# -------------------------------------------------------------
sub create_germplasm {
    my ( $mdb, $q, $t ) = @_;

    my @errors;
    my $germplasm_name  = $q->param('germplasm_name') 
                          or push @errors, 'No germplasm name';
    my $species_id      = $q->param('species_id') 
                          or push @errors, 'No species';
    my $type            = $q->param('type') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_germplasm_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $germplasm_id = $mdb->find_or_create_germplasm( 
            $germplasm_name, $species_id 
        );

        $mdb->update_germplasm(
            germplasm_id   => $germplasm_id,
            germplasm_name => $germplasm_name,
            species_id     => $species_id,
            description    => $q->param('description') || '',
        );

        return $q->redirect( $q->url . '?action=browse_germplasm' );
    }
}

# -------------------------------------------------------------
sub create_germplasm_form {
    my ( $mdb, $q, $t ) = @_;

    show_action_form(
        @_,
        { form_extras => { species => $mdb->get_all_species } }
    );
}

# -------------------------------------------------------------
sub create_map_set_form {
    my ( $mdb, $q, $t, $errors ) = @_;

    $q->param('action', 'create_map_set_form');

    show_action_form(
        $mdb, $q, $t,
        { 
            errors      => $errors,
            form_extras => { 
                species   => $mdb->get_all_species,
                map_types => $mdb->get_all_map_types,
#                germplasm => $mdb->get_all_germplasm 
            },
        }
    );
}

# -------------------------------------------------------------
sub create_map_set {
    my ( $mdb, $q, $t ) = @_;

    my @errors;
    my $map_set_name = $q->param('map_set_name') 
                       or push @errors, 'No map set name';
    my $species_id   = $q->param('species_id') 
                       or push @errors, 'No species';
    my $map_type_id  = $q->param('map_type_id') 
                       or push @errors, 'No map type';
    my $cmap_ms_acc  = $q->param('cmap_map_set_accession') || '';

    if ( @errors ) {
        create_map_set_form( @_, \@errors );
    }
    else {
        my $MapSet = Gramene::CDBI::Markers::MapSet->find_or_create({
            species_id             => $species_id,
            map_type_id            => $map_type_id,
            map_set_name           => $map_set_name,
            cmap_map_set_accession => $cmap_ms_acc,
        });
        
        for my $fld ( 
            qw[ project reference total_length distance_unit published_on
            description ]
        ) {
            my $value = $q->param( $fld );
            next unless defined $value;
            $MapSet->$fld( $value );
        }
        $MapSet->update;

        return $q->redirect( 
            $q->url . '?action=view_map_set&map_set_id=' . $MapSet->id
        );
    }
}

# -------------------------------------------------------------
sub create_marker_form {
    my ( $mdb, $q, $t, $errors ) = @_;

    show_action_form(
        $mdb, $q, $t,
        { 
            errors      => $errors,
            form_extras => { 
                species      => $mdb->get_all_species,
                marker_types => $mdb->get_all_marker_types,
                germplasm    => $mdb->get_all_germplasm 
            } 
        }
    );
}

# -------------------------------------------------------------
sub create_marker {
    my ( $mdb, $q, $t ) = @_;

    my @errors;
    my $marker_name    = $q->param('marker_name') 
                         or push @errors, 'No marker name';
    my @synonyms       = split( /,/, $q->param('synonyms') );
    my $marker_type_id = $q->param('marker_type_id') 
                         or push @errors, 'No marker type name';
    my $species_id     = $q->param('species_id') 
                         or push @errors, 'No species';
    my $germplasm_id   = $q->param('germplasm_id') 
                         or push @errors, 'No germplasm';

    if ( @errors ) {
        $q->param( 'action', 'create_marker_form' );
        create_marker_form( $mdb, $q, $t, \@errors );
    }
    else {
        my $marker_id = $mdb->find_or_create_marker( 
            marker_name    => $marker_name,
            synonyms       => \@synonyms,
            marker_type_id => $marker_type_id,
            species_id     => $species_id,
        );

        return $q->redirect( 
            $q->url . "?action=view_marker&marker_id=$marker_id" 
        );
    }
}

# -------------------------------------------------------------
sub create_marker_synonym {
    my ( $mdb, $q, $t ) = @_;

    my $marker_id   = $q->param('marker_id')       or die 'No marker id';
    my $syn_type_id = $q->param('synonym_type_id') || 1;
    my $synonym     = $q->param('synonym')         or die 'No synonym';
    my $marker      = Gramene::CDBI::Markers::Marker->retrieve( $marker_id );

    $mdb->add_synonyms_to_Marker( 
        Marker => $marker,
        synonyms => [ {
            synonym_type_id => $syn_type_id,
            marker_name     => $synonym,
        } ]
    );

    return $q->redirect( 
        $q->url . "?action=view_marker&marker_id=$marker_id" 
    );
}

# -------------------------------------------------------------
sub create_map_type {
    my ( $mdb, $q, $t ) = @_;

    my @errors;
    my $map_type    = $q->param('map_type') 
                      or push @errors, 'No map type name';
    my $description = $q->param('description') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_map_type_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $map_type_id = $mdb->find_or_create_map_type( $map_type );

        $mdb->update_map_type(
            map_type_id => $map_type_id,
            map_type    => $map_type,
            description => $description,
        );

        return $q->redirect( $q->url . '?action=browse_map_types' );
    }
}

# -------------------------------------------------------------
sub create_marker_type {
    my ( $mdb, $q, $t ) = @_;
    my @errors;
    my $marker_type = $q->param('marker_type') 
                      or push @errors, 'No marker type name';
    my $description = $q->param('description') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_marker_type_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $marker_type_id = $mdb->find_or_create_marker_type( $marker_type );

        $mdb->update_marker_type(
            marker_type_id => $marker_type_id,
            marker_type    => $marker_type,
            description    => $description,
        );

        return $q->redirect( $q->url . '?action=browse_marker_types' );
    }
}

# -------------------------------------------------------------
sub create_species {
    my ( $mdb, $q, $t ) = @_;
    my @errors;
    my $species     = $q->param('species') or push @errors, 'No species name';
    my $description = $q->param('description') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_species_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $species_id = $mdb->find_or_create_species( $species ) or 
            die $mdb->error;

        $mdb->update_species(
            species_id  => $species_id,
            species     => $species,
            description => $description,
        );

        return $q->redirect( $q->url . '?action=browse_species' );
    }
}

# -------------------------------------------------------------
sub create_synonym_type {
    my ( $mdb, $q, $t ) = @_;
    my @errors;
    my $synonym_type = $q->param('synonym_type') 
                       or push @errors, 'No synonym type';
    my $description  = $q->param('description') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_synonym_type_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $st = Gramene::CDBI::Markers::SynonymType->find_or_create( 
            { synonym_type => $synonym_type }
        );

        $mdb->update_synonym_type(
            %{ $q->Vars },
            synonym_type_id => $st->id,
        );

        return $q->redirect( $q->url . '?action=browse_synonym_types' );
    }
}

# -------------------------------------------------------------
sub create_xref_form {
    my ( $mdb, $q, $t, $args ) = @_;
    my $errors      = $args->{'errors'};
    my $table_name  = $q->param('table_name') or die 'No table name';
    my $record_id   = $q->param('record_id')  or die 'No record id';
    my $xref_types  = $mdb->get_all_xref_types;
    my $class       = table_name_to_gramene_cdbi_class('Markers', $table_name);
    my $pk_name     = $class->columns('Primary');
    my $object_name = $class->object_type;

    process_template(
        $t, 'create-xref-form.tmpl',
        { 
            cgi         => $q, 
            table_name  => $table_name,
            record_id   => $record_id,
            pk_name     => $pk_name,
            object_name => $object_name,
            xref_types  => $xref_types,
            errors      => $errors,
        }
    );
}

# -------------------------------------------------------------
sub create_xref {
    my ( $mdb, $q, $t ) = @_;
    my @errors;
    my $table_name   = $q->param('table_name') or 
        push @errors, 'No table_name';
    my $record_id    = $q->param('record_id') or 
        push @errors, 'No record_id';
    my $xref_type_id = $q->param('xref_type_id') or 
        push @errors, 'No xref_type_id';
    my $xref_value   = $q->param('xref_value') or
        push @errors, 'No xref value';

    my $class   = table_name_to_gramene_cdbi_class('Markers', $table_name);
    my $pk_name = $class->columns('Primary');

    if ( @errors ) {
        $q->param( 'action', 'create_xref_form' );
        create_xref_form( @_, { errors => \@errors } );
    }
    else {
        my $xref_id = $mdb->find_or_create_xref( 
            table_name   => $table_name,
            record_id    => $record_id,
            xref_type_id => $xref_type_id,
            xref_value   => $xref_value,
        );

        return $q->redirect( 
            $q->url . "?action=view_${table_name}&${pk_name}=$record_id"
        );
    }
}


# -------------------------------------------------------------
sub create_xref_type {
    my ( $mdb, $q, $t ) = @_;
    my @errors;
    my $xref_type    = $q->param('xref_type') or push @errors, 'No xref_type';
    my $url_template = $q->param('url_template') || '';

    if ( @errors ) {
        $q->param( 'action', 'create_xref_type_form' );
        show_action_form( @_, { errors => \@errors } );
    }
    else {
        my $xref_type_id = $mdb->find_or_create_xref_type( 
            xref_type => $xref_type 
        );

        $mdb->update_xref_type(
            xref_type_id => $xref_type_id,
            xref_type    => $xref_type,
            url_template => $url_template,
        );

        return $q->redirect( $q->url . '?action=browse_xref_types' );
    }
}

# -------------------------------------------------------------
sub delete_correspondence {
    my ( $mdb, $q, $t ) = @_;

    my $marker_id = $q->param('marker_id') or die 'No marker id';
    $mdb->delete_analytical_correspondence( $q->Vars );

    return $q->redirect( $q->url . "?action=view_marker&marker_id=$marker_id" );
}

# -------------------------------------------------------------
sub delete_germplasm {
    my ( $mdb, $q, $t ) = @_;

    $mdb->delete_germplasm( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_germplasm' );
}

# -------------------------------------------------------------
sub delete_mapping {
    my ( $mdb, $q, $t ) = @_;

    my $marker_id = $mdb->delete_mapping( $q->Vars );

    return $q->redirect( $q->url . "?action=view_marker&marker_id=$marker_id" );
}

# -------------------------------------------------------------
sub delete_marker {
    my ( $mdb, $q, $t ) = @_;

    my $marker = $mdb->delete_marker( $q->Vars );

    return $q->redirect( $q->url . '?action=home' );
}

# -------------------------------------------------------------
sub delete_marker_synonym {
    my ( $mdb, $q, $t ) = @_;

    my $marker_id = $mdb->delete_marker_synonym( $q->Vars );

    return $q->redirect( 
        $q->url . "?action=view_marker&marker_id=$marker_id" 
    );
}

# -------------------------------------------------------------
sub delete_map_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->delete_map_type( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_map_types' );
}

# -------------------------------------------------------------
sub delete_marker_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->delete_marker_type( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_marker_types' );
}

# -------------------------------------------------------------
sub delete_species {
    my ( $mdb, $q, $t ) = @_;

    $mdb->delete_species( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_species' );
}

# -------------------------------------------------------------
sub delete_xref {
    my ( $mdb, $q, $t ) = @_;

    my $xref = $mdb->view_xref( $q->Vars );

    my $table_name = $xref->{'table_name'} or die 'No table name for xref?';
    my $record_id  = $xref->{'record_id'}  or die 'No record id for xref?';
    my $class      = table_name_to_gramene_cdbi_class('Markers', $table_name);
    my $pk_name    = $class->columns('Primary');

    $mdb->delete_xref( $q->Vars );

    return $q->redirect( 
        $q->url . "?action=view_${table_name}&${pk_name}=$record_id"
    );
}

# -------------------------------------------------------------
sub delete_xref_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->delete_xref_type( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_xref_types' );
}

# -------------------------------------------------------------
sub edit_analysis {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_analysis( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_analyses' );
}

# -------------------------------------------------------------
sub edit_analytical_correspondence_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_analytical_correspondence_type( $q->Vars );

    return $q->redirect( 
        $q->url . '?action=browse_analytical_correspondence_types' 
    );
}

# -------------------------------------------------------------
sub edit_germplasm {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_germplasm(
        germplasm_id   => $q->param('germplasm_id')   ||  0,
        germplasm_name => $q->param('germplasm_name') || '',
        species_id     => $q->param('species_id')     ||  0,
        description    => $q->param('description')    || '',
    );

    return $q->redirect( $q->url . '?action=browse_germplasm' );
}

# -------------------------------------------------------------
sub edit_library {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_library( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_libraries' );
}

# -------------------------------------------------------------
sub edit_map {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_map( $q->Vars );

    return $q->redirect( 
        $q->url . '?action=view_map;map_id=' . $q->param('map_id')
    );
}

# -------------------------------------------------------------
sub edit_map_set {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_map_set( $q->Vars );

    return $q->redirect( 
        $q->url 
        . '?action=view_map_set;map_set_id='
        . $q->param('map_set_id')
    );
}

# -------------------------------------------------------------
sub edit_map_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_map_type( $q->Vars );

    return $q->redirect( $q->url . '?action=browse_map_types' );
}

# -------------------------------------------------------------
sub edit_marker {
    my ( $mdb, $q, $t ) = @_;

    my $marker_id = $q->param('marker_id') or die 'No marker id';

    $mdb->update_marker( $q->Vars );
    $mdb->set_marker_details( $q->Vars );

    return $q->redirect( $q->url."?action=view_marker&marker_id=$marker_id" );
}

# -------------------------------------------------------------
sub edit_marker_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_marker_type( $q->Vars );

    return $q->redirect( 
        $q->url . '?action=browse_marker_types'
    );
}

# -------------------------------------------------------------
sub edit_marker_synonym {
    my ( $mdb, $q, $t ) = @_;

    my $marker_id = $mdb->update_marker_synonym( $q->Vars );

    return $q->redirect( $q->url . "?action=view_marker&marker_id=$marker_id" );
}

# -------------------------------------------------------------
sub edit_species { 
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_species( $q->Vars );

    return $q->redirect( 
        $q->url . '?action=browse_species'
    );
}

# -------------------------------------------------------------
sub edit_synonym_type {
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_synonym_type( $q->Vars );

    return $q->redirect( 
        $q->url . '?action=browse_synonym_types'
    );
}

# -------------------------------------------------------------
sub edit_xref { 
    my ( $mdb, $q, $t ) = @_;

    my $table_name = $q->param('table_name') or die 'No table name';
    my $record_id  = $q->param('record_id')  or die 'No record id';
    my $class   = table_name_to_gramene_cdbi_class('Markers', $table_name);
    my $pk_name = $class->columns('Primary');

    $mdb->update_xref( $q->Vars );

    return $q->redirect( 
        $q->url . "?action=view_${table_name}&${pk_name}=$record_id"
    );
}

# -------------------------------------------------------------
sub edit_xref_type { 
    my ( $mdb, $q, $t ) = @_;

    $mdb->update_xref_type(
        xref_type_id => $q->param('xref_type_id') ||  0,
        xref_type    => $q->param('xref_type')    || '',
        url_template => $q->param('url_template') || '',
    );

    return $q->redirect( 
        $q->url . '?action=browse_xref_types'
    );
}

# -------------------------------------------------------------
sub home { 
    my ( $mdb, $q, $t ) = @_;

    process_template( $t, 'home.tmpl', { cgi => $q } );
}

# -------------------------------------------------------------
sub process_template {
    my ( $t, $template, $args ) = @_;

    my $html;
    if ( $t ) {
        $t->process( $template, $args, \$html ) or $html = $t->error;
    }
    else {
        $html = 'No template object!';
    }

    print $q->header('text/html'), $html;
}

# -------------------------------------------------------------
sub show_action_form { 
    my ( $mdb, $q, $t, $args ) = @_;
    my $errors                 = $args->{'errors'};
    my $form_extras            = $args->{'form_extras'};

    my $action = $q->param('action');
    ( my $form_name = $action ) =~ s/_/-/g;

    my ( $object_type, $object );
    if ( $action =~ /^edit_([a-z]+)_form/ ) {
        $object_type = $1;
        my $method   = 'view_' . $object_type;
        my $id_name  = $object_type . '_id';
        my $id       = $q->param( $id_name );
        $object      = $mdb->$method( $id_name, $id );
    }

    process_template(
        $t, "$form_name.tmpl", 
        { 
            'cgi'       , $q, 
            'errors'    , $errors,
            $object_type, $object,
            %{ $form_extras || {} }
        }
    );
}

# -------------------------------------------------------------
sub search { 
    my ( $mdb, $q, $t )  = @_;
    my $query            = $q->param('marker_name')      || '';
    my $marker_type_id   = $q->param('marker_type_id')   ||  0;
    my $species_id       = $q->param('species_id')       ||  0;
    my $germplasm_id     = $q->param('germplasm_id')     ||  0;
    my $cmap_feature_aid = $q->param('cmap_feature_aid') || '';
    my $xref_type        = $q->param('xref_type')        || '';
    my $xref_value       = $q->param('xref_value')       || '';
    my $order_by         = $q->param('order_by')         || '';
    my $submit           = $q->param('submit')           || '';
    my $form_submitted   = $query || $marker_type_id || $species_id || 
                           $germplasm_id || $cmap_feature_aid ||
                           $xref_type || $order_by || $submit;

    my $markers = [];
    if ( $form_submitted ) {
        $markers = $mdb->marker_search( 
            $q->Vars
#            marker_name      => $query            || '*',
#            marker_type_id   => $marker_type_id,
#            species_id       => $species_id,
#            germplasm_id     => $germplasm_id,
#            cmap_feature_aid => $cmap_feature_aid,
#            xref_type        => $xref_type,
#            xref_value       => $xref_value,
#            order_by         => $order_by,
        );
    }

    if ( scalar @$markers == 1 ) {
        $q->param('marker_id', $markers->[0]{'marker_id'} );
        view_marker( $mdb, $q, $t );
    }
    else {
        my $pager;
        if ( @$markers ) {
            my $url = $q->url( -full => 1, -query => 1 );
            my ( $p, $data ) = pager(
                data             => $markers,
                url              => $url,
                entries_per_page => 25,
                current_page     => $q->param('page_no') || 1,
            );
            $markers = $data;
            $pager   = $p;
        }

        my $db = $mdb->db;
        my $marker_types = $db->selectall_arrayref(
            q[
                select   distinct mt.marker_type_id, mt.marker_type
                from     marker_type mt, marker m
                where    mt.marker_type_id=m.marker_type_id
                order by marker_type
            ],
            { Columns => {} }
        );

#        my $species      = $db->selectall_arrayref(
#            q[
#                select   species_id, species
#                from     species
#                order by species
#            ],
#            { Columns => {} }
#        );
#
#        my $germplasm    = $db->selectall_arrayref(
#            q[
#                select   distinct g.germplasm_id, 
#                         g.germplasm_name,
#                         s.species
#                from     germplasm g, marker m, species s
#                where    g.germplasm_id=m.germplasm_id
#                and      g.species_id=s.species_id
#                order by species, germplasm_name
#            ],
#            { Columns => {} }
#        );

        my $xref_types   = $db->selectall_arrayref(
            q[
                select   distinct xt.xref_type
                from     xref_type xt, xref x, marker m
                where    xt.xref_type_id=x.xref_type_id
                and      x.table_name='marker'
                and      x.record_id=m.marker_id
                order by xref_type
            ],
            { Columns => {} }
        );

        process_template(
            $t,
            'search.tmpl',
            { 
                cgi            => $q, 
                markers        => $markers,
                pager          => $pager,
                title          => 'Marker Search',
                form_submitted => $form_submitted,
                marker_types   => $marker_types,
#                species        => $species,
#                germplasm      => $germplasm,
                xref_types     => $xref_types,
            }
        );
    }
}

# -------------------------------------------------------------
sub set_marker_display_synonym {
    my ( $mdb, $q, $t ) = @_;

    $mdb->set_marker_display_synonym( $q->Vars );

    my $marker_id = $q->param('marker_id');

    return $q->redirect( 
        $q->url . "?action=view_marker&marker_id=$marker_id" 
    );
}

# -------------------------------------------------------------
sub transfer_mapping {
    my ( $mdb, $q, $t ) = @_;

    $mdb->transfer_mapping( $q->Vars );

    my $marker_id = $q->param('to_marker_id');

    return $q->redirect( 
        $q->url . "?action=view_marker&marker_id=$marker_id" 
    );
}

# -------------------------------------------------------------
sub view_analysis {
    my ( $mdb, $q, $t ) = @_;

    my $analysis = $mdb->view_analysis( $q->Vars );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $analysis->{'correspondences'},
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $analysis->{'correspondences'} = $data;

    process_template( 
        $t, 
        'view-analysis.tmpl',
        {
            cgi      => $q,
            analysis => $analysis,
            pager    => $p,
            title    => 'View Analysis &quot;' .  
                        $analysis->{'analysis_name'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_analytical_correspondence_type {
    my ( $mdb, $q, $t ) = @_;

    my $type = $mdb->view_analytical_correspondence_type( $q->Vars );

    process_template( 
        $t, 
        'view-analytical-correspondence-type.tmpl',
        {
            cgi   => $q,
            type  => $type,
            title => 'View Analytical Correspondence Type &quot;' .  
                     $type->{'type'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_germplasm {
    my ( $mdb, $q, $t ) = @_;

    my $germplasm = $mdb->view_germplasm(
        germplasm_id => $q->param('germplasm_id') || 0,
        order_by     => $q->param('order_by')    || '',
    );

    process_template( 
        $t, 
        'view-germplasm.tmpl',
        {
            cgi       => $q,
            germplasm => $germplasm,
            species   => $mdb->get_all_species,
            title     => 'View Germplasm &quot;' .  
                         $germplasm->{'germplasm_name'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_library {
    my ( $mdb, $q, $t ) = @_;

    my $library = $mdb->view_library( $q->Vars );

    $library->{'xrefs'} = $mdb->get_xrefs(
        table_name  => 'library',
        record_id   => $library->id,
        process_url => 1,
    );

    process_template( 
        $t, 
        'view-library.tmpl',
        {
            cgi            => $q,
            library        => $library,
            species        => $mdb->get_all_species,
            germplasm      => $mdb->get_all_germplasm(
                species_id => $library->species_id
            ),
        },
    );
}

# -------------------------------------------------------------
sub view_map {
    my ( $mdb, $q, $t ) = @_;

    my $map = $mdb->view_map( $q->Vars );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $map->{'sorted_mappings'},
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $map->{'sorted_mappings'} = $data;

    process_template( 
        $t, 
        'view-map.tmpl',
        {
            cgi   => $q,
            map   => $map,
            pager => $p,
            title => 'View Map &quot;' .  $map->{'map_name'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_map_set {
    my ( $mdb, $q, $t ) = @_;

    my $map_set = $mdb->view_map_set( $q->Vars );

    my $sorted_maps = $mdb->db->selectall_arrayref(
        q[
            select   map.map_id, map.map_name, map.cmap_map_accession,
                     map.start, map.end, 
                     count(mapping.mapping_id) as num_mappings
            from     map, mapping
            where    map.map_set_id=?
            and      map.map_id=mapping.map_id
            group by 1,2,3,4
        ],
        { Columns => {} },
        ( $map_set->id )
    );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $sorted_maps,
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );

    $map_set->{'sorted_maps'} = $data;

    $map_set->{'xrefs'} = $mdb->get_xrefs(
        table_name  => 'map_set',
        record_id   => $q->param('map_set_id'),
        process_url => 1,
    );

    process_template( 
        $t, 
        'view-map-set.tmpl',
        {
            cgi       => $q,
            pager     => $p,
            map_set   => $map_set,
            species   => $mdb->get_all_species,
            map_types => $mdb->get_all_map_types,
#            germplasm => $mdb->get_all_germplasm( 
#                species_id => $map_set->species_id
#            )
        },
    );
}

# -------------------------------------------------------------
sub view_map_type {
    my ( $mdb, $q, $t ) = @_;

    my $map_type = $mdb->view_map_type(
        map_type_id => $q->param('map_type_id') || 0,
        order_by    => $q->param('order_by')    || '',
    );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $map_type->{'map_sets'},
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $map_type->{'map_sets'} = $data;

    process_template( 
        $t, 
        'view-map-type.tmpl',
        {
            cgi      => $q,
            map_type => $map_type,
            pager    => $p,
            title    => 'View Map Type &quot;' .
                        $map_type->{'map_type'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_marker {
    my ( $mdb, $q, $t ) = @_;

    my $marker = $mdb->view_marker( $q->Vars );

#    my $url = $q->url( -full => 1, -query => 1 );
#    my ( $p, $data ) = pager(
#        data             => $marker->{'mappings'},
#        url              => $url,
#        entries_per_page => 25,
#        current_page     => $q->param('page_no') || 1,
#    );
#    $marker->{'mappings'} = $data;

    $marker->{'xrefs'} = $mdb->get_xrefs(
        table_name  => 'marker',
        record_id   => $q->param('marker_id'),
        process_url => 1,
    );

    $marker->{'synonyms'} = $mdb->get_marker_synonyms(
        marker_id   => $q->param('marker_id'),
        process_url => 1,
    );

    my @synonym_types 
        = Gramene::CDBI::Markers::SynonymType->retrieve_all_sorted_by( 
            'synonym_type'
        );

    process_template( 
        $t, 
        'view-marker.tmpl',
        {
#            pager         => $p,
            cgi           => $q,
            marker        => $marker,
            synonym_types => \@synonym_types,
            marker_types  => $mdb->get_all_marker_types,
            species       => $mdb->get_all_species,
        },
    );
}

# -------------------------------------------------------------
sub view_marker_type {
    my ( $mdb, $q, $t ) = @_;

    my $marker_type = $mdb->view_marker_type(
        marker_type_id => $q->param('marker_type_id') || 0,
        order_by       => $q->param('order_by')       || '',
    );

    process_template( 
        $t, 
        'view-marker-type.tmpl',
        {
            cgi         => $q,
            marker_type => $marker_type,
            title       => 'View Marker Type &quot;' .
                           $marker_type->{'marker_type'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_population {
    my ( $mdb, $q, $t ) = @_;

    my $population = $mdb->view_population(
        population_id => $q->param('population_id') || 0,
    );

    process_template( 
        $t, 
        'view-population.tmpl',
        {
            cgi        => $q,
            population => $population,
            title      => 'View Population &quot;' .
                          $population->{'population_name'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_seq_region {
    my ( $mdb, $q, $t ) = @_;

    my $seq_region = $mdb->view_seq_region(
        seq_region_id => $q->param('seq_region_id') || 0,
        order_by      => $q->param('order_by')      || '',
    );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $seq_region->{'mappings'},
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $seq_region->{'mappings'} = $data;

    process_template( 
        $t, 
        'view-seq-region.tmpl',
        {
            cgi        => $q,
            seq_region => $seq_region,
            pager      => $p,
            title      => 'View Sequence Region &quot;' .
                          $seq_region->{'seq_region_name'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_species {
    my ( $mdb, $q, $t ) = @_;

    my $species = $mdb->view_species(
        species_id => $q->param('species_id') || 0,
        order_by   => $q->param('order_by')   || '',
    );

    my $url = $q->url( -full => 1, -query => 1 );
    my ( $p, $data ) = pager(
        data             => $species->{'map_sets'},
        url              => $url,
        entries_per_page => 25,
        current_page     => $q->param('page_no') || 1,
    );
    $species->{'map_sets'} = $data;

    process_template( 
        $t, 
        'view-species.tmpl',
        {
            cgi     => $q,
            species => $species,
            pager   => $p,
            title   => 'View Species &quot;' . $species->{'species'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_synonym_type {
    my ( $mdb, $q, $t ) = @_;

    my $synonym_type    = $mdb->view_synonym_type(
        synonym_type_id => $q->param('synonym_type_id') || 0,
    );

    process_template( 
        $t, 
        'view-synonym-type.tmpl',
        {
            cgi          => $q,
            synonym_type => $synonym_type,
            title        => 'View Synonym Type &quot;' .
                            $synonym_type->{'synonym_type'} . '&quot;',
        },
    );
}

# -------------------------------------------------------------
sub view_xref {
    my ( $mdb, $q, $t ) = @_;

    my $xref        = $mdb->view_xref( $q->Vars ) or die $mdb->error;
    my $xref_types  = $mdb->get_all_xref_types;
    my $class       
        = table_name_to_gramene_cdbi_class('Markers', $xref->table_name);
    my $pk_name     = $class->columns('Primary');
    my $object_name = $class->object_type;

    process_template( 
        $t, 
        'view-xref.tmpl',
        {
            cgi         => $q,
            xref        => $xref,
            xref_types  => $xref_types,
            class       => $class,
            pk_name     => $pk_name,
            object_name => $object_name,
            title       => 'View XRef',
        },
    );
}

# -------------------------------------------------------------
sub view_xref_type {
    my ( $mdb, $q, $t ) = @_;

    my $xref_type = $mdb->view_xref_type(
        xref_type_id => $q->param('xref_type_id') || 0,
        order_by     => $q->param('order_by')   || '',
    );

    process_template( 
        $t, 
        'view-xref-type.tmpl',
        {
            cgi       => $q,
            xref_type => $xref_type,
            title     => 'View XRef Type &quot;' . 
                          $xref_type->{'xref_type'} . '&quot;',
        },
    );
}
