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

Annotation of /FigKernelPackages/FIGMODELTable.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.8 # -*- 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 :    
13 :     package FIGMODELTable;
14 :    
15 :     =head1 Table object for the model database interaction module
16 :    
17 :     =head2 Public Methods
18 :    
19 :     =head3 new
20 :     Definition:
21 :     my $TableObj = FIGMODELTable->new($heading_list_ref,$filename,$hash_heading_list_ref,$delimiter,$itemdelimiter,$prefix);
22 :     Description:
23 :     Creates an empty table object which may be filled using the add row function.
24 :     The $heading_list_ref and $filename are required, but all remaining arguments are optional.
25 :     Example:
26 :     my $TableObj = FIGMODELTable->new($heading_list_ref,$filename,$hash_heading_list_ref,$delimiter,$itemdelimiter,$prefix);
27 :     =cut
28 :    
29 :     sub new {
30 :     my ($ObjectType,$headings,$filename,$hash_headings,$delimiter,$itemdelimiter,$prefix) = @_;
31 :    
32 :     my $self;
33 :     if (!defined($filename) || !defined($headings)) {
34 :     print STDERR "FIGMODELTable:new: cannot create table without a list of headings and a filename\n";
35 :     return undef;
36 :     }
37 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
38 :     $self->{"file IO settings"}->{"orderedkeys"} = $headings;
39 :     #Dealing with optional arguments
40 :     if (defined($hash_headings)) {
41 :     for (my $i=0; $i < @{$hash_headings}; $i++) {
42 :     $self->{"hash columns"}->{$hash_headings->[$i]} = {};
43 :     }
44 :     }
45 :     if (!defined($delimiter)) {
46 :     $delimiter = ";";
47 :     }
48 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
49 :     if (!defined($itemdelimiter)) {
50 :     $itemdelimiter = "|";
51 :     }
52 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $itemdelimiter;
53 :     if (!defined($prefix)) {
54 :     $prefix = "";
55 :     }
56 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $prefix;
57 :    
58 :     return bless $self;
59 :     }
60 :    
61 :     =head2 TABLE Methods
62 :    
63 :     =head3 size
64 :     Definition:
65 :     my $tablesize = $TableObj->size();
66 :     Description:
67 :     This returns the number of rows in the table
68 :     Example:
69 :     my $tablesize = $TableObj->size();
70 :     =cut
71 :    
72 :     sub size {
73 :     my ($self) = @_;
74 :     my $TableSize = 0;
75 :     if (defined($self->{"array"})) {
76 :     $TableSize = @{$self->{"array"}};
77 :     }
78 :     return $TableSize;
79 :     }
80 :    
81 :     =head3 get_row
82 :     Definition:
83 :     my $RowObject = $TableObj->get_row($Row_index);
84 :     Description:
85 :     Returns a hash reference for the specified row in the table. Returns undef if the row does not exist.
86 :     Example:
87 :     my $RowObject = $TableObj->get_row(1);
88 :     =cut
89 :    
90 :     sub get_row {
91 :     my ($self,$RowNumber) = @_;
92 :     return $self->{"array"}->[$RowNumber];
93 :     }
94 :    
95 : chenry 1.14 =head3 get_rows
96 :     Definition:
97 :     (RowObjects):array reference to all rows = FIGMODELTable->get_rows();
98 :     Description:
99 :     Returns a reference to the complete array of rows
100 :     =cut
101 :     sub get_rows {
102 :     my ($self) = @_;
103 :     return $self->{"array"};
104 :     }
105 :    
106 : parrello 1.8 =head3 filename
107 :     Definition:
108 :     my $filename = $TableObj->filename();
109 :     Description:
110 :     Returns the filename for the table.
111 :     Example:
112 :     my $filename = $TableObj->filename();
113 :     =cut
114 :    
115 :     sub filename {
116 :     my ($self,$NewFilename) = @_;
117 :    
118 :     if (defined($NewFilename)) {
119 :     $self->{"file IO settings"}->{"filename"}->[0] = $NewFilename;
120 :     }
121 :    
122 :     return $self->{"file IO settings"}->{"filename"}->[0];
123 :     }
124 :    
125 : chenry 1.15 =head3 prefix
126 :     Definition:
127 :     string: prefix = FIGMODELTable->prefix(string:new prefix);
128 :     =cut
129 :     sub prefix {
130 :     my ($self,$newPrefix) = @_;
131 :     if (defined($newPrefix)) {
132 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $newPrefix;
133 :     }
134 :     return $self->{"file IO settings"}->{"file prefix"}->[0];
135 :     }
136 :    
137 : parrello 1.8 =head3 delimiter
138 :     Definition:
139 :     my $delimiter = $TableObj->delimiter();
140 :     Description:
141 :     Returns the delimiter for the table.
142 :     Example:
143 :     my $delimiter = $TableObj->delimiter();
144 :     =cut
145 :    
146 :     sub delimiter {
147 :     my ($self,$NewDelimiter) = @_;
148 :    
149 :     if (defined($NewDelimiter)) {
150 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $NewDelimiter;
151 :     }
152 :    
153 :     return $self->{"file IO settings"}->{"delimiter"}->[0];
154 :     }
155 :    
156 :     =head3 item_delimiter
157 :     Definition:
158 :     my $item_delimiter = $TableObj->item_delimiter();
159 :     Description:
160 :     Returns the item delimiter for the table.
161 :     Example:
162 :     my $item_delimiter = $TableObj->item_delimiter();
163 :     =cut
164 :    
165 :     sub item_delimiter {
166 :     my ($self,$ItemDelimiter) = @_;
167 :    
168 :     if (defined($ItemDelimiter)) {
169 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $ItemDelimiter;
170 :     }
171 :    
172 :     return $self->{"file IO settings"}->{"item delimiter"}->[0];
173 :     }
174 :    
175 :     =head3 headings
176 :     Definition:
177 :     my @Headings = $TableObj->headings();
178 :     Description:
179 :     Returns an array containing the headings for the table.
180 :     Example:
181 :     my @Headings = $TableObj->headings();
182 :     =cut
183 :    
184 :     sub headings {
185 :     my ($self,$InHeadings) = @_;
186 :     if (defined($InHeadings)) {
187 :     $self->{"file IO settings"}->{"orderedkeys"} = $InHeadings;
188 :     }
189 :     return @{$self->{"file IO settings"}->{"orderedkeys"}};
190 :     }
191 :    
192 :     =head3 get_table_hash_headings
193 :     Definition:
194 :     my @hash_headings = $TableObj->get_table_hash_headings();
195 :     Description:
196 :     Returns an array containing the headings that have also been added to the hash key for the table.
197 :     Example:
198 :     my @hash_headings = $TableObj->get_table_hash_headings();
199 :     =cut
200 :    
201 :     sub hash_headings {
202 :     my ($self) = @_;
203 :     return keys(%{$self->{"hash columns"}});
204 :     }
205 :    
206 :     =head3 get_row_by_key
207 :     Definition:
208 :     my $RowObject = $TableObj->get_row_by_key($Key,$HashColumn,$AddRow);
209 :     Description:
210 :     Returns the row object for the firt row that matches the input key. Return undef if nothing matches the input key.
211 :     Example:
212 :     my $RowObject = $TableObj->get_row_by_key("rxn00001");
213 :     =cut
214 :    
215 :     sub get_row_by_key {
216 :     my ($self,$Key,$HashColumn,$AddRow) = @_;
217 :     if (defined($self->{"hash columns"}->{$HashColumn}->{$Key}->[0])) {
218 :     return $self->{"hash columns"}->{$HashColumn}->{$Key}->[0];
219 :     } elsif (defined($AddRow) && $AddRow == 1) {
220 :     my $NewRow = {$HashColumn => [$Key]};
221 :     $self->add_row($NewRow);
222 :     return $NewRow;
223 :     }
224 :     return undef;
225 :     }
226 :    
227 :     =head3 get_rows_by_key
228 :     Definition:
229 :     my @RowObjects = $TableObj->get_rows_by_key($Key);
230 :     Description:
231 :     Returns the list of row objects that match the input key. Returns an empty list if nothing matches the input key.
232 :     Example:
233 :     my @RowObjects = $TableObj->get_rows_by_key("rxn00001");
234 :     =cut
235 :    
236 :     sub get_rows_by_key {
237 :     my ($self,$Key,$HashColumn) = @_;
238 : chenry 1.12
239 : parrello 1.8 if (defined($self->{"hash columns"}->{$HashColumn}->{$Key})) {
240 :     return @{$self->{"hash columns"}->{$HashColumn}->{$Key}};
241 :     }
242 :     return ();
243 :     }
244 :    
245 :    
246 :     =head3 get_table_by_key
247 :     Definition:
248 :     my $NewTable = $TableObj->get_table_by_key();
249 :     Description:
250 :     Returns a new table object where every row matches the input key/data combo.
251 :     Returns an empty table if no rows match the input key/data combo.
252 :     Example:
253 :     my $NewTable = $TableObj->get_table_by_key();
254 :     =cut
255 :    
256 :     sub get_table_by_key {
257 :     my ($self,$Key,$HashColumn) = @_;
258 :    
259 :     my $NewTable = $self->clone_table_def();
260 :     my @Rows = $self->get_rows_by_key($Key,$HashColumn);
261 :     for (my $i=0; $i < @Rows; $i++) {
262 :     $NewTable->add_row($Rows[$i]);
263 :     }
264 :    
265 :     return $NewTable;
266 :     }
267 :    
268 :     =head3 get_hash_column_keys
269 :     Definition:
270 :     my @HashKeys = $TableObj->get_hash_column_keys($HashColumn);
271 :     Description:
272 :     Returns the list of the keys stored in the hash of the values in the column labeled $HashColumn.
273 :     Example:
274 :     my @HashKeys = $TableObj->get_hash_column_keys("Media");
275 :     =cut
276 :    
277 :     sub get_hash_column_keys {
278 :     my ($self,$HashColumn) = @_;
279 :     if (defined($self->{"hash columns"}->{$HashColumn})) {
280 :     return keys(%{$self->{"hash columns"}->{$HashColumn}});
281 :     }
282 :     return ();
283 :     }
284 :    
285 :     =head3 add_row
286 :     Definition:
287 :     $TableObj->add_row($row_object);
288 :     Description:
289 :     Adds a row to the table.
290 :     Example:
291 :     $TableObj->add_row({"COLUMN 1" => ["A"],"COLUMN 2" => ["B"]});
292 :     =cut
293 :    
294 :     sub add_row {
295 :     my ($self,$RowObject,$RowIndex) = @_;
296 :     if (defined($RowIndex) && $RowIndex == 0) {
297 :     unshift(@{$self->{"array"}},$RowObject);
298 :     } else {
299 :     push(@{$self->{"array"}},$RowObject);
300 :     }
301 :     my @HashHeadings = $self->hash_headings();
302 :     foreach my $HashHeading (@HashHeadings) {
303 :     if (defined($RowObject->{$HashHeading})) {
304 :     for (my $i=0; $i < @{$RowObject->{$HashHeading}}; $i++) {
305 :     push(@{$self->{$RowObject->{$HashHeading}->[$i]}},$RowObject);
306 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}},$RowObject);
307 :     }
308 :     }
309 :     }
310 :     return $RowObject;
311 :     }
312 :    
313 :     =head3 sort_rows
314 :     Definition:
315 :     $TableObj->sort_rows($sortcolumn);
316 :     Description:
317 :     Sorts the rows in the table by the specified column
318 :     Example:
319 :     =cut
320 :    
321 :     sub sort_rows {
322 :     my ($self,$sortcolumn) = @_;
323 : chenry 1.16 if (defined($self->{"array"})) {
324 :     @{$self->{"array"}} = sort { $a->{$sortcolumn}->[0] cmp $b->{$sortcolumn}->[0] } @{$self->{"array"}};
325 :     }
326 : parrello 1.8 }
327 :    
328 :     =head3 replace_row
329 :     Definition:
330 :     $TableObj->replace_row($OriginalRow,$NewRow);
331 :     Description:
332 :     Replaces the original row in the table with the new row.
333 :     Example:
334 :     =cut
335 :    
336 :     sub replace_row {
337 :     my ($self,$OriginalRow,$NewRow) = @_;
338 :    
339 :     for (my $i=0; $i < $self->size(); $i++) {
340 :     if ($self->get_row($i) == $OriginalRow) {
341 :     $self->{"array"}->[$i] = $NewRow;
342 :     last;
343 :     }
344 :     }
345 :     }
346 :    
347 :     =head3 add_row_copy
348 :     Definition:
349 :     $TableObj->add_row_copy($OriginalRow,$NewRow);
350 :     Description:
351 :     Replaces the original row in the table with the new row.
352 :     Example:
353 :     =cut
354 :    
355 :     sub add_row_copy {
356 :     my ($self,$OriginalRow) = @_;
357 :    
358 :     my @HashKeys = keys(%{$OriginalRow});
359 :     my $NewRow;
360 :     foreach my $Key (@HashKeys) {
361 :     $NewRow->{$Key} = $OriginalRow->{$Key};
362 :     }
363 :    
364 :     $self->add_row($NewRow);
365 :     return $NewRow;
366 :     }
367 :    
368 :     =head3 add_data
369 :     Definition:
370 :     $TableObj->add_data($Row,"TEST",1,1);
371 :     Description:
372 :     Deletes a row from the table.
373 :     Example:
374 :     $TableObj->delete_row(1);
375 :     =cut
376 :    
377 :     sub add_data {
378 :     my ($self,$RowObject,$Heading,$Data,$Unique) = @_;
379 :    
380 :     #First checking that the input row exists
381 : chenry 1.9 if (!defined($RowObject) || !defined($Data)) {
382 : parrello 1.8 return -1;
383 :     }
384 :    
385 :     if (ref($Data) eq 'ARRAY') {
386 :     my $Indecies;
387 :     for (my $i=0; $i < @{$Data}; $i++) {
388 :     $Indecies->[$i] = $self->add_data($RowObject,$Heading,$Data->[$i],$Unique);
389 :     }
390 :     return $Indecies;
391 :     }
392 :    
393 :     #Now checking if the heading exists in the row
394 :     if (defined($Unique) && $Unique == 1 && defined($RowObject->{$Heading})) {
395 :     for (my $i=0; $i < @{$RowObject->{$Heading}}; $i++) {
396 :     if ($RowObject->{$Heading}->[$i] eq $Data) {
397 :     return $i;
398 :     }
399 :     }
400 :     }
401 :    
402 :     #Adding the data
403 :     push(@{$RowObject->{$Heading}},$Data);
404 :     my @HashHeadings = $self->hash_headings();
405 :     foreach my $HashHeading (@HashHeadings) {
406 :     if ($HashHeading eq $Heading) {
407 :     push(@{$self->{$Data}},$RowObject);
408 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$Data}},$RowObject);
409 :     last;
410 :     }
411 :     }
412 :     my $Index = (@{$RowObject->{$Heading}}-1);
413 :    
414 :     return $Index;
415 :     }
416 :    
417 :     =head3 remove_data
418 :     Definition:
419 :     $TableObj->remove_data($Row,"HEADING","TEST");
420 :     Description:
421 :     Deletes a element of data from the input row
422 :     Example:
423 :     $TableObj->remove_data(1);
424 :     =cut
425 :    
426 :     sub remove_data {
427 :     my ($self,$RowObject,$Heading,$Data) = @_;
428 :    
429 :     #First checking that the input row exists
430 :     if (!defined($RowObject)) {
431 :     return 0;
432 :     }
433 :    
434 :     #Now checking if the heading exists in the row
435 :     if (defined($RowObject->{$Heading})) {
436 :     for (my $i=0; $i < @{$RowObject->{$Heading}}; $i++) {
437 :     if ($RowObject->{$Heading}->[$i] eq $Data) {
438 :     splice(@{$RowObject->{$Heading}},$i,1);
439 :     $i--;
440 :     }
441 :     }
442 :     if (defined($self->{"hash columns"}->{$Heading}) && defined($self->{"hash columns"}->{$Heading}->{$Data})) {
443 :     if (@{$self->{"hash columns"}->{$Heading}->{$Data}} == 1) {
444 :     delete $self->{"hash columns"}->{$Heading}->{$Data};
445 :     } else {
446 :     for (my $j=0; $j < @{$self->{"hash columns"}->{$Heading}->{$Data}}; $j++) {
447 :     if ($self->{"hash columns"}->{$Heading}->{$Data}->[$j] eq $RowObject) {
448 :     splice(@{$self->{"hash columns"}->{$Heading}->{$Data}},$j,1);
449 :     $j--;
450 :     }
451 :     }
452 :     }
453 :     }
454 :     }
455 :    
456 :     return 1;
457 :     }
458 :    
459 :     =head3 row_index
460 :     Definition:
461 :     $TableObj->row_index($Row);
462 :     Description:
463 :     Returns the index in the table where the input row is stored.
464 :     This only works if the input $Row object was pulled from the table using one of the get_row functions.
465 :     Returns undef if the row could not be found.
466 :     Example:
467 :     $TableObj->row_index($Row);
468 :     =cut
469 :    
470 :     sub row_index {
471 :     my ($self,$Row) = @_;
472 :    
473 :     for (my $i=0; $i < $self->size(); $i++) {
474 :     if ($self->get_row($i) == $Row) {
475 :     return $i;
476 :     }
477 :     }
478 :    
479 :     return undef;
480 :     }
481 :    
482 :     =head3 delete_row_by_key
483 :     Definition:
484 :     $TableObj->delete_row_by_key($Key,$Heading);
485 :     Description:
486 :     Deletes a row from the table based on the input key and heading that the key will be stored under.
487 :     Returns 1 if a row was found and deleted. Returns 0 if no row was found.
488 :     Example:
489 :     $TableObj->delete_row_by_key("Core83333.1","Model ID");
490 :     =cut
491 :    
492 :     sub delete_row_by_key {
493 :     my ($self,$Key,$Heading) = @_;
494 :    
495 :     my $Row = $self->get_row_by_key($Key,$Heading);
496 :     if (defined($Row)) {
497 :     $self->delete_row($self->row_index($Row));
498 :     return 1;
499 :     }
500 :     return 0;
501 :     }
502 :    
503 :     =head3 clone_table_def
504 :     Definition:
505 :     my $NewTable = $TableObj->get_clone_table();
506 :     Description:
507 :     Returns a new *empty* table with the same headings, hash headings, and delimiters as the input table.
508 :     Example:
509 :     my $NewTable = $TableObj->get_clone_table();
510 :     =cut
511 :    
512 :     sub clone_table_def {
513 :     my ($self) = @_;
514 :    
515 :     my $HeadingRef;
516 :     push(@{$HeadingRef},$self->headings());
517 :     my $HashHeadingRef;
518 :     push(@{$HashHeadingRef},$self->hash_headings());
519 :    
520 :     my $TableObj = FIGMODELTable->new($HeadingRef,$self->filename(),$HashHeadingRef,$self->delimiter(),$self->item_delimiter(),$self->{"file IO settings"}->{"file prefix"}->[0]);
521 :     return $TableObj;
522 :     }
523 :    
524 :     =head3 clone_row
525 :     Definition:
526 :     my $NewRow = $TableObj->clone_row($Index);
527 :     Description:
528 :     Returns an exact copy of row located at $Index
529 :     Example:
530 :     my $NewRow = $TableObj->clone_row(5);
531 :     =cut
532 :    
533 :     sub clone_row {
534 :     my ($self,$Index) = @_;
535 :    
536 :     my @Headings = $self->headings();
537 :     my $NewRow;
538 :     for (my$k=0; $k < @Headings; $k++) {
539 :     if (defined($self->get_row($Index)->{$Headings[$k]})) {
540 :     push(@{$NewRow->{$Headings[$k]}},@{$self->get_row($Index)->{$Headings[$k]}});
541 :     }
542 :     }
543 :    
544 :     return $NewRow;
545 :     }
546 :    
547 :     =head3 delete_row
548 :     Definition:
549 :     $TableObj->delete_row($i);
550 :     Description:
551 :     Deletes a row from the table.
552 :     Example:
553 :     $TableObj->delete_row(1);
554 :     =cut
555 :    
556 :     sub delete_row {
557 :     my ($self,$RowIndex) = @_;
558 :     my @HashHeadings = $self->hash_headings();
559 :     foreach my $HashHeading (@HashHeadings) {
560 :     my $RowObject = $self->get_row($RowIndex);
561 :     if (defined($RowObject->{$HashHeading})) {
562 :     for (my $i=0; $i < @{$RowObject->{$HashHeading}}; $i++) {
563 :     if (defined($self->{$RowObject->{$HashHeading}->[$i]})) {
564 :     for (my $j =0; $j < @{$self->{$RowObject->{$HashHeading}->[$i]}}; $j++) {
565 :     if ($self->{$RowObject->{$HashHeading}->[$i]}->[$j] eq $RowObject) {
566 :     if ($j == 0 && @{$self->{$RowObject->{$HashHeading}->[$i]}} == 1) {
567 :     delete $self->{$RowObject->{$HashHeading}->[$i]};
568 :     last;
569 :     } else {
570 :     splice(@{$self->{$RowObject->{$HashHeading}->[$i]}},$j,1);
571 :     $j--;
572 :     }
573 :     }
574 :     }
575 :     }
576 :     if (defined($self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]})) {
577 :     for (my $j =0; $j < @{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}}; $j++) {
578 :     if ($self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}->[$j] eq $RowObject) {
579 :     if ($j == 0 && @{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}} == 1) {
580 :     delete $self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]};
581 :     last;
582 :     } else {
583 :     splice(@{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}},$j,1);
584 :     $j--;
585 :     }
586 :     }
587 :     }
588 :     }
589 :     }
590 :     }
591 :     }
592 :     splice(@{$self->{"array"}},$RowIndex,1);
593 :     }
594 :    
595 :     =head3 add_headings
596 :     Definition:
597 :     $TableObj->add_headings(@Headings);
598 :     Description:
599 :     Adds new headings to the table. This is needed to get the table to print the data under the new heading.
600 :     Example:
601 :     $TableObj->add_headings("Notes");
602 :     =cut
603 :    
604 :     sub add_headings {
605 :     my ($self,@Headings) = @_;
606 :    
607 :     foreach my $Heading (@Headings) {
608 :     #First check if the heading already exists
609 :     foreach my $ExistingHeading ($self->headings()) {
610 :     if ($Heading eq $ExistingHeading) {
611 :     $Heading = "";
612 :     last;
613 :     }
614 :     }
615 :     if ($Heading ne "") {
616 :     push(@{$self->{"file IO settings"}->{"orderedkeys"}},$Heading);
617 :     }
618 :     }
619 :     }
620 :    
621 : chenry 1.14 sub is_heading {
622 :     my ($self,$heading) = @_;
623 :     foreach my $ExistingHeading ($self->headings()) {
624 :     if ($heading eq $ExistingHeading) {
625 :     return 1;
626 :     }
627 :     }
628 :     return 0;
629 :     }
630 :    
631 :     sub is_indexed {
632 :     my ($self,$heading) = @_;
633 :     if (defined($self->{"hash columns"}->{$heading})) {
634 :     return 1;
635 :     }
636 :     return 0;
637 :     }
638 :    
639 : chenry 1.11 =head3 add_hashheadings
640 :     Definition:
641 :     $TableObj->add_hashheadings(@Headings);
642 :     Description:
643 :     Adds new hash headings to the table. This is needed to get the table to print the data under the new heading.
644 :     Example:
645 :     $TableObj->add_hashheadings("Notes");
646 :     =cut
647 :    
648 :     sub add_hashheadings {
649 :     my ($self,@HashHeadings) = @_;
650 :    
651 :     foreach my $HashHeading (@HashHeadings) {
652 :     if (!defined($self->{"hash columns"}->{$HashHeading})) {
653 :     $self->{"hash columns"}->{$HashHeading} = {};
654 :     for (my $i=0; $i < $self->size(); $i++) {
655 :     my $Row = $self->get_row($i);
656 :     if (defined($Row->{$HashHeading})) {
657 :     for (my $j=0; $j < @{$Row->{$HashHeading}}; $j++) {
658 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$Row->{$HashHeading}->[$j]}},$Row);
659 :     }
660 :     }
661 :     }
662 :     }
663 :     }
664 :     }
665 :    
666 : parrello 1.8 =head3 save
667 :     Definition:
668 :     $TableObj->save($filename,$delimiter,$itemdelimiter,$prefix);
669 :     Description:
670 :     Saves the table to the specified filename with the specified column delimiter and subcolumn delimiter, and file prefix (lines that appear before the table heading in the file).
671 :     All arguments are optional. If arguments are not supplied, the values used to read the table from file will be used.
672 :     Example:
673 :     $TableObj->save("/vol/Table.txt",";","|","REACTIONS");
674 :     =cut
675 :    
676 :     sub save {
677 :     my ($self,$filename,$delimiter,$itemdelimiter,$prefix) = @_;
678 :     if (defined($filename)) {
679 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
680 :     }
681 :     if (defined($delimiter)) {
682 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
683 :     }
684 :     if (defined($itemdelimiter)) {
685 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $itemdelimiter;
686 :     }
687 :     if (defined($prefix)) {
688 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $prefix;
689 :     }
690 : chenry 1.11 $self->print_table_to_file();
691 :     }
692 :    
693 :     sub print_table_to_file {
694 :     my ($self) = @_;
695 :    
696 :     #Checking that a filename exists
697 :     if (!defined($self->{"array"}) || !defined($self->{"file IO settings"}->{"filename"}) || !defined($self->{"file IO settings"}->{"orderedkeys"})) {
698 :     return -1;
699 :     }
700 :    
701 :     my $Filename = $self->{"file IO settings"}->{"filename"}->[0];
702 :     my $Delimiter = ";";
703 :     my $ItemDelimiter = "|";
704 :     my $Prefix = "";
705 :     if (defined($self->{"file IO settings"}->{"delimiter"})) {
706 :     $Delimiter = $self->{"file IO settings"}->{"delimiter"}->[0];
707 :     if ($Delimiter eq "\\|" || $Delimiter eq "\|") {
708 :     $Delimiter = "|";
709 :     } elsif ($Delimiter eq "\\t") {
710 :     $Delimiter = "\t";
711 :     }
712 :     }
713 :     if (defined($self->{"file IO settings"}->{"item delimiter"})) {
714 :     $ItemDelimiter = $self->{"file IO settings"}->{"item delimiter"}->[0];
715 :     if ($ItemDelimiter eq "\\|" || $ItemDelimiter eq "\|") {
716 :     $ItemDelimiter = "|";
717 :     } elsif ($ItemDelimiter eq "\\t") {
718 :     $ItemDelimiter = "\t";
719 :     }
720 :     }
721 :     if (defined($self->{"file IO settings"}->{"file prefix"})) {
722 :     $Prefix = $self->{"file IO settings"}->{"file prefix"}->[0];
723 :     }
724 :    
725 :     #Opening the file
726 :     if (defined($self->{"file IO settings"}->{"append"})) {
727 :     if (!open (SAVINGTABLE, ">>$Filename")) {
728 :     return -1;
729 :     }
730 :     } else {
731 :     if (!open (SAVINGTABLE, ">$Filename")) {
732 :     return -1;
733 :     }
734 :     }
735 :    
736 :     if (defined($Prefix)) {
737 :     print SAVINGTABLE $Prefix;
738 :     }
739 :     print SAVINGTABLE join($Delimiter,@{$self->{"file IO settings"}->{"orderedkeys"}})."\n";
740 :     for (my $i=0; $i < @{$self->{"array"}}; $i++) {
741 :     for (my $j=0; $j < @{$self->{"file IO settings"}->{"orderedkeys"}}; $j++) {
742 :     if ($j > 0) {
743 :     print SAVINGTABLE $Delimiter;
744 :     }
745 :     if (defined($self->{"array"}->[$i]->{$self->{"file IO settings"}->{"orderedkeys"}->[$j]})) {
746 :     if(ref($self->{"array"}->[$i]->{$self->{"file IO settings"}->{"orderedkeys"}->[$j]}) eq 'ARRAY') {
747 :     print SAVINGTABLE join($ItemDelimiter,@{$self->{"array"}->[$i]->{$self->{"file IO settings"}->{"orderedkeys"}->[$j]}});
748 :     } else {
749 :     print SAVINGTABLE $self->{"array"}->[$i]->{$self->{"file IO settings"}->{"orderedkeys"}->[$j]};
750 :     }
751 :     }
752 :     }
753 :     print SAVINGTABLE "\n";
754 :     }
755 :     close (SAVINGTABLE);
756 : parrello 1.8 }
757 :    
758 : chenry 1.10 =head3 html_print
759 :     Definition:
760 :     string::html_text = FIGMODELTable::my_table->html_print(void);
761 :     Description:
762 :     This function returns the table contents in html format for simple display on a webpage.
763 :     Example:
764 :     =cut
765 :    
766 :     sub html_print {
767 :     my ($self) = @_;
768 :    
769 :     #Printing the table headings first
770 :     my $html = "<table><tr>";
771 :     my @Headings = $self->headings();
772 :     for (my $i=0; $i < @Headings; $i++) {
773 :     $html .= "<th align='left'>".$Headings[$i]."</th>";
774 :     }
775 :     $html .= "</tr>\n";
776 :    
777 :     #Printing the table rows
778 :     for (my $j=0; $j < $self->size(); $j++) {
779 :     my $Row = $self->get_row($j);
780 :     $html .= "<tr>";
781 :     for (my $i=0; $i < @Headings; $i++) {
782 :     $html .= "<td>";
783 :     if (defined($Row->{$Headings[$i]})) {
784 :     $html .= join("|",@{$Row->{$Headings[$i]}});
785 :     }
786 :     $html .= "</td>";
787 :     }
788 :     $html .= "</tr>\n";
789 :     }
790 :     $html .= "</table>";
791 :    
792 :     return $html;
793 :     }
794 :    
795 : parrello 1.8 =head3 load
796 :     Definition:
797 :     my $Table = load_table($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns);
798 :     Description:
799 :    
800 :     Example:
801 :     my $Table = load_table($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns);
802 :     =cut
803 :    
804 :     sub load_table {
805 :     my ($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns) = @_;
806 :    
807 :     #Checking that the table file exists
808 :     if (!-e $Filename) {
809 :     return undef;
810 :     }
811 :    
812 :     #Sanity checking input values
813 :     if (!defined($HeadingLine) || $HeadingLine eq "") {
814 :     $HeadingLine = 0;
815 :     }
816 :     if (!defined($Delimiter) || $Delimiter eq "") {
817 :     $Delimiter = ";";
818 :     }
819 :     if ($Delimiter eq "|") {
820 :     $Delimiter = "\\|";
821 :     }
822 :     if (!defined($ItemDelimiter) || $ItemDelimiter eq "") {
823 :     $ItemDelimiter = "";
824 :     } elsif ($ItemDelimiter eq "|") {
825 :     $ItemDelimiter = "\\|";
826 :     }
827 :    
828 :     #Loading the data table
829 :     my $Prefix;
830 :     my @Headings;
831 :     if (!open (TABLEINPUT, "<$Filename")) {
832 :     return undef;
833 :     }
834 :     my $Line = <TABLEINPUT>;
835 :     for (my $i=0; $i < $HeadingLine; $i++) {
836 :     $Prefix .= $Line;
837 :     $Line = <TABLEINPUT>;
838 :     }
839 :     chomp($Line);
840 :     @Headings = split(/$Delimiter/,$Line);
841 :     my $HeadingRef;
842 :     push(@{$HeadingRef},@Headings);
843 :     my $Table = new FIGMODELTable($HeadingRef,$Filename,$HashColumns,$Delimiter,$ItemDelimiter,$Prefix);
844 :    
845 :     while ($Line = <TABLEINPUT>) {
846 :     chomp($Line);
847 :     my @Data = split(/$Delimiter/,$Line);
848 :     my $ArrayRefHashRef;
849 :     for (my $i=0; $i < @Headings; $i++) {
850 :     if (defined($Data[$i]) && length($Data[$i]) > 0) {
851 :     if (defined($ItemDelimiter) && length($ItemDelimiter) > 0) {
852 :     my @TempArray = split(/$ItemDelimiter/,$Data[$i]);
853 :     foreach my $Item (@TempArray) {
854 :     push(@{$ArrayRefHashRef->{$Headings[$i]}},$Item);
855 :     }
856 :     } else {
857 :     $ArrayRefHashRef->{$Headings[$i]}->[0] = $Data[$i];
858 :     }
859 :     }
860 :     }
861 :     $Table->add_row($ArrayRefHashRef);
862 :     }
863 :     close(TABLEINPUT);
864 :    
865 :     return $Table;
866 :     }
867 :    
868 : chenry 1.11 =head3 connect_to_db
869 :     Definition:
870 :     integer::status = FIGMODELTable->connect_to_db(string::table name,string::database,string::user,host::host)
871 :     Description:
872 :     Connects to the database for input and output for the table to and from the database
873 :     =cut
874 :    
875 :     sub connect_to_db {
876 :     my ($self,$Table,$Database,$Username,$Host,$SubTableHeadings,$TableKey) = @_;
877 :    
878 :     #Getting DB data from arguments
879 :     my $Changed = 0;
880 :     if (!defined($Host)) {
881 :     $Host = $self->{_host};
882 :     } elsif (!defined($self->{_host}) || $Host ne $self->{_host}) {
883 :     $Changed = 1;
884 :     }
885 :     if (!defined($Table)) {
886 :     $Table = $self->{_table};
887 :     } elsif (!defined($self->{_table}) || $Table ne $self->{_table}) {
888 :     $Changed = 1;
889 :     }
890 :     if (!defined($Database)) {
891 :     $Database = $self->{_database};
892 :     } elsif (!defined($self->{_database}) || $Database ne $self->{_database}) {
893 :     $Changed = 1;
894 :     }
895 :     if (!defined($Username)) {
896 :     $Username = $self->{_user};
897 :     } elsif (!defined($self->{_user}) || $Username ne $self->{_user}) {
898 :     $Changed = 1;
899 :     }
900 :     if (!defined($Username)) {
901 :     $Username = $self->{_user};
902 :     } elsif (!defined($self->{_user}) || $Username ne $self->{_user}) {
903 :     $Changed = 1;
904 :     }
905 :     if (defined($SubTableHeadings)) {
906 :     for (my $i=0; $i < @{$SubTableHeadings}; $i++) {
907 :     $self->{_subheadings}->{$SubTableHeadings->[$i]} = 1;
908 :     }
909 :     }
910 :     if (defined($TableKey)) {
911 :     $self->{_tablekey} = $TableKey;
912 :     }
913 :    
914 :     #If no change, then we leave
915 :     if ($Changed == 0) {
916 :     return 1;
917 :     }
918 :    
919 :     #If the connection data was changed, we reconnect to the database
920 :     if (defined($self->{_dbhandle})) {
921 :     #Closing any previous connection
922 :     delete $self->{_dbhandle};
923 :     }
924 :    
925 :     #Checking if DBMaster is even available
926 :     eval {
927 :     require "DBMaster.pm";
928 :     };
929 :     if ($@) {
930 :     print STDERR "FIGMODELTable:connect_to_db:Cannot connect to database because DBMaster module is unavailable\n";
931 :     return -1;
932 :     }
933 :    
934 :     $self->{_dbhandle} = DBMaster->new(-database => $Database, -user => $Username, -host => $Host);
935 :     $self->{_dbtable} = $self->{_dbhandle}->$Table;
936 :    
937 :     #Check that the connection was successful
938 :     if (!defined($self->{_dbhandle})) {
939 :     print STDERR "FIGMODELTable:save_to_db: could not connect to database with ".$Database.";".$Table.";".$Username.";".$Host."\n";
940 :     return -1;
941 :     }
942 :    
943 :     return 1;
944 :     }
945 :    
946 :     =head3 save_to_db
947 :     Definition:
948 :     integer::status = FIGMODELTable->save_to_db(string::table name,string::database,string::user,host::host)
949 :     Description:
950 :     Syncs the FIGMODELTable and the database
951 :     =cut
952 :    
953 :     sub save_to_db {
954 :     my ($self,$Table,$Database,$Username,$Host,$SubTableHeadings,$TableKey) = @_;
955 :    
956 :     #Connecting to database
957 :     if ($self->connect_to_db($Table,$Database,$Username,$Host,$SubTableHeadings,$TableKey) == -1) {
958 :     return -1;
959 :     }
960 :    
961 :     #Saving the table
962 :     for (my $i=0; $i < $self->size(); $i++) {
963 :     my $Row = $self->get_row($i);
964 :     $self->update_db_row($Row);
965 :     }
966 :    
967 :     return 1;
968 :     }
969 :    
970 :     =head3 update_db_row
971 :     Definition:
972 :     integer::status = FIGMODELTable->update_db_row(FIGMODELTable::Row::row to be updated)
973 :     Description:
974 :     Updates the input row in the database. Returns -1 upon failure, 0 if there was no change, 1 if the row is new, 2 if the row was changed
975 :     =cut
976 :    
977 :     sub update_db_row {
978 :     my ($self,$row) = @_;
979 :    
980 :     #Checking that the database is connected
981 :     if (!defined($self->{_dbhandle})) {
982 :     print STDERR "FIGMODELTable:update_db_row: need to be connected to database prior to update of row.\n";
983 :     return -1;
984 :     }
985 :    
986 :     #Checking if a row with the same table key already exists in the table
987 :     if (!defined($row->{_dbhandle}) && defined($self->{_tablekey}) && defined($row->{$self->{_tablekey}}->[0])) {
988 :     $row->{_dbhandle} = $self->{_dbtable}->init( { $self->{_tablekey} => $row->{$self->{_tablekey}}->[0] } );
989 :     }
990 :    
991 :     #Checking if the row has a dbhandle
992 :     if (defined($row->{_dbhandle})) {
993 :     #This is not a new row-first we check if anything has changed
994 :     } else {
995 :     #First we add the base object to the table on the server
996 :     my $NewObject;
997 :     my @Headings = $self->headings();
998 :     for (my $i=0; $i < @Headings; $i++) {
999 :     if (defined($row->{$Headings[$i]}->[0])) {
1000 :     if (!defined($self->{_subheadings}->{$Headings[$i]})) {
1001 :     $NewObject->{$Headings[$i]} = join($self->item_delimiter(),@{$row->{$Headings[$i]}});
1002 :     }
1003 :     }
1004 :     }
1005 :     $row->{_dbhandle} = $self->{_dbtable}->create($NewObject);
1006 :     #Now we add all of the subtable objects
1007 :     for (my $i=0; $i < @Headings; $i++) {
1008 :     if (defined($row->{$Headings[$i]}->[0])) {
1009 :     if (defined($self->{_subheadings}->{$Headings[$i]})) {
1010 :     #Adding the subtable rows to the database
1011 :     for (my $j=0; $j < @{$row->{$Headings[$i]}}; $j++) {
1012 :     #my $Object = $self->{_dbtable}->init( { $self->{_tablekey} => $row->{$self->{_tablekey}}->[0] } );
1013 :     }
1014 :     }
1015 :     }
1016 :     }
1017 :     }
1018 :    
1019 :     return 1;
1020 :     }
1021 :    
1022 : chenry 1.12 =head3 set_metadata
1023 :     Definition:
1024 :     FIGMODELTable->set_metadata(string::key,string::data);
1025 :     Description:
1026 :     Sets a specified metadata for the table
1027 :     =cut
1028 :     sub set_metadata {
1029 :     my ($self,$key,$data) = @_;
1030 :     $self->{_metadata}->{$key} = $data;
1031 :     }
1032 :    
1033 :     =head3 get_meta_data
1034 :     Definition:
1035 :     string::data = FIGMODELTable->get_meta_data(string::key);
1036 :     Description:
1037 :     Sets a specified metadata for the table
1038 :     =cut
1039 :     sub get_meta_data {
1040 :     my ($self,$key,$data) = @_;
1041 :     return $self->{_metadata}->{$key};
1042 :     }
1043 :    
1044 : devoid 1.13 =head3 add_column
1045 :     Definition:
1046 :     FIGMODELTable->add_column(array, string);
1047 :     FIGMODELTable->add_column(function(hash), string);
1048 :     Descrition:
1049 :     Adds a column to the table under column name string. If the first
1050 :     argument is an array, it places the content of the i-th elment of
1051 :     the array in row i for the new column. If the first argument is a
1052 :     function operating over a hash, the output of that function
1053 :     run over the i-th row is placed in the new column for row i.
1054 :     Just be sure to pass function sub foo { ... } as \&PACKAGE::PATH::foo
1055 :     =cut
1056 :     sub add_column {
1057 :     my ($self, $arg, $column_name) = @_;
1058 :     if( ref($arg) == 'CODE' ) {
1059 :     # $arg is a function, apply to all rows
1060 :     my @columnData = [];
1061 :     for( my $i = 0; $i < $self->size(); $i++ ) {
1062 :     my $row = $self->get_row($i);
1063 :     my $entry = &$arg($row);
1064 :     $row->{$column_name} = $entry;
1065 :     }
1066 :     } elsif ( ref($arg) == 'ARRAY' ) {
1067 :     for( my $i = 0; $i < $self->size(); $i++ ) {
1068 :     if( $i > @{$arg} ) { return; }
1069 :     my $row = $self->get_row($i);
1070 :     $row->{$column_name} = $arg->[$i];
1071 :     }
1072 :     }
1073 :     }
1074 :    
1075 :    
1076 :     =head3 remove_column
1077 :     Defintion:
1078 :     FIGMODELTable->remove_column(string)
1079 :     Description:
1080 :     Removes column whose name matches string.
1081 :     =cut
1082 :     sub remove_column {
1083 :     my ($self, $column_name) = @_;
1084 :     for( my $i = 0; $i < $self->size(); $i++ ) {
1085 :     my $row = $self->get_row($i);
1086 :     if(defined($row->{$column_name})) {
1087 :     delete($row->{$column_name});
1088 :     }
1089 :     }
1090 :     }
1091 :    
1092 : chenry 1.12
1093 :    
1094 :    
1095 : parrello 1.8 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3