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

Annotation of /FigKernelPackages/FIGMODELTable.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3