scripts/biosql/update-on-new-version.pl

   1 # $Id$
   2 #
   3 # This is a closure that may be used as an argument to the --mergeobjs
   4 # option of load-seqdatabase.pl.
   5 #
   6 # The goal is to trigger an update only if the version has changed from
   7 # the old entry to the new one. In that case we remove all annotation and
   8 # features for that entry from the database, as updating them is difficult
   9 # due to poor unique key definitions. If the version is unchanged, we'll
  10 # assume the database entry is up-to-date already and skip the new entry.
  11 #
  12 sub {
  13     my ($old,$new,$db) = @_;
  14
  15     # as a special tuning step we make sure here that caching is turned
  16     # on for Annotation::Reference objects, since the updated record will
  17     # in many cases have almost the same references as were already there
  18     my $refadp = $db->get_object_adaptor("Bio::Annotation::Reference");
  19     $refadp->caching_mode(1) if $refadp && (! $refadp->caching_mode);
  20
  21     # Identifiables always have a version
  22     if($old->isa("Bio::IdentifiableI") && $new->isa("Bio::IdentifiableI")) {
  23         if((defined($old->version) xor defined($new-version)) ||
  24            ($old->version < $new->version)) {
  25             # remove existing features
  26             if($old->isa("Bio::FeatureHolderI")) {
  27                 foreach my $fea ($old->get_all_SeqFeatures()) {
  28                     $fea->remove();
  29                 }
  30             }
  31             # remove existing annotation
  32             if($old->isa("Bio::AnnotatableI")) {
  33                 my $anncoll = $old->annotation();
  34                 if($anncoll->isa("Bio::DB::PersistentObjectI")) {
  35                     $anncoll->remove(-fkobjs => [$old]);
  36                 }
  37             }
  38             print STDERR "about to update ",$new->object_id()," (version ",
  39                          (defined($old->version) ? $old->version : "<undef>"),
  40                          " -> ",
  41                          (defined($new->version) ? $new->version : "<undef>"),
  42                          ")\n";
  43         } else {
  44             # skip the update
  45             $new = undef;
  46         }
  47     } else {
  48         warn "Either ".ref($old->obj)." or ".ref($new->obj).
  49             " is not IdentifiableI - cannot compare by version";
  50     }
  51     return $new;
  52 }