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

Annotation of /FigKernelPackages/Subsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1
2 :     package Subsystem;
3 :    
4 :     use FIG;
5 :    
6 : olson 1.10 use FIGAttributes;
7 :     use base 'FIGAttributes';
8 :    
9 : olson 1.12 use POSIX;
10 : olson 1.7 use DirHandle;
11 : olson 1.1 use Data::Dumper;
12 : olson 1.14 use File::Copy;
13 : olson 1.1 use File::Spec;
14 : olson 1.12 use IPC::Open2;
15 : olson 1.1
16 :     use strict;
17 :    
18 : olson 1.2 =pod
19 :    
20 :     =head1 Subsystem manipulation.
21 :    
22 :     Any manipulation of subsystem data should happen through this interface.
23 :     This allows us to assure ourselves that the relational tables that
24 :     mirror and index the subsystem data are kept up to date with the
25 :     canonical version of the subsystem information in the flat-files
26 :     kept in $FIG_Config::data/Subsystems.
27 :    
28 :     =head2 Thoughts on locking
29 :    
30 :     It is currently dangerous for multiple users to modify spreadsheets at once.
31 :     It will likely remain dangerous while the subsystem backend is fairly
32 :     stateless, as it is with the CGI mechanism.
33 :    
34 :     We'd like to make this a little safer. One mechanism might be to allow
35 :     a user to open a subsystem for modification, and others for readonly access.
36 :     For this to work we have to be able to tell which users is allowed; current
37 :     implementation uses the curator of the subsystem for this purpose.
38 :    
39 :     NB: This module does not currently attempt to handle locking or exclusion.
40 :     It is up to the caller (user application, CGI script, etc) to do so.
41 :     It does attempt to use locking internally where appropriate.
42 :    
43 :     =head2 Data structures
44 :    
45 :     We maintain the following data structures (all members of %$self).
46 :    
47 :     =over 4
48 :    
49 :     =item dir
50 :    
51 :     Directory in which the subsystem is stored.
52 :    
53 :     =item notes
54 :    
55 :     The current notes contents for the subsystem
56 :    
57 :     =item version
58 :    
59 :     Current subsystem version.
60 :    
61 :     =item exchangable
62 :    
63 :     1 if subsystem is exchangable, 0 otherwise.
64 :    
65 :    
66 :     =item roles
67 :    
68 :     list of role names
69 :    
70 :     =item role_index
71 :    
72 :     hash that maps from role name to index
73 :    
74 :     =item role_abbrs
75 :    
76 :     list of role abbreviations
77 :    
78 :     =item abbr
79 :    
80 :     hash mapping from role abbreviation to role name
81 :    
82 :     =item col_subsets
83 :    
84 :     list of column subset names
85 :    
86 :     =item col_subset_members
87 :    
88 :     hash that maps from column subset name to subset members
89 :    
90 :     =item col_active_subset
91 :    
92 :     currently-active column subset
93 :    
94 :     =item row_active_subset
95 :    
96 :     currently-active row subset
97 :    
98 :     =item genome
99 :    
100 :     List (1-indexed, so element 0 is undef) of genome IDs.
101 :    
102 :     =item variant_code
103 :    
104 :     List (1-indexed, so element 0 is undef) of variant codes.
105 :    
106 :     =item genome_index
107 :    
108 :     Hash mapping from genome ID to genome index.
109 :    
110 :     =item variant_code
111 :    
112 :     List (1-indexed, so element 0 is undef) of variant codes.
113 :    
114 :     =item spreadsheet
115 :    
116 :     Spreadsheet data. Structured as a list of rows, each of which
117 :     is a list of entries. An entry is a list of PEG numbers.
118 :    
119 :     =item spreadsheet_inv
120 :    
121 :     Inverted structure of spreadsheet - list of columns, each of which is a list
122 :     of rows.
123 :    
124 :     =back
125 :    
126 :     =cut
127 : olson 1.1
128 :     use FIG;
129 :    
130 :     =pod
131 :    
132 :     =head1 Subsystem constructor
133 :    
134 :     usage: $sub = Subsystem->new("subsystem name", $fig, $createFlag)
135 :    
136 :     Load the subsystem. If it does not exist, and $createFlag is true, create
137 :     a new empty subsystem.
138 :    
139 :     =cut
140 :    
141 :     sub new
142 :     {
143 :     my($class, $name, $fig, $create) = @_;
144 :    
145 :     my $ssa_dir = get_dir_from_name($name);
146 :    
147 :     #
148 :     # For loading, the subsystem directory must already exist.
149 :     #
150 :    
151 :     if (! -d $ssa_dir)
152 :     {
153 :     if ($create)
154 :     {
155 :     return create_subsystem($class, $name, $fig);
156 :     }
157 :     else
158 :     {
159 : olson 1.11 # warn "Subsystem $name does not exist\n";
160 : olson 1.1 return undef;
161 :     }
162 :     }
163 :    
164 :     my $self = {
165 :     dir => $ssa_dir,
166 :     name => $name,
167 :     fig => $fig,
168 :     };
169 :    
170 :     bless($self, $class);
171 :    
172 :     $self->load();
173 :    
174 :     return $self;
175 :     }
176 :    
177 : olson 1.19 sub new_from_dir
178 :     {
179 :     my($class, $dir, $fig) = @_;
180 :    
181 :     my $ssa_dir = $dir;
182 :     my $name;
183 :    
184 :     #
185 :     # For loading, the subsystem directory must already exist.
186 :     #
187 :    
188 :     my $self = {
189 :     dir => $ssa_dir,
190 :     name => $name,
191 :     fig => $fig,
192 :     };
193 :    
194 :     bless($self, $class);
195 :    
196 :     $self->load();
197 :    
198 :     return $self;
199 :     }
200 :    
201 : olson 1.1 sub create_subsystem
202 :     {
203 :     my($class, $name, $fig) = @_;
204 :    
205 :     return undef;
206 :     }
207 :    
208 : olson 1.5 #
209 : olson 1.7 # Retrieve the diagrams associated with this subsystem.
210 :     #
211 :     # This is done via a lookup into FIG/Data/SubsystemDiagrams/<ssaname>/<diagram-name>.
212 :     #
213 :     # Returned is a list of names.
214 :     #
215 :    
216 :     sub get_diagrams
217 :     {
218 :     my($self) = @_;
219 :    
220 :     my $b = $self->{name};
221 :     $b =~ s/ /_/g;
222 :     my $dir = File::Spec->catfile($FIG_Config::data, 'SubsystemDiagrams', $b);
223 :    
224 :     my $dh = new DirHandle($dir);
225 :    
226 :     my @names = grep(/^[^.]/, $dh->read());
227 :    
228 :     return @names;
229 :     }
230 :    
231 :     #
232 :     # Return a Subsystem::Diagram object for this diagram.
233 :     #
234 :     sub get_diagram
235 :     {
236 :     my($self, $name) = @_;
237 :    
238 :     my $b = $self->{name};
239 :     $b =~ s/ /_/g;
240 :     my $dir = File::Spec->catfile($FIG_Config::data, 'SubsystemDiagrams', $b, $name);
241 :    
242 :     if (-d $dir)
243 :     {
244 :     return Subsystem::Diagram->new($self, $self->{fig}, $name, $dir);
245 :     }
246 :     else
247 :     {
248 :     return undef;
249 :     }
250 :     }
251 :    
252 :     #
253 : olson 1.5 # Synchronize the database index for this subsystem to the
254 :     # subsystem data.
255 :     #
256 :     # We assume the table already exists.
257 :     #
258 :    
259 :     sub db_sync
260 :     {
261 :     my($self, $skip_delete) = @_;
262 :    
263 :     my $rdbH = $self->{fig}->db_handle();
264 :    
265 :     if (!$skip_delete)
266 :     {
267 :     $rdbH->SQL("DELETE FROM subsystem_index where subsystem = '$self->{name}'")
268 :     }
269 :    
270 :     #
271 :     # We run thru all the cells, writing an entry in the database for the peg/subsystem/role.
272 :     #
273 :    
274 : olson 1.6 my $sth = $rdbH->{_dbh}->prepare("INSERT INTO subsystem_index values(?, ?, ?)");
275 :    
276 : olson 1.5 for my $role ($self->get_roles())
277 :     {
278 :     my $ridx = $self->get_role_index($role);
279 :     my $col = $self->get_col($ridx);
280 :     for my $cell (@$col)
281 :     {
282 :     if ($cell)
283 :     {
284 :     for my $peg (@$cell)
285 :     {
286 : olson 1.6 $sth->execute($peg, $self->{name}, $role);
287 : olson 1.5 }
288 :     }
289 :     }
290 :     }
291 :     }
292 :    
293 : olson 1.1 sub load
294 :     {
295 :     my($self) = @_;
296 :    
297 :     #
298 :     # Load the subsystem.
299 :     #
300 :    
301 :     my $ssa;
302 :     if (!open($ssa,"<$self->{dir}/spreadsheet"))
303 :     {
304 :     warn "Spreadsheet does not exist in subsystem\n";
305 :     return;
306 :     }
307 :    
308 :     local $/ = "//\n";
309 :    
310 :     my $roles = <$ssa>;
311 :     if ($roles)
312 :     {
313 :     $roles =~ s,$/$,,;
314 :     #
315 :     # Split on newline, filter for non-empty lines.
316 :     #
317 :     my @roles = split("\n", $roles);
318 :    
319 :     @roles = grep { $_ ne "" } @roles;
320 :    
321 :     $self->load_roles(@roles);
322 :     }
323 :    
324 :     my $subsets = <$ssa>;
325 :     if ($subsets)
326 :     {
327 :     $subsets =~ s,$/$,,;
328 :     $self->load_subsets($subsets);
329 :     }
330 :    
331 :     $/ = "\n";
332 :    
333 :     $self->load_genomes($ssa);
334 :    
335 :     #
336 :     # Now load the rest of the info.
337 :     #
338 :    
339 :     $self->load_notes();
340 :     $self->load_version();
341 :     $self->load_exchangable();
342 : olson 1.17 $self->load_curation();
343 : olson 1.1 }
344 :    
345 :     sub load_notes
346 :     {
347 :     my($self) = @_;
348 :    
349 :     $self->{notes} = &FIG::file_read(File::Spec->catfile($self->{dir}, "notes"));
350 :     }
351 :    
352 : olson 1.17 sub load_curation
353 :     {
354 :     my($self) = @_;
355 :    
356 :     my @l = &FIG::file_head(File::Spec->catfile($self->{dir}, "curation.log"), 1);
357 :    
358 :     $_ = $l[0];
359 :     chomp;
360 :     if (/^\d+\t(\S+)\s+started/)
361 :     {
362 :     $self->{curator} = $1;
363 :     }
364 :     }
365 :    
366 : olson 1.1 sub load_version
367 :     {
368 :     my($self) = @_;
369 :    
370 :     my @l = &FIG::file_head(File::Spec->catfile($self->{dir}, "VERSION"), 1);
371 :     my $l = $l[0];
372 :     chomp $l;
373 :     $self->{version} = $l;
374 :     }
375 :    
376 :     sub load_exchangable
377 :     {
378 :     my($self) = @_;
379 :    
380 :     my $file = File::Spec->catfile($self->{dir}, "EXCHANGABLE");
381 :    
382 :     if (-f $file)
383 :     {
384 :     my($l, @l);
385 :    
386 :     @l = &FIG::file_head($file, 1);
387 :     $l = $l[0];
388 :     chomp $l;
389 :     $self->{exchangable} = $l;
390 :     }
391 :     else
392 :     {
393 :     $self->{exchangable} = 0;
394 :     }
395 :     }
396 :    
397 :    
398 :     sub load_roles
399 :     {
400 :     my($self, @roles) = @_;
401 :    
402 : olson 1.5 $self->{abbr} = {};
403 :     $self->{role_index} = {};
404 :     $self->{roles} = [];
405 :     $self->{role_abbrs} = [];
406 :    
407 : olson 1.1 my $i = 1;
408 :     for my $role (@roles)
409 :     {
410 :     my($abbr, $name) = split(/\t/, $role);
411 : olson 1.2 # print "Role $i: abbr=$abbr name=$name\n";
412 : olson 1.1
413 :     $self->{abbr}->{$abbr} = $name;
414 :     $self->{role_index}->{$name} = $i;
415 :     $self->{roles}->[$i] = $name;
416 : olson 1.4 $self->{role_abbrs}->[$i] = $abbr;
417 : olson 1.1 $i++;
418 :     }
419 :     }
420 :    
421 :     sub load_subsets
422 :     {
423 :     my($self, $subsets) = @_;
424 :    
425 :     #
426 :     # Column and row subsets.
427 :     #
428 :     my($subsetsC, $subsetsR) = split(/\n\n/, $subsets);
429 :    
430 :    
431 :     #
432 :     # Handle column subsets.
433 :     #
434 :    
435 :     my @subsetsC = split(/\n/, $subsetsC);
436 :    
437 :     #
438 :     # Determine active subset.
439 :     #
440 :    
441 :     my $active_subsetC;
442 :     if (@subsetsC > 0)
443 :     {
444 :     $active_subsetC = pop(@subsetsC);
445 :     }
446 :     else
447 :     {
448 :     $active_subsetC = 'All';
449 :     }
450 :    
451 :     $self->{col_active_subset} = $active_subsetC;
452 :    
453 :     $self->{col_subsets} = [];
454 : olson 1.5 $self->{col_subset_members} = {};
455 :    
456 : olson 1.1 for my $subset (@subsetsC)
457 :     {
458 :     my($name, @members) = split(/\s+/, $subset);
459 :    
460 :     push(@{$self->{col_subsets}}, $name);
461 :    
462 :     #
463 :     # Map role members from name to index if necessary.
464 :     #
465 :     # Is it really necessary? ssa2 code was looking up in %pos for this.
466 :     #
467 :     @members = map {
468 :     if (my $new = $self->{role_index}->{$_})
469 :     {
470 :     $new;
471 :     }
472 :     else
473 :     {
474 :     $_;
475 :     }
476 :     } @members;
477 :    
478 :     @{$self->{col_subset_members}->{$name}} = @members;
479 :     }
480 :    
481 :     #
482 :     # Now the row subsets.
483 :     #
484 :    
485 :     chomp($subsetsR);
486 :    
487 :     if ($subsetsR =~ /(\S+.*\S+)/)
488 :     {
489 :     $self->{row_subset_active} = $1;
490 :     }
491 :     else
492 :     {
493 :     $self->{row_subset_active} = 'All';
494 :     }
495 :     }
496 :    
497 :     sub load_genomes
498 :     {
499 :     my($self, $fh) = @_;
500 :     my(%seen);
501 :    
502 : olson 1.5 $self->{spreadsheet} = [];
503 :     $self->{spreadshhet_inv} = [];
504 :     $self->{genome} = [];
505 :     $self->{genome_index} = {};
506 :     $self->{variant_code} = [];
507 :    
508 : olson 1.1 my $i = 1;
509 :     while (<$fh>)
510 :     {
511 :     chomp;
512 :    
513 :     my($genome, $variant_code, @row) = split(/\t/);
514 :    
515 :     next if $seen{$genome};
516 :     $seen{$genome}++;
517 :    
518 :     my $j = 1;
519 :    
520 :     $self->{genome}->[$i] = $genome;
521 :     $self->{genome_index}->{$genome} = $i;
522 :     $self->{variant_code}->[$i] = $variant_code;
523 :    
524 :     for my $entry (@row)
525 :     {
526 :     my $e2 = [map("fig|$genome.peg.$_", split(/,/, $entry))];
527 :     $self->{spreadsheet}->[$i]->[$j] = $e2;
528 :     $self->{spreadsheet_inv}->[$j]->[$i] = $e2;
529 :     $j++;
530 :     }
531 :     $i++;
532 :    
533 :     }
534 :     }
535 :    
536 : olson 1.2 =pod
537 :    
538 :     =head1 get_genomes
539 :    
540 :     =cut
541 :    
542 :     sub get_genomes
543 :     {
544 :     my($self) = @_;
545 :    
546 :     my $glist = $self->{genome};
547 :    
548 :     return @$glist[1..$#$glist];
549 :     }
550 :    
551 :     =pod
552 :    
553 :     =head1 get_variant_codes
554 :    
555 :     =cut
556 :    
557 :     sub get_variant_codes
558 :     {
559 :     my($self) = @_;
560 :    
561 :     my $glist = $self->{variant_code};
562 :    
563 :     return @$glist[1..$#$glist];
564 :     }
565 :    
566 :     sub get_variant_code_for_genome
567 :     {
568 :     my($self, $genome) = @_;
569 :    
570 :     my $index = $self->{genome_index}->{$genome};
571 :     return $self->{variant_code}->[$index];
572 :     }
573 :    
574 :     sub get_roles
575 :     {
576 :     my($self) = @_;
577 :    
578 :     my $rlist = $self->{roles};
579 :    
580 :     return @$rlist[1..$#$rlist];
581 :     }
582 :    
583 : olson 1.10 sub get_row :scalar
584 : olson 1.1 {
585 :     my($self, $row) = @_;
586 :    
587 :     return $self->{spreadsheet}->[$row];
588 :     }
589 :    
590 :     sub get_col
591 :     {
592 :     my($self, $col) = @_;
593 :    
594 :     return $self->{spreadsheet_inv}->[$col];
595 :     }
596 :    
597 :     sub get_cell
598 :     {
599 :     my($self, $row, $col) = @_;
600 :    
601 : olson 1.5 my $cell = $self->{spreadsheet}->[$row]->[$col];
602 :     return $cell;
603 : olson 1.1 }
604 :    
605 : olson 1.3 sub get_genome_index
606 :     {
607 :     my($self, $genome) = @_;
608 :    
609 :     return $self->{genome_index}->{$genome};
610 :     }
611 :    
612 :     sub get_genome
613 :     {
614 :     my($self, $gidx) = @_;
615 :    
616 :     return $self->{genome}->[$gidx];
617 :     }
618 :    
619 : olson 1.5 sub get_role_index
620 :     {
621 :     my($self, $role) = @_;
622 :    
623 :     return $self->{role_index}->{$role};
624 :     }
625 :    
626 : olson 1.3 sub get_role
627 :     {
628 :     my($self, $ridx) = @_;
629 :    
630 :     return $self->{roles}->[$ridx];
631 :     }
632 :    
633 : olson 1.4 sub get_role_abbr
634 :     {
635 :     my($self, $ridx) = @_;
636 :    
637 :     return $self->{role_abbrs}->[$ridx];
638 :     }
639 :    
640 : olson 1.1 sub get_pegs_from_cell
641 :     {
642 :     my($self, $rowstr, $colstr) = @_;
643 :     my($row, $col);
644 :    
645 :     #
646 :     # If row isn't numeric, look it up in the genomes list.
647 :     #
648 :    
649 :     if ($rowstr !~ /^\d+$/)
650 :     {
651 :     $row = $self->{genome_index}->{$rowstr};
652 :     }
653 :     else
654 :     {
655 :     $row = $rowstr;
656 :     }
657 :    
658 :     if (!$row)
659 :     {
660 :     warn "Cannot find row for $rowstr\n";
661 :     return undef;
662 :     }
663 :    
664 :     #
665 :     # If col isn't numeric, look it up in the roles and role abbreviations.
666 :     #
667 :    
668 :     if ($colstr !~ /^\d+$/)
669 :     {
670 :     #
671 :     # See if it's an abbr
672 :     #
673 :    
674 :     my $a = $self->{abbr}->{$colstr};
675 :     $colstr = $a if $a;
676 :    
677 :     $col = $self->{role_index}->{$colstr};
678 :     }
679 :     else
680 :     {
681 :     $col = $colstr;
682 :     }
683 :    
684 :     if (!$col)
685 :     {
686 :     warn "Cannot find col for $colstr\n";
687 :     return undef;
688 :     }
689 : olson 1.12 my $cell = $self->get_cell($row, $col);
690 : olson 1.1
691 :     if ($cell)
692 :     {
693 :     return @$cell;
694 :     }
695 :     else
696 :     {
697 :     return undef;
698 :     }
699 :     }
700 :    
701 : olson 1.17 sub get_name :scalar
702 :     {
703 :     my($self) = @_;
704 :     return $self->{name};
705 :     }
706 :    
707 :    
708 :     sub get_version :scalar
709 :     {
710 :     my($self) = @_;
711 :     return $self->{version};
712 :     }
713 :    
714 :     sub get_curator :scalar
715 :     {
716 :     my($self) = @_;
717 :     return $self->{curator};
718 :     }
719 :    
720 :    
721 : olson 1.1 sub dump
722 :     {
723 :     my($self) = @_;
724 :    
725 :     for my $k (keys(%$self))
726 :     {
727 :     next if $k eq "spreadsheet" or $k eq "spreadsheet_inv";
728 :     print "Key \"$k\": ", Dumper($self->{$k});
729 :     }
730 :     }
731 :    
732 : olson 1.14 #
733 :     # Increment the subsystem's version number.
734 :     #
735 :     sub incr_version {
736 :     my($self) = @_;
737 :    
738 :     my $dir = $self->{dir};
739 :     my $vfile = "$dir/VERSION";
740 :     my($ver);
741 :    
742 :     if (open(my $fh,"<$vfile"))
743 :     {
744 :     if (defined($ver = <$fh>) && ($ver =~ /^(\S+)/))
745 :     {
746 :     $ver = $1;
747 :     }
748 :     else
749 :     {
750 :     $ver = 0;
751 :     }
752 :     close($fh);
753 :     }
754 :     else
755 :     {
756 :     $ver = 0;
757 :     }
758 :    
759 :     $ver++;
760 :    
761 :     open(my $fh, ">$vfile") || die "could not open $vfile";
762 :     print $fh "$ver\n";
763 :     close($fh);
764 :    
765 :     chmod(0777, $vfile);
766 :    
767 :     $self->load_version();
768 :     }
769 : olson 1.1
770 :     sub get_dir_from_name
771 :     {
772 :     my($name) = @_;
773 :    
774 :     my $b = $name;
775 :     $b =~ s/ /_/g;
776 :     my $dir = File::Spec->catfile($FIG_Config::data, 'Subsystems', $b);
777 :     return $dir;
778 :     }
779 :    
780 : olson 1.12 #
781 :     # Code for dealing with Bill McCune's prolog code for extending subsystems.
782 :     #
783 :     # The code here is a reconstruction of Bill's "go" script in perl with
784 :     # data pulled from the local SEED configuration.
785 :     #
786 :    
787 :     sub extend_with_billogix
788 :     {
789 :     my($self, $muser) = @_;
790 :     my($isMaster, $user);
791 :    
792 :     my $now = time();
793 :    
794 :     if ($muser =~ /master:(.*)/)
795 :     {
796 :     $isMaster = 1;
797 :     $user = $1;
798 :     }
799 :     else
800 :     {
801 :     $isMaster = 0;
802 :     $user = $muser;
803 :     }
804 :    
805 :     #
806 :     # Find the executable.
807 :     #
808 :    
809 :     my $exe = "$FIG_Config::bin/billogix";
810 :    
811 :     if (! -x $exe)
812 :     {
813 :     warn "Cannot find billogix exe at $exe\n";
814 :     return;
815 :     }
816 :    
817 :     my $ss_name = $self->{name};
818 : olson 1.18
819 :     $ss_name =~ s/\s+/_/g;
820 :    
821 : olson 1.14 my $ss_dir = "$self->{dir}/";
822 : olson 1.15 my $assign_dir = "$FIG_Config::data/Assignments/$user/";
823 : olson 1.12 &FIG::verify_dir($assign_dir);
824 :    
825 : olson 1.16 my $when= strftime("%m-%d-%y:%H:%M:%S", localtime($now));
826 :     my $job_id = "${when}:sss:$ss_name";
827 :    
828 : olson 1.12 my $seed = &FIG::cgi_url() . "/";
829 : olson 1.13 my $export_part = "ssa.cgi?user=$muser&request=delete_or_export_ssa&export=";
830 : olson 1.12
831 :     #
832 :     # Have the prereq stuff, now start up the app.
833 :     #
834 :    
835 :     $ENV{LOCALSZ} = "80000";
836 :     $ENV{GLOBALSZ} = "80000";
837 :     $ENV{TRAILSZ} = "30000";
838 : olson 1.13
839 :     my $arch = &FIG::get_current_arch();
840 :    
841 :     $ENV{BILLOGIX} = "$FIG_Config::fig_disk/dist/releases/current/$arch/lib/Billogix";
842 :    
843 :     #
844 :     # Need to ensure pl2wam is in our path
845 :     #
846 :    
847 :     $ENV{PATH} = "${FIG_Config::ext_bin}:$ENV{PATH}";
848 : olson 1.12
849 :     my $app_input = <<EOINP;
850 :     ['\$BILLOGIX/top'].
851 :     loadup.
852 :     asserta(url_default_seed('$seed')).
853 : olson 1.13 asserta(url_export_part('$export_part')).
854 : olson 1.12 asserta(ss_directory('$ss_dir')).
855 :     asserta(assign_directory('$assign_dir')).
856 :     asserta(job_id('$job_id')).
857 :     extend_test3('$ss_name').
858 :     EOINP
859 :    
860 :     print STDERR <<EOF;
861 :     Starting app
862 :    
863 :     ss_name = $ss_name
864 :     ss_dir = $ss_dir
865 :     user = $user
866 :     assign_dir = $assign_dir
867 :     exe = $exe
868 : olson 1.13 libdir = $ENV{BILLOGIX}
869 :     path = $ENV{PATH}
870 : olson 1.12
871 :     App input
872 :     $app_input
873 :     EOF
874 :     # feh, put in a block to reset perlmode indentation.
875 :     {
876 :     my($app_read, $app_write, $log);
877 :    
878 : olson 1.16 open($log, ">$ss_dir/$job_id.log");
879 : olson 1.12
880 : olson 1.14 #
881 :     # Start the actual application with stdin and stdout redirected
882 :     # to pipes.
883 :     #
884 :     # We write $app_input to the stdin pipe, and close it.
885 :     # Then loop reading stdout, logging that output.
886 :     #
887 : olson 1.12 my $pid = open2($app_read, $app_write, $exe);
888 :    
889 :     if (!$pid)
890 :     {
891 :     warn "open2 $exe failed: $!\n";
892 :     print $log "open2 $exe failed: $!\n";
893 :     return;
894 :     }
895 :    
896 :     print $app_write $app_input;
897 :     close($app_write);
898 :    
899 :     #
900 :     # Set autoflush on the logfile.
901 :     #
902 :    
903 :     my $old = select($log);
904 :     $| = 1;
905 :     select(STDERR);
906 :     $| = 1;
907 :     select($old);
908 :    
909 :     warn "Starting $exe with pid $pid\n";
910 :     print $log "Starting $exe with pid $pid\n";
911 :    
912 :     while (<$app_read>)
913 :     {
914 :     print STDERR $_;
915 :     print $log $_;
916 :     }
917 :    
918 :     print STDERR "App done\n";
919 :     print $log "App done\n";
920 :    
921 :     close($app_read);
922 :    
923 :     my $ret = waitpid($pid, 0);
924 :     my $stat = $?;
925 :     print STDERR "Return status is $?\n";
926 :     print $log "Return status is $?\n";
927 : olson 1.14
928 : olson 1.19
929 : olson 1.14 #
930 :     # At this point, the extension is finished.
931 : olson 1.19 # Make sure we have a rows file after the run.
932 :     #
933 :    
934 :     my $ssaD = $self->{dir};
935 :    
936 :     my $rows_file = "$ssaD/rows";
937 :     if (! -f $rows_file)
938 :     {
939 :     print STDERR "Missing rows file: $ssaD/rows\n";
940 :     print $log "Missing rows file: $ssaD/rows\n";
941 :     return;
942 :     }
943 :    
944 :     #
945 : olson 1.14 # Back up the spreadsheet, and append the rows file to it.
946 :     #
947 :    
948 :     &FIG::verify_dir("$ssaD/Backup");
949 :     my $ts = time;
950 :     rename("$ssaD/spreadsheet~","$ssaD/Backup/spreadsheet.$ts");
951 :     copy("$ssaD/spreadsheet","$ssaD/spreadsheet~");
952 :     rename("$ssaD/notes~","$ssaD/Backup/notes.$ts");
953 :    
954 :     #
955 :     # Append the new rows to the spreadsheet.
956 :     #
957 :    
958 :     my($ssafh, $rowsfh);
959 :     open($ssafh, ">>$ssaD/spreadsheet") or die "Cannot open $ssaD/spreadsheet for append: $!\n";
960 :     open($rowsfh, "<$ssaD/rows") or die "Cannot open $ssaD/rows for reading: $!\n";
961 :    
962 :     while (<$rowsfh>)
963 :     {
964 :     print $ssafh $_;
965 :     }
966 :     close($ssafh);
967 :     close($rowsfh);
968 :    
969 :     $self->incr_version();
970 : olson 1.12 }
971 : olson 1.14
972 : olson 1.12 }
973 : olson 1.13
974 : olson 1.14
975 : olson 1.13 sub set_current_extend_pid
976 :     {
977 :     my($self, $pid) = @_;
978 :    
979 :     if (open(my $fh, ">$self->{dir}/EXTEND_PID"))
980 :     {
981 :     print $fh "$pid\n";
982 :     }
983 :     else
984 :     {
985 :     warn "Cannot open $self->{dir}/EXTEND_PID: $!\n";
986 :     }
987 :     }
988 :    
989 :     sub get_current_extend_pid
990 :     {
991 :     my($self) = @_;
992 :    
993 :     if (open(my $fh, "<$self->{dir}/EXTEND_PID"))
994 :     {
995 :     my $pid = <$fh>;
996 :     close($fh);
997 :     if ($pid)
998 :     {
999 :     chomp $pid;
1000 :    
1001 :     return $pid;
1002 :     }
1003 :     }
1004 :     return undef;
1005 :     }
1006 : olson 1.12
1007 : olson 1.7 package Subsystem::Diagram;
1008 :    
1009 :     sub new
1010 :     {
1011 :     my($class, $sub, $fig, $name, $dir) = @_;
1012 :    
1013 :     if (!-d $dir)
1014 :     {
1015 :     return undef;
1016 :     }
1017 :    
1018 :     my $self = {
1019 :     fig => $fig,
1020 :     subsystem => $sub,
1021 :     name => $name,
1022 :     dir =>$ dir,
1023 :     };
1024 :     bless $self, $class;
1025 :    
1026 :     $self->load();
1027 :    
1028 :     return $self;
1029 :     }
1030 :    
1031 :     #
1032 :     # Parse the diagram into internal data structure.
1033 :     #
1034 :    
1035 :     sub load
1036 :     {
1037 :     my($self) = @_;
1038 :    
1039 :     $self->load_area();
1040 :     }
1041 :    
1042 :     sub load_area
1043 :     {
1044 :     my($self) = @_;
1045 :     my $fh;
1046 :    
1047 : olson 1.8 if (!open($fh, "<$self->{dir}/area_table"))
1048 : olson 1.7 {
1049 : olson 1.8 warn "Could not load $self->{dir}/area_table: $!\n";
1050 : olson 1.7 return;
1051 :     }
1052 :    
1053 :     $self->{areas} = [];
1054 :    
1055 :     my $area_list = $self->{areas};
1056 :    
1057 :     while (<$fh>)
1058 :     {
1059 :     chomp;
1060 :     s/#.*$//;
1061 :     s/^\s+//;
1062 :     s/\s+$//;
1063 :     next if $_ eq '';
1064 :     my ($area, $tag, $value) = split(/\s+/, $_, 3);
1065 :     # print "area=$area tag=$tag value=$value\n";
1066 :    
1067 :     push(@$area_list, [$area, $tag, $value]);
1068 :    
1069 :     #
1070 :     # Do a little checking.
1071 :     #
1072 :    
1073 :     if ($tag eq "role")
1074 :     {
1075 :     my $idx = $self->{subsystem}->get_role_index($value);
1076 :     if (!defined($idx))
1077 :     {
1078 :     warn "Role not found for \"$value\" in subsystem $self->{subsystem}->{name}\n";
1079 :     }
1080 :     }
1081 :     }
1082 :     close($fh);
1083 :     }
1084 :    
1085 :     sub get_areas
1086 :     {
1087 :     my($self) = @_;
1088 :    
1089 :     return @{$self->{areas}};
1090 :     }
1091 :    
1092 : olson 1.1 1;
1093 : olson 1.7
1094 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3