lib/CXGN/Insitu.pm

   1 use strict;
   2 use CXGN::DB::Connection;
   3 use CXGN::DB::SQLWrappers;
   4
   5 package CXGN::Insitu;
   6 use base('CXGN::DB::Connection');
   7
   8 use Data::Dumper;
   9
  10 # for debugging, greater is for more output
  11 our $debug = 1;
  12
  13 #####################################################################
  14 #####################################################################
  15 # generic functions
  16 #####################################################################
  17 #####################################################################
  18
  19 #####################################################################
  20 # constructor
  21 sub new {
  22         my $class=shift;
  23         my $self=$class->SUPER::new({dbtype=>"mysql",dbhost=>"localhost",dbschema=>"insitu",dbuser=>"insitu",dbpass=>"insitu_editor"});
  24         return $self;
  25 }
  26
  27 # get last insert id from database
  28 sub last_insert_id {
  29         my $self=shift;
  30         my $sth = $self->prepare("select last_insert_id() as id");
  31         $sth->execute;
  32         my $id = $sth->fetchrow_hashref->{'id'};
  33         return $id;
  34 }
  35
  36 #####################################################################
  37 #####################################################################
  38 # functions to retrieve data
  39 #####################################################################
  40 #####################################################################
  41
  42 sub return_organisms {
  43         my ($self, $user) = @_;
  44         my %organisms;
  45         my ($id, $name, $common, $description);
  46         my $stm = "select organism_id, name, common_name, description from organism order by name;";
  47         my $sth = $self->prepare($stm);
  48         my $rv = $sth->execute;
  49         my $rc = $sth->bind_columns(\$id, \$name, \$common, \$description);
  50         my $count = 1;
  51         while ($sth->fetch) {
  52                 $organisms{$count}{id} = $id;
  53                 $organisms{$count}{name} = $name;
  54                 $organisms{$count}{common_name} = $common;
  55                 $organisms{$count}{description} = $description;
  56                 $count++;
  57         }
  58         $sth->finish;
  59         return %organisms;
  60 }
  61
  62 #####################################################################
  63 # will return the name of the tag with the requested id
  64 sub return_tag {
  65         my ($self, $id) = @_;
  66         my $name;
  67         my $stm = "select name from tag where tag_id=?;";
  68         my $sth = $self->prepare($stm);
  69         my $rv = $sth->execute($id);
  70         my $rc = $sth->bind_columns(\$name);
  71         $sth->fetch;
  72         $sth->finish;
  73         return $name;
  74 }
  75
  76 #####################################################################
  77 # will return a hash with all tags (optionally owned by $user)
  78 sub return_tags {
  79         my ($self, $user) = @_;
  80         my %tags;
  81         my ($tag_id, $name, $description, $user);
  82         my $stm = "select tag_id, name, description, user_id from tag order by name asc;";
  83         my $sth = $self->prepare($stm);
  84         my $rv = $sth->execute;
  85         my $rc = $sth->bind_columns(\$tag_id, \$name, \$description, \$user);
  86         while ($sth->fetch) {
  87                 $tags{$name} = [$tag_id, $name, $description, $user];
  88         }
  89         $sth->finish;
  90         return %tags;
  91 }
  92
  93 #####################################################################
  94 # will return all tags, implied tags, etc for the requested item
  95 sub return_relevant_tags {
  96         my ($self, $type, $id) = @_;
  97         my ($tag_link_table, $linked_key);
  98         if ($type eq 'ex') {
  99                 $tag_link_table = "ex_tag";
 100                 $linked_key = "experiment_id";
 101         }
 102         elsif ($type eq 'image') {
 103                 $tag_link_table = "image_tag";
 104                 $linked_key = "image_id";
 105         }
 106         else {
 107                 die "Unkown table type: $type!\n"
 108         }
 109         my %tags = ();
 110         my @tag_implications = ();
 111         my ($tag_id, $tag_name, $tag_description, $implied_tag);
 112         my @implied_tags = ();
 113         # get general tag info
 114         my $stm = "select t.tag_id, t.name, t.description from $tag_link_table as l join tag as t on l.tag_id=t.tag_id where l.${linked_key}=?;";
 115         my $sth = $self->prepare($stm);
 116         my $rv = $sth->execute($id);
 117         my $rc = $sth->bind_columns(\$tag_id, \$tag_name, \$tag_description);
 118         while ($sth->fetch) {
 119                 push @tag_implications, $tag_id;
 120                 $tags{$tag_name} = [$tag_id, $tag_name, $tag_description];
 121         }
 122         # get implied tag info
 123         @implied_tags = $self->get_implied_tags(\@tag_implications);
 124         %tags = $self->follow_implied_tags(\%tags, \@implied_tags);
 125         return %tags;
 126 }
 127
 128 #####################################################################
 129 # given an array of tag ids, return an array of all implied tags
 130 sub get_implied_tags {
 131         my ($self, $tags) = @_;
 132         my @implied_tags = ();
 133         foreach my $tag_id (@$tags) {
 134                 my $implied_tag;
 135                 ($debug > 1) and warn "implied tags for tag ${tag_id}:\n";
 136                 my $stm = "select implied_id from tag_implication where tag_id=?;";
 137                 my $sth = $self->prepare($stm);
 138                 my $rv = $sth->execute($tag_id);
 139                 my $rc = $sth->bind_columns(\$implied_tag);
 140                 while ($sth->fetch) {
 141                         ($debug > 1) and warn "\t$implied_tag\n";
 142                         push @implied_tags, $implied_tag;
 143                 }
 144         }
 145         return @implied_tags;
 146 }
 147
 148 #####################################################################
 149 # given a pre-existing hash, and an array of implied tags, recurses
 150 # through the implications, adding all implied tags to the existing hash
 151 sub follow_implied_tags {
 152         my ($self, $tags, $implied_tags, $seen_tags) = @_;
 153         if (!$seen_tags) {
 154                 my %empty_hash = ();
 155                 $seen_tags = \%empty_hash;
 156         }
 157         # add all tags currently being viewed to a hash to avoid redundancy
 158         foreach my $done_id (keys %$tags) {
 159                 my $tag_id = $tags->{$done_id}[0];
 160                 $seen_tags->{$tag_id}++;
 161         }
 162         # get information for previously implied tags
 163         my @implied_tag_ids = $self->get_implied_tags($implied_tags);
 164         foreach my $id (@$implied_tags) {
 165                 if (!$seen_tags->{$id}) {
 166                         my ($tag_id, $tag_name, $tag_description, $implied_tag);
 167                         # get general tag info
 168                         my $stm = "select tag_id, name, description from tag where tag_id=?;";
 169                         my $sth = $self->prepare($stm);
 170                         my $rv = $sth->execute($id);
 171                         my $rc = $sth->bind_columns(\$tag_id, \$tag_name, \$tag_description);
 172                         $sth->fetch;
 173                         $sth->finish;
 174                         $tags->{$tag_name} = [$tag_id, $tag_name, $tag_description];
 175                 }
 176                 $seen_tags->{$id}++;
 177         }
 178         # only push new implied tags if they havn't been seen before
 179         my @new_implications = ();
 180         foreach my $implied_tag (@implied_tag_ids) {
 181                 if ($implied_tag && !$seen_tags->{$implied_tag}) {
 182                         push @new_implications, $implied_tag;
 183                 }
 184         }
 185         # recurse through new implications, provided there are any
 186         my %new_tags = ();
 187         if (@new_implications>0) {
 188                 %new_tags = $self->follow_implied_tags($tags, \@new_implications, $seen_tags);
 189         }
 190         else {
 191                 %new_tags = %{$tags};
 192         }
 193         return %new_tags;
 194 }
 195
 196 #####################################################################
 197 # follow implied tags in the reverse direction
 198 # given a search array and a seen hash, recurse through the search
 199 # array, ignoring anything in the seen hash. return seen hash
 200 sub follow_reverse_implications {
 201         my ($self, $search, $seen) = @_;
 202         if (!$seen) {
 203                 my %empty_hash = ();
 204                 $seen = \%empty_hash;
 205         }
 206         my @new_impliers = ();
 207
 208         foreach my $tag (@$search) {
 209                 if (!$seen->{$tag}) {
 210                         $seen->{$tag}++;
 211                         my $implying_tag;
 212                         my $stm = "select tag_id from tag_implication where implied_id=?;";
 213                         my $sth = $self->prepare($stm);
 214                         my $rv = $sth->execute($tag);
 215                         my $rc = $sth->bind_columns(\$implying_tag);
 216                         while ($sth->fetch) {
 217                                 push @new_impliers, $implying_tag;
 218                         }
 219                 }
 220         }
 221
 222         my %return_hash = ();
 223         if (@new_impliers<1) {
 224                 %return_hash = %{$seen};
 225         }
 226         else {
 227                 %return_hash = $self->follow_reverse_implications(\@new_impliers, $seen);
 228         }
 229
 230         return %return_hash;
 231 }
 232
 233 #####################################################################
 234 # will return a hash with all data for each image in the specified
 235 # experiment
 236 #
 237 # DEPRECATED
 238 #
 239 sub return_images {
 240         my ($self, $experiment_id) = @_;
 241         my %images = ();
 242         my ($image_id, $name, $desription, $filename, $file_ext);
 243         # get information about each image
 244         my $stm = "select image_id, name, description, filename, file_ext from image where experiment_id=? order by image_id asc;";
 245         my $sth = $self->prepare($stm);
 246         my $rv = $sth->execute($experiment_id);
 247         my $rc = $sth->bind_columns(\$image_id, \$name, \$desription, \$filename, \$file_ext);
 248         # store non-tag info about each image
 249         while ($sth->fetch) {
 250                 $images{$image_id} = [$name, $desription, $filename, $file_ext];
 251         }
 252         # get tags for each image
 253         foreach my $image (keys %images) {
 254                 $images{$image}[5] = $self->return_relevant_tags("image", $image);
 255         }
 256         return %images;
 257 }
 258
 259 #####################################################################
 260 # will return a hash with all data for the reqested image
 261 #
 262 # DEPRECATED
 263 #
 264 sub return_image {
 265         my ($self, $image_id) = @_;
 266         my %image = ();
 267         my ($experiment_id, $name, $description, $filename, $file_ext);
 268         # get general info
 269         my $stm = "select experiment_id, name, description, filename, file_ext from image where image_id=?;";
 270         my $sth = $self->prepare($stm);
 271         my $rv = $sth->execute($image_id);
 272         my $rc = $sth->bind_columns(\$experiment_id, \$name, \$description, \$filename, \$file_ext);
 273         $sth->fetch;
 274         $sth->finish;
 275         # get hash of tags for this image, including implied tags
 276         my %tags = $self->return_relevant_tags("image", $image_id);
 277         $image{experiment_id} = $experiment_id;
 278         $image{name} = $name;
 279         $image{description} = $description;
 280         $image{filename} = $filename;
 281         $image{file_ext} = $file_ext;
 282         $image{tags} = \%tags;
 283         return %image;
 284 }
 285
 286 #####################################################################
 287 # will return a hash with some data for all experiments
 288 #
 289 # DEPRECATED
 290 #
 291 sub return_experiments {
 292         my $self = shift;
 293         my %experiments = ();
 294         my ($experiment_id, $name, $date, $organism_id, $tissue, $stage, $primer_id, $primer, $description, $user_id);
 295         # get general info
 296         my $stm = "select experiment_id, name, date, organism_id, tissue, stage, primer_id, description, user_id from experiment;";
 297         my $sth = $self->prepare($stm);
 298         my $rv = $sth->execute;
 299         my $rc = $sth->bind_columns(\$experiment_id, \$name, \$date, \$organism_id, \$tissue, \$stage, \$primer_id, \$description, \$user_id);
 300         # store non-tag info about each experiment
 301         while ($sth->fetch) {
 302                 $experiments{$experiment_id}{name} = $name;
 303                 $experiments{$experiment_id}{date} = $date;
 304                 $experiments{$experiment_id}{organism_id} = $organism_id;
 305                 $experiments{$experiment_id}{tissue} = $tissue;
 306                 $experiments{$experiment_id}{stage} = $stage;
 307                 $experiments{$experiment_id}{primer_id} = $primer_id;
 308                 $experiments{$experiment_id}{description} = $description;
 309                 $experiments{$experiment_id}{user_id} = $user_id;
 310         }
 311         return %experiments;
 312 }
 313
 314 #####################################################################
 315 # will return a hash with all data for the reqested experiment
 316 #
 317 # DEPRECATED
 318 #
 319 sub return_experiment {
 320         my ($self, $experiment_id) = @_;
 321         my %experiment = ();
 322         my ($name, $date, $stage, $organism_id, %organism, $tissue, $primer_id, $primer, $description, $user_id);
 323         # get general info
 324         my $stm = "select name, date, organism_id, tissue, stage, primer_id, description, user_id from experiment where experiment_id=?;";
 325         my $sth = $self->prepare($stm);
 326         my $rv = $sth->execute($experiment_id);
 327         my $rc = $sth->bind_columns(\$name, \$date, \$organism_id, \$tissue, \$stage, \$primer_id, \$description, \$user_id);
 328         $sth->fetch;
 329         $sth->finish;
 330         # get organism name
 331         %organism = $self->return_organism($organism_id);
 332         # get primer name
 333         $primer = $self->return_primer_name($primer_id);
 334         # get hash of tags for this experiment, including implied tags
 335         my %tags = $self->return_relevant_tags("ex", $experiment_id);
 336         $experiment{name} = $name;
 337         $experiment{date} = $date;
 338         $experiment{organism_id} = $organism_id;
 339         $experiment{organism_name} = $organism{name};
 340         $experiment{organism_common} = $organism{common_name};
 341         $experiment{tissue} = $tissue;
 342         $experiment{stage} = $stage;
 343         $experiment{primer_id} = $primer_id;
 344         $experiment{primer} = $primer;
 345         $experiment{description} = $description;
 346         $experiment{user_id} = $user_id;
 347         $experiment{tags} = \%tags;
 348         return %experiment;
 349 }
 350
 351 ####################################################################
 352 # will return a hash containing all experiments
 353 # concerning the specified organism
 354 #
 355 # DEPRECATED
 356 #
 357 sub get_organism_items {
 358         my ($self, $org) = @_;
 359
 360         if ($debug>1) {
 361                 warn "get_organism_items searching for experiments involving organism $org\n";
 362         }
 363
 364         my ($stm, $sth, $rv, $rc);
 365         my %experiments;
 366
 367         # get information from experiments that match
 368         my ($ex_id, $ex_name, $ex_date, $ex_org, $ex_tissue, $ex_stage, $ex_primer_id, $ex_primer, $ex_description, $ex_user_id);
 369         $stm = "select distinct experiment_id, name, date, organism_id, tissue, stage, primer_id, description, user_id from experiment where organism_id=?;";
 370         $sth = $self->prepare($stm);
 371         $rv = $sth->execute($org);
 372         $rc = $sth->bind_columns(\$ex_id, \$ex_name, \$ex_date, \$ex_org, \$ex_tissue, \$ex_stage, \$ex_primer_id, \$ex_description, \$ex_user_id);
 373         while ($sth->fetch) {
 374                 my %organism = $self->return_organism($ex_org);
 375                 $experiments{$ex_id}{name} = $ex_name;
 376                 $experiments{$ex_id}{date} = $ex_date;
 377                 $experiments{$ex_id}{organism_id} = $ex_org;
 378                 $experiments{$ex_id}{organism_name} = $organism{name};
 379                 $experiments{$ex_id}{organism_common} = $organism{common_name};
 380                 $experiments{$ex_id}{tissue} = $ex_tissue;
 381                 $experiments{$ex_id}{stage} = $ex_stage;
 382                 $experiments{$ex_id}{primer_id} = $ex_primer_id;
 383                 $experiments{$ex_id}{primer} = $self->return_primer_name($ex_primer_id);
 384                 $experiments{$ex_id}{description} = $ex_description;
 385                 $experiments{$ex_id}{user_id} = $ex_user_id;
 386                 my %tags = $self->return_relevant_tags("ex", $ex_id);
 387                 $experiments{$ex_id}{tags} = \%tags;
 388         }
 389
 390         return %experiments;
 391 }
 392
 393 ####################################################################
 394 # will return a hash containing all experiments
 395 # submitted by the specified user
 396 #
 397 # DEPRECATED
 398 #
 399 sub get_user_items {
 400         my ($self, $user) = @_;
 401
 402         if ($debug>1) {
 403                 warn "get_user_items searching for experiments submitted by $user\n";
 404         }
 405
 406         my ($stm, $sth, $rv, $rc);
 407         my %experiments;
 408
 409         # get information from experiments that match
 410         my ($ex_id, $ex_name, $ex_date, $ex_org, $ex_tissue, $ex_stage, $ex_primer_id, $ex_primer, $ex_description, $ex_user_id);
 411         $stm = "select distinct experiment_id, name, date, organism_id, tissue, stage, primer_id, description, user_id from experiment where user_id=?;";
 412         $sth = $self->prepare($stm);
 413         $rv = $sth->execute($user);
 414         $rc = $sth->bind_columns(\$ex_id, \$ex_name, \$ex_date, \$ex_org, \$ex_tissue, \$ex_stage, \$ex_primer_id, \$ex_description, \$ex_user_id);
 415         while ($sth->fetch) {
 416                 my %organism = $self->return_organism($ex_org);
 417                 $experiments{$ex_id}{name} = $ex_name;
 418                 $experiments{$ex_id}{date} = $ex_date;
 419                 $experiments{$ex_id}{organism_id} = $ex_org;
 420                 $experiments{$ex_id}{organism_name} = $organism{name};
 421                 $experiments{$ex_id}{organism_common} = $organism{common_name};
 422                 $experiments{$ex_id}{tissue} = $ex_tissue;
 423                 $experiments{$ex_id}{stage} = $ex_stage;
 424                 $experiments{$ex_id}{primer_id} = $ex_primer_id;
 425                 $experiments{$ex_id}{primer} = $self->return_primer_name($ex_primer_id);
 426                 $experiments{$ex_id}{description} = $ex_description;
 427                 $experiments{$ex_id}{user_id} = $ex_user_id;
 428                 my %tags = $self->return_relevant_tags("ex", $ex_id);
 429                 $experiments{$ex_id}{tags} = \%tags;
 430         }
 431
 432         return %experiments;
 433 }
 434
 435 ####################################################################
 436 # will return a hash containing all experiments
 437 # concerning the specified probe
 438 #
 439 # DEPRECATED
 440 #
 441 sub get_primer_items {
 442         my ($self, $probe) = @_;
 443
 444         if ($debug>1) {
 445                 warn "get_probe_items searching for experiments involving probe $probe\n";
 446         }
 447
 448         my ($stm, $sth, $rv, $rc);
 449         my %experiments;
 450
 451         # get information from experiments that match
 452         my ($ex_id, $ex_name, $ex_date, $ex_org, $ex_tissue, $ex_stage, $ex_primer_id, $ex_primer, $ex_description, $ex_user_id);
 453         $stm = "select distinct experiment_id, name, date, organism_id, tissue, stage, primer_id, description, user_id from experiment where primer_id=?;";
 454         $sth = $self->prepare($stm);
 455         $rv = $sth->execute($probe);
 456         $rc = $sth->bind_columns(\$ex_id, \$ex_name, \$ex_date, \$ex_org, \$ex_tissue, \$ex_stage, \$ex_primer_id, \$ex_description, \$ex_user_id);
 457         while ($sth->fetch) {
 458                 my %organism = $self->return_organism($ex_org);
 459                 $experiments{$ex_id}{name} = $ex_name;
 460                 $experiments{$ex_id}{date} = $ex_date;
 461                 $experiments{$ex_id}{organism_id} = $ex_org;
 462                 $experiments{$ex_id}{organism_name} = $organism{name};
 463                 $experiments{$ex_id}{organism_common} = $organism{common_name};
 464                 $experiments{$ex_id}{tissue} = $ex_tissue;
 465                 $experiments{$ex_id}{stage} = $ex_stage;
 466                 $experiments{$ex_id}{primer_id} = $ex_primer_id;
 467                 $experiments{$ex_id}{primer} = $self->return_primer_name($ex_primer_id);
 468                 $experiments{$ex_id}{description} = $ex_description;
 469                 $experiments{$ex_id}{user_id} = $ex_user_id;
 470                 my %tags = $self->return_relevant_tags("ex", $ex_id);
 471                 $experiments{$ex_id}{tags} = \%tags;
 472         }
 473
 474         return %experiments;
 475
 476 }
 477
 478
 479 ####################################################################
 480 # will return a hash containing an experiment array and an image
 481 # array of all items with the submitted tag(s)
 482 #
 483 # DEPRECATED
 484 #
 485 sub get_tagged_items {
 486         my ($self, $in_tags) = @_;
 487
 488         # the count that an item has to have to be a match
 489         my $match_count = @$in_tags;
 490
 491         # hashes where matches will live
 492         my %return_matches = ();
 493         my %matches = ();
 494         my %experiments = ();
 495         my %images = ();
 496         my %sub_tags = (); # tags that were also found in these matches
 497
 498         # this is hirsute, because we need to query for each tag separately,
 499         # and then combine the results.  we need to do this because there needs
 500         # to be 'OR's for implied tags, and 'AND's for searches for multiple tags
 501         foreach my $tag (@$in_tags) {
 502                 ($debug > 1) and warn "Searching for experiments/images that match tag $tag...\n";
 503
 504                 # first find out whether any of the tags we are querying for are
 505                 # implied by other tags- if so, these may not match with the standard
 506                 # query, but they should stil be hits
 507                 my @dummy_array = [$tag];
 508                 my %implying_tags = $self->follow_reverse_implications(@dummy_array);
 509
 510                 # create a where clause for this tag and the tags that imply it
 511                 my $where = "where tag_id=?";
 512                 foreach (sort keys %implying_tags) {
 513                         $where .= " or tag_id=$_";
 514                 }
 515
 516                 my ($stm, $sth, $rv, $rc);
 517
 518                 # get information from experiments that match
 519                 my ($ex_id, $ex_name, $ex_date, $ex_org, $ex_tissue, $ex_stage, $ex_primer_id, $ex_primer, $ex_description);
 520                 $stm = "select distinct t.experiment_id, e.name, e.date, e.organism_id, e.tissue, e.stage, e.primer_id, e.description from ex_tag as t left join experiment as e on t.experiment_id=e.experiment_id $where;";
 521                 $sth = $self->prepare($stm);
 522                 $rv = $sth->execute($tag);
 523                 $rc = $sth->bind_columns(\$ex_id, \$ex_name, \$ex_date, \$ex_org, \$ex_tissue, \$ex_stage, \$ex_primer_id, \$ex_description);
 524                 while ($sth->fetch) {
 525                         $matches{experiments}{$ex_id}++;
 526                         my %organism = $self->return_organism($ex_org);
 527                         $experiments{$ex_id}{name} = $ex_name;
 528                         $experiments{$ex_id}{date} = $ex_date;
 529                         $experiments{$ex_id}{organism_id} = $ex_org;
 530                         $experiments{$ex_id}{organism_name} = $organism{name};
 531                         $experiments{$ex_id}{organism_common} = $organism{common};
 532                         $experiments{$ex_id}{tissue} = $ex_tissue;
 533                         $experiments{$ex_id}{stage} = $ex_stage;
 534                         $experiments{$ex_id}{primer_id} = $ex_primer_id;
 535                         $experiments{$ex_id}{primer} = $self->return_primer_name($ex_primer_id);
 536                         $experiments{$ex_id}{description} = $ex_description;
 537                         my %ex_tags = $self->return_relevant_tags("ex", $ex_id);
 538                         $experiments{$ex_id}{tags} = \%ex_tags;
 539                         # add tags for this item to sub_tags
 540                         foreach my $sub_tag (keys %ex_tags) {
 541                                 $sub_tags{experiments}{$ex_id}{$sub_tag} = $ex_tags{$sub_tag};
 542                         }
 543                 }
 544
 545                  # get information from images that match
 546                  my ($image_id, $image_experiment, $image_name, $image_description, $image_filename, $image_file_ext);
 547                  $stm = "select distinct t.image_id, i.experiment_id, i.name, i.description, i.filename, i.file_ext from image_tag as t left join image as i on t.image_id=i.image_id $where;";
 548                  $sth = $self->prepare($stm);
 549                  $rv = $sth->execute($tag);
 550                  $rc = $sth->bind_columns(\$image_id, \$image_experiment, \$image_name, \$image_description, \$image_filename, \$image_file_ext);
 551                  while ($sth->fetch) {
 552                         $matches{images}{$image_id}++;
 553                         $images{$image_id}{experiment} = $image_experiment;
 554                         $images{$image_id}{name} = $image_name;
 555                         $images{$image_id}{description} = $image_description;
 556                         $images{$image_id}{filename} = $image_filename;
 557                         $images{$image_id}{file_ext} = $image_file_ext;
 558                         my %img_tags = $self->return_relevant_tags("image", $image_id);
 559                         $images{$image_id}{tags} = \%img_tags;
 560                         # add tags for this item to sub_tags
 561                         foreach my $sub_tag (keys %img_tags) {
 562                                 $sub_tags{images}{$image_id}{$sub_tag} = $img_tags{$sub_tag};
 563                         }
 564                  }
 565
 566         }
 567
 568         if ($debug>1) {
 569                 warn "\n\nget_tagged_items required match count: $match_count\n";
 570                 warn "\n\nget_tagged_items matches: \n";
 571                 warn Dumper \%matches;
 572                 warn "\n\nget_tagged_items experiments: \n";
 573                 warn Dumper \%experiments;
 574                 warn "\n\nget_tagged_items images: \n";
 575                 warn Dumper \%images;
 576                 warn "\n\nget_tagged_items sub_tags: \n";
 577                 warn Dumper \%sub_tags;
 578                 warn "\n\n";
 579         }
 580
 581         # given the match_count and matches, only return items that have
 582         # these numbers equal
 583         foreach my $match_ex (keys %{$matches{experiments}}) {
 584                 if ($matches{experiments}{$match_ex} == $match_count) {
 585                         $debug and warn "experiment $match_ex is a match against all tags!\n";
 586                         $return_matches{experiments}{$match_ex} = $experiments{$match_ex};
 587                         $return_matches{matches}{experiments}++;
 588                         foreach my $sub_tag (keys %{$sub_tags{experiments}{$match_ex}}) {
 589                                 $return_matches{sub_tags}{$sub_tag} = $sub_tags{experiments}{$match_ex}{$sub_tag};
 590                         }
 591                 }
 592                 else {
 593                         $debug and warn "experiment $match_ex doesn't match\n";
 594                 }
 595         }
 596         foreach my $match_img (keys %{$matches{images}}) {
 597                 if ($matches{images}{$match_img} == $match_count) {
 598                         $debug and warn "image $match_img is a match against all tags!\n";
 599                         $return_matches{images}{$match_img} = $images{$match_img};
 600                         $return_matches{matches}{images}++;
 601                         foreach my $sub_tag (keys %{$sub_tags{images}{$match_img}}) {
 602                                 $return_matches{sub_tags}{$sub_tag} = $sub_tags{images}{$match_img}{$sub_tag};
 603                         }
 604                 }
 605                 else {
 606                         $debug and warn "image $match_img doesn't match\n";
 607                 }
 608         }
 609
 610         if ($debug>1) {
 611                 warn "\n\nget_tagged_items return_matches: \n";
 612                 warn Dumper \%return_matches;
 613                 warn "\n\n";
 614         }
 615
 616         # return resultint hash
 617         return %return_matches;
 618
 619 }
 620
 621 #####################################################################
 622 # given organism id, return scientific name, common name, and desc.
 623 #
 624 # DEPRECATED
 625 #
 626 sub return_organism {
 627         my ($self, $organism_id) = @_;
 628         my (%org, $organism, $common_name, $description);
 629         my $stm = "select name, common_name, description from organism where organism_id=?";
 630         my $sth = $self->prepare($stm);
 631         my $rv = $sth->execute($organism_id);
 632         my $rc = $sth->bind_columns(\$organism, \$common_name, \$description);
 633         $sth->fetch;
 634         $sth->finish;
 635         $org{id} = $organism_id;
 636         $org{name} = $organism;
 637         $org{common_name} = $common_name;
 638         $org{description} = $description;
 639         return %org;
 640 }
 641
 642
 643 #####################################################################
 644 # given primer id, return name
 645 #
 646 # DEPRECATED
 647 #
 648 sub return_primer_name {
 649         my ($self, $primer_id) = @_;
 650         my ($primer);
 651         my $stm = "select name from primer where primer_id=?";
 652         my $sth = $self->prepare($stm);
 653         my $rv = $sth->execute($primer_id);
 654         my $rc = $sth->bind_columns(\$primer);
 655         $sth->fetch;
 656         $sth->finish;
 657         return $primer;
 658 }
 659
 660 #####################################################################
 661 # given primer id, return all primer info
 662 #
 663 # DEPRECATED
 664 #
 665 sub return_primer {
 666         my ($self, $primer_id) = @_;
 667         my (%primer, $name, $p1, $p1seq, $p2, $p2seq, $seq, $clone, $link_desc, $link);
 668         my $stm = "select name, primer1, primer1_seq, primer2, primer2_seq, sequence, clone, link_desc, link from primer where primer_id=?";
 669         my $sth = $self->prepare($stm);
 670         my $rv = $sth->execute($primer_id);
 671         my $rc = $sth->bind_columns(\$name, \$p1, \$p1seq, \$p2, \$p2seq, \$seq, \$clone, \$link_desc, \$link);
 672         $sth->fetch;
 673         $sth->finish;
 674         $primer{id} = $primer_id;
 675         $primer{name} = $name;
 676         $primer{primer1} = $p1;
 677         $primer{primer1_seq} = $p1seq;
 678         $primer{primer2} = $p2;
 679         $primer{primer2_seq} = $p2seq;
 680         $primer{sequence} = $seq;
 681         $primer{clone} = $clone;
 682         $primer{link_desc} = $link_desc;
 683         $primer{link} = $link;
 684         return %primer;
 685 }
 686
 687 #####################################################################
 688 # return primer info for all primers
 689 #
 690 # DEPRECATED
 691 #
 692 sub return_primers {
 693         my $self = shift;
 694         my (%primer, $id, $name, $p1, $p1seq, $p2, $p2seq, $seq, $clone, $link_desc, $link);
 695         my $stm = "select primer_id, name, primer1, primer1_seq, primer2, primer2_seq, sequence, clone, link_desc, link from primer";
 696         my $sth = $self->prepare($stm);
 697         my $rv = $sth->execute();
 698         my $rc = $sth->bind_columns(\$id, \$name, \$p1, \$p1seq, \$p2, \$p2seq, \$seq, \$clone, \$link_desc, \$link);
 699         while ($sth->fetch) {
 700                 $primer{$name}{id} = $id;
 701                 $primer{$name}{name} = $name;
 702                 $primer{$name}{primer1} = $p1;
 703                 $primer{$name}{primer1_seq} = $p1seq;
 704                 $primer{$name}{primer2} = $p2;
 705                 $primer{$name}{primer2_seq} = $p2seq;
 706                 $primer{$name}{sequence} = $seq;
 707                 $primer{$name}{clone} = $clone;
 708                 $primer{$name}{link_desc} = $link_desc;
 709                 $primer{$name}{link} = $link;
 710         }
 711         return %primer;
 712 }
 713
 714 #####################################################################
 715 #####################################################################
 716 # functions to update existing data
 717 #####################################################################
 718 #####################################################################
 719
 720 #####################################################################
 721 # will update data for the specified image
 722 #
 723 # DEPRECATED
 724 #
 725 sub update_image_data {
 726         my ($self, $id, $name, $description, $tags) =@_;
 727         if ($debug > 1) {
 728                 warn "update_image_data got:\n";
 729                 warn "\tid: $id\n";
 730                 warn "\tname: $name\n";
 731                 warn "\tdescription: $description\n";
 732                 warn "\ttags:\n";
 733                 warn Dumper $tags;
 734                 warn "\n";
 735         }
 736         # update image table
 737         my $stm = "update image set name=?, description=? where image_id=?;";
 738         my $sth = $self->prepare($stm);
 739         my $rv = $sth->execute($name, $description, $id);
 740         $sth->finish;
 741         # update tags
 742         foreach my $tag (@$tags) {
 743                 if ($tag && ($tag =~ m/[0-9]+/)) {
 744                         $stm = "insert into image_tag (image_id, tag_id) values (?, ?)";
 745                         $sth = $self->prepare($stm);
 746                         $rv = $sth->execute($id, $tag);
 747                         $sth->finish;
 748                 }
 749         }
 750 }
 751
 752 #####################################################################
 753 # will update data for the specified tag
 754 #
 755 # DEPRECATED
 756 #
 757 sub update_tag_data {
 758         my ($self, $id, $name, $description, $implied_tags) =@_;
 759         if ($debug > 1) {
 760                 warn "update_tag_data got:\n";
 761                 warn "\tid: $id\n";
 762                 warn "\tname: $name\n";
 763                 warn "\tdescription: $description\n";
 764                 warn "\timplied_tags:\n";
 765                 warn Dumper $implied_tags;
 766                 warn "\n";
 767         }
 768
 769         # update tage table
 770         my $stm = "update tag set name=?, description=? where tag_id=?;";
 771         my $sth = $self->prepare($stm);
 772         my $rv = $sth->execute($name, $description, $id);
 773         $sth->finish;
 774
 775         # update tags
 776         # first delete all old implications
 777         $stm = "delete from tag_implication where tag_id=?;";
 778         $sth = $self->prepare($stm);
 779         $rv = $sth->execute($id);
 780         $sth->finish;
 781         # now insert new implications
 782         foreach my $tag (@$implied_tags) {
 783                 if ($tag && ($tag =~ m/[0-9]+/)) {
 784                         $stm = "insert into tag_implication (tag_id, implied_id) values (?, ?)";
 785                         $sth = $self->prepare($stm);
 786                         $rv = $sth->execute($id, $tag);
 787                         $sth->finish;
 788                 }
 789         }
 790
 791 }
 792
 793 #####################################################################
 794 #####################################################################
 795 # functions to insert data
 796 #####################################################################
 797 #####################################################################
 798
 799 #####################################################################
 800 # will insert a new organism into the database
 801 #
 802 # DEPRECATED
 803 #
 804 sub insert_organism {
 805         my ($self, $name, $description, $user) = @_;
 806         my $stm = "insert into organism (name, common_name, description) values (?, ?, ?)";
 807         my $sth = $self->prepare($stm);
 808         my $rv = $sth->execute($name, $description, $user);
 809 }
 810
 811 #####################################################################
 812 # will insert a new category into the database
 813 #
 814 # DEPRECATED
 815 #
 816 sub insert_tag {
 817         my ($self, $name, $description, $user) = @_;
 818         my $stm = "insert into tag (name, description, user_id) values (?, ?, ?)";
 819         my $sth = $self->prepare($stm);
 820         my $rv = $sth->execute($name, $description, $user);
 821 }
 822
 823 #####################################################################
 824 # will insert information regarding an experiment into the database
 825 #
 826 # DEPRECATED
 827 #
 828 sub insert_experiment {
 829         my ($self, $name, $date, $organism_id, $tissue, $stage, $primer, $primer_link_desc, $primer_link, $primer_clone, $primer_sequence, $primer_p1, $primer_p1_seq, $primer_p2, $primer_p2_seq, $description, $tags, $user) = @_;
 830         if ($debug > 1) {
 831                 warn "insert_experiment got:\n";
 832                 warn "\tname: $name\n";
 833                 warn "\tdate: $date\n";
 834                 warn "\torganism: $organism_id\n";
 835                 warn "\ttissue: $tissue\n";
 836                 warn "\tstage: $stage\n";
 837                 warn "\tprimer: $primer\n";
 838                 warn "\tprimer_link_desc: $primer_link_desc\n";
 839                 warn "\tprimer_link: $primer_link\n";
 840                 warn "\tprimer_clone: $primer_clone\n";
 841                 warn "\tprimer_sequence:\n$primer_sequence\n";
 842                 warn "\tprimer_p1: $primer_p1\n";
 843                 warn "\tprimer_p1_seq:\n$primer_p1_seq\n";
 844                 warn "\tprimer_p2: $primer_p2\n";
 845                 warn "\tprimer_p2_seq:\n$primer_p2_seq\n";
 846                 warn "\tdescription:\n$description\n";
 847                 warn "\ttags:\n" . Dumper $tags;
 848                 warn "\tuser: $user\n";
 849         }
 850
 851         # look up the primer in the primer table, if it already exists use that key
 852         # otherwise, create a new row for it and use that key
 853         my $primer_id;
 854         my $stm = "select primer_id from primer where name=?";
 855         my $sth = $self->prepare($stm);
 856         my $rv = $sth->execute($primer);
 857         my $rc = $sth->bind_columns (\$primer_id);
 858         $sth->fetch;
 859         $sth->finish;
 860         if (!$primer_id) {
 861                 $stm = "insert into primer (name, link_desc, link, clone, sequence, primer1, primer1_seq, primer2, primer2_seq, user_id) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)";
 862                 $sth = $self->prepare($stm);
 863                 $rv = $sth->execute($primer, $primer_link_desc, $primer_link, $primer_clone, $primer_sequence, $primer_p1, $primer_p1_seq, $primer_p2, $primer_p2_seq, $user);
 864                 $sth->finish;
 865                 $primer_id = $self->last_insert_id;
 866         }
 867
 868         # insert row into experiment table, get key for that row
 869         $stm = "insert into experiment (name, date, organism_id, tissue, stage, primer_id, description, user_id) values (?, ?, ?, ?, ?, ?, ?, ?)";
 870         $sth = $self->prepare($stm);
 871         $rv = $sth->execute($name, $date, $organism_id, $tissue, $stage, $primer_id, $description, $user);
 872         $sth->finish;
 873         my $experiment_id = $self->last_insert_id;
 874
 875         # link this experiment with selected tags
 876         foreach my $tag (@$tags) {
 877                 $stm = "insert into ex_tag (experiment_id, tag_id) values (?, ?)";
 878                 $sth = $self->prepare($stm);
 879                 $rv = $sth->execute($experiment_id, $tag);
 880                 $sth->finish;
 881         }
 882
 883         # return key of this experiment
 884         return $experiment_id;
 885
 886 }
 887
 888 #####################################################################
 889 # will insert information regarding an image into the database
 890 #
 891 # DEPRECATED
 892 #
 893 sub insert_image {
 894         my ($self, $experiment_id, $filename, $file_ext) = @_;
 895         my $stm = "insert into image (experiment_id, filename, file_ext) values (?, ?, ?)";
 896         my $sth = $self->prepare($stm);
 897         my $rv = $sth->execute($experiment_id, $filename, $file_ext);
 898         $sth->finish;
 899         my $image_id = $self->last_insert_id;
 900         return $image_id;
 901 }
 902
 903 #####################################################################
 904 #####################################################################
 905 # Do not delete this line:
 906 1;