annotate variant_effect_predictor/Bio/EnsEMBL/Utils/Scalar.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author devteam <devteam@galaxyproject.org>
date Mon, 13 Jan 2014 10:38:30 -0500
parents 1f6dce3d34e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
1 package Bio::EnsEMBL::Utils::Scalar;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
2
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
3 =pod
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
4
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
5 =head1 LICENSE
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
6
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
7 Copyright (c) 1999-2012 The European Bioinformatics Institute and
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
8 Genome Research Limited. All rights reserved.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
9
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
10 This software is distributed under a modified Apache license.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
11 For license details, please see
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
12
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
13 http://www.ensembl.org/info/about/code_licence.html
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
14
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
15 =head1 CONTACT
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
16
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
17 Please email comments or questions to the public Ensembl
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
18 developers list at <dev@ensembl.org>.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
19
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
20 Questions may also be sent to the Ensembl help desk at
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
21 <helpdesk@ensembl.org>.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
22
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
23 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
24
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
25 =pod
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
26
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
27 =head1 NAME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
28
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
29 Bio::EnsEMBL::Utils::Scalar
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
30
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
31 =head1 SYNOPSIS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
32
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
33 use Bio::EnsEMBL::Utils::Scalar qw(check_ref assert_ref wrap_array check_ref_can assert_ref_can assert_numeric assert_integer scope_guard);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
34
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
35 check_ref([], 'ARRAY'); # Will return true
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
36 check_ref({}, 'ARRAY'); # Will return false
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
37 check_ref($dba, 'Bio::EnsEMBL::DBSQL::DBAdaptor'); #Returns true if $dba is a DBAdaptor
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
38
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
39 assert_ref([], 'ARRAY'); #Returns true
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
40 assert_ref({}, 'ARRAY'); #throws an exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
41 assert_ref($dba, 'Bio::EnsEMBL::Gene'); #throws an exception if $dba is not a Gene
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
42
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
43 wrap_array([]); #Returns the same reference
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
44 wrap_array($a); #Returns [$a] if $a was not an array
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
45 wrap_array(undef); #Returns [] since incoming was undefined
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
46 wrap_array(); #Returns [] since incoming was empty (therefore undefined)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
47
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
48 check_ref_can([], 'dbID'); #returns false as ArrayRef is not blessed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
49 check_ref_can($gene, 'dbID'); #returns true as Gene should implement dbID()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
50 check_ref_can(undef); #Throws an exception as we gave no method to test
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
51
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
52 assert_ref_can([], 'dbID'); #throws an exception since ArrayRef is not blessed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
53 assert_ref_can($gene, 'dbID'); #returns true if gene implements dbID()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
54 assert_ref_can(undef); #Throws an exception as we gave no method to test
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
55
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
56 asssert_integer(1, 'dbID'); #Passes
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
57 asssert_integer(1.1, 'dbID'); #Fails
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
58 asssert_numeric(1E-11, 'dbID'); #Passes
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
59 asssert_numeric({}, 'dbID'); #Fails
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
60
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
61 #Scope guards
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
62 my $v = 'wibble';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
63 {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
64 #Build a guard to reset $v to wibble
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
65 my $guard = scope_guard(sub { $v = 'wibble'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
66 $v = 'wobble';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
67 warn $v; # prints wobble
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
68 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
69 # $guard is out of scope; sub is triggered and $v is reset
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
70 warn $v; # prints wibble
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
71
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
72 #Tags are also available for exporting
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
73 use Bio::EnsEMBL::Utils::Scalar qw(:assert); # brings in all assert methods
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
74 use Bio::EnsEMBL::Utils::Scalar qw(:check); #brings in all check methods
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
75 use Bio::EnsEMBL::Utils::Scalar qw(:array); #brings in wrap_array
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
76 use Bio::EnsEMBL::Utils::Scalar qw(:all); #import all methods
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
77
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
78 =head1 DESCRIPTION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
79
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
80 A collection of subroutines aimed to helping Scalar based operations
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
81
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
82 =head1 METHODS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
83
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
84 See subroutines.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
85
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
86 =head1 MAINTAINER
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
87
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
88 $Author: ady $
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
89
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
90 =head1 VERSION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
91
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
92 $Revision: 1.12.14.1 $
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
93
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
94 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
95
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
96 use strict;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
97 use warnings;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
98
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
99 use base qw(Exporter);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
100
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
101 our %EXPORT_TAGS;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
102 our @EXPORT_OK;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
103
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
104 @EXPORT_OK = qw(
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
105 check_ref check_ref_can
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
106 assert_ref assert_ref_can assert_numeric assert_integer assert_boolean assert_strand assert_file_handle
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
107 wrap_array
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
108 scope_guard
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
109 );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
110 %EXPORT_TAGS = (
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
111 assert => [qw(assert_ref assert_ref_can assert_integer assert_numeric assert_boolean assert_strand assert_file_handle)],
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
112 check => [qw(check_ref check_ref_can)],
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
113 array => [qw/wrap_array/],
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
114 all => [@EXPORT_OK]
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
115 );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
116
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
117 use Bio::EnsEMBL::Utils::Exception qw(throw);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
118 use Scalar::Util qw(blessed looks_like_number openhandle);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
119
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
120 =head2 check_ref()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
121
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
122 Arg [1] : The reference to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
123 Arg [2] : The type we expect
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
124 Description : A subroutine which checks to see if the given object/ref is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
125 what you expect. If you give it a blessed reference then it
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
126 will perform an isa() call on the object after the defined
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
127 tests. If it is a plain reference then it will use ref().
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
128
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
129 An undefined value will return a false.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
130 Returntype : Boolean indicating if the reference was the type we
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
131 expect
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
132 Example : my $ok = check_ref([], 'ARRAY');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
133 Exceptions : If the expected type was not set
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
134 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
135
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
136 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
137
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
138 sub check_ref {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
139 my ($ref, $expected) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
140 throw('No expected type given') if ! defined $expected;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
141 if(defined $ref) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
142 if(blessed($ref)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
143 return 1 if $ref->isa($expected);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
144 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
145 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
146 my $ref_ref_type = ref($ref);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
147 return 1 if defined $ref_ref_type && $ref_ref_type eq $expected;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
148 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
149 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
150 return 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
151 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
152
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
153 =head2 assert_ref()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
154
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
155 Arg [1] : The reference to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
156 Arg [2] : The type we expect
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
157 Arg [3] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
158 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
159 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
160 Description : A subroutine which checks to see if the given object/ref is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
161 what you expect. This behaves in an identical manner as
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
162 C<check_ref()> does except this will raise exceptions when
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
163 the values do not match rather than returning a boolean
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
164 indicating the situation.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
165
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
166 Undefs cause exception circumstances.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
167 Returntype : Boolean; true if we managed to get to the return
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
168 Example : assert_ref([], 'ARRAY');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
169 Exceptions : If the expected type was not set and if the given reference
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
170 was not assignable to the expected value
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
171 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
172
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
173 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
174
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
175 sub assert_ref {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
176 my ($ref, $expected, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
177 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
178 throw('No expected type given') if ! defined $expected;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
179 my $class = ref($ref);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
180 throw("The given reference for attribute $attribute_name was undef") unless defined $ref;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
181 throw("Asking for the type of the attribute $attribute_name produced no type; check it is a reference") unless $class;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
182 if(blessed($ref)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
183 throw("${attribute_name}'s type '${class}' is not an ISA of '${expected}'") if ! $ref->isa($expected);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
184 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
185 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
186 throw("$attribute_name was expected to be '${expected}' but was '${class}'") if $expected ne $class;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
187 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
188 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
189 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
190
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
191 =head2 wrap_array()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
192
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
193 Arg : The reference we want to wrap in an array
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
194 Description : Takes in a reference and returns either the reference if it
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
195 was already an array, the reference wrapped in an array or
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
196 an empty array (if the given value was undefined).
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
197 Returntype : Array Reference
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
198 Example : my $a = wrap_array($input);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
199 Exceptions : None
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
200 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
201
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
202 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
203
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
204 sub wrap_array {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
205 my ($incoming_reference) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
206 if(defined $incoming_reference) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
207 if(check_ref($incoming_reference, 'ARRAY')) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
208 return $incoming_reference;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
209 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
210 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
211 return [$incoming_reference];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
212 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
213 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
214 return [];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
215 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
216
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
217 =head2 check_ref_can
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
218
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
219 Arg [1] : The reference to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
220 Arg [2] : The method we expect to run
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
221 Description : A subroutine which checks to see if the given object/ref is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
222 implements the given method. This is very similar to the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
223 functionality given by C<UNIVERSAL::can()> but works
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
224 by executing C<can()> on the object meaning we consult the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
225 object's potentially overriden version rather than Perl's
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
226 default mechanism.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
227 Returntype : CodeRef
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
228 Example : check_ref_can($gene, 'dbID');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
229 Exceptions : If the expected type was not set.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
230 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
231
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
232 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
233
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
234 sub check_ref_can {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
235 my ($ref, $method) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
236 throw('No method given') if ! defined $method;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
237 return unless defined $ref && blessed($ref);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
238 return $ref->can($method);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
239 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
240
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
241 =head2 assert_ref_can
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
242
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
243 Arg [1] : The reference to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
244 Arg [2] : The method we expect to run
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
245 Arg [3] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
246 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
247 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
248 Description : A subroutine which checks to see if the given object/ref is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
249 implements the given method. Will throw exceptions.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
250 Returntype : Boolean; true if we managed to get to the return
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
251 Example : assert_ref_can($gene, 'dbID');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
252 Exceptions : If the reference is not defined, if the object does not
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
253 implement the given method and if no method was given to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
254 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
255
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
256 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
257
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
258 sub assert_ref_can {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
259 my ($ref, $method, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
260 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
261 throw('No method given') if ! defined $method;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
262 throw "The given reference $attribute_name is not defined" unless defined $ref;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
263 throw "The given reference $attribute_name is not blessed" unless blessed($ref);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
264 if(! $ref->can($method)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
265 my $str_ref = ref($ref);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
266 throw sprintf(q{The given blessed reference '%s' for attribute '%s' does not implement the method '%s'}, $str_ref, $attribute_name, $method);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
267 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
268 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
269 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
270
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
271 =head2 assert_numeric
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
272
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
273 Arg [1] : The Scalar to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
274 Arg [2] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
275 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
276 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
277 Description : A subroutine which checks to see if the given scalar is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
278 number or not. If not then we raise exceptions detailing why
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
279 Returntype : Boolean; true if we had a numeric otherwise we signal failure
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
280 via exceptions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
281 Example : assert_numeric(1, 'dbID');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
282 Exceptions : If the Scalar is not defined, if the Scalar was blessed and
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
283 if the value was not a number
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
284 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
285
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
286 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
287
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
288 sub assert_numeric {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
289 my ($integer, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
290 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
291 throw "$attribute_name attribute is undefined" if ! defined $integer;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
292 throw "The given attribute $attribute_name is blessed; cannot work with blessed values" if blessed($integer);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
293 if(! looks_like_number($integer)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
294 throw "Attribute $attribute_name was not a number";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
295 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
296 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
297 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
298
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
299 =head2 assert_integer
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
300
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
301 Arg [1] : The Scalar to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
302 Arg [2] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
303 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
304 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
305 Description : A subroutine which checks to see if the given scalar is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
306 a whole integer; we delegate to L<assert_numeric> for number
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
307 checking.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
308 Returntype : Boolean; true if we had a numeric otherwise we signal failure
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
309 via exceptions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
310 Example : assert_integer(1, 'dbID');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
311 Exceptions : See L<assert_numeric> and we raise exceptions if the value
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
312 was not a whole integer
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
313 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
314
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
315 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
316
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
317 sub assert_integer {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
318 my ($integer, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
319 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
320 assert_numeric($integer, $attribute_name);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
321 if($integer != int($integer)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
322 throw "Attribute $attribute_name was a number but not an Integer";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
323 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
324 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
325 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
326
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
327 =head2 assert_boolean
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
328
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
329 Arg [1] : The Scalar to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
330 Arg [2] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
331 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
332 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
333 Description : A subroutine which checks to see if the given scalar is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
334 a boolean i.e. value is set to C<1> or C<0>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
335 Returntype : Boolean; true if we were given a boolean otherwise we signal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
336 failure via exceptions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
337 Example : assert_boolean(1, 'is_circular');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
338 Exceptions : See L<assert_integer> and we raise exceptions if the value
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
339 was not equal to the 2 valid states
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
340 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
341
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
342 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
343
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
344 sub assert_boolean {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
345 my ($boolean, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
346 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
347 assert_numeric($boolean, $attribute_name);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
348 if($boolean != 0 && $boolean != 1) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
349 throw "Attribute $attribute_name was an invalid boolean. Expected: 1 or 0. Got: $boolean";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
350 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
351 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
352 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
353
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
354 =head2 assert_strand
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
355
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
356 Arg [1] : The Scalar to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
357 Arg [2] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
358 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
359 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
360 Description : A subroutine which checks to see if the given scalar is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
361 a whole integer and if the value is set to C<1>, C<0> or C<-1>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
362 Returntype : Boolean; true if we had a strand integer otherwise we signal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
363 failure via exceptions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
364 Example : assert_strand(1, 'strand');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
365 Exceptions : See L<assert_integer> and we raise exceptions if the value
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
366 was not equal to the 3 valid states
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
367 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
368
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
369 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
370
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
371 sub assert_strand {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
372 my ($strand, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
373 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
374 assert_numeric($strand, $attribute_name);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
375 if($strand != -1 && $strand != 0 && $strand ne 1) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
376 throw "Attribute $attribute_name was an invalid strand. Expected: 1, 0 or -1. Got: $strand";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
377 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
378 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
379 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
380
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
381
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
382 =head2 assert_file_handle
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
383
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
384 Arg [1] : The Scalar to check
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
385 Arg [2] : The attribute name you are asserting; not required but allows
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
386 for more useful error messages to be generated. Defaults to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
387 C<-Unknown->.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
388 Description : A subroutine which checks to see if the given scalar is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
389 actually a file handle. This will handle those which are Glob
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
390 references and those which inherit from C<IO::Handle>. It will
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
391 also cope with a blessed Glob reference.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
392 Returntype : Boolean;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
393 Example : assert_file_handle($fh, '-FILE_HANDLE');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
394 Exceptions : Raised if not defined, not a reference and was not a
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
395 GLOB or did not inherit from IO::Handle
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
396 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
397
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
398 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
399
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
400 sub assert_file_handle {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
401 my ($file_handle, $attribute_name) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
402 $attribute_name ||= '-Unknown-';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
403 throw "Attribute $attribute_name was undefined" if ! defined $file_handle;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
404 my $ref = ref($file_handle);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
405 throw "Attribute $attribute_name was not a reference. Got: $file_handle" if ! $ref;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
406 if(!openhandle($file_handle)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
407 if(blessed($file_handle)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
408 if(! $file_handle->isa('IO::Handle')) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
409 throw "Attribute $attribute_name was blessed but did not inherit from IO::Handle. Ref was: $ref";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
410 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
411 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
412 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
413 throw "Attribute $attribute_name was not a file handle. Ref was: $ref";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
414 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
415 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
416 return 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
417 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
418
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
419 =head2 scope_guard
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
420
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
421 Arg [1] : CodeRef The block of code to exit once it escapes out of scope
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
422 Description : Simple subroutine which blesses your given code reference into
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
423 a L<Bio::EnsEMBL::Utils::Scalar::ScopeGuard> object. This has
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
424 a DESTROY implemented which will cause the code reference
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
425 to execute once the object goes out of scope and its reference
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
426 count hits 0.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
427 Returntype : Bio::EnsEMBL::Utils::Scalar::ScopeGuard
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
428 Example : my $v = 'wibble';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
429 {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
430 #Build a guard to reset $v to wibble
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
431 my $guard = scope_guard(sub { $v = 'wibble'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
432 $v = 'wobble';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
433 warn $v;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
434 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
435 # $guard is out of scope; sub is triggered and $v is reset
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
436 warn $v;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
437 Exceptions : Raised if argument was not a CodeRef
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
438 Status : Stable
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
439
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
440 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
441
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
442 sub scope_guard {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
443 my ($callback) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
444 assert_ref($callback, 'CODE', 'callback');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
445 return bless($callback, 'Bio::EnsEMBL::Utils::Scalar::ScopeGuard');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
446 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
447
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
448 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
449
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
450 #### SUPER SECRET PACKAGE. IGNORE ME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
451 package Bio::EnsEMBL::Utils::Scalar::ScopeGuard;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
452 sub DESTROY {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
453 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
454 $self->();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
455 return;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
456 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
457
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
458 1;