[Bio] / Sprout / ERDBLoadGroup.pm Repository:
ViewVC logotype

Diff of /Sprout/ERDBLoadGroup.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Tue Sep 30 15:23:55 2008 UTC revision 1.4, Thu Oct 9 17:23:54 2008 UTC
# Line 119  Line 119 
119    
120  =item source  =item source
121    
122  The object to be used by the subclass to access the source data.  The object to be used by the subclass to access the source data. If this parameter
123    is undefined, the source object will be retrieved from the database object as soon
124    as the client calls the L</source> method.
125    
126  =item db  =item db
127    
128  The [[ErdbPm]] object for the database being loaded.  The [[ErdbPm]] object for the database being loaded.
129    
 =item directory  
   
 Name of the directory to contain the load files.  
   
130  =item options  =item options
131    
132  Reference to a hash of options. At the current time, no options are needed  Reference to a hash of options. At the current time, no options are needed
# Line 140  Line 138 
138    
139  =back  =back
140    
 This constructor is deliberately kept lightweight in order to insure that  
 L</GetGroupHash> is high-performance. For this reason, the [[ERDBGeneratePm]]  
 objects in the loaders hash are not created until L</ProcessSection>.  
   
141  =cut  =cut
142    
143  sub new {  sub new {
144      # Get the parameters.      # Get the parameters.
145      my ($class, $source, $db, $directory, $options, @tables) = @_;      my ($class, $source, $db, $options, @tables) = @_;
146      # Create a statistics object      # Create a statistics object
147      my $stats = Stats->new();      my $stats = Stats->new();
148      # Compute the group name from the class name. It is the first word in      # Compute the group name from the class name. It is the first word in
149      # a name that is presumably capital case.      # a name that is presumably capital case.
150      my $group = ($class =~ /^([A-Z][a-z]+)/ ? $1 : $class);      my $group = ($class =~ /^([A-Z][a-z]+)/ ? $1 : $class);
151      # Validate the directory.      # Get the directory.
152        my $directory = $db->LoadDirectory();
153      Confess("Load directory \"$directory\" not found or invalid.") if ! -d $directory;      Confess("Load directory \"$directory\" not found or invalid.") if ! -d $directory;
154      # Create the ERDBLoadGroup object. Note that so far we don't have any loaders      # Create the ERDBLoadGroup object. Note that so far we don't have any loaders
155      # defined and the section has not yet been assigned. The "ProcessSection"      # defined and the section has not yet been assigned. The "ProcessSection"
# Line 219  Line 214 
214      }      }
215  }  }
216    
217    =head3 PutE
218    
219        $edbl->PutE($table => $id, %fields);
220    
221    Place an entity-based table record in a load file. The first field
222    specified after the table name is the ID.
223    
224    =over 4
225    
226    =item table
227    
228    Name of the relevant table.
229    
230    =item id
231    
232    ID of the relevant entity.
233    
234    =item fields
235    
236    Hash mapping field names to values.
237    
238    =back
239    
240    =cut
241    
242    sub PutE {
243        # Get the parameters.
244        my ($self, $table, $id, %fields) = @_;
245        # Put the record.
246        $self->Put($table, id => $id, %fields);
247        # Record that we've done a putE.
248        $self->Add(putE => 1);
249    }
250    
251    =head3 PutR
252    
253        $edbl->PutR($table => $from, $to, %fields);
254    
255    Place a relationship record in a load file. The first two fields
256    specified after the table name are the from-link and the to-link,
257    respectively.
258    
259    =over 4
260    
261    =item table
262    
263    Name of the relevant relationship.
264    
265    =item from
266    
267    ID of the from-entity.
268    
269    =item to
270    
271    ID of the to-entity.
272    
273    =item fields
274    
275    Hash mapping field names to field values.
276    
277    =back
278    
279    =cut
280    
281    sub PutR {
282        # Get the parameters.
283        my ($self, $table, $from, $to, %fields) = @_;
284        # Put the record.
285        $self->Put($table, 'from-link' => $from, 'to-link' => $to, %fields);
286        # Record that we've done a PutR.
287        $self->Add(putR => 1);
288    }
289    
290    
291  =head3 Add  =head3 Add
292    
293      $edbl->Add($statName => $count);      $edbl->Add($statName => $count);
# Line 248  Line 317 
317      $self->{stats}->Add($statName => $count);      $self->{stats}->Add($statName => $count);
318  }  }
319    
320    =head3 AddWarning
321    
322        $edbl->AddWarning($errorType => $message);
323    
324    Record a warning. Warnings indicate possible errors in the incoming data.
325    The first warning of a specified type is added as a message to the load
326    statistic. All warnings are also traced at level 3.
327    
328    =over 4
329    
330    =item errorType
331    
332    Type of error indicated by the warning. This is used as the label when the
333    warning is counted in the statistics object.
334    
335    =item message
336    
337    Message describing the reason for the warning.
338    
339    =back
340    
341    =cut
342    
343    sub AddWarning {
344        # Get the parameters.
345        my ($self, $errorType, $message) = @_;
346        # Count the warning.
347        my $count = $self->Add($errorType);
348        # Is this the first one of this type?
349        if ($count == 1) {
350            # Yes, add it to the messages for the end.
351            $self->{stats}->AddMessage($errorType);
352        } else {
353            # No, just trace it.
354            Trace("Data warning: $message") if T(3);
355        }
356    }
357    
358  =head3 Track  =head3 Track
359    
360      $edbl->Track($statName => $key, $period);      $edbl->Track($statName => $key, $period);
# Line 324  Line 431 
431  sub source {  sub source {
432      # Get the parameters.      # Get the parameters.
433      my ($self) = @_;      my ($self) = @_;
434        # If we do not have a source object, retrieve it.
435        if (! defined $self->{source}) {
436            $self->{source} = $self->{db}->GetSourceObject();
437        }
438      # Return the result.      # Return the result.
439      return $self->{source};      return $self->{source};
440  }  }
# Line 389  Line 500 
500              my $loader = $loaderHash->{$table};              my $loader = $loaderHash->{$table};
501              # If it doesn't exist yet, create it.              # If it doesn't exist yet, create it.
502              if (! defined $loader) {              if (! defined $loader) {
503                  $loader = ERDBGenerate->new($db, $self->{directory}, $table);                  $loader = ERDBGenerate->new($db, $self->{directory}, $table, $self->{stats});
504                  # Save it for future use.                  # Save it for future use.
505                  $loaderHash->{$table} = $loader;                  $loaderHash->{$table} = $loader;
506                  # Count it.                  # Count it.
# Line 398  Line 509 
509              $loader->Start($section);              $loader->Start($section);
510          }          }
511          # Generate the data to put in the newly-created load files.          # Generate the data to put in the newly-created load files.
         Trace("Calling generator.") if T(3);  
