← 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.PLS

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