[Bio] / FigKernelPackages / FIGMODELObject.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/FIGMODELObject.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download) (as text)

1 : parrello 1.2 # -*- perl -*-
2 :     ########################################################################
3 :     #
4 :     # Table object for the model database interaction module
5 :     # Initiating author: Christopher Henry
6 :     # Initiating author email: chrisshenry@gmail.com
7 :     # Initiating author affiliation: Mathematics and Computer Science Division, Argonne National Lab
8 :     # Date of module creation: 2/1/2008
9 :     ########################################################################
10 :    
11 :     use strict;
12 :     use FIGMODEL;
13 :    
14 :     package FIGMODELObject;
15 :    
16 :     =head1 Object module for the model database interaction module
17 :    
18 :     =head2 Public Methods
19 :    
20 :     =head3 new
21 :     Definition:
22 :     my $Object = FIGMODELObject->new($headings,$filename,$delimiter);
23 :     Description:
24 :     Creates an empty object that may be populated by the user.
25 :     Example:
26 :     my $Object = FIGMODELObject->new($heading_list,$filename,$delimiter);
27 :     =cut
28 :    
29 :     sub new {
30 :     my ($ObjectType,$headings,$filename,$delimiter) = @_;
31 :    
32 :     if (!defined($filename) || !defined($headings)) {
33 :     print STDERR "FIGMODELObject:new: cannot create object without a list of headings and a filename\n";
34 :     return undef;
35 :     }
36 :    
37 :     my $self;
38 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
39 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
40 :     $self->{"file IO settings"}->{"orderedkeys"}->[0] = shift(@{$headings});
41 :     bless $self;
42 :     $self->add_headings(@{$headings});
43 :    
44 :     return $self;
45 :     }
46 :    
47 :     =head3 get_data_size
48 :     Definition:
49 :     my $Size = $Object->get_data_size($Key);
50 :     Description:
51 :     Returns the number of elements stored in a particular key.
52 :     Example:
53 :     my $Size = $Object->get_data_size($Key);
54 :     =cut
55 :    
56 :     sub get_data_size {
57 :     my ($self,$Key) = @_;
58 :    
59 :     my $Size = 0;
60 :     if (defined($self->{$Key})) {
61 :     $Size = @{$self->{$Key}};
62 :     }
63 :    
64 :     return $Size;
65 :     }
66 :    
67 :     =head3 get_data
68 :     Definition:
69 :     my $DataArrayRef = $Object->get_data($Key);
70 :     Description:
71 :     Returns a reference to the array stored in Key.
72 :     Example:
73 :     my DataArrayRef = $Object->get_data($Key);
74 :     =cut
75 :    
76 :     sub get_data {
77 :     my ($self,$Key) = @_;
78 :    
79 :     if (defined($self->{$Key})) {
80 :     return $self->{$Key};
81 :     }
82 :    
83 :     return undef;
84 :     }
85 :    
86 :     =head3 filename
87 :     Definition:
88 :     my $filename = $Object->filename();
89 :     Description:
90 :     Returns the filename for the object.
91 :     Example:
92 :     my $filename = $Object->filename();
93 :     =cut
94 :    
95 :     sub filename {
96 :     my ($self,$NewFilename) = @_;
97 :    
98 :     if (defined($NewFilename)) {
99 :     $self->{"file IO settings"}->{"filename"}->[0] = $NewFilename;
100 :     }
101 :    
102 :     return $self->{"file IO settings"}->{"filename"}->[0];
103 :     }
104 :    
105 :     =head3 delimiter
106 :     Definition:
107 :     my $delimiter = $Object->delimiter();
108 :     Description:
109 :     Returns the delimiter for the object.
110 :     Example:
111 :     my $delimiter = $Object->delimiter();
112 :     =cut
113 :    
114 :     sub delimiter {
115 :     my ($self,$NewDelimiter) = @_;
116 :    
117 :     if (defined($NewDelimiter)) {
118 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $NewDelimiter;
119 :     }
120 :    
121 :     return $self->{"file IO settings"}->{"delimiter"}->[0];
122 :     }
123 :    
124 :     =head3 headings
125 :     Definition:
126 :     my $Headings = $Object->headings();
127 :     Description:
128 :     Returns an array reference containing the headings for the object.
129 :     Example:
130 :     my $Headings = $Object->headings();
131 :     =cut
132 :    
133 :     sub headings {
134 :     my ($self) = @_;
135 :     return $self->{"file IO settings"}->{"orderedkeys"};
136 :     }
137 :    
138 :     =head3 add_data
139 :     Definition:
140 :     my $Count = $Object->add_data($Data,$Key,$Unique);
141 :     Description:
142 :     Adds $Data to the array stored in $Key. If $Unique is specified and equal to "1", only new data is added to the array.
143 :     Returns "1" if data was added and "0" if no data was added
144 :     Example:
145 :     my $Count = $Object->add_data($Data,$Key,$Unique);
146 :     =cut
147 :    
148 :     sub add_data {
149 : chenry 1.3 my ($self,$DataArray,$Key,$Unique) = @_;
150 : parrello 1.2
151 : chenry 1.3 if (defined($DataArray)) {
152 :     foreach my $Data (@{$DataArray}) {
153 :     #Now checking if the heading exists and if the $Data is unique
154 :     if (!defined($Unique) || $Unique ne 1 || $self->data_exists($Data,$Key) == 0) {
155 :     #Adding the data
156 :     if (defined($self->get_data($Key))) {
157 :     push(@{$self->get_data($Key)},$Data);
158 :     } else {
159 :     $self->{$Key}->[0] = $Data;
160 :     }
161 : parrello 1.2 }
162 :     }
163 :     }
164 :    
165 :     return 0;
166 :     }
167 :    
168 :     =head3 data_exists
169 :     Definition:
170 :     my $Result = $Object->data_exists($Data,$Key);
171 :     Description:
172 :     Returns "1" if the input $Data matches one of the entries in the array stored in $Key.
173 :     Example:
174 :     my $Result = $Object->data_exists($Data,$Key);
175 :     =cut
176 :    
177 :     sub data_exists {
178 :     my ($self,$Data,$Key) = @_;
179 :    
180 :     if ($self->get_data_size($Key) > 0) {
181 :     for (my $i=0; $i < $self->get_data_size($Key); $i++) {
182 :     if ($self->get_data($Key)->[$i] eq $Data) {
183 :     return 1;
184 :     }
185 :     }
186 :     }
187 :    
188 :     return 0;
189 :     }
190 :    
191 :     =head3 delete_key
192 :     Definition:
193 :     $Object->delete_key($Key);
194 :     Description:
195 :     Deletes a key from the object.
196 :     Example:
197 :     $Object->delete_key($Key);
198 :     =cut
199 :    
200 :     sub delete_key {
201 :     my ($self,$Key) = @_;
202 :    
203 :     if ($self->get_data_size($Key) > 0) {
204 :     delete $self->{$Key};
205 : chenry 1.3 $self->remove_heading($Key);
206 : parrello 1.2 }
207 :     }
208 :    
209 :     =head3 remove_data
210 :     Definition:
211 :     $Object->remove_data(@Data,$Key);
212 :     Description:
213 :     Removes the data specified in @Data from the array stored in $Key.
214 :     Example:
215 :     $Object->remove_data(@Data,$Key);
216 :     =cut
217 :    
218 :     sub remove_data {
219 :     my ($self,@Data,$Key) = @_;
220 :    
221 :     if ($self->get_data_size($Key) > 0) {
222 :     for (my $i=0; $i < $self->get_data_size($Key); $i++) {
223 :     foreach my $Item (@Data) {
224 :     if ($Item eq $self->get_data_size($Key)->[$i]) {
225 :     splice(@{$self->get_data()},$i,1);
226 :     $i--;
227 :     last;
228 :     }
229 :     }
230 :     }
231 :     }
232 :    
233 :     if ($self->get_data_size($Key) == 0) {
234 :     delete $self->{$Key};
235 :     $self->remove_heading($Key);
236 :     }
237 :     }
238 :    
239 :     =head3 remove_heading
240 :     Definition:
241 :     $Object->remove_heading($Key);
242 :     Description:
243 :     Removes the specified heading from the heading list
244 :     Example:
245 :     $Object->remove_heading($Key);
246 :     =cut
247 :    
248 :     sub remove_heading {
249 :     my ($self,$Key) = @_;
250 :    
251 : chenry 1.3 for (my $i=0; $i < @{$self->headings()}; $i++) {
252 : parrello 1.2 if ($self->headings()->[$i] eq $Key) {
253 :     splice(@{$self->headings()},$i,1);
254 :     $i--;
255 :     }
256 :     }
257 :     }
258 :    
259 : chenry 1.4 =head3 rename_heading
260 :    
261 :     Definition:
262 :     FIGMODELObject->rename_heading(string:old name,string:new name);
263 :     Description:
264 :     Renames a heading
265 :    
266 :     =cut
267 :     sub rename_heading {
268 :     my ($self,$old,$new) = @_;
269 :     for (my $i=0; $i < @{$self->headings()}; $i++) {
270 :     if ($self->headings()->[$i] eq $old) {
271 :     $self->headings()->[$i] = $new;
272 :     $self->{$new} = $self->{$old};
273 :     }
274 :     }
275 :     }
276 :    
277 : parrello 1.2 =head3 add_headings
278 :     Definition:
279 :     $Object->add_headings(@Headings);
280 :     Description:
281 :     Adds new headings to the table. This is needed to get the object to print the data under the new heading.
282 :     Example:
283 :     $Object->add_headings("Notes");
284 :     =cut
285 :    
286 :     sub add_headings {
287 :     my ($self,@Headings) = @_;
288 :    
289 :     foreach my $Heading (@Headings) {
290 :     if (defined($self->headings())) {
291 :    
292 :     #First check if the heading already exists
293 :     foreach my $ExistingHeading (@{$self->headings()}) {
294 :     if ($Heading eq $ExistingHeading) {
295 :     $Heading = "";
296 :     last;
297 :     }
298 :     }
299 :     }
300 :     if ($Heading ne "") {
301 :     push(@{$self->{"file IO settings"}->{orderedkeys}},$Heading);
302 :     }
303 :     }
304 :     }
305 :    
306 :     =head3 save
307 :     Definition:
308 :     $Object->save($filename,$delimiter);
309 :     Description:
310 :     Saves the object to a horizontal table file
311 :     Example:
312 :     $Object->save("cpd00001.txt","\t");
313 :     =cut
314 :    
315 :     sub save {
316 :     my ($self,$filename,$delimiter) = @_;
317 :    
318 :     $self->filename($filename);
319 :     $self->delimiter($delimiter);
320 :     if (open (HASHTOHORIZONTALOUTPUT, ">".$self->filename())) {
321 :     foreach my $Item (@{$self->headings()}) {
322 :     if ($self->get_data_size($Item) > 0) {
323 :     print HASHTOHORIZONTALOUTPUT $Item.$self->delimiter().join($self->delimiter(),@{$self->get_data($Item)})."\n";
324 :     }
325 :     }
326 :     close(HASHTOHORIZONTALOUTPUT);
327 :     }
328 :     }
329 :    
330 :     =head3 load
331 :     Definition:
332 :     my $Object = FIGMODELObject->load($filename,$delimiter);
333 :     Description:
334 :     Loads an object from file.
335 :     Example:
336 :     my $Object = FIGMODELObject->load($filename,$delimiter);
337 :     =cut
338 :    
339 :     sub load {
340 :     my ($ObjectType,$filename,$delimiter) = @_;
341 :    
342 :     if (!defined($filename) || !defined($delimiter)) {
343 :     print STDERR "FIGMODELObject:new: cannot load object without filename and delimiter\n";
344 :     return undef;
345 :     }
346 :    
347 :     my $self = {};
348 : chenry 1.3 bless $self;
349 : parrello 1.2 $self->filename($filename);
350 :     $self->delimiter($delimiter);
351 : chenry 1.3 if (open (INPUT, "<".$self->filename())) {
352 : parrello 1.2 while (my $Line = <INPUT>) {
353 :     chomp($Line);
354 :     my $Delimiter = $self->delimiter();
355 :     my @Data = split(/$Delimiter/,$Line);
356 :     my $Heading = shift(@Data);
357 : chenry 1.3 my $Temp;
358 :     push(@{$Temp},@Data);
359 :     $self->add_data($Temp,$Heading);
360 :     $self->add_headings(($Heading));
361 : parrello 1.2 }
362 :     close(INPUT);
363 :     return $self;
364 :     }
365 :     print STDERR "FIGMODELObject:load: could not load ".$self->filename()."\n";
366 :     return undef;
367 :     }
368 :    
369 : chenry 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3