512          $self->Generate();          $self->Generate();
513      };      };
514      # Did it work?      # Did it work?
# Line 468  Line 578 
578      my $retVal = {};      my $retVal = {};
579      # Loop through the list of load groups.      # Loop through the list of load groups.
580      for my $group ($erdb->LoadGroupList()) {      for my $group ($erdb->LoadGroupList()) {
         # Get a loader for this group.  
         my $loader = $erdb->Loader($group, {});  
581          # Stash the loader's tables in the output hash.          # Stash the loader's tables in the output hash.
582          $retVal->{$group} = $loader->{tables};          $retVal->{$group} = [ GetTables($erdb, $group) ];
583      }      }
584      # Return the result.      # Return the result.
585      return $retVal;      return $retVal;
586  }  }
587    
588  =head3 ComputeGroups  =head3 GetTables
589    
590      my @groupList = ERDBLoadGroup::ComputeGroups($erdb, $options, \@groups);      my @tables = ERDBLoadGroup::GetTables($group);
591    
592  Compute the actual list of groups determined by the incoming options and  Return the list of tables belonging to the specified load group.
 group list. If the list is an asterisk (C<*>), this method returns a list  
 of all the groups. If the options include C<resume>, this method returns  
 the first specified group and all the groups after it in the standard  
 ordering.  
593    
594  =over 4  =over 4
595    
596  =item erdb  =item erdb
597    
598  [[ErdbPm]] object for the database being loaded.  Return the list of tables for the specified load group.
599    
600  =item options  =item group
601    
602    Name of relevant group.
603    
604    =item RETURN
605    
606    Returns a list of a tables loaded by the specified group.
607    
608    =back
609    
610    =cut
611    
612    sub GetTables {
613        # Get the parameters.
614        my ($erdb, $group) = @_;
615        # Create a loader for the specified group.
616        my $loader = $erdb->Loader($group, undef, {});
617        # Extract the list of tables.
618        my @retVal = @{$loader->{tables}};
619        # Return the result.
620        return @retVal;
621    }
622    
623    
624    =head3 ComputeGroups
625    
626        my @groupList = ERDBLoadGroup::ComputeGroups($erdb, \@groups);
627    
628    Compute the actual list of groups determined by the incoming group list.
629    
630    =over 4
631    
632  Reference to a hash of command-line options for the command that started  =item erdb
633  this load operation.  
634    [[ErdbPm]] object for the database being loaded.
635    
636  =item groups  =item groups
637    
638  Reference to a list of group names specified on the command line.  Reference to a list of group names specified on the command line. A plus sign
639    (C<+>) has special meaning.
640    
641  =item RETURN  =item RETURN
642    
# Line 513  Line 649 
649    
650  sub ComputeGroups {  sub ComputeGroups {
651      # Get the parameters.      # Get the parameters.
652      my ($erdb, $options, $groups) = @_;      my ($erdb, $groups) = @_;
653      # Declare the return variable.      # Get the complete group list in standard order.
654        my @allGroups = $erdb->LoadGroupList();
655        # Create a hash for validation purposes. This will map each valid group
656        # name to its position in the standard order.
657        my %allGroupHash;
658        for (my $i = 0; $i <= $#allGroups; $i++) {
659            $allGroupHash{$allGroups[$i]} = $i;
660        }
661        # This variable will be the index of the last-processed group in
662        # the standard order. We start it before the first group in the list.
663        my $lastI = -1;
664        # The listed groups will be put in here.
665      my @retVal;      my @retVal;
666      # Check the group list.      # Process the group list.
667      if ($groups->[0] eq '*') {      for my $group (@$groups) {
668          # Load all groups.          # Process this group.
669          @retVal = $erdb->LoadGroupList();          if ($group eq '+') {
670      } elsif ($options->{resume}) {              # Here we have a plus sign. Push in everything after the previous
671          # Load all groups after and including the specified one.              # group processed. Note that we'll be ending at the last position.
672          my $starter = $groups->[0];              # A second "+" after this one will generate no entries in the result
         @retVal = $erdb->LoadGroupList();  
         shift @retVal until (! @retVal) || $retVal[0] eq $starter;  
         # If we didn't find the specified group, it's an error.  
         Confess("Invalid group name \"$starter\" in parameter list.") if (! @retVal);  
     } else {  
         # Here the groups are all on the command line. Stuff them in the return  
673          # list.          # list.
674          @retVal = @{$groups};              my $firstI = $lastI + 1;
675          # Verify that they're all valid.              $lastI = $#allGroups;
676          my %checker = map { $_ => 1 } $erdb->LoadGroupList();              push @retVal, @allGroups[$firstI..$lastI];
677          for my $group (@retVal) {          } elsif (exists $allGroupHash{$group}) {
678              Confess("Invalid group name \"$group\" in parameter list.")              # Here we have a valid group name. Push it into the list.
679                  if ! $checker{$group};              push @retVal, $group;
680                # Remember its location in case there's a plus sign.
681                $lastI = $allGroupHash{$group};
682            } else {
683                # This is an error.
684                Confess("Invalid load group name $group.");
685          }          }
686      }      }
687      # Normalize the group names and return them.      # Normalize the group names and return them.
688      return map { ucfirst $_ } @retVal;      @retVal = map { ucfirst $_ } @retVal;
689        Trace("Final group list is " . join(" ", @retVal) . ".") if T(2);
690        return @retVal;
691  }  }
692    
693    =head3 KillFileName
694    
695        my $fileName = ERDBLoadGroup::KillFileName($erdb, $directory);
696    
697    Compute the kill file name for the specified database in the specified
698    directory. When the [[ERDBGeneratorPl]] script sees the kill file, it will
699    terminate itself at the end of the current section.
700    
701    =over 4
702    
703    =item erdb
704    
705    Database
706    
707    =item directory (optional)
708    
709    Load directory for the database.
710    
711    =item RETURN
712    
713    Returns the specified database's kill file name. If a directory is specified,
714    it is prefixed to the name with an intervening slash.
715    
716    
717    =back
718    
719    =cut
720    
721    sub KillFileName {
722        # Get the parameters.
723        my ($erdb, $directory) = @_;
724        # Compute the kill file name. We start with the database name in
725        # lower case, then prefix it with "kill_";
726        my $dbName = lc ref $erdb;
727        my $retVal = ERDBGenerate::CreateFileName("kill_$dbName", undef, 'control', $directory);
728        # Return the result.
729        return $retVal;
730    }
731    
732    
733  =head2 Virtual Methods  =head2 Virtual Methods
734    
735  =head3 Generate  =head3 Generate

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3