View of /Sprout/BaseSaplingLoader.pm

#!/usr/bin/perl -w

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
#
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License.
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

package BaseSaplingLoader;

    use strict;
    use Tracer;
    use ERDB;
    use FIG;
    use Time::HiRes;
    use base 'ERDBLoadGroup';
    
    # Name of the global section
    use constant GLOBAL => 'Globals';

=head1 Sapling Load Group Base Class

=head2 Introduction

This is the base class for all the Sapling loaders. It performs common tasks
required by multiple load groups.

=head3 new

    my $sl = BaseSaplingLoader->new($erdb, $options, @tables);

Construct a new BaseSaplingLoader object.

=over 4

=item erdb

[[SaplingPm]] object for the database being loaded.

=item source

[[FigPm]] object used to access the source data.

=item options

Reference to a hash of command-line options.

=item tables

List of tables in this load group.

=back

=cut

sub new {
    # Get the parameters.
    my ($class, $erdb, $options, @tables) = @_;
    # Create the base load group object.
    my $retVal = ERDBLoadGroup::new($class, $erdb, $options, @tables);
    # Return it.
    return $retVal;
}


=head2 Public Methods

=head3 global

    my $flag = $sl->global();

Return TRUE if the current section is the global section.

=cut

sub global {
    my ($self) = @_;
    # Get the database.
    my $sapling = $self->db();
    # Get the section ID.
    my $section = $self->section();
    # Ask the DB object if this is the global section.
    return $sapling->GlobalSection($section);
}

=head3 Starless

    my $adjusted = $sl->Starless($codeString);

Remove any spaces and leading or trailing asterisks from the incoming string and
return the result.

=over 4

=item codeString

Input string that needs to have the asterisks trimmed.

=item RETURN

Returns the incoming string with spaces and leading and trailing asterisks
removed.

=back

=cut

sub Starless {
    # Get the parameters.
    my ($self, $codeString) = @_;
    # Declare the return variable.
    my $retVal = $codeString;
    # Remove the spaces.
    $retVal =~ s/ //g;
    # Trim the asterisks.
    $retVal =~ s/^\*+//;
    $retVal =~ s/\*+$//;
    # Return the result.
    return $retVal;
}

=head3 AnalyzeSubsystemName

    my ($subsystemName, $subsystemID) = $sl->AnalyzeSubsystemName($rawSubsystemName);

This method will analyze the name of a subsystem, computing from it the
display name and its ID for use in the database. The display name has
underscores converted to spaces, and the ID is an MD5 digest.

=over 4

=item rawSubsystemName

The raw name of the subsystem.

=item RETURN

Returns a two-element list, the first element being the subsystem's display
name, and the second its ID.

=back

=cut

sub AnalyzeSubsystemName {
    # Get the parameters.
    my ($self, $rawSubsystemName) = @_;
    # Compute the subsystem's display name.
    my $subsystemName = $rawSubsystemName;
    $subsystemName =~ tr/_/ /;
    # Compute the ID.
    my $subsystemID = $self->db()->SubsystemID($rawSubsystemName);
    # Return the results.
    return ($subsystemName, $subsystemID);
}


1;