← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to scripts/Bio-DB-SeqFeature-Store/bp_seqfeature_delete.pl

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
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
 }