upload trial returns error message from TrialCreate when 1 or more arg is not found...
[sgn.git] / db / 00003 / UpdateSolcapMapInfo.pm
blob38a7596d97b31ea7e5d20e64dfb010a0b1d1f8ce
1 #!/usr/bin/env perl
4 =head1 NAME
6 UpdateSolcapMapInfo.pm
8 =head1 SYNOPSIS
10 mx-run ThisPackageName [options] -H hostname -D dbname -u username [-F]
12 this is a subclass of L<CXGN::Metadata::Dbpatch>
13 see the perldoc of parent class for more details.
15 =head1 DESCRIPTION
17 This is a patch for updating info for solcap maps. This should be run after running the loading script for the 3 maps
19 This subclass uses L<Moose>. The parent class uses L<MooseX::Runnable>
21 =head1 AUTHOR
23 Naama Menda<nm249@cornell.edu>
25 =head1 COPYRIGHT & LICENSE
27 Copyright 2010 Boyce Thompson Institute for Plant Research
29 This program is free software; you can redistribute it and/or modify
30 it under the same terms as Perl itself.
32 =cut
35 package UpdateSolcapMapInfo;
37 use Moose;
38 extends 'CXGN::Metadata::Dbpatch';
40 use Bio::Chado::Schema;
41 use CXGN::Accession;
43 sub init_patch {
44 my $self = shift;
45 my $name = __PACKAGE__;
46 print "dbpatch name is ':" . $name . "\n\n";
47 my $description = 'loading solcap map info';
48 my @previous_requested_patches ; #ADD HERE
50 $self->name($name);
51 $self->description($description);
52 $self->prereq(\@previous_requested_patches);
56 sub patch {
57 my $self=shift;
58 print STDOUT "Executing the patch:\n " . $self->name . ".\n\nDescription:\n ". $self->description . ".\n\nExecuted by:\n " . $self->username . " .";
60 print STDOUT "\nChecking if this db_patch was executed before or if previous db_patches have been executed.\n";
62 print STDOUT "\nExecuting the SQL commands.\n";
63 my $schema = Bio::Chado::Schema->connect( sub { $self->dbh->clone } );
66 my @maps = (
68 name => "Integrated map: Yellow Stuffer X LA1589 and Sun1642 X LA1589",
69 abstract => "Linkage maps were developed for the Yellow Stuffer × LA1589 and Sun1642 × LA1589 populations separately then the two maps were combined by chromosome into an integrated map using Joinmap 3.0 (Van Ooijen and Voorrips 2001).",
70 parent1 =>'any',
71 parent2 => 'any',
72 species1 => 'Solanum lycopersicum',
73 species2 => 'Solanum lycopersicum',
74 long_name => "Integrated map: Yellow Stuffer X LA1589 and Sun1642 X LA1589"
77 name => "Yellow Stuffer x LA1589",
78 abstract =>"200 F2 plants from a cross between Yellow Stuffer and LA1589 (van der Knaap and Tanksley 2003).",
79 parent1 => "Yellow Stuffer",
80 parent2 => "LA1589",
81 species1 => 'Solanum lycopersicum',
82 species2 => 'Solanum pimpinellifolium',
83 long_name => 'S.lycopersicum Yellow Stuffer X S.pimpinellifolium LA1589'
86 name => "Sun1642 x LA1589",
87 abstract => "The mapping population derived from Sun1642 (S.lycopersicum) and LA1589 (S. pimpinellifolium) consists of 100 F2 individuals (van der Knaap and Tanksley 2001).",
88 parent1 => 'LA1589',
89 parent2 => 'Sun1642',
90 species1 => 'Solanum pimpinellifolium',
91 species2 => 'Solanum lycopersicum',
92 long_name => 'S.lycopersicum Sun1642 X S.pimpinellifolium LA1589'
96 my $result = $schema->txn_do( sub {
98 for my $map ( @maps ) {
100 my ( $map_id ) = $self->dbh->selectrow_array( <<'', undef, $map->{name} );
101 SELECT map_id
102 FROM sgn.map
103 WHERE short_name = ?
105 $map_id or die "Map '$map->{name}' not found in database. Aborting.\n";
107 my $accession_id1 = $self->_find_accession( $schema, $map->{name}, $map->{parent1}, $map->{species1} );
108 my $accession_id2 = $self->_find_accession( $schema, $map->{name}, $map->{parent2}, $map->{species2} );
110 print <<"";
111 Updating map '$map->{name}'
112 id = $map_id
113 abstract = $map->{abstract}
114 parent1 = $accession_id1
115 parent2 = $accession_id2
117 $self->dbh->do( <<'', undef, $map->{long_name}, $map->{abstract}, $accession_id1, $accession_id2, ,'genetic' , $map_id );
118 UPDATE sgn.map
119 SET long_name= ?, abstract = ? , parent_1 = ? , parent_2 = ?, map_type = ?
120 WHERE map_id = ?
124 if ( $self->trial ) {
125 print "Trial mode! Rolling back transaction.\n\n";
126 $schema->txn_rollback;
127 return 0;
128 } else {
129 print "Committing.\n";
130 return 1;
134 print $result ? "Patch applied successfully.\n" : "Patch not applied.\n";
137 sub _find_accession {
138 my $self = shift;
139 my $schema = shift;
140 my $name = shift;
141 my $parent = shift;
142 my $species = shift;
144 my $organism = $schema->resultset("Organism::Organism")->find( { species=> $species }, );
145 die 'Organism $species not found in the database! Aborting\n' if !$organism;
146 my $sgn_q = "SELECT organism_id FROM sgn.organism WHERE chado_organism_id =? ";
147 my $o_sth = $self->dbh->prepare($sgn_q);
148 $o_sth->execute($organism->organism_id);
149 my ($sgn_organism_id) = $o_sth->fetchrow_array();
151 my $accession_cvterm = $schema->resultset("Cv::Cvterm")->create_with( {
152 name => 'accession',
153 cv => 'stock type', }
155 $self->dbh->do('set search_path to sgn, public');
156 my $accession = CXGN::Accession->new($self->dbh , $parent);
157 my $accession_id;
158 if ( !$accession) {
159 my ($stock) = $schema->resultset("Stock::Stock")->find_or_create(
161 name => $parent,
162 uniquename => $parent,
163 type_id => $accession_cvterm->cvterm_id,
164 organism_id => $organism->organism_id,
165 }, );
166 print "inserting into accession_names value $parent\n";
167 $self->dbh->do("insert into sgn.accession_names (accession_name) values ('".$parent."') " );
168 my $a_name_id = $self->dbh->last_insert_id('Pg' , 'sgn','accession_names', 'accession_name_id');
169 print "inserting into accession value $a_name_id, stock_id = " . $stock->stock_id . "\n";
170 $self->dbh->do("insert into sgn.accession (accession_name_id, stock_id, organism_id, chado_organism_id) values ('".$a_name_id . "', " . $stock->stock_id . ", $sgn_organism_id , " . $organism->organism_id . ")");
171 $accession_id = $self->dbh->last_insert_id('Pg' , 'sgn','accession', 'accession_id');
172 print "Updating accession_names , setting accession_id = ". $accession_id . "\n";
173 $self->dbh->do("UPDATE sgn.accession_names SET accession_id = ". $accession_id . " WHERE accession_name_id = $a_name_id");
175 $accession = CXGN::Accession->new($self->dbh , $parent);
176 } else { $accession_id = $accession->accession_id ; }
178 return $accession_id;
182 ####
183 1; #
184 ####