3 Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
4 Copyright [2016-2022] EMBL-European Bioinformatics Institute
6 Licensed under the Apache License,
Version 2.0 (the
"License");
7 you may not use
this file except in compliance with the License.
8 You may obtain a copy of the License at
12 Unless required by applicable law or agreed to in writing, software
13 distributed under the License is distributed on an
"AS IS" BASIS,
14 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 See the License
for the specific language governing permissions and
16 limitations under the License.
28 package Bio::EnsEMBL::Hive::Utils::Collection;
37 my $self = bless {}, $class;
39 $self->
listref( shift @_ || [] );
49 $self->{
'_listref'} = shift @_;
51 return $self->{
'_listref'};
58 return @{ $self->listref };
64 my $candidate = shift @_;
66 foreach my $element (@{ $self->listref }) {
67 return 1
if($element eq $candidate);
76 push @{ $self->listref }, @_;
82 my $candidate = shift @_;
84 unless( $self->present( $candidate ) ) {
85 $self->add( $candidate );
92 my $candidate = shift @_;
94 my $listref = $self->listref;
96 for(my $i=scalar(@$listref)-1;$i>=0;$i--) {
97 if($listref->[$i] eq $candidate) {
98 splice @$listref, $i, 1;
105 my ($self, %method_to_filter_value) = @_;
107 ELEMENT:
foreach my $element (@{ $self->listref }) {
108 keys %method_to_filter_value; # sic! This is to
"rewind" the each%
operator to the beginning each time
109 while(my ($filter_name, $filter_value) = each %method_to_filter_value) {
110 my $actual_value = (ref($element) eq
'HASH') ? $element->{$filter_name} : $element->$filter_name();
111 next ELEMENT unless( defined($actual_value) # either both defined and equal or neither defined
112 ? defined($filter_value) && ( (ref($filter_value) eq
'CODE')
113 ? &$filter_value( $actual_value )
114 : ( $filter_value eq $actual_value )
116 : !defined($filter_value)
122 return undef; # have to be
explicit here to avoid surprises
127 my ($self, %method_to_filter_value) = @_;
129 my @filtered_elements = ();
131 ELEMENT:
foreach my $element (@{ $self->listref }) {
132 keys %method_to_filter_value; # sic! This is to
"rewind" the each%
operator to the beginning each time
133 while(my ($filter_name, $filter_value) = each %method_to_filter_value) {
134 my $actual_value = (ref($element) eq
'HASH') ? $element->{$filter_name} : $element->$filter_name();
135 next ELEMENT unless( defined($actual_value) # either both defined and equal or neither defined
136 ? defined($filter_value) && ( (ref($filter_value) eq
'CODE')
137 ? &$filter_value( $actual_value )
138 : ( $filter_value eq $actual_value )
140 : !defined($filter_value)
143 push @filtered_elements, $element;
146 return \@filtered_elements;
150 sub _find_all_by_subpattern { # subpatterns can be combined into full patterns
using +-,
151 my ($self, $pattern) = @_;
153 my $filtered_elements = [];
156 if( $pattern=~/^\d+$/ ) {
158 $filtered_elements = $self->find_all_by(
'dbID', $pattern );
160 } elsif( $pattern=~/^(\d+)\.\.(\d+)$/ ) {
162 $filtered_elements = $self->find_all_by(
'dbID', sub {
return $1<=$_[0] && $_[0]<=$2; } );
164 } elsif( $pattern=~/^(\d+)\.\.$/ ) {
166 $filtered_elements = $self->find_all_by(
'dbID', sub {
return $1<=$_[0]; } );
168 } elsif( $pattern=~/^\.\.(\d+)$/ ) {
170 $filtered_elements = $self->find_all_by(
'dbID', sub {
return $_[0]<=$1; } );
172 } elsif( $pattern=~/^\w+$/) {
174 $filtered_elements = $self->find_all_by(
'name', $pattern );
176 } elsif( $pattern=~/^[\w\%]+$/) {
179 $filtered_elements = $self->find_all_by(
'name', sub {
return $_[0]=~/^${pattern}$/; } );
181 } elsif( $pattern=~/^(\w+)==(.*)$/) {
183 $filtered_elements = $self->find_all_by( $1, $2 );
185 } elsif( $pattern=~/^(\w+)!=(.*)$/) {
187 $filtered_elements = $self->find_all_by( $1, sub {
return $_[0] ne $2; } );
189 } elsif( $pattern=~/^(\w+)<=(.*)$/) { # NB: the order is important - all digraphs should be parsed before their proper prefixes
191 $filtered_elements = $self->find_all_by( $1, sub {
return $_[0] <= $2; } );
193 } elsif( $pattern=~/^(\w+)>=(.*)$/) {
195 $filtered_elements = $self->find_all_by( $1, sub {
return $_[0] >= $2; } );
197 } elsif( $pattern=~/^(\w+)<(.*)$/) {
199 $filtered_elements = $self->find_all_by( $1, sub {
return $_[0] < $2; } );
201 } elsif( $pattern=~/^(\w+)>(.*)$/) {
203 $filtered_elements = $self->find_all_by( $1, sub {
return $_[0] > $2; } );
206 die
"The pattern '$pattern' is not recognized\n";
209 return $filtered_elements;
213 =head2 find_all_by_pattern
215 Arg [1] : (optional)
string $pattern
216 Example : my $first_fifteen_analyses_and_two_more = $collection->find_all_by_pattern(
'1..15,analysis_X,21' );
217 Example : my $two_open_ranges = $collection->>find_all_by_pattern(
'..7,10..' );
218 Example : my $double_exclusion = $collection->find_all_by_pattern(
'1..15-3..5+4' );
219 Example : my $blast_related_with_exceptions = $collection->find_all_by_pattern(
'blast%-12-%funnel' );
220 Description: Filters an arrayref of non-repeating objects from the given collection by interpreting a pattern.
221 The pattern can contain individual analyses_ids, individual logic_names,
222 open and closed ranges of analysis_ids, wildcard patterns of logic_names,
223 merges (+ or ,) and exclusions (-) of the above subsets.
225 Caller : both beekeeper.pl (
for scheduling) and runWorker.pl (
for specialization)
229 sub find_all_by_pattern {
230 my ($self, $pattern) = @_;
232 if( not defined($pattern) ) {
234 return [ $self->list ];
238 # By using the grouping, we ask Perl to return the pattern and their delimiters 239 my @syll = split(/([+\-,])/, $pattern);
241 my %uniq = map { (
"$_" => $_) } @{ $self->_find_all_by_subpattern( shift @syll ) }; # initialize with the first syllable
244 my $operation = shift @syll; # by construction
this is one of [+-,]
245 my $subpattern = shift @syll; # can be an empty
string 247 foreach my $element (@{ $self->_find_all_by_subpattern( $subpattern ) }) {
248 if($operation eq
'-') {
249 delete $uniq{
"$element" };
251 $uniq{
"$element" } = $element;
256 return [ values %uniq ];
261 sub dark_collection { # contain another collection of objects marked
for deletion
265 $self->{
'_dark_collection'} = shift @_;
267 return $self->{
'_dark_collection'};
271 sub forget_and_mark_for_deletion {
273 my $candidate = shift @_;
275 $self->forget( $candidate );
277 unless( $self->dark_collection ) {
280 $self->dark_collection->add( $candidate );
287 $self->listref( [] );
288 $self->dark_collection( undef );