lib/CXGN/Insitu/Image.pm

   1 package CXGN::Insitu::Image;
   2
   3 =head1 NAME
   4
   5 Image.pm - a class to deal with insitu images.
   6
   7 =head1 DESCRIPTION
   8
   9 This class provides database access and store functions as well as image upload and certain image manipulation functions, such as image file type conversion and image resizing; and functions to associate tags with the image.
  10
  11 =head1 AUTHOR(S)
  12
  13 Lukas Mueller (lam87@cornell.edu)
  14
  15 =head1 MEMBER FUNCTIONS
  16
  17 The following functions are provided in this class:
  18
  19 =cut
  20
  21
  22 use strict;
  23 use warnings;
  24 use CXGN::Insitu::DB;
  25 use CXGN::Insitu::Tag;
  26 use SGN::Context;
  27
  28 use base qw / CXGN::Insitu::DB / ;
  29
  30
  31 =head2 new
  32
  33  Usage:
  34  Desc:
  35  Ret:
  36  Args:
  37  Side Effects:
  38  Example:
  39
  40 =cut
  41
  42 sub new {
  43     my $class = shift;
  44     my $dbh=shift;
  45     my $id = shift;
  46     my $self = $class ->SUPER::new($dbh);
  47
  48     $self->set_configuration_object(SGN::Context->new());
  49
  50     if ($id) {
  51         $self->set_image_id($id);
  52         $self->fetch_image();
  53     }
  54     return $self;
  55 }
  56
  57 sub fetch_image {
  58     my $self = shift;
  59     my $query = "SELECT experiment_id,
  60                         name,
  61                         description,
  62                         filename,
  63                         file_ext,
  64                         user_id
  65                  FROM   insitu.image
  66                  WHERE  insitu.image.image_id=?";
  67
  68     my $sth = $self->get_dbh()->prepare($query);
  69     $sth->execute($self->get_image_id()) ;
  70
  71     my ($experiment_id, $name, $description, $filename, $file_ext, $user_id) =
  72         $sth->fetchrow_array();
  73
  74     #print STDERR "fetched image: image_id ".($self->get_image_id())." experiment_id = $experiment_id.\n";
  75
  76     $self->set_experiment_id($experiment_id);
  77     $self->set_name($name);
  78     $self->set_description($description);
  79     $self->set_filename($filename);
  80     $self->set_file_ext($file_ext);
  81     $self->set_user_id($user_id);
  82
  83 }
  84
  85 sub store {
  86     my $self = shift;
  87     if ($self->get_image_id()) {
  88
  89         # it's an update
  90         #
  91         my $query = "UPDATE insitu.image SET
  92                             experiment_id=?,
  93                             name=?,
  94                             description=?,
  95                             filename=?,
  96                             file_ext=?,
  97                             user_id =?
  98                       WHERE insitu.image.image_id=?";
  99
 100         my $sth = $self->get_dbh()->prepare($query);
 101
 102         $sth->execute(
 103                       $self->get_experiment_id(),
 104                       $self->get_name(),
 105                       $self->get_description(),
 106                       $self->get_filename(),
 107                       $self->get_file_ext(),
 108                       $self->get_user_id(),
 109                       $self->get_image_id()
 110                       );
 111         return $self->get_image_id();
 112     }
 113     else {
 114
 115         # it is an insert
 116         #
 117         my $query = "INSERT INTO insitu.image (
 118                             experiment_id,
 119                             name,
 120                             description,
 121                             filename,
 122                             file_ext,
 123                             user_id)
 124                      VALUES (?, ?, ?, ?, ?, ?)";
 125         my $sth = $self->get_dbh()->prepare($query);
 126         $sth->execute(
 127                        $self->get_experiment_id(),
 128                        $self->get_name(),
 129                        $self->get_description(),
 130                        $self->get_filename(),
 131                        $self->get_file_ext(),
 132                        $self->get_user_id()
 133                        );
 134
 135         $self->set_image_id($self->get_dbh()->last_insert_id("image"));
 136         return $self->get_image_id();
 137     }
 138 }
 139
 140 =head2 delete
 141
 142  Usage:
 143  Desc:
 144  Ret:
 145  Args:
 146  Side Effects:
 147  Example:
 148
 149 =cut
 150
 151 sub delete {
 152     my $self = shift;
 153     if ($self->get_image_id()) {
 154         my $query = "UPDATE insitu.image set obsolete='t' WHERE image_id=?";
 155         my $sth = $self->get_dbh()->prepare($query);
 156         $sth->execute($self->get_image_id());
 157     }
 158     else {
 159         print STDERR "Image.pm: Trying to delete an image from the db that has not yet been stored.";
 160     }
 161
 162 }
 163
 164
 165
 166
 167 =head2 get_image_id
 168
 169  Usage:
 170  Desc:
 171  Ret:
 172  Args:
 173  Side Effects:
 174  Example:
 175
 176 =cut
 177
 178 sub get_image_id {
 179   my $self=shift;
 180   return $self->{image_id};
 181
 182 }
 183
 184 =head2 set_image_id
 185
 186  Usage:
 187  Desc:
 188  Ret:
 189  Args:
 190  Side Effects:
 191  Example:
 192
 193 =cut
 194
 195 sub set_image_id {
 196   my $self=shift;
 197   $self->{image_id}=shift;
 198 }
 199
 200 =head2 get_experiment_id
 201
 202  Usage:
 203  Desc:
 204  Ret:
 205  Args:
 206  Side Effects:
 207  Example:
 208
 209 =cut
 210
 211 sub get_experiment_id {
 212   my $self=shift;
 213   return $self->{experiment_id};
 214
 215 }
 216
 217 =head2 set_experiment_id
 218
 219  Usage:
 220  Desc:
 221  Ret:
 222  Args:
 223  Side Effects:
 224  Example:
 225
 226 =cut
 227
 228 sub set_experiment_id {
 229   my $self=shift;
 230   $self->{experiment_id}=shift;
 231 }
 232
 233 =head2 get_name
 234
 235  Usage:
 236  Desc:
 237  Ret:
 238  Args:
 239  Side Effects:
 240  Example:
 241
 242 =cut
 243
 244 sub get_name {
 245   my $self=shift;
 246   return $self->{name};
 247
 248 }
 249
 250 =head2 set_name
 251
 252  Usage:
 253  Desc:
 254  Ret:
 255  Args:
 256  Side Effects:
 257  Example:
 258
 259 =cut
 260
 261 sub set_name {
 262   my $self=shift;
 263   $self->{name}=shift;
 264 }
 265
 266 =head2 get_description
 267
 268  Usage:
 269  Desc:
 270  Ret:
 271  Args:
 272  Side Effects:
 273  Example:
 274
 275 =cut
 276
 277 sub get_description {
 278   my $self=shift;
 279   return $self->{description};
 280
 281 }
 282
 283 =head2 set_description
 284
 285  Usage:
 286  Desc:
 287  Ret:
 288  Args:
 289  Side Effects:
 290  Example:
 291
 292 =cut
 293
 294 sub set_description {
 295   my $self=shift;
 296   $self->{description}=shift;
 297 }
 298
 299
 300 =head2 get_user_id
 301
 302  Usage:
 303  Desc:
 304  Ret:
 305  Args:
 306  Side Effects:
 307  Example:
 308
 309 =cut
 310
 311 sub get_user_id {
 312     my $self=shift;
 313     return $self->{user_id};
 314
 315 }
 316
 317 =head2 set_user_id
 318
 319  Usage:
 320  Desc:
 321  Ret:
 322  Args:
 323  Side Effects:
 324  Example:
 325
 326 =cut
 327
 328 sub set_user_id {
 329     my $self=shift;
 330     $self->{user_id}=shift;
 331 }
 332
 333
 334
 335 =head2 get_filename
 336
 337  Usage:
 338  Desc:
 339  Ret:
 340  Args:
 341  Side Effects:
 342  Example:
 343
 344 =cut
 345
 346 sub get_filename {
 347   my $self=shift;
 348   return $self->{filename};
 349 }
 350
 351 =head2 set_filename
 352
 353  Usage:
 354  Desc:
 355  Ret:
 356  Args:
 357  Side Effects:
 358  Example:
 359
 360 =cut
 361
 362 sub set_filename {
 363   my $self=shift;
 364   $self->{filename}=shift;
 365 }
 366
 367 =head2 get_file_ext
 368
 369  Usage:
 370  Desc:
 371  Ret:
 372  Args:
 373  Side Effects:
 374  Example:
 375
 376 =cut
 377
 378 sub get_file_ext {
 379   my $self=shift;
 380   return $self->{file_ext};
 381
 382 }
 383
 384 =head2 set_file_ext
 385
 386  Usage:
 387  Desc:
 388  Ret:
 389  Args:
 390  Side Effects:
 391  Example:
 392
 393 =cut
 394
 395 sub set_file_ext {
 396   my $self=shift;
 397   $self->{file_ext}=shift;
 398 }
 399
 400 =head2 add_tag
 401
 402  Usage:
 403  Desc:         adds a tag to the image
 404  Ret:          nothing
 405  Args:         a tag object (CXGN::Insitu::Tag).
 406  Side Effects: the tag is immediately store in the database.
 407                there is no need to call store() on the image object.
 408  Example:
 409
 410 =cut
 411
 412 sub add_tag {
 413     my $self = shift;
 414     my $tag = shift;
 415
 416     my $query = "INSERT INTO insitu.image_tag (tag_id, image_id) values (?, ?)";
 417
 418     my $sth = $self->get_dbh()->prepare($query);
 419     $sth->execute($tag->get_tag_id(), $self->get_image_id());
 420
 421 }
 422
 423 =head2 get_tags
 424
 425  Usage:        my @tags = $image->get_tags();
 426  Desc:         gets all the tags associated with this image object
 427  Ret:
 428  Args:
 429  Side Effects: the tags are being fetched from the database. The image
 430                object does not 'buffer' tag associations (see also add_tag()).
 431  Example:
 432
 433 =cut
 434
 435 sub get_tags {
 436     my $self  = shift;
 437
 438     my $query = "SELECT tag_id FROM insitu.image_tag WHERE image_id=?";
 439     my $sth = $self->get_dbh()->prepare($query);
 440     $sth->execute($self->get_image_id());
 441     my @tags = ();
 442     while (my ($tag_id) = $sth->fetchrow_array()) {
 443         push @tags, CXGN::Insitu::Tag->new($self->get_dbh(), $tag_id);
 444     }
 445     return @tags;
 446 }
 447
 448 =head2 remove_tag
 449
 450  Usage:
 451  Desc:
 452  Ret:          nothing
 453  Args:         a tag object.
 454  Side Effects: the association to the tag object will be removed
 455                directly accessing the database backstore. There is no
 456                need to call store() after remove_tag(). The tag itself
 457                is not affected.
 458  Example:
 459
 460 =cut
 461
 462 sub remove_tag {
 463     my $self = shift;
 464     my $tag = shift;
 465     my $query = "DELETE FROM insitu.image_tag WHERE tag_id=? and image_id=?";
 466     my $sth = $self->get_dbh()->prepare($query);
 467     $sth->execute($tag->get_tag_id(), $self->get_image_id());
 468 }
 469
 470 =head2 get_large_suffix
 471
 472  Usage:
 473  Desc:
 474  Ret:
 475  Args:
 476  Side Effects:
 477  Example:
 478
 479 =cut
 480
 481 sub get_large_suffix {
 482     my $self = shift;
 483     return "_mid";
 484 }
 485
 486 =head2 get_thumb_suffix
 487
 488  Usage:
 489  Desc:
 490  Ret:
 491  Args:
 492  Side Effects:
 493  Example:
 494
 495 =cut
 496
 497 sub get_thumb_suffix {
 498     my $self = shift;
 499     return "_thumb";
 500 }
 501
 502
 503
 504 =head2 get_large_size
 505
 506  Usage:
 507  Desc:
 508  Ret:
 509  Args:
 510  Side Effects:
 511  Example:
 512
 513 =cut
 514
 515 sub get_large_size {
 516     my $self = shift;
 517     return 600;
 518 }
 519
 520 =head2 get_thumb_size
 521
 522  Usage:
 523  Desc:
 524  Ret:
 525  Args:
 526  Side Effects:
 527  Example:
 528
 529 =cut
 530
 531 sub get_thumb_size {
 532     my $self=shift;
 533     return 200;
 534 }
 535
 536
 537
 538 =head2 get_fullsize_dir
 539
 540  Usage:
 541  Desc:
 542  Ret:
 543  Args:
 544  Side Effects:
 545  Example:
 546
 547 =cut
 548
 549 sub get_fullsize_dir {
 550     my $self = shift;
 551     my $fullsize_dir = $self->get_configuration_object()->get_conf("insitu_fullsize_dir");
 552     $fullsize_dir =~ s|/+$||;
 553     return $fullsize_dir."/".$self->get_experiment_id();
 554 }
 555
 556
 557 =head2 get_display_dir
 558
 559  Usage:
 560  Desc:
 561  Ret:
 562  Args:
 563  Side Effects:
 564  Example:
 565  To do:        should get info through conf object
 566
 567 =cut
 568
 569 sub get_display_dir {
 570     my $self = shift;
 571     # directory this script will move  shrunken images to
 572     my $display_dir = SGN::Context->new->get_conf("insitu_display_dir");
 573     $display_dir =~ s|/+$||;
 574     return $display_dir."/".$self->get_experiment_id();
 575 }
 576
 577 =head2 get_input_dir
 578
 579  Usage:
 580  Desc:
 581  Ret:
 582  Args:
 583  Side Effects:
 584  Example:
 585  To do:        should get info through conf object
 586 =cut
 587
 588 sub get_input_dir {
 589     my $self = shift;
 590     my $input_dir = SGN::Context->new->get_conf("insitu_input_dir");
 591     $input_dir =~ s|/+$||;
 592     return $input_dir;
 593 }
 594
 595
 596 =head2 get_thumbnail_url
 597
 598  Usage:
 599  Desc:
 600  Ret:
 601  Args:
 602  Side Effects:
 603  Example:
 604
 605 =cut
 606
 607 sub get_thumbnail_url {
 608     my $self = shift;
 609     return $self->get_configuration_object()->get_conf("insitu_display_url")."/".$self->get_experiment_id()."/".$self->get_filename()."_".$self->get_large_suffix().".jpg";
 610 }
 611
 612
 613 =head2 get_fullsize_url
 614
 615  Usage:
 616  Desc:
 617  Ret:
 618  Args:
 619  Side Effects:
 620  Example:
 621
 622 =cut
 623
 624 sub get_fullsize_url {
 625     my $self = shift;
 626     return $self->get_configuration_object()->get_conf("insitu_fullsize_url")."/".$self->get_experiment_id()."/".$self->get_filename().$self->get_file_ext();
 627 }
 628
 629
 630 =head2 get_configuration_object
 631
 632  Usage:
 633  Desc:
 634  Ret:
 635  Args:
 636  Side Effects:
 637  Example:
 638
 639 =cut
 640
 641 sub get_configuration_object {
 642   my $self=shift;
 643   return $self->{configuration_object};
 644 }
 645
 646 =head2 set_configuration_object
 647
 648  Usage:
 649  Desc:
 650  Ret:
 651  Args:
 652  Side Effects:
 653  Example:
 654
 655 =cut
 656
 657 sub set_configuration_object {
 658   my $self=shift;
 659   $self->{configuration_object}=shift;
 660 }
 661
 662
 663
 664 =head2 get_img_src_tag
 665
 666  Usage:
 667  Desc:
 668  Ret:
 669  Args:
 670  Side Effects:
 671  Example:
 672
 673 =cut
 674
 675 sub get_img_src_tag {
 676     my $self = shift;
 677     return "<img src=\"".$self->get_thumbnail_url()."\" border=\"0\" width=".$self->get_thumb_size()." /> ";
 678 }
 679
 680 =head2 get_temp_filename
 681
 682  Usage:
 683  Desc:
 684  Ret:
 685  Args:
 686  Side Effects:
 687  Example:
 688
 689 =cut
 690
 691 sub get_temp_filename {
 692   my $self=shift;
 693   return $self->{temp_filename};
 694
 695 }
 696
 697 =head2 set_temp_filename
 698
 699  Usage:
 700  Desc:
 701  Ret:
 702  Args:
 703  Side Effects:
 704  Example:
 705
 706 =cut
 707
 708 sub set_temp_filename {
 709   my $self=shift;
 710   $self->{temp_filename}=shift;
 711 }
 712
 713 sub upload_image {
 714     my $self = shift;
 715     my $experiment = shift;
 716     my $uploaded_filename=shift;
 717     my $uploaded_filehandle = shift;
 718
 719     my $error = 0;
 720
 721     # if an image file has been uploaded, copy it to a temporary
 722     # location
 723     # get remote file name, make it safe, keep it sane
 724     #
 725     $uploaded_filename =~ s/.*[\/\\](.*)/$1/;
 726
 727     # generate local file name, including IP and time, to make sure
 728     # multiple uploads don't clobber each other
 729     #
 730     #my $date = `strftime "\%Y-\%m-\%d", gmtime`;
 731     my $create_time = time();
 732     $uploaded_filename = $self->get_input_dir()."/" . $ENV{REMOTE_ADDR} . "_${create_time}_${uploaded_filename}";
 733     warn "Uploaded_filename=$uploaded_filename\n";
 734
 735     $self->set_temp_filename($uploaded_filename);
 736
 737     #my $uploaded_filehandle = $query->upload('e_file');
 738
 739     # only copy file if it doesn't already exist
 740     #
 741     if (!-e $uploaded_filename) {
 742
 743         # open a filehandle for the uploaded file
 744         #
 745         if (!$uploaded_filehandle) {
 746             return 1;
 747         }
 748         else {
 749             # copy said file to destination, line by line
 750             warn "Now uploading file...\n";
 751             open UPLOADFILE, ">$uploaded_filename" or die "Could not write to ${uploaded_filename}: $!\n";
 752             warn "could open filename...\n";
 753             binmode UPLOADFILE;
 754             while (<$uploaded_filehandle>) {
 755                 #warn "Read another chunk...\n";
 756                 print UPLOADFILE;
 757             }
 758             close UPLOADFILE;
 759             warn "Done uploading...\n";
 760         }
 761     }
 762     else {
 763         print STDERR "$uploaded_filename exists, not overwriting...\n";
 764     }
 765 }
 766
 767 =head2 process_image
 768
 769  Usage:
 770  Desc:
 771  Ret:
 772  Args:
 773  Side Effects:
 774  Example:
 775
 776 =cut
 777
 778 sub process_image {
 779     my $self = shift;
 780     my $file_name = shift;
 781     my $experiment = shift;
 782
 783     my $experiment_id=$experiment->get_experiment_id();
 784     if (!$experiment_id) { die "Need an experiment id!\n"; }
 785
 786     # create subdirectories for these images to live in
 787     #
 788     my $fullsize_dir = $self->get_fullsize_dir();
 789     my $display_dir = $self->get_display_dir();
 790
 791     # these commands shouldn't do any harm if these directories already exist
 792     #
 793     if (! -d '$fullsize_dir' ) {
 794         system("mkdir '$fullsize_dir'" );
 795         system("chmod 775 '$fullsize_dir'");
 796     }
 797
 798     if (! -d '$display_dir') {
 799         system("mkdir '$display_dir'");
 800         system("chmod 775 '$display_dir'");
 801     }
 802
 803
 804     # process image
 805     #
 806     my ($safe_file, $safe_ext, $unix_file);
 807     $safe_file = $file_name;
 808     $safe_file =~ m/(.*)(\.[a-zA-Z0-9]{3,4})$/i;
 809     $safe_file = $1;
 810     $safe_ext = $2;
 811     $unix_file = $safe_file;
 812     $unix_file =~ s/\s/_/g;
 813
 814     my $input_dir = $self->get_input_dir();
 815     my $large_suffix = $self->get_large_suffix();
 816     my $thumb_suffix = $self->get_thumb_suffix();
 817     my $large_size = $self->get_large_size();
 818     my $thumb_size = $self->get_thumb_size();
 819     # copy unmodified image to be fullsize image
 820     #
 821     my $temp_filename = $self->get_temp_filename();
 822     my $mv = "mv '$temp_filename' '${fullsize_dir}/${unix_file}${safe_ext}'";
 823     print STDERR "MOVING FILE $mv\n";
 824     system($mv);
 825     my $chmod = "chmod 664 '${fullsize_dir}/${unix_file}${safe_ext}'";
 826     print STDERR "CHMODing FILE: $chmod\n";
 827     system($chmod);
 828
 829     # convert to jpg if format is different
 830     if ($safe_ext !~ /jpg|jpeg/i) {
 831         system("convert ${fullsize_dir}/${unix_file}${safe_ext} ${fullsize_dir}/${unix_file}.jpg");
 832         $safe_ext = ".jpg";
 833     }
 834
 835     # create small thumbnail for each image
 836     $self->copy_image_resize("${fullsize_dir}/${unix_file}${safe_ext}", "${display_dir}/${unix_file}_${thumb_suffix}.jpg", "$thumb_size");
 837
 838     # create midsize image for each image
 839     $self->copy_image_resize("${fullsize_dir}/${unix_file}${safe_ext}", "${display_dir}/${unix_file}_${large_suffix}.jpg", "$large_size");
 840
 841     # enter preliminary image data into database
 842     #$tag_table->insert_image($experiment_id, $unix_file, ${safe_ext});
 843     $self -> set_filename($unix_file);
 844     $self -> set_file_ext($safe_ext);
 845     $self -> store();
 846
 847 }
 848
 849 sub copy_image_resize {
 850     my $self=shift;
 851     my ($original_image, $new_image, $width) = @_;
 852
 853     #$debug and warn "\tCopying $original_image to $new_image and resizing it to $width px wide\n";
 854
 855     # first copy the file
 856     my $copy = "cp '$original_image' '$new_image'";
 857     print STDERR "COPYING: $copy\n";
 858     system($copy);
 859     my $chmod = "chmod 664 '$new_image'";
 860     print STDERR "CHMODing: $chmod\n";
 861     system($chmod);
 862
 863     # now resize the new file, and ensure it is a jpeg
 864     my $resize = `mogrify -geometry $width '$new_image'`;
 865     my $jpeg = `mogrify -format jpg '$new_image'`;
 866
 867     if ($resize || $jpeg) {
 868         return 0;
 869     }
 870     else {
 871         return 1;
 872     }
 873
 874 }
 875
 876
 877
 878 # sub as_html {
 879 #     my $self = shift;
 880 #     my $image_id = $self->get_image_id();
 881 #     my $experiment_id = $self->get_experiment_id();
 882 #     my $filename = $self->get_filename();
 883 #     my $description = $self->get_description();
 884 #     my $name = $self->get_name();
 885 #     my $file_ext= $self->get_file_ext();
 886 #     my $large_suffix = $self->get_large_suffix();
 887 #     my $large_size = $self->get_large_size();
 888 #     my @tags = $self->get_tags();
 889 #     my $categories = "CATEGORIES GO HERE";
 890 #     my $output = "";
 891
 892 #     my $thumbnail = $self->get_display_dir()."/thumbnail_images/$experiment_id/$filename.jpg";
 893 #     my $fullsize = $self->get_fullsize_dir()."/fullsize_images/$experiment_id/$filename$file_ext";
 894
 895 #     print <<HTML;
 896
 897 # <center>
 898 # <a href="/thumbnail_images/$experiment_id/$filename.jpg" onclick="javascript: window.open('/fullsize_images/$experiment_id/$filename$file_ext', 'blank', 'toolbar=no'); return false;"><img src="/thumbnail_images/$experiment_id/$filename\_$large_suffix.jpg" border="0" width="$large_size" alt="image id: $image_id" /></a><br /><em>$filename</em></center>
 899
 900 # HTML
 901
 902 #     #print $thumbnail;
 903 #     #print $fullsize;
 904
 905 #    $output .= "<hr noshade=\"noshade\" />\n\n";
 906
 907 #     # generate table showing additional information for this image
 908 #     if ($name || $description || @tags>0) {
 909 #       $output .= <<IMAGE_INFO;
 910 #       <center><table border="0" cellpadding="0" cellspacing="0" width="90%">
 911 #           <tr>
 912 #           <th class="fielddef" style="text-align:center" colspan="2">Image Info</td>
 913 #           </tr>
 914 # IMAGE_INFO
 915 #           if ($name) {
 916 #               $output .= <<IMAGE_NAME;
 917 #               <tr>
 918 #                   <td class="fielddef">Name</td>
 919 #                   <td class="fieldinput">$name</td>
 920 #                   </tr>
 921 # IMAGE_NAME
 922 #               }
 923 #       if ($description) {
 924 #           $output .= <<IMAGE_DESC;
 925 #           <tr>
 926 #               <td class="fielddef">Description</td>
 927 #               <td class="fieldinput">$description</td>
 928 #               </td>
 929 # IMAGE_DESC
 930 #           }
 931 #       if (@tags>0) {
 932             # first make sure to kill any redundancy with the experiment tags
 933             #   my %expr_tags = $tag_table->return_relevant_tags("ex", $image{experiment_id});
 934 #                       my %new_image_tags = ();
 935 #                       foreach my $img_tag (keys %{$image{tags}}) {
 936 #                               if (!$expr_tags{$img_tag}) {
 937 #                                       ($debug>1) and warn "setting tag $img_tag for image\n";
 938 #                                       $new_image_tags{$img_tag} = $image{tags}{$img_tag};
 939 #                               }
 940 #                               else {
 941 #                                       ($debug>1) and warn "tag $img_tag is set for both experiment and image!\n";
 942 #                               }
 943 #                       }
 944 #                       my $categories = get_tag_links(\%new_image_tags);
 945 #                       (keys(%new_image_tags)>0) and $output .= <<IMAGE_TAGS;
 946
 947
 948 # <tr>
 949 #       <td class="fielddef">Categories</td>
 950 #       <td class="fieldinput">$categories</td>
 951 # </tr>
 952 # IMAGE_TAGS
 953 #               }
 954 #               $output .= "</table></center>\n";
 955 #               $output .= "<hr noshade=\"noshade\" />\n\n";
 956 #       }
 957
 958 #       # generate table showing information about this experiment
 959 #       #$output .= get_experiment_string($image{experiment_id});
 960
 961 #           print $output;
 962 #       }
 963 #     }
 964 # }
 965
 966
 967 return 1;