scripts/Bio-DB-SeqFeature-Store/bp_seqfeature_delete.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use File::Spec;
   8 use Bio::DB::SeqFeature::Store;
   9
  10 my $DSN      = 'dbi:mysql:test';
  11 my $USER     = '';
  12 my $PASS     = '';
  13 my $ADAPTOR  = 'DBI::mysql';
  14 my $NAME     = 0;
  15 my $TYPE     = 0;
  16 my $ID       = 0;
  17 my $VERBOSE  = 1;
  18 my $TEST     = 0;
  19 my $FAST     = 0;
  20
  21 GetOptions(
  22            'dsn|d=s'       => \$DSN,
  23            'adaptor=s'   => \$ADAPTOR,
  24            'verbose!'    => \$VERBOSE,
  25            'dryrun|dry-run' => \$TEST,
  26            'name|n'      => \$NAME,
  27            'type|t'      => \$TYPE,
  28            'id'          => \$ID,
  29            'fast|f'          => \$FAST,
  30            'user=s'      => \$USER,
  31            'password=s'  => \$PASS,
  32            ) || die <<END;
  33 Usage: $0 [options] <feature1> <feature2> <feature3>
  34   Options:
  35           -d --dsn        The database name ($DSN)
  36           -a --adaptor    The storage adaptor to use ($ADAPTOR)
  37           -n --name       Delete features based on name or wildcard pattern (default)
  38           -t --type       Delete features based on type
  39           -i --id         Delete features based on primary id
  40           -v --verbose    Turn on verbose progress reporting (default)
  41              --noverbose  Turn off verbose progress reporting
  42           --dryrun        Dry run; report features to be deleted without actually deleting them
  43           -u --user       User to connect to database as
  44           -p --password   Password to use to connect to database
  45           -f --fast       Deletes each item instantly not atomic for full dataset (mainly for deleting massive datasets linked to a type)
  46
  47 Examples:
  48
  49  Delete from mysql database volvox features named f08 f09 f10
  50      $0 -d volvox -n f08 f09 f10
  51
  52  Delete features whose names start with f
  53      $0 -d volvox -n 'f*'
  54
  55  Delete all features of type remark, source example
  56      $0 -d volvox -t remark:example
  57
  58  Delete all remark features, regardless of source
  59      $0 -d volvox -t 'remark:*'
  60
  61  Delete the feature with ID 1234
  62      $0 -d volvox -i 1234
  63
  64  Delete all features named f* from a berkeleydb database
  65      $0 -a berkeleydb -d /usr/local/share/db/volvox -n 'f*'
  66
  67 Remember to protect wildcards against shell interpretation by putting
  68 single quotes around them!
  69 END
  70     ;
  71
  72 if ($NAME+$TYPE+$ID > 1) {
  73     die "Please provide only one of the --name, --type or --id options.\nRun \"$0 --help\" for usage.\n";
  74 }
  75
  76 unless (@ARGV) {
  77     die "Please provide a list of feature names, types or ids.\n Run \"$0 --help\" for usage.\n";
  78 }
  79
  80 my $mode = $ID   ? 'id'
  81           :$TYPE ? 'type'
  82           :$NAME ? 'name'
  83           :'name';
  84
  85
  86 my @options;
  87 @options = ($USER,$PASS) if $USER || $PASS;
  88
  89 my $store = Bio::DB::SeqFeature::Store->new(
  90                                             -dsn     => $DSN,
  91                                             -adaptor => $ADAPTOR,
  92                                             -user    => $USER,
  93                                             -pass    => $PASS,
  94                                             -write    => 1,
  95     )
  96   or die "Couldn't create connection to the database";
  97
  98 my @features = retrieve_features($store,$mode,\@ARGV);
  99
 100 if ($VERBOSE || $TEST) {
 101     print scalar (@features)," feature(s) match.\n\n";
 102     my $heading;
 103     foreach (@features) {
 104         printf "%-20s %-20s %-12s\n%-20s %-20s %-12s\n",
 105                'Name','Type','Primary ID',
 106                '----','----','----------'
 107                    unless $heading++;
 108         printf "%-20s %-20s %-12d\n",$_->display_name,$_->type,$_->primary_id;
 109     }
 110     print "\n";
 111 }
 112
 113 if (@features && !$TEST) {
 114     if($FAST) {
 115       my $del = 0;
 116       foreach my $feat(@features) {
 117         my @tmp_feat = ($feat);
 118         my $deleted = $store->delete(@tmp_feat);
 119         $del++ if($deleted);
 120         if ($VERBOSE && $deleted) {
 121           print 'Feature ',$del," successfully deleted.\n";
 122         } elsif (!$deleted) {
 123           die "An error occurred. Some or all of the indicated features could not be deleted.";
 124         }
 125       }
 126     }
 127     else {
 128         my $deleted = $store->delete(@features);
 129         if ($VERBOSE && $deleted) {
 130                 print scalar(@features)," features successfully deleted.\n";
 131         } elsif (!$deleted) {
 132                 die "An error occurred. Some or all of the indicated features could not be deleted.";
 133         }
 134     }
 135 }
 136
 137 exit 0;
 138
 139 sub retrieve_features {
 140     my($db,$mode,$list) = @_;
 141     my @features;
 142     if ($mode eq 'name') {
 143         @features = map {$db->get_features_by_alias($_)} @$list;
 144     }
 145     elsif ($mode eq 'type') {
 146         my $regexp = glob2regexp(@$list);
 147         my @types  = grep {/$regexp/} $db->types;
 148         @features  = $db->get_features_by_type(@types) if @types;
 149     }
 150     elsif ($mode eq 'id') {
 151         @features  = grep {defined $_} map {$db->get_feature_by_primary_id($_)} @$list;
 152     }
 153     return @features;
 154 }
 155
 156 sub glob2regexp {
 157     my @globs = map {
 158         $_ = quotemeta($_);
 159         s/\\\*/.*/g;
 160         s/\?/./g;
 161         $_ } @_;
 162     return '^(?:'.join('|',@globs).')$';
 163  }