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

Annotation of /FigKernelPackages/FIGMODELTable.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (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 :     use FIGMODEL;
13 :    
14 :     package FIGMODELTable;
15 :    
16 :     =head1 Table object for the model database interaction module
17 :    
18 :     =head2 Public Methods
19 :    
20 :     =head3 new
21 :     Definition:
22 :     my $TableObj = FIGMODELTable->new($heading_list_ref,$filename,$hash_heading_list_ref,$delimiter,$itemdelimiter,$prefix);
23 :     Description:
24 :     Creates an empty table object which may be filled using the add row function.
25 :     The $heading_list_ref and $filename are required, but all remaining arguments are optional.
26 :     Example:
27 :     my $TableObj = FIGMODELTable->new($heading_list_ref,$filename,$hash_heading_list_ref,$delimiter,$itemdelimiter,$prefix);
28 :     =cut
29 :    
30 :     sub new {
31 :     my ($ObjectType,$headings,$filename,$hash_headings,$delimiter,$itemdelimiter,$prefix) = @_;
32 :    
33 :     my $self;
34 :     if (!defined($filename) || !defined($headings)) {
35 :     print STDERR "FIGMODELTable:new: cannot create table without a list of headings and a filename\n";
36 :     return undef;
37 :     }
38 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
39 :     $self->{"file IO settings"}->{"orderedkeys"} = $headings;
40 :     #Dealing with optional arguments
41 :     if (defined($hash_headings)) {
42 :     for (my $i=0; $i < @{$hash_headings}; $i++) {
43 :     $self->{"hash columns"}->{$hash_headings->[$i]} = {};
44 :     }
45 :     }
46 :     if (!defined($delimiter)) {
47 :     $delimiter = ";";
48 :     }
49 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
50 :     if (!defined($itemdelimiter)) {
51 :     $itemdelimiter = "|";
52 :     }
53 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $itemdelimiter;
54 :     if (!defined($prefix)) {
55 :     $prefix = "";
56 :     }
57 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $prefix;
58 :    
59 :     return bless $self;
60 :     }
61 :    
62 :     =head2 TABLE Methods
63 :    
64 :     =head3 size
65 :     Definition:
66 :     my $tablesize = $TableObj->size();
67 :     Description:
68 :     This returns the number of rows in the table
69 :     Example:
70 :     my $tablesize = $TableObj->size();
71 :     =cut
72 :    
73 :     sub size {
74 :     my ($self) = @_;
75 :     my $TableSize = 0;
76 :     if (defined($self->{"array"})) {
77 :     $TableSize = @{$self->{"array"}};
78 :     }
79 :     return $TableSize;
80 :     }
81 :    
82 :     =head3 get_row
83 :     Definition:
84 :     my $RowObject = $TableObj->get_row($Row_index);
85 :     Description:
86 :     Returns a hash reference for the specified row in the table. Returns undef if the row does not exist.
87 :     Example:
88 :     my $RowObject = $TableObj->get_row(1);
89 :     =cut
90 :    
91 :     sub get_row {
92 :     my ($self,$RowNumber) = @_;
93 :     return $self->{"array"}->[$RowNumber];
94 :     }
95 :    
96 :     =head3 filename
97 :     Definition:
98 :     my $filename = $TableObj->filename();
99 :     Description:
100 :     Returns the filename for the table.
101 :     Example:
102 :     my $filename = $TableObj->filename();
103 :     =cut
104 :    
105 :     sub filename {
106 :     my ($self,$NewFilename) = @_;
107 :    
108 :     if (defined($NewFilename)) {
109 :     $self->{"file IO settings"}->{"filename"}->[0] = $NewFilename;
110 :     }
111 :    
112 :     return $self->{"file IO settings"}->{"filename"}->[0];
113 :     }
114 :    
115 :     =head3 delimiter
116 :     Definition:
117 :     my $delimiter = $TableObj->delimiter();
118 :     Description:
119 :     Returns the delimiter for the table.
120 :     Example:
121 :     my $delimiter = $TableObj->delimiter();
122 :     =cut
123 :    
124 :     sub delimiter {
125 :     my ($self,$NewDelimiter) = @_;
126 :    
127 :     if (defined($NewDelimiter)) {
128 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $NewDelimiter;
129 :     }
130 :    
131 :     return $self->{"file IO settings"}->{"delimiter"}->[0];
132 :     }
133 :    
134 :     =head3 item_delimiter
135 :     Definition:
136 :     my $item_delimiter = $TableObj->item_delimiter();
137 :     Description:
138 :     Returns the item delimiter for the table.
139 :     Example:
140 :     my $item_delimiter = $TableObj->item_delimiter();
141 :     =cut
142 :    
143 :     sub item_delimiter {
144 :     my ($self,$ItemDelimiter) = @_;
145 :    
146 :     if (defined($ItemDelimiter)) {
147 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $ItemDelimiter;
148 :     }
149 :    
150 :     return $self->{"file IO settings"}->{"item delimiter"}->[0];
151 :     }
152 :    
153 :     =head3 headings
154 :     Definition:
155 :     my @Headings = $TableObj->headings();
156 :     Description:
157 :     Returns an array containing the headings for the table.
158 :     Example:
159 :     my @Headings = $TableObj->headings();
160 :     =cut
161 :    
162 :     sub headings {
163 :     my ($self,$InHeadings) = @_;
164 :     if (defined($InHeadings)) {
165 :     $self->{"file IO settings"}->{"orderedkeys"} = $InHeadings;
166 :     }
167 :     return @{$self->{"file IO settings"}->{"orderedkeys"}};
168 :     }
169 :    
170 :     =head3 get_table_hash_headings
171 :     Definition:
172 :     my @hash_headings = $TableObj->get_table_hash_headings();
173 :     Description:
174 :     Returns an array containing the headings that have also been added to the hash key for the table.
175 :     Example:
176 :     my @hash_headings = $TableObj->get_table_hash_headings();
177 :     =cut
178 :    
179 :     sub hash_headings {
180 :     my ($self) = @_;
181 :     return keys(%{$self->{"hash columns"}});
182 :     }
183 :    
184 :     =head3 get_row_by_key
185 :     Definition:
186 :     my $RowObject = $TableObj->get_row_by_key($Key,$HashColumn,$AddRow);
187 :     Description:
188 :     Returns the row object for the firt row that matches the input key. Return undef if nothing matches the input key.
189 :     Example:
190 :     my $RowObject = $TableObj->get_row_by_key("rxn00001");
191 :     =cut
192 :    
193 :     sub get_row_by_key {
194 :     my ($self,$Key,$HashColumn,$AddRow) = @_;
195 :     if (defined($self->{"hash columns"}->{$HashColumn}->{$Key}->[0])) {
196 :     return $self->{"hash columns"}->{$HashColumn}->{$Key}->[0];
197 :     } elsif (defined($AddRow) && $AddRow == 1) {
198 :     my $NewRow = {$HashColumn => [$Key]};
199 :     $self->add_row($NewRow);
200 :     return $NewRow;
201 :     }
202 :     return undef;
203 :     }
204 :    
205 :     =head3 get_rows_by_key
206 :     Definition:
207 :     my @RowObjects = $TableObj->get_rows_by_key($Key);
208 :     Description:
209 :     Returns the list of row objects that match the input key. Returns an empty list if nothing matches the input key.
210 :     Example:
211 :     my @RowObjects = $TableObj->get_rows_by_key("rxn00001");
212 :     =cut
213 :    
214 :     sub get_rows_by_key {
215 :     my ($self,$Key,$HashColumn) = @_;
216 :     if (defined($self->{"hash columns"}->{$HashColumn}->{$Key})) {
217 :     return @{$self->{"hash columns"}->{$HashColumn}->{$Key}};
218 :     }
219 :     return ();
220 :     }
221 :    
222 :    
223 :     =head3 get_table_by_key
224 :     Definition:
225 :     my $NewTable = $TableObj->get_table_by_key();
226 :     Description:
227 :     Returns a new table object where every row matches the input key/data combo.
228 :     Returns an empty table if no rows match the input key/data combo.
229 :     Example:
230 :     my $NewTable = $TableObj->get_table_by_key();
231 :     =cut
232 :    
233 :     sub get_table_by_key {
234 :     my ($self,$Key,$HashColumn) = @_;
235 :    
236 :     my $NewTable = $self->clone_table_def();
237 :     my @Rows = $self->get_rows_by_key($Key,$HashColumn);
238 :     for (my $i=0; $i < @Rows; $i++) {
239 :     $NewTable->add_row($Rows[$i]);
240 :     }
241 :    
242 :     return $NewTable;
243 :     }
244 :    
245 :     =head3 get_hash_column_keys
246 :     Definition:
247 :     my @HashKeys = $TableObj->get_hash_column_keys($HashColumn);
248 :     Description:
249 :     Returns the list of the keys stored in the hash of the values in the column labeled $HashColumn.
250 :     Example:
251 :     my @HashKeys = $TableObj->get_hash_column_keys("Media");
252 :     =cut
253 :    
254 :     sub get_hash_column_keys {
255 :     my ($self,$HashColumn) = @_;
256 :     if (defined($self->{"hash columns"}->{$HashColumn})) {
257 :     return keys(%{$self->{"hash columns"}->{$HashColumn}});
258 :     }
259 :     return ();
260 :     }
261 :    
262 :     =head3 add_row
263 :     Definition:
264 :     $TableObj->add_row($row_object);
265 :     Description:
266 :     Adds a row to the table.
267 :     Example:
268 :     $TableObj->add_row({"COLUMN 1" => ["A"],"COLUMN 2" => ["B"]});
269 :     =cut
270 :    
271 :     sub add_row {
272 :     my ($self,$RowObject,$RowIndex) = @_;
273 :     if (defined($RowIndex) && $RowIndex == 0) {
274 :     unshift(@{$self->{"array"}},$RowObject);
275 :     } else {
276 :     push(@{$self->{"array"}},$RowObject);
277 :     }
278 :     my @HashHeadings = $self->hash_headings();
279 :     foreach my $HashHeading (@HashHeadings) {
280 :     if (defined($RowObject->{$HashHeading})) {
281 :     for (my $i=0; $i < @{$RowObject->{$HashHeading}}; $i++) {
282 :     push(@{$self->{$RowObject->{$HashHeading}->[$i]}},$RowObject);
283 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}},$RowObject);
284 :     }
285 :     }
286 :     }
287 :     return $RowObject;
288 :     }
289 :    
290 :     =head3 sort_rows
291 :     Definition:
292 :     $TableObj->sort_rows($sortcolumn);
293 :     Description:
294 :     Sorts the rows in the table by the specified column
295 :     Example:
296 :     =cut
297 :    
298 :     sub sort_rows {
299 :     my ($self,$sortcolumn) = @_;
300 :    
301 :     @{$self->{"array"}} = sort { $a->{$sortcolumn}->[0] <=> $b->{$sortcolumn}->[0] } @{$self->{"array"}};
302 :     }
303 :    
304 :     =head3 replace_row
305 :     Definition:
306 :     $TableObj->replace_row($OriginalRow,$NewRow);
307 :     Description:
308 :     Replaces the original row in the table with the new row.
309 :     Example:
310 :     =cut
311 :    
312 :     sub replace_row {
313 :     my ($self,$OriginalRow,$NewRow) = @_;
314 :    
315 :     for (my $i=0; $i < $self->size(); $i++) {
316 :     if ($self->get_row($i) == $OriginalRow) {
317 :     $self->{"array"}->[$i] = $NewRow;
318 :     last;
319 :     }
320 :     }
321 :     }
322 :    
323 :     =head3 add_row_copy
324 :     Definition:
325 :     $TableObj->add_row_copy($OriginalRow,$NewRow);
326 :     Description:
327 :     Replaces the original row in the table with the new row.
328 :     Example:
329 :     =cut
330 :    
331 :     sub add_row_copy {
332 :     my ($self,$OriginalRow) = @_;
333 :    
334 :     my @HashKeys = keys(%{$OriginalRow});
335 :     my $NewRow;
336 :     foreach my $Key (@HashKeys) {
337 :     $NewRow->{$Key} = $OriginalRow->{$Key};
338 :     }
339 :    
340 :     $self->add_row($NewRow);
341 :     return $NewRow;
342 :     }
343 :    
344 :     =head3 add_data
345 :     Definition:
346 :     $TableObj->add_data($Row,"TEST",1,1);
347 :     Description:
348 :     Deletes a row from the table.
349 :     Example:
350 :     $TableObj->delete_row(1);
351 :     =cut
352 :    
353 :     sub add_data {
354 :     my ($self,$RowObject,$Heading,$Data,$Unique) = @_;
355 :    
356 :     #First checking that the input row exists
357 : chenry 1.9 if (!defined($RowObject) || !defined($Data)) {
358 : parrello 1.8 return -1;
359 :     }
360 :    
361 :     if (ref($Data) eq 'ARRAY') {
362 :     my $Indecies;
363 :     for (my $i=0; $i < @{$Data}; $i++) {
364 :     $Indecies->[$i] = $self->add_data($RowObject,$Heading,$Data->[$i],$Unique);
365 :     }
366 :     return $Indecies;
367 :     }
368 :    
369 :     #Now checking if the heading exists in the row
370 :     if (defined($Unique) && $Unique == 1 && defined($RowObject->{$Heading})) {
371 :     for (my $i=0; $i < @{$RowObject->{$Heading}}; $i++) {
372 :     if ($RowObject->{$Heading}->[$i] eq $Data) {
373 :     return $i;
374 :     }
375 :     }
376 :     }
377 :    
378 :     #Adding the data
379 :     push(@{$RowObject->{$Heading}},$Data);
380 :     my @HashHeadings = $self->hash_headings();
381 :     foreach my $HashHeading (@HashHeadings) {
382 :     if ($HashHeading eq $Heading) {
383 :     push(@{$self->{$Data}},$RowObject);
384 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$Data}},$RowObject);
385 :     last;
386 :     }
387 :     }
388 :     my $Index = (@{$RowObject->{$Heading}}-1);
389 :    
390 :     return $Index;
391 :     }
392 :    
393 :     =head3 remove_data
394 :     Definition:
395 :     $TableObj->remove_data($Row,"HEADING","TEST");
396 :     Description:
397 :     Deletes a element of data from the input row
398 :     Example:
399 :     $TableObj->remove_data(1);
400 :     =cut
401 :    
402 :     sub remove_data {
403 :     my ($self,$RowObject,$Heading,$Data) = @_;
404 :    
405 :     #First checking that the input row exists
406 :     if (!defined($RowObject)) {
407 :     return 0;
408 :     }
409 :    
410 :     #Now checking if the heading exists in the row
411 :     if (defined($RowObject->{$Heading})) {
412 :     for (my $i=0; $i < @{$RowObject->{$Heading}}; $i++) {
413 :     if ($RowObject->{$Heading}->[$i] eq $Data) {
414 :     splice(@{$RowObject->{$Heading}},$i,1);
415 :     $i--;
416 :     }
417 :     }
418 :     if (defined($self->{"hash columns"}->{$Heading}) && defined($self->{"hash columns"}->{$Heading}->{$Data})) {
419 :     if (@{$self->{"hash columns"}->{$Heading}->{$Data}} == 1) {
420 :     delete $self->{"hash columns"}->{$Heading}->{$Data};
421 :     } else {
422 :     for (my $j=0; $j < @{$self->{"hash columns"}->{$Heading}->{$Data}}; $j++) {
423 :     if ($self->{"hash columns"}->{$Heading}->{$Data}->[$j] eq $RowObject) {
424 :     splice(@{$self->{"hash columns"}->{$Heading}->{$Data}},$j,1);
425 :     $j--;
426 :     }
427 :     }
428 :     }
429 :     }
430 :     }
431 :    
432 :     return 1;
433 :     }
434 :    
435 :     =head3 row_index
436 :     Definition:
437 :     $TableObj->row_index($Row);
438 :     Description:
439 :     Returns the index in the table where the input row is stored.
440 :     This only works if the input $Row object was pulled from the table using one of the get_row functions.
441 :     Returns undef if the row could not be found.
442 :     Example:
443 :     $TableObj->row_index($Row);
444 :     =cut
445 :    
446 :     sub row_index {
447 :     my ($self,$Row) = @_;
448 :    
449 :     for (my $i=0; $i < $self->size(); $i++) {
450 :     if ($self->get_row($i) == $Row) {
451 :     return $i;
452 :     }
453 :     }
454 :    
455 :     return undef;
456 :     }
457 :    
458 :     =head3 delete_row_by_key
459 :     Definition:
460 :     $TableObj->delete_row_by_key($Key,$Heading);
461 :     Description:
462 :     Deletes a row from the table based on the input key and heading that the key will be stored under.
463 :     Returns 1 if a row was found and deleted. Returns 0 if no row was found.
464 :     Example:
465 :     $TableObj->delete_row_by_key("Core83333.1","Model ID");
466 :     =cut
467 :    
468 :     sub delete_row_by_key {
469 :     my ($self,$Key,$Heading) = @_;
470 :    
471 :     my $Row = $self->get_row_by_key($Key,$Heading);
472 :     if (defined($Row)) {
473 :     $self->delete_row($self->row_index($Row));
474 :     return 1;
475 :     }
476 :     return 0;
477 :     }
478 :    
479 :     =head3 clone_table_def
480 :     Definition:
481 :     my $NewTable = $TableObj->get_clone_table();
482 :     Description:
483 :     Returns a new *empty* table with the same headings, hash headings, and delimiters as the input table.
484 :     Example:
485 :     my $NewTable = $TableObj->get_clone_table();
486 :     =cut
487 :    
488 :     sub clone_table_def {
489 :     my ($self) = @_;
490 :    
491 :     my $HeadingRef;
492 :     push(@{$HeadingRef},$self->headings());
493 :     my $HashHeadingRef;
494 :     push(@{$HashHeadingRef},$self->hash_headings());
495 :    
496 :     my $TableObj = FIGMODELTable->new($HeadingRef,$self->filename(),$HashHeadingRef,$self->delimiter(),$self->item_delimiter(),$self->{"file IO settings"}->{"file prefix"}->[0]);
497 :     return $TableObj;
498 :     }
499 :    
500 :     =head3 clone_row
501 :     Definition:
502 :     my $NewRow = $TableObj->clone_row($Index);
503 :     Description:
504 :     Returns an exact copy of row located at $Index
505 :     Example:
506 :     my $NewRow = $TableObj->clone_row(5);
507 :     =cut
508 :    
509 :     sub clone_row {
510 :     my ($self,$Index) = @_;
511 :    
512 :     my @Headings = $self->headings();
513 :     my $NewRow;
514 :     for (my$k=0; $k < @Headings; $k++) {
515 :     if (defined($self->get_row($Index)->{$Headings[$k]})) {
516 :     push(@{$NewRow->{$Headings[$k]}},@{$self->get_row($Index)->{$Headings[$k]}});
517 :     }
518 :     }
519 :    
520 :     return $NewRow;
521 :     }
522 :    
523 :     =head3 delete_row
524 :     Definition:
525 :     $TableObj->delete_row($i);
526 :     Description:
527 :     Deletes a row from the table.
528 :     Example:
529 :     $TableObj->delete_row(1);
530 :     =cut
531 :    
532 :     sub delete_row {
533 :     my ($self,$RowIndex) = @_;
534 :     my @HashHeadings = $self->hash_headings();
535 :     foreach my $HashHeading (@HashHeadings) {
536 :     my $RowObject = $self->get_row($RowIndex);
537 :     if (defined($RowObject->{$HashHeading})) {
538 :     for (my $i=0; $i < @{$RowObject->{$HashHeading}}; $i++) {
539 :     if (defined($self->{$RowObject->{$HashHeading}->[$i]})) {
540 :     for (my $j =0; $j < @{$self->{$RowObject->{$HashHeading}->[$i]}}; $j++) {
541 :     if ($self->{$RowObject->{$HashHeading}->[$i]}->[$j] eq $RowObject) {
542 :     if ($j == 0 && @{$self->{$RowObject->{$HashHeading}->[$i]}} == 1) {
543 :     delete $self->{$RowObject->{$HashHeading}->[$i]};
544 :     last;
545 :     } else {
546 :     splice(@{$self->{$RowObject->{$HashHeading}->[$i]}},$j,1);
547 :     $j--;
548 :     }
549 :     }
550 :     }
551 :     }
552 :     if (defined($self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]})) {
553 :     for (my $j =0; $j < @{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}}; $j++) {
554 :     if ($self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}->[$j] eq $RowObject) {
555 :     if ($j == 0 && @{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}} == 1) {
556 :     delete $self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]};
557 :     last;
558 :     } else {
559 :     splice(@{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}},$j,1);
560 :     $j--;
561 :     }
562 :     }
563 :     }
564 :     }
565 :     }
566 :     }
567 :     }
568 :     splice(@{$self->{"array"}},$RowIndex,1);
569 :     }
570 :    
571 :     =head3 add_headings
572 :     Definition:
573 :     $TableObj->add_headings(@Headings);
574 :     Description:
575 :     Adds new headings to the table. This is needed to get the table to print the data under the new heading.
576 :     Example:
577 :     $TableObj->add_headings("Notes");
578 :     =cut
579 :    
580 :     sub add_headings {
581 :     my ($self,@Headings) = @_;
582 :    
583 :     foreach my $Heading (@Headings) {
584 :     #First check if the heading already exists
585 :     foreach my $ExistingHeading ($self->headings()) {
586 :     if ($Heading eq $ExistingHeading) {
587 :     $Heading = "";
588 :     last;
589 :     }
590 :     }
591 :     if ($Heading ne "") {
592 :     push(@{$self->{"file IO settings"}->{"orderedkeys"}},$Heading);
593 :     }
594 :     }
595 :     }
596 :    
597 :     =head3 save
598 :     Definition:
599 :     $TableObj->save($filename,$delimiter,$itemdelimiter,$prefix);
600 :     Description:
601 :     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).
602 :     All arguments are optional. If arguments are not supplied, the values used to read the table from file will be used.
603 :     Example:
604 :     $TableObj->save("/vol/Table.txt",";","|","REACTIONS");
605 :     =cut
606 :    
607 :     sub save {
608 :     my ($self,$filename,$delimiter,$itemdelimiter,$prefix) = @_;
609 :     if (defined($filename)) {
610 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
611 :     }
612 :     if (defined($delimiter)) {
613 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
614 :     }
615 :     if (defined($itemdelimiter)) {
616 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $itemdelimiter;
617 :     }
618 :     if (defined($prefix)) {
619 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $prefix;
620 :     }
621 :     FIGMODEL::SaveTable($self);
622 :     }
623 :    
624 : chenry 1.10 =head3 html_print
625 :     Definition:
626 :     string::html_text = FIGMODELTable::my_table->html_print(void);
627 :     Description:
628 :     This function returns the table contents in html format for simple display on a webpage.
629 :     Example:
630 :     =cut
631 :    
632 :     sub html_print {
633 :     my ($self) = @_;
634 :    
635 :     #Printing the table headings first
636 :     my $html = "<table><tr>";
637 :     my @Headings = $self->headings();
638 :     for (my $i=0; $i < @Headings; $i++) {
639 :     $html .= "<th align='left'>".$Headings[$i]."</th>";
640 :     }
641 :     $html .= "</tr>\n";
642 :    
643 :     #Printing the table rows
644 :     for (my $j=0; $j < $self->size(); $j++) {
645 :     my $Row = $self->get_row($j);
646 :     $html .= "<tr>";
647 :     for (my $i=0; $i < @Headings; $i++) {
648 :     $html .= "<td>";
649 :     if (defined($Row->{$Headings[$i]})) {
650 :     $html .= join("|",@{$Row->{$Headings[$i]}});
651 :     }
652 :     $html .= "</td>";
653 :     }
654 :     $html .= "</tr>\n";
655 :     }
656 :     $html .= "</table>";
657 :    
658 :     return $html;
659 :     }
660 :    
661 : parrello 1.8 =head3 load
662 :     Definition:
663 :     my $Table = load_table($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns);
664 :     Description:
665 :    
666 :     Example:
667 :     my $Table = load_table($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns);
668 :     =cut
669 :    
670 :     sub load_table {
671 :     my ($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns) = @_;
672 :    
673 :     #Checking that the table file exists
674 :     if (!-e $Filename) {
675 :     return undef;
676 :     }
677 :    
678 :     #Sanity checking input values
679 :     if (!defined($HeadingLine) || $HeadingLine eq "") {
680 :     $HeadingLine = 0;
681 :     }
682 :     if (!defined($Delimiter) || $Delimiter eq "") {
683 :     $Delimiter = ";";
684 :     }
685 :     if ($Delimiter eq "|") {
686 :     $Delimiter = "\\|";
687 :     }
688 :     if (!defined($ItemDelimiter) || $ItemDelimiter eq "") {
689 :     $ItemDelimiter = "";
690 :     } elsif ($ItemDelimiter eq "|") {
691 :     $ItemDelimiter = "\\|";
692 :     }
693 :    
694 :     #Loading the data table
695 :     my $Prefix;
696 :     my @Headings;
697 :     if (!open (TABLEINPUT, "<$Filename")) {
698 :     return undef;
699 :     }
700 :     my $Line = <TABLEINPUT>;
701 :     for (my $i=0; $i < $HeadingLine; $i++) {
702 :     $Prefix .= $Line;
703 :     $Line = <TABLEINPUT>;
704 :     }
705 :     chomp($Line);
706 :     @Headings = split(/$Delimiter/,$Line);
707 :     my $HeadingRef;
708 :     push(@{$HeadingRef},@Headings);
709 :     my $Table = new FIGMODELTable($HeadingRef,$Filename,$HashColumns,$Delimiter,$ItemDelimiter,$Prefix);
710 :    
711 :     while ($Line = <TABLEINPUT>) {
712 :     chomp($Line);
713 :     my @Data = split(/$Delimiter/,$Line);
714 :     my $ArrayRefHashRef;
715 :     for (my $i=0; $i < @Headings; $i++) {
716 :     if (defined($Data[$i]) && length($Data[$i]) > 0) {
717 :     if (defined($ItemDelimiter) && length($ItemDelimiter) > 0) {
718 :     my @TempArray = split(/$ItemDelimiter/,$Data[$i]);
719 :     foreach my $Item (@TempArray) {
720 :     push(@{$ArrayRefHashRef->{$Headings[$i]}},$Item);
721 :     }
722 :     } else {
723 :     $ArrayRefHashRef->{$Headings[$i]}->[0] = $Data[$i];
724 :     }
725 :     }
726 :     }
727 :     $Table->add_row($ArrayRefHashRef);
728 :     }
729 :     close(TABLEINPUT);
730 :    
731 :     return $Table;
732 :     }
733 :    
734 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3