lib/CXGN/Metadata.pm

   1 use strict;
   2 use CXGN::DB::Connection;
   3 use CXGN::People;
   4
   5 package CXGN::Metadata;
   6 use base('CXGN::DB::Connection');
   7
   8 sub new {
   9     my $class      = shift;
  10     my $db_name    = shift;
  11     my $table_name = shift;
  12     my $id         = shift;
  13
  14     my $self = $class->SUPER::new();
  15
  16     $self->set_db_name($db_name);
  17     $self->set_table_name($table_name);
  18     $self->set_row_id($id);
  19
  20     return $self;
  21 }
  22
  23 =head2 function get_db_name
  24
  25 Synopsis:
  26 Arguments:
  27 Returns:
  28 Side effects:
  29 Description:
  30
  31 =cut
  32
  33 sub get_db_name {
  34     my $self = shift;
  35     return $self->{db_name};
  36 }
  37
  38 =head2 function set_db_name
  39
  40 Synopsis:
  41 Arguments:
  42 Returns:
  43 Side effects:
  44 Description:
  45
  46 =cut
  47
  48 sub set_db_name {
  49     my $self = shift;
  50     $self->{db_name} = shift;
  51 }
  52
  53 =head2 function get_table_name
  54
  55 Synopsis:
  56 Arguments:
  57 Returns:
  58 Side effects:
  59 Description:
  60
  61 =cut
  62
  63 sub get_table_name {
  64     my $self = shift;
  65     return $self->{table_name};
  66 }
  67
  68 =head2 function set_table_name
  69
  70 Synopsis:
  71 Arguments:
  72 Returns:
  73 Side effects:
  74 Description:
  75
  76 =cut
  77
  78 sub set_table_name {
  79     my $self = shift;
  80     $self->{table_name} = shift;
  81 }
  82
  83 =head2 function get_id
  84
  85 Synopsis:
  86 Arguments:
  87 Returns:
  88 Side effects:
  89 Description:
  90
  91 =cut
  92
  93 sub get_row_id {
  94     my $self = shift;
  95     return $self->{row_id};
  96 }
  97
  98 =head2 function set_row_id
  99
 100 Synopsis:
 101 Arguments:
 102 Returns:
 103 Side effects:
 104 Description:
 105
 106 =cut
 107
 108 sub set_row_id {
 109     my $self = shift;
 110     $self->{row_id} = shift;
 111 }
 112
 113 sub comments {
 114     my $self           = shift;
 115     my $comments_query = $self->prepare(
 116 'select comment_text from comments inner join attribution using (attribution_id) where database_name=? and table_name=? and row_id=?'
 117     );
 118     $comments_query->execute( $self->{db_name}, $self->{table_name},
 119         $self->{row_id} );
 120     my @comments;
 121     while ( my ($comment) = $comments_query->fetchrow_array() ) {
 122         push( @comments, $comment );
 123     }
 124     if   (@comments) { return \@comments; }
 125     else             { return undef; }
 126 }
 127
 128 sub attribute_bac_to_chromosome {
 129     my $self = shift;
 130     my ( $bac_id, $chromosome ) = @_;
 131     if ( defined($chromosome) ) {
 132         if ( my $proj = $self->get_project_associated_with_bac($bac_id) ) {
 133
 134             #remove the existing attribution
 135             warn
 136 "WARNING: moving BAC $bac_id from chromosome $proj to chromosome $chromosome";
 137             $self->attribute_bac_to_chromosome( $bac_id, undef );
 138         }
 139
 140         #find chromosome project id
 141         my $project_object = CXGN::People::Project->new($self);
 142         my $projects       = $project_object->get_projects_with_name_like(
 143             "Tomato Chromosome $chromosome Sequencing Project");
 144         my $project_id = $projects->[0][0];
 145         if ( defined($project_id) ) {
 146
 147 #this insert says, "there is a bac that is going to be attributed to some person, project, or organization"
 148             my $attribution_insert = $self->prepare(
 149 "insert into attribution (database_name,table_name,primary_key_column_name,row_id) values ('genomic','clone','clone_id',?)"
 150             );
 151             $attribution_insert->execute($bac_id);
 152             my $id_query = $self->prepare(
 153                 "select currval('attribution_attribution_id_seq')");
 154             $id_query->execute();
 155             my @id = $id_query->fetchrow_array();
 156             $id_query->finish();
 157             my $attribution_id = $id[0];
 158
 159  #print STDERR "\n\nATTRIBUTION ID: $attribution_id\n\n";
 160  #this insert says, "attribute this bac to the person/project/organization/role"
 161             my $attribution_to_insert = $self->prepare(
 162 "insert into attribution_to (attribution_id,person_id,organization_id,project_id,role_id) values (?,?,?,?,?)"
 163             );
 164             $attribution_to_insert->execute( $attribution_id, undef, undef,
 165                 $project_id, undef );
 166
 167        #        warn"$bac_id attributed with attribution id $attribution_id.\n";
 168             return $attribution_id;
 169         }
 170     }
 171     else {
 172
 173         #remove the attribution of a bac to a chromosome
 174         $self->do( <<EOQ, undef, 'genomic', 'clone', 'clone_id', $bac_id );
 175 delete from attribution where database_name = ? and table_name = ? and primary_key_column_name = ? and row_id = ?
 176 EOQ
 177
 178         #the attribution_to table will be taken care of by the
 179         #ON DELETE CASCADE of its attribution_id foreign key column
 180         return;
 181     }
 182
 183     #warn"Project not found.\n";
 184     return;
 185 }
 186
 187 sub attribute_bac_to_project {
 188     my ( $self, $bac_id, $project_id ) = @_;
 189
 190     if ( defined($project_id) ) {
 191         if ( my $proj = $self->get_project_associated_with_bac($bac_id) ) {
 192
 193             #remove the existing attribution
 194             $self->attribute_bac_to_project( $bac_id, undef );
 195         }
 196
 197 #this insert says, "there is a bac that is going to be attributed to some person, project, or organization"
 198         my $attribution_insert = $self->prepare(
 199 "insert into attribution (database_name,table_name,primary_key_column_name,row_id) values ('genomic','clone','clone_id',?)"
 200         );
 201         $attribution_insert->execute($bac_id);
 202         my $id_query =
 203           $self->prepare("select currval('attribution_attribution_id_seq')");
 204         $id_query->execute();
 205         my @id = $id_query->fetchrow_array();
 206         $id_query->finish();
 207         my $attribution_id = $id[0];
 208
 209  #print STDERR "\n\nATTRIBUTION ID: $attribution_id\n\n";
 210  #this insert says, "attribute this bac to the person/project/organization/role"
 211         my $attribution_to_insert = $self->prepare(
 212 "insert into attribution_to (attribution_id,person_id,organization_id,project_id,role_id) values (?,?,?,?,?)"
 213         );
 214         $attribution_to_insert->execute( $attribution_id, undef, undef,
 215             $project_id, undef );
 216
 217        #        warn"$bac_id attributed with attribution id $attribution_id.\n";
 218         return $attribution_id;
 219     }
 220     else {
 221
 222         #remove the attribution of a bac to a chromosome
 223         $self->do( <<EOQ, undef, 'genomic', 'clone', 'clone_id', $bac_id );
 224 delete from attribution where database_name = ? and table_name = ? and primary_key_column_name = ? and row_id = ?
 225 EOQ
 226
 227         #the attribution_to table will be taken care of by the
 228         #ON DELETE CASCADE of its attribution_id foreign key column
 229         return;
 230     }
 231 }
 232
 233 sub get_project_associated_with_bac {
 234     my $self          = shift;
 235     my ($bac_id)      = @_;
 236     my $project_query = $self->prepare(
 237 "select project_id from attribution inner join attribution_to on attribution.attribution_id=attribution_to.attribution_id where database_name='genomic' and table_name='clone' and row_id=?"
 238     );
 239     $project_query->execute($bac_id);
 240     my ($proj_id) = $project_query->fetchrow_array();
 241
 242     #warn"\n\nASSOCIATED WITH PROJECT: '$proj_id'\n\n";
 243     return $proj_id;
 244 }
 245
 246 1;
 247
 248 package CXGN::Metadata::Attribution;
 249
 250 use base('CXGN::Metadata');
 251
 252 sub new {
 253     my $class = shift;
 254     my $self  = $class->SUPER::new(@_);
 255     @{ $self->{attributions} } = ();
 256
 257     $self->_fetch_attribution_data();
 258
 259     return $self;
 260 }
 261
 262 sub _fetch_attribution_data {
 263     my $self = shift;
 264
 265     #print "ROW-ID: ".$self->get_row_id()."\n";
 266     my $q = "
 267         SELECT
 268             person_id,
 269             sp_organization.name,
 270             sp_project.name,
 271             role_name,
 272             attribution.attribution_id
 273         FROM
 274             attribution
 275             inner join attribution_to using(attribution_id)
 276             left join roles using (role_id)
 277             left join sgn_people.sp_organization on (organization_id=sp_organization_id)
 278             left join sgn_people.sp_project on (project_id=sp_project_id)
 279          WHERE
 280             attribution.database_name=?
 281             and attribution.table_name=?
 282             and attribution.row_id=?
 283     ";
 284
 285     my $h = $self->prepare($q);
 286     $h->execute( $self->get_db_name(), $self->get_table_name(),
 287         $self->get_row_id() );
 288     my %attribution;
 289     while (
 290         my ( $person_id, $organization, $project, $role_name, $attribution_id )
 291         = $h->fetchrow_array() )
 292     {
 293
 294         #print "PERSON-ID: $person_id, RPOJECT_ID: $project_id etc...\n";
 295         $attribution{person} = CXGN::People::Person->new( $self, $person_id );
 296         $attribution{organization} = $organization;
 297         $attribution{project}      = $project;
 298
 299         #print "project name: ".($attribution{project}->get_name())."\n";
 300         $attribution{role} = $role_name;
 301
 302         #print "Attribution_id: $attribution_id\n";
 303         push @{ $self->{attributions} }, \%attribution;
 304
 305     }
 306 }
 307
 308 =head2 function get_attributions
 309
 310 Synopsis:
 311 Arguments:
 312 Returns:      a list of hashes containing objects, hash keys are person, project, organization and a string, role.
 313 Side effects:
 314 Description:
 315
 316 =cut
 317
 318 sub get_attributions {
 319     my $self = shift;
 320     return @{ $self->{attributions} };
 321 }
 322
 323 1;