lib/CXGN/GEM/Schema.pm

   1 package CXGN::GEM::Schema;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6
   7 use Module::Find;
   8 use CXGN::Biosource::Schema;
   9 use CXGN::Metadata::Schema;
  10 use Bio::Chado::Schema;
  11 use base 'DBIx::Class::Schema';
  12
  13 ###############
  14 ### PERLDOC ###
  15 ###############
  16
  17 =head1 NAME
  18
  19 CXGN::GEM::Schema
  20 a DBIx::Class::Schema object to manipulate the gem schema.
  21
  22 =cut
  23
  24 our $VERSION = '0.01';
  25 $VERSION = eval $VERSION;
  26
  27 =head1 SYNOPSIS
  28
  29  my $schema_list = 'gem,biosource,metadata,public';
  30
  31  my $schema = CXGN::GEM::Schema->connect( sub { $dbh },
  32                                           { on_connect_do => ["SET search_path TO $schema_list"] }, );
  33
  34  ## Using DBICFactory:
  35
  36  my @schema_list = split(/,/, $schema_list);
  37  my $schema = CXGN::DB::DBICFactory->open_schema( 'CXGN::GEM::Schema', search_path => \@schema_list, );
  38
  39
  40 =head1 DESCRIPTION
  41
  42  This class create a new DBIx::Class::Schema object and load the dependencies of other schema classes as
  43  metadata, bioosource or chado.
  44
  45  It need set_path to be able to use all of them.
  46
  47  Also load the relations between schemas.
  48
  49 =head1 AUTHOR
  50
  51 Aureliano Bombarely <ab782@cornell.edu>
  52
  53
  54 =head1 CLASS METHODS
  55
  56 The following class methods are implemented:
  57
  58 =cut
  59
  60 ## Load our own classes
  61 __PACKAGE__->load_classes;
  62
  63 ## Load Metadata and Biosource
  64 __PACKAGE__->load_classes({
  65     'CXGN::Metadata::Schema' =>  [ _find_classes( 'CXGN::Metadata::Schema'  ) ],
  66     'CXGN::Biosource::Schema' => [ _find_classes( 'CXGN::Biosource::Schema' ) ],
  67 });
  68
  69 ## Load Bio::Chado::Schema a little differently, depending on its version
  70 my $bcs_result_ns;
  71 if(    !defined $Bio::Chado::Schema::VERSION
  72     || $Bio::Chado::Schema::VERSION >= 0.08
  73   ) {
  74     $bcs_result_ns = 'Bio::Chado::Schema::Result';
  75     __PACKAGE__->load_namespaces(
  76         result_namespace    => '+Bio::Chado::Schema::Result',
  77         resultset_namespace => '+Bio::Chado::Schema::ResultSet',
  78       );
  79 } else {
  80     $bcs_result_ns = 'Bio::Chado::Schema';
  81     __PACKAGE__->load_classes({
  82         'Bio::Chado::Schema' => [ _find_classes( 'Bio::Chado::Schema' ) ],
  83       });
  84 }
  85 # check that we successfully loaded BCS
  86 __PACKAGE__->source('Organism::Organism') or die 'Failed to load Bio::Chado::Schema classes';
  87
  88 ## Finally add the relationships (all the gem tables will be metadata_id relation)
  89 for my $gem_class ( _find_classes( __PACKAGE__ ) ) {
  90
  91   __PACKAGE__->source($gem_class)
  92              ->add_relationship(
  93                  'metadata_id',
  94                  "CXGN::Metadata::Schema::MdMetadata",
  95                  { 'foreign.metadata_id' => 'self.metadata_id' },
  96                );
  97
  98   if ($gem_class =~ m/Dbxref^/i) {
  99       __PACKAGE__->source($gem_class)->add_relationship(
 100           'dbxref_id',
 101           "${bcs_result_ns}::General::Dbxref",
 102           { 'foreign.dbxref_id' => 'self.dbxref_id' },
 103         );
 104   }
 105 }
 106
 107 __PACKAGE__->source('GePlatformPub')
 108            ->add_relationship('pub_id', "${bcs_result_ns}::Pub::Pub", { 'foreign.pub_id' => 'self.pub_id' } );
 109
 110 __PACKAGE__->source('GePlatformDesign')
 111            ->add_relationship('sample_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.sample_id' } );
 112
 113 __PACKAGE__->source('GeTemplateDbiref')
 114            ->add_relationship('dbiref_id', "CXGN::Metadata::Schema::MdDbiref", { 'foreign.dbiref_id' => 'self.dbiref_id' } );
 115
 116 __PACKAGE__->source('GeProbe')
 117            ->add_relationship('sequence_file_id', "CXGN::Metadata::Schema::MdFiles", { 'foreign.file_id' => 'self.sequence_file_id' } );
 118
 119 __PACKAGE__->source('GeExperimentalDesignPub')
 120            ->add_relationship('pub_id', "${bcs_result_ns}::Pub::Pub", { 'foreign.pub_id' => 'self.pub_id' } );
 121
 122 __PACKAGE__->source('GeTargetElement')
 123            ->add_relationship('sample_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.sample_id' } );
 124
 125 __PACKAGE__->source('GeTargetElement')
 126            ->add_relationship('protocol_id', "CXGN::Biosource::Schema::BsProtocol", { 'foreign.protocol_id' => 'self.protocol_id' } );
 127
 128 __PACKAGE__->source('GeHybridization')
 129            ->add_relationship('protocol_id', "CXGN::Biosource::Schema::BsProtocol", { 'foreign.protocol_id' => 'self.protocol_id' } );
 130
 131 __PACKAGE__->source('GeFluorescanning')
 132            ->add_relationship('protocol_id', "CXGN::Biosource::Schema::BsProtocol", { 'foreign.protocol_id' => 'self.protocol_id' } );
 133
 134 __PACKAGE__->source('GeFluorescanning')
 135            ->add_relationship('dbxref_id', "${bcs_result_ns}::General::Dbxref", { 'foreign.dbxref_id' => 'self.dbxref_id' } );
 136
 137 __PACKAGE__->source('GeFluorescanning')
 138            ->add_relationship('file_id', "CXGN::Metadata::Schema::MdFiles", { 'foreign.file_id' => 'self.file_id' } );
 139
 140 __PACKAGE__->source('GeProbeExpression')
 141            ->add_relationship('dataset_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.dataset_id' } );
 142
 143 __PACKAGE__->source('GeTemplateExpression')
 144            ->add_relationship('dataset_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.dataset_id' } );
 145
 146 __PACKAGE__->source('GeExpressionByExperiment')
 147            ->add_relationship('dataset_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.dataset_id' } );
 148
 149 __PACKAGE__->source('GeTemplateDiffExpression')
 150            ->add_relationship('dataset_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.dataset_id' } );
 151
 152 __PACKAGE__->source('GeCorrelationMember')
 153            ->add_relationship('dataset_id', "CXGN::Biosource::Schema::BsSample", { 'foreign.sample_id' => 'self.dataset_id' } );
 154
 155 __PACKAGE__->source('GeClusterAnalysis')
 156            ->add_relationship('protocol_id', "CXGN::Biosource::Schema::BsProtocol", { 'foreign.protocol_id' => 'self.protocol_id' } );
 157
 158 __PACKAGE__->source('GeClusterProfile')
 159            ->add_relationship('file_id', "CXGN::Metadata::Schema::MdFiles", { 'foreign.file_id' => 'self.file_id' } );
 160
 161 sub _find_classes {
 162     my $ns = shift;
 163     my @classes = findallmod $ns;
 164     s/^${ns}::// for @classes;
 165     return @classes;
 166 }
 167
 168
 169 ## The following functions are used by the test scripts
 170
 171 =head2 get_all_last_ids (deprecated)
 172
 173   Usage: my $all_last_ids_href = $schema->get_all_last_ids();
 174
 175   Desc: Get all the last ids and store then in an hash reference for a specified schema
 176
 177   Ret: $all_last_ids_href, a hash reference with keys = SQL_sequence_name and value = last_value
 178
 179   Args: $schema, a CXGN::Biosource::Schema object
 180
 181   Side Effects: If the seq name don't have the schema name (schema.sequence_seq) is ignored
 182
 183   Example: my $all_last_ids_href = $schema->get_all_last_ids();
 184
 185 =cut
 186
 187 sub get_all_last_ids {
 188     my $schema = shift || die("None argument was supplied to the subroutine get_all_last_ids()");
 189     my %last_ids;
 190     my @source_names = $schema->sources();
 191
 192     warn("WARNING: $schema->get_all_last_id() is a deprecated method. Use get_nextval().\n");
 193
 194     foreach my $source_name (sort @source_names) {
 195
 196         my $source = $schema->source($source_name);
 197         my $table_name = $schema->class($source_name)->table();
 198
 199         if ( $schema->exists_dbtable($table_name) ) {
 200
 201             my ($primary_key_col) = $source->primary_columns();
 202
 203             my $primary_key_col_info;
 204             my $primary_key_col_info_href = $source->column_info($primary_key_col);
 205             if (exists $primary_key_col_info_href->{'default_value'}) {
 206                 $primary_key_col_info = $primary_key_col_info_href->{'default_value'};
 207             }
 208             elsif (exists $primary_key_col_info_href->{'sequence'}) {
 209                 $primary_key_col_info = $primary_key_col_info_href->{'sequence'};
 210             }
 211
 212             my $last_value = $schema->resultset($source_name)
 213                                     ->get_column($primary_key_col)
 214                                     ->max();
 215             my $seq_name;
 216
 217             if (defined $primary_key_col_info) {
 218                 if (exists $primary_key_col_info_href->{'default_value'}) {
 219                     if ($primary_key_col_info =~ m/\'(.*?_seq)\'/) {
 220                         $seq_name = $1;
 221                     }
 222                 }
 223                 elsif (exists $primary_key_col_info_href->{'sequence'}) {
 224                     if ($primary_key_col_info =~ m/(.*?_seq)/) {
 225                         $seq_name = $1;
 226                     }
 227                 }
 228             }
 229             else {
 230                 print STDERR "The source:$source_name ($source) with primary_key_col:$primary_key_col hasn't any primary_key_col_info.\n";
 231             }
 232
 233             if (defined $seq_name) {
 234                 $last_ids{$seq_name} = $last_value || 0;
 235             }
 236         }
 237     }
 238     return \%last_ids;
 239 }
 240
 241 =head2 set_sqlseq_values_to_original_state (deprecated)
 242
 243   Usage: $schema->set_sqlseq_values_to_original_state($seqvalues_href);
 244
 245   Desc: set the sequence values to the values specified in the $seqvalues_href
 246
 247   Ret: none
 248
 249   Args: $schema, a schema object
 250         $seqvalues_href, a hash reference with keys=sequence_name and value=value to set
 251         $on_message, enable the message option
 252
 253   Side Effects: If value to set is undef set value to the first seq
 254
 255   Example: $schema->set_sqlseq_values_to_original_state($seqvalues_href, 1);
 256
 257 =cut
 258
 259 sub set_sqlseq_values_to_original_state {
 260     my $schema = shift || die("None argument was supplied to the subroutine set_sqlseq_values_to_original_state().\n");
 261     my $seqvalues_href = shift || die("None argument was supplied to the subroutine set_sqlseq_values_to_original_state().\n");
 262     my $on_message = shift;  ## To enable messages
 263
 264     warn("WARNING: $schema->set_sqlseq_values_to_original_state is a deprecated method. Table sequences should be set manually.\n");
 265
 266     my %seqvalues = %{ $seqvalues_href };
 267
 268     foreach my $sqlseq (keys %seqvalues) {
 269
 270         my $sqlseqline = "'".$sqlseq."'";
 271         my $val = $seqvalues{$sqlseq};
 272         if ($val > 0) {
 273
 274             $schema->storage()
 275                    ->dbh()
 276                    ->do("SELECT setval ($sqlseqline, $val, true)");
 277         }
 278         else {
 279
 280             ## If there aren't any value (the table is empty, it set to 1, false)
 281
 282             $schema->storage()->dbh()->do("SELECT setval ($sqlseqline, 1, false)");
 283         }
 284     }
 285     if (defined $on_message) {
 286         print STDERR "Setting the SQL sequences to the original values before run the script... done\n";
 287     }
 288 }
 289
 290 =head2 exists_dbtable
 291
 292   Usage: $schema->exists_dbtable($dbtablename, $dbschemaname);
 293
 294   Desc: Check in exists a table in the database
 295
 296   Ret: A boolean, 1 for true and 0 for false
 297
 298   Args: $dbtablename and $dbschemaname. If none schename is supplied,
 299         it will use the schema set in search_path
 300
 301
 302   Side Effects: None
 303
 304   Example: if ($schema->exists_dbtable($table)) { ## do something }
 305
 306 =cut
 307
 308 sub exists_dbtable {
 309     my $schema = shift;
 310     my $tablename = shift;
 311     my $schemaname = shift;
 312
 313     my @schema_list;
 314     unless (defined $schemaname) {
 315         my ($search_path) = $schema->storage()
 316                                    ->dbh()
 317                                    ->selectrow_array('SHOW search_path');
 318         $search_path =~ s/\s+//g;
 319         @schema_list = split(/,/, $search_path);
 320     }
 321     else {
 322         @schema_list = ($schemaname);
 323     }
 324
 325     my $dbtrue = 0;
 326     foreach my $schema_name (@schema_list) {
 327         my ($count) = $schema->storage()
 328                              ->dbh()
 329                              ->selectrow_array("SELECT COUNT(*) FROM pg_tables WHERE schemaname = ? AND tablename = ?",
 330                                                undef,
 331                                                ($schema_name, $tablename) );
 332         if ($count == 1) {
 333             $dbtrue = $count;
 334         }
 335     }
 336     return $dbtrue;
 337 }
 338
 339
 340 ##################################################
 341 ## New function to replace deprecated functions ##
 342 ##################################################
 343
 344 =head2 get_nextval
 345
 346   Usage: my %nextval = $schema->get_nextval();
 347
 348   Desc: Get all the next values from the table sequences
 349         and store into hash using SELECT nextval()
 350
 351   Ret: %nextval, a hash with keys = SQL_sequence_name
 352        and value = nextval
 353
 354   Args: $schema, a CXGN::GEM::Schema object
 355
 356   Side Effects: If the table has not primary_key or
 357                 default value sequence, it will be ignore.
 358
 359   Example: my %nextval = $schema->get_nextval();
 360
 361 =cut
 362
 363 sub get_nextval {
 364     my $schema = shift
 365         || die("None argument was supplied to the subroutine get_nextval()");
 366
 367     my %nextval;
 368     my @source_names = $schema->sources();
 369
 370     my $dbh = $schema->storage()
 371                      ->dbh();
 372
 373     my ($search_path) = $dbh->selectrow_array("SHOW search_path");
 374     my @schemas_path = split(/, /, $search_path);
 375
 376     foreach my $source_name (sort @source_names) {
 377
 378         my $source = $schema->source($source_name);
 379         my $table_name = $schema->class($source_name)
 380                                 ->table();
 381
 382         ## To get the sequence
 383         ## 1) Get primary key
 384
 385         my $seq_name;
 386         my $prikey;
 387
 388         foreach my $schema_name (@schemas_path) {
 389            my ($primary_key) = $dbh->primary_key(undef, $schema_name, $table_name);
 390            if (defined $primary_key) {
 391                $prikey = $primary_key;
 392            }
 393         }
 394
 395         if (defined $prikey) {
 396
 397             ## 2) Get default for primary key
 398
 399             my $sth = $dbh->column_info( undef, undef, $table_name, $prikey);
 400             my ($rel) = (@{$sth->fetchall_arrayref({})});
 401             my $default_val = $rel->{'COLUMN_DEF'};
 402
 403             ## 3) Extract the seq_name
 404
 405             if ($default_val =~ m/nextval\('(.+)'::regclass\)/) {
 406                 $seq_name = $1;
 407             }
 408         }
 409
 410
 411         if (defined $seq_name) {
 412             if ($schema->is_table($table_name)) {
 413
 414                 ## Get the nextval (it is not using currval, because
 415                 ## you can not use it without use nextval before).
 416
 417                 my $query = "SELECT nextval('$seq_name')";
 418                 my ($nextval) = $dbh->selectrow_array($query);
 419
 420                 $nextval{$table_name} = $nextval || 0;
 421             }
 422         }
 423
 424     }
 425     return %nextval;
 426 }
 427
 428 =head2 is_table
 429
 430   Usage: $schema->is_table($tablename, $schemaname);
 431
 432   Desc: Return 0/1 if exists or not a table into the
 433         database
 434
 435   Ret: 0 or 1
 436
 437   Args: $schema, a CXGN::GEM::Schema object
 438         $tablename, name of a table
 439         $schemaname, name of a schema
 440
 441   Side Effects: If $tablename is undef. it will return
 442                 0.
 443                 If $schemaname is undef. it will search
 444                 for the tablename in all the schemas.
 445
 446   Example: if ($schema->is_table('ge_experiment')) {
 447                   ## Do something
 448            }
 449
 450 =cut
 451
 452 sub is_table {
 453     my $schema = shift
 454         || die("None argument was supplied to the subroutine is_table()");
 455
 456     my $tablename = shift;
 457     my $schemaname = shift;
 458
 459     ## Get the dbh
 460
 461     my $dbh = $schema->storage()
 462                      ->dbh();
 463
 464     ## Define the hash with the tablenames
 465
 466     my %tables;
 467
 468     ## Get all the tables with the tablename
 469
 470     my $presence = 0;
 471
 472     if (defined $tablename) {
 473         my $sth = $dbh->table_info('', $schemaname, $tablename, 'TABLE');
 474         for my $rel (@{$sth->fetchall_arrayref({})}) {
 475
 476             ## It will search based in LIKE so it need to check the right anme
 477             if ($rel->{TABLE_NAME} eq $tablename) {
 478                 $presence = 1;
 479             }
 480         }
 481     }
 482
 483     return $presence;
 484 }
 485
 486
 487
 488
 489
 490
 491
 492 ####
 493 1;##
 494 ####