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

Diff of /Sprout/CustomAttributes.pm

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

revision 1.11, Wed Nov 29 20:28:52 2006 UTC revision 1.14, Wed Dec 20 20:04:23 2006 UTC
# Line 8  Line 8 
8      use strict;      use strict;
9      use Tracer;      use Tracer;
10      use ERDBLoad;      use ERDBLoad;
11        use Stats;
12    
13  =head1 Custom SEED Attribute Manager  =head1 Custom SEED Attribute Manager
14    
# Line 532  Line 533 
533      return $retVal;      return $retVal;
534  }  }
535    
536    =head3 BackupKeys
537    
538    C<< my $stats = $attrDB->BackupKeys($fileName, %options); >>
539    
540    Backup the attribute key information from the attribute database.
541    
542    =over 4
543    
544    =item fileName
545    
546    Name of the output file.
547    
548    =item options
549    
550    Options for modifying the backup process.
551    
552    =item RETURN
553    
554    Returns a statistics object for the backup.
555    
556    =back
557    
558    Currently there are no options. The backup is straight to a text file in
559    tab-delimited format. Each key is backup up to two lines. The first line
560    is all of the data from the B<AttributeKey> table. The second is a
561    tab-delimited list of all the groups.
562    
563    =cut
564    
565    sub BackupKeys {
566        # Get the parameters.
567        my ($self, $fileName, %options) = @_;
568        # Declare the return variable.
569        my $retVal = Stats->new();
570        # Open the output file.
571        my $fh = Open(undef, ">$fileName");
572        # Set up to read the keys.
573        my $keyQuery = $self->Get(['AttributeKey'], "", []);
574        # Loop through the keys.
575        while (my $keyData = $keyQuery->Fetch()) {
576            $retVal->Add(key => 1);
577            # Get the fields.
578            my ($id, $type, $description) = $keyData->Values(['AttributeKey(id)', 'AttributeKey(data-type)',
579                                                              'AttributeKey(description)']);
580            # Escape any tabs or new-lines in the description.
581            my $escapedDescription = Tracer::Escape($description);
582            # Write the key data to the output.
583            Tracer::PutLine($fh, [$id, $type, $escapedDescription]);
584            # Get the key's groups.
585            my @groups = $self->GetFlat(['IsInGroup'], "IsInGroup(from-link) = ?", [$id],
586                                        'IsInGroup(to-link)');
587            $retVal->Add(memberships => scalar(@groups));
588            # Write them to the output. Note we put a marker at the beginning to insure the line
589            # is nonempty.
590            Tracer::PutLine($fh, ['#GROUPS', @groups]);
591        }
592        # Return the result.
593        return $retVal;
594    }
595    
596    =head3 RestoreKeys
597    
598    C<< my $stats = $attrDB->RestoreKeys($fileName, %options); >>
599    
600    Restore the attribute keys and groups from a backup file.
601    
602    =over 4
603    
604    =item fileName
605    
606    Name of the file containing the backed-up keys. Each key has a pair of lines,
607    one containing the key data and one listing its groups.
608    
609    =back
610    
611    =cut
612    
613    sub RestoreKeys {
614        # Get the parameters.
615        my ($self, $fileName, %options) = @_;
616        # Declare the return variable.
617        my $retVal = Stats->new();
618        # Set up a hash to hold the group IDs.
619        my %groups = ();
620        # Open the file.
621        my $fh = Open(undef, "<$fileName");
622        # Loop until we're done.
623        while (! eof $fh) {
624            # Get a key record.
625            my ($id, $dataType, $description) = Tracer::GetLine($fh);
626            if ($id eq '#GROUPS') {
627                Confess("Group record found when key record expected.");
628            } elsif (! defined($description)) {
629                Confess("Invalid format found for key record.");
630            } else {
631                $retVal->Add("keyIn" => 1);
632                # Add this key to the database.
633                $self->InsertObject('AttributeKey', { id => $id, 'data-type' => $dataType,
634                                                      description => Tracer::UnEscape($description) });
635                Trace("Attribute $id stored.") if T(3);
636                # Get the group line.
637                my ($marker, @groups) = Tracer::GetLine($fh);
638                if (! defined($marker)) {
639                    Confess("End of file found where group record expected.");
640                } elsif ($marker ne '#GROUPS') {
641                    Confess("Group record not found after key record.");
642                } else {
643                    $retVal->Add(memberships => scalar(@groups));
644                    # Connect the groups.
645                    for my $group (@groups) {
646                        # Find out if this is a new group.
647                        if (! $groups{$group}) {
648                            $retVal->Add(newGroup => 1);
649                            # Add the group.
650                            $self->InsertObject('AttributeGroup', { id => $group });
651                            Trace("Group $group created.") if T(3);
652                            # Make sure we know it's not new.
653                            $groups{$group} = 1;
654                        }
655                        # Connect the group to our key.
656                        $self->InsertObject('IsInGroup', { 'from-link' => $id, 'to-link' => $group });
657                    }
658                    Trace("$id added to " . scalar(@groups) . " groups.") if T(3);
659                }
660            }
661        }
662        # Return the result.
663        return $retVal;
664    }
665    
666    
667  =head3 BackupAllAttributes  =head3 BackupAllAttributes
668    
669  C<< my $stats = $attrDB->BackupAllAttributes($fileName, %options); >>  C<< my $stats = $attrDB->BackupAllAttributes($fileName, %options); >>
# Line 568  Line 700 
700      my @keys = $self->GetFlat(['AttributeKey'], "", [], 'AttributeKey(id)');      my @keys = $self->GetFlat(['AttributeKey'], "", [], 'AttributeKey(id)');
701      Trace(scalar(@keys) . " keys found during backup.") if T(2);      Trace(scalar(@keys) . " keys found during backup.") if T(2);
702      # Open the file for output.      # Open the file for output.
703      my $fh = Open(undef, $fileName);      my $fh = Open(undef, ">$fileName");
704      # Loop through the keys.      # Loop through the keys.
705      for my $key (@keys) {      for my $key (@keys) {
706          Trace("Backing up attribute $key.") if T(3);          Trace("Backing up attribute $key.") if T(3);
707          $retVal->Add(keys => 1);          $retVal->Add(keys => 1);
708          # Loop through this key's values.          # Loop through this key's values.
709          my $query = $self->Get(['HasValueFor'], "HasValueFor(to-link) = ?", [$key]);          my $query = $self->Get(['HasValueFor'], "HasValueFor(from-link) = ?", [$key]);
710          my $valuesFound = 0;          my $valuesFound = 0;
711          while (my $line = $query->Fetch()) {          while (my $line = $query->Fetch()) {
712              $valuesFound++;              $valuesFound++;
713              # Get this row's data.              # Get this row's data.
714              my @row = $line->Values(['HasValueFor(from-link)', 'HasValueFor(to-link)',              my @row = $line->Values(['HasValueFor(to-link)', 'HasValueFor(from-link)',
715                                       'HasValueFor(value)']);                                       'HasValueFor(value)']);
716              # Write it to the file.              # Write it to the file.
717              Tracer::PutLine($fh, \@row);              Tracer::PutLine($fh, \@row);
# Line 945  Line 1077 
1077  or an empty string is specified, all values in that section will match. A  or an empty string is specified, all values in that section will match. A
1078  generic match can be requested by placing a percent sign (C<%>) at the end.  generic match can be requested by placing a percent sign (C<%>) at the end.
1079  In that case, all values that match up to and not including the percent sign  In that case, all values that match up to and not including the percent sign
1080  will match.  will match. You may also specify a regular expression enclosed
1081    in slashes. All values that match the regular expression will be returned. For
1082    performance reasons, only values have this extra capability.
1083    
1084  =item RETURN  =item RETURN
1085    
# Line 1035  Line 1169 
1169          my $matching = 1;          my $matching = 1;
1170          for (my $i = 0; $i < $sectionCount && $matching; $i++) {          for (my $i = 0; $i < $sectionCount && $matching; $i++) {
1171              # We need to check to see if this section is generic.              # We need to check to see if this section is generic.
1172              if (substr($values[$i], -1, 1) eq '%') {              my $value = $values[$i];
1173                Trace("Current value pattern is \"$value\".") if T(4);
1174                if (substr($value, -1, 1) eq '%') {
1175                    Trace("Generic match used.") if T(4);
1176                    # Here we have a generic match.
1177                  my $matchLen = length($values[$i] - 1);                  my $matchLen = length($values[$i] - 1);
1178                  $matching = substr($sections[$i], 0, $matchLen) eq                  $matching = substr($sections[$i], 0, $matchLen) eq
1179                              substr($values[$i], 0, $matchLen);                              substr($values[$i], 0, $matchLen);
1180                } elsif ($value =~ m#^/(.+)/[a-z]*$#) {
1181                    Trace("Regular expression detected.") if T(4);
1182                    # Here we have a regular expression match.
1183                    my $section = $sections[$i];
1184                    $matching = eval("\$section =~ $value");
1185              } else {              } else {
1186                    # Here we have a strict match.
1187                    Trace("Strict match used.") if T(4);
1188                  $matching = ($sections[$i] eq $values[$i]);                  $matching = ($sections[$i] eq $values[$i]);
1189              }              }
1190          }          }
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.14
MCS Webmaster
 ViewVC Help
Powered by ViewVC 1.0.3