package Bio::Chado::Schema;
BEGIN {
  $Bio::Chado::Schema::AUTHORITY = 'cpan:RBUELS';
}
BEGIN {
  $Bio::Chado::Schema::VERSION = '0.08000'; # TRIAL
}

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_namespaces;


# Created by DBIx::Class::Schema::Loader v0.04999_12 @ 2010-01-01 13:09:35
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:GfcGc0XJeU/0mXXXgJb7FQ


{
    my @after_load;
    $_->() for @after_load; #< note that this executes after load_classes above

    sub plugin_add_relationship {
        my ( $class, $target_moniker, $reltype, @args ) = @_;

        push @after_load, sub {
            no strict 'refs';
            my $target_class = $class->class( $target_moniker );
            $target_class->$reltype( @args );
            __PACKAGE__->register_class( $target_moniker => $target_class );
        };
    }
}



#########################################################################################
##                                                                                     ##
## NOTE: The documentation for this package can be found in Bio/Chado/Schema/Util.pod  ##
##                                                                                     ##
## The reason to put this package in the same file than Schema.pm is because if you    ##
## put non DBIx::Class packages under Schema folder, when Module::Find get all the     ##
## dbix classes to load in the schema, the non dbix classes will return an error       ##
##                                                                                     ##
#########################################################################################

package Bio::Chado::Schema::Util;
BEGIN {
  $Bio::Chado::Schema::Util::AUTHORITY = 'cpan:RBUELS';
}
BEGIN {
  $Bio::Chado::Schema::Util::VERSION = '0.08000'; # TRIAL
}
use strict;
use Carp::Clan qr/^Bio::Chado::Schema/;


sub create_properties {
    my ($class,  %args) = @_;

    #check for required args
    $args{prop_relation_name} or confess "must provide $_ arg"
      for qw/ row prop_relation_name properties options/;

    my $self  = delete $args{row};
    my $props = delete $args{properties};
    my $opts  = delete $args{options};
    my $prop_relation_name = delete $args{prop_relation_name};

    %args and confess "invalid option(s): ".join(', ', sort keys %args);

    # normalize the props to hashrefs
    foreach (values %$props) {
        $_ = { value => $_ } unless ref eq 'HASH';
    }

    # process opts
    $opts ||= {};
    defined $opts->{cv_name} or confess 'must provide a cv_name in options';
    $opts->{db_name} = 'null'
        unless defined $opts->{db_name};
    $opts->{dbxref_accession_prefix} = 'autocreated:'
        unless defined $opts->{dbxref_accession_prefix};

    my $schema = $self->result_source->schema;

    my $prop_cv = do {
        my $cvrs = $schema->resultset('Cv::Cv');
        my $find_or_create = $opts->{autocreate} ? 'find_or_create' : 'find';
        $cvrs->$find_or_create({ name => $opts->{cv_name}},
                               { key => 'cv_c1' })
            or croak "cv '$opts->{cv_name}' not found and autocreate option not passed, cannot continue";
    };

    my $prop_db; #< set as needed below

    # find/create cvterms and dbxrefs for each of our featureprops,
    # and remember them in %propterms
    my %propterms;
    foreach my $propname (keys %$props) {
        my $existing_cvterm = $propterms{$propname} =
            $prop_cv->find_related('cvterms',
                                   { name => $propname,
                                     is_obsolete => 0,
                                   },
                                   { key => 'cvterm_c1' },
                                  );

        # if there is no existing cvterm for this in the prop table,
        # and we have the autocreate flag set true, then create a
        # cvterm, dbxref, and db for it if necessary
        unless( $existing_cvterm ) {
            $opts->{autocreate}
               or croak "cvterm not found for property '$propname', and autocreate option not passed, cannot continue";

            # look up the db object if we don't already have it, now
            # that we know we need it
            $prop_db ||=
                $self->result_source->schema
                     ->resultset('General::Db')
                     ->find_or_create( { name => $opts->{db_name} },
                                       { key => 'db_c1' }
                                     );

            # find or create the dbxref for this cvterm we are about
            # to create
            my $dbx_acc = $opts->{dbxref_accession_prefix}.$propname;
            my $dbxref =
                $prop_db->search_related( 'dbxrefs',
                                          { accession => $dbx_acc },
                                          { order_by => { -desc => ['version'] } }
                                        )
                                ->first
             || $prop_db->create_related( 'dbxrefs', { accession => $dbx_acc,
                                                               version => 1,
                                                             });

            # look up any definition we might have been given for this
            # propname, so we can insert it if given
            my $def = $opts->{definitions}->{$propname};

            $propterms{$propname} =
                $prop_cv->create_related('cvterms',
                                         { name => $propname,
                                           is_obsolete => 0,
                                           dbxref_id => $dbxref->dbxref_id,
                                           $def ? (definition => $def) : (),
                                         }
                                        );
        }
    }

    my %props;
    while( my ($propname,$propval) = each %$props ) {

        my $data = ref $propval
            ? {%$propval}
            : { value => $propval };

        $data->{type_id} = $propterms{$propname}->cvterm_id;


      # decide whether to skip creating this prop
      my $skip_creation = $opts->{allow_duplicate_values}
            ? 0
            : $self->search_related( $prop_relation_name,
                                     { type_id => $data->{type_id},
                                       value   => $data->{value},
                                     })
                   ->count;


        unless( $skip_creation ) {
            #if rank is defined
          if ($opts->{rank} && defined $opts->{rank} ) {
            my ($existing_prop) = $self->search_related( $prop_relation_name,
                                            {type_id =>$data->{type_id},
                                             rank => $opts->{rank}
                                            });
            warn "Property " .  $existing_prop->value() . "  already exists with rank " . $opts->{rank} . ". skipping! \n" if  defined $existing_prop;
            $data->{rank} = $opts->{rank};

          } else {
            # find highest rank for props of this type
            my $max_rank= $self->search_related( $prop_relation_name,
                                         { type_id =>$data->{type_id} }
                )->get_column('rank')->max;
            $data->{rank} = defined $max_rank ? $max_rank + 1 : 0;

          }
          $props{$propname} = $self->find_or_create_related( $prop_relation_name,
                                           $data
            );
      }
    }
    return \%props;
}

1;

package Bio::Chado::Schema::Test;
BEGIN {
  $Bio::Chado::Schema::Test::AUTHORITY = 'cpan:RBUELS';
}
BEGIN {
  $Bio::Chado::Schema::Test::VERSION = '0.08000'; # TRIAL
}
use strict;
use warnings;
use Carp::Clan qr/^Bio::Chado::Schema/;
use Bio::Chado::Schema;


sub has_custom_dsn {
    return $ENV{"BCS_TEST_DSN"} ? 1 : 0;
}

sub _sqlite_dbfilename {
    return "t/var/BCS.db";
}

sub _sqlite_dbname {
    my $self = shift;
    my %args = @_;
    return $self->_sqlite_dbfilename; # if $args{sqlite_use_file} or $ENV{"BCS_SQLITE_USE_FILE"};
    return ":memory:";
}

sub _database {
    my $self = shift;
    my %args = @_;
    my $db_file = $self->_sqlite_dbname(%args);

    #warn "Removing $db_file";
    #unlink($db_file) if -e $db_file;
    #unlink($db_file . "-journal") if -e $db_file . "-journal";
    mkdir("t/var") unless -d "t/var";

    my $dsn    = $ENV{"BCS_TEST_DSN"} || "dbi:SQLite:${db_file}";
    my $dbuser = $ENV{"BCS_TEST_DBUSER"} || '';
    my $dbpass = $ENV{"BCS_TEST_DBPASS"} || '';

    my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, %args });

    return @connect_info;
}

sub init_schema {
    my $self = shift;
    my %args = @_;
    my $should_deploy = $ENV{"BCS_TEST_DSN"} ? 0 : 1 ;

    my $schema;

    if ($args{compose_connection}) {
      $schema = Bio::Chado::Schema->compose_connection(
                  'Bio::Chado::Schema::Test', $self->_database(%args)
                );
    } else {
      $schema = Bio::Chado::Schema->compose_namespace('Bio::Chado::Schema::Test');
    }

    if ($args{storage_type}) {
      $schema->storage_type($args{storage_type});
    }

    $schema = $schema->connect($self->_database(%args));
    $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']) unless $self->has_custom_dsn;

    unless ( -e _sqlite_dbfilename() ) {
        __PACKAGE__->deploy_schema( $schema, $args{deploy_args} ) if $should_deploy;
        __PACKAGE__->populate_schema( $schema ) if $args{populate};
    }
    return $schema;
}


sub deploy_schema {
    my $self = shift;
    my $schema = shift;
    my $args = shift || {};

    $schema->deploy($args);
    return;
}


sub populate_schema {
    my $self = shift;
    my $schema = shift;

#    $schema->populate('Genre', [
#      [qw/genreid name/],
#      [qw/1        emo/],
#    ]);

}

1;

__END__
=pod

=encoding utf-8

=head1 NAME

Bio::Chado::Schema

=head1 SYNOPSIS

  use lib qw(t/lib);
  use Bio::Chado::Schema::Test;
  use Test::More;

  my $schema = Bio::Chado::Schema::Test->init_schema();

=head1 SYNOPSIS

  use Bio::Chado::Schema;

  my $chado = Bio::Chado::Schema->connect( $dsn, $user, $password );

  print "number of rows in feature table: ",
        $chado->resultset('Sequence::Feature')->count,
        "\n";

=head1 DESCRIPTION

This module provides the basic utilities to write tests against Bio::Chado::Schema.

=head1 DESCRIPTION

This is a standard object-relational mapping layer for use with the
GMOD Chado database schema.  This layer is implemented with
L<DBIx::Class>, generated with the help of the very fine
L<DBIx::Class::Schema::Loader> module.

Chado is an open-source modular database schema for biological data.
It is divided into several notional "modules", which are reflected in
the namespace organization of this package.  Note that modules in the
Chado context refers to sets of tables, they are not modules in the
Perl sense.

To learn how to use this DBIx::Class ORM layer, a good starting
point is the L<DBIx::Class::Manual>.

=head1 NAME

Bio::Chado::Schema - A standard DBIx::Class layer for the Chado database schema.

=head1 CHADO MODULES COVERED BY THIS PACKAGE

L<Bio::Chado::Schema::CellLine>

L<Bio::Chado::Schema::Companalysis>

L<Bio::Chado::Schema::Composite>

L<Bio::Chado::Schema::Contact>

L<Bio::Chado::Schema::Cv>

L<Bio::Chado::Schema::Expression>

L<Bio::Chado::Schema::General>

L<Bio::Chado::Schema::Genetic>

L<Bio::Chado::Schema::Library>

L<Bio::Chado::Schema::Mage>

L<Bio::Chado::Schema::Map>

L<Bio::Chado::Schema::NaturalDiversity>

L<Bio::Chado::Schema::Organism>

L<Bio::Chado::Schema::Phenotype>

L<Bio::Chado::Schema::Phylogeny>

L<Bio::Chado::Schema::Project>

L<Bio::Chado::Schema::Pub>

L<Bio::Chado::Schema::Sequence>

L<Bio::Chado::Schema::Stock>

=head1 CLASS METHODS

=head2 plugin_add_relationship( 'ChadoModule::SourceName', 'reltype', @args )

Sometimes application-specific plugins need to add relationships to
the core BCS classes.  It can't just be done normally from inside the
classes of the plugins, you need to use this method.

Example: Bio::Chado::Schema::Result::MyApp::SpecialThing belongs_to
the core BCS Organism::Organism, and you would like to be able to call
C<$organism-&gt;myapp_specialthings> on organisms to get their
associated SpecialThings.

    package Bio::Chado::Schema::MyApp::Result::SpecialThing;

    # ( do table and column definitions and so forth here )

    Bio::Chado::Schema->plugin_add_relationship(
        'Organism::Organism', 'has_many', (
            "myapp_specialthings",
            "Bio::Chado::Schema::MyApp::Result::Foo",
            { "foreign.organism_id" => "self.organism_id" },
            { cascade_copy => 0, cascade_delete => 0 },
        );
    );

=head1 AUTHOR

Robert Buels, <rmb32@cornell.edu>

=head1 CONTRIBUTORS

Aureliano Bombarely, <ab782@cornell.edu>

Naama Menda, <nm249@cornell.edu>

Jonathan "Duke" Leto, <jonathan@leto.net>

=head1 COPYRIGHT & LICENSE

Copyright 2009 Boyce Thompson Institute for Plant Research

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

=head1 NAME

Bio::Chado::Schema::Test - Library to be used by Bio::Chado::Schema test scripts.

=head1 METHODS

=head2 init_schema

  my $schema = Bio::Chado::Schema::Test->init_schema(
    deploy            => 1,
    populate          => 1,
    storage_type      => '::DBI::Replicated',
    storage_type_args => {
      balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
    },
  );

This method removes the test SQLite database in t/var/BCS.db
and then creates a new, empty database.

This method will call deploy_schema() by default, unless the
deploy flag is set to 0.

This method will call populate_schema() if the populate argument
is set to a true value.

=head2 deploy_schema

  Bio::Chado::Schema::Test->deploy_schema( $schema );

This method does one of two things to the schema.  It can either call
the experimental $schema->deploy() if the BCSTEST_SQLT_DEPLOY environment
variable is set, otherwise the default is to read in the t/lib/sqlite.sql
file and execute the SQL within. Either way you end up with a fresh set
of tables for testing.

=head2 populate_schema

  Bio::Chado::Schema::Test->populate_schema( $schema );

After you deploy your schema you can use this method to populate
the tables with test data.

=head1 AUTHOR

Robert Buels <rbuels@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Robert Buels.

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

=cut

