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

View of /FigKernelPackages/FIGMODELObject.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (as text) (annotate)
Wed Apr 21 22:18:05 2010 UTC (9 years, 6 months ago) by chenry
Branch: MAIN
CVS Tags: rast_rel_2010_0827, rast_rel_2010_0928, rast_rel_2010_0526, rast_rel_2010_1206
Changes since 1.3: +18 -0 lines
Implemented new function to change the name of a date header.

# -*- perl -*-
########################################################################
#
# Table object for the model database interaction module
# Initiating author: Christopher Henry
# Initiating author email: chrisshenry@gmail.com
# Initiating author affiliation: Mathematics and Computer Science Division, Argonne National Lab
# Date of module creation: 2/1/2008
########################################################################

use strict;
use FIGMODEL;

package FIGMODELObject;

=head1 Object module for the model database interaction module

=head2 Public Methods

=head3 new
Definition:
	my $Object = FIGMODELObject->new($headings,$filename,$delimiter);
Description:
	Creates an empty object that may be populated by the user.
Example:
	my $Object = FIGMODELObject->new($heading_list,$filename,$delimiter);
=cut

sub new {
	my ($ObjectType,$headings,$filename,$delimiter) = @_;

	if (!defined($filename) || !defined($headings)) {
		print STDERR "FIGMODELObject:new: cannot create object without a list of headings and a filename\n";
		return undef;
	}

	my $self;
	$self->{"file IO settings"}->{"filename"}->[0] = $filename;
	$self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
	$self->{"file IO settings"}->{"orderedkeys"}->[0] = shift(@{$headings});
	bless $self;
	$self->add_headings(@{$headings});

	return $self;
}

=head3 get_data_size
Definition:
	my $Size = $Object->get_data_size($Key);
Description:
	Returns the number of elements stored in a particular key.
Example:
	my $Size = $Object->get_data_size($Key);
=cut

sub get_data_size {
	my ($self,$Key) = @_;

	my $Size = 0;
	if (defined($self->{$Key})) {
		$Size = @{$self->{$Key}};
	}

	return $Size;
}

=head3 get_data
Definition:
	my $DataArrayRef = $Object->get_data($Key);
Description:
	Returns a reference to the array stored in Key.
Example:
	my DataArrayRef = $Object->get_data($Key);
=cut

sub get_data {
	my ($self,$Key) = @_;

	if (defined($self->{$Key})) {
		return $self->{$Key};
	}

	return undef;
}

=head3 filename
Definition:
	my $filename = $Object->filename();
Description:
	Returns the filename for the object.
Example:
	my $filename = $Object->filename();
=cut

sub filename {
	my ($self,$NewFilename) = @_;

	if (defined($NewFilename)) {
		$self->{"file IO settings"}->{"filename"}->[0] = $NewFilename;
	}

	return $self->{"file IO settings"}->{"filename"}->[0];
}

=head3 delimiter
Definition:
	my $delimiter = $Object->delimiter();
Description:
	Returns the delimiter for the object.
Example:
	my $delimiter = $Object->delimiter();
=cut

sub delimiter {
	my ($self,$NewDelimiter) = @_;

	if (defined($NewDelimiter)) {
		$self->{"file IO settings"}->{"delimiter"}->[0] = $NewDelimiter;
	}

	return $self->{"file IO settings"}->{"delimiter"}->[0];
}

=head3 headings
Definition:
	my $Headings = $Object->headings();
Description:
	Returns an array reference containing the headings for the object.
Example:
	my $Headings = $Object->headings();
=cut

sub headings {
	my ($self) = @_;
	return $self->{"file IO settings"}->{"orderedkeys"};
}

=head3 add_data
Definition:
	my $Count = $Object->add_data($Data,$Key,$Unique);
Description:
	Adds $Data to the array stored in $Key. If $Unique is specified and equal to "1", only new data is added to the array.
	Returns "1" if data was added and "0" if no data was added
Example:
	my $Count = $Object->add_data($Data,$Key,$Unique);
=cut

sub add_data {
	my ($self,$DataArray,$Key,$Unique) = @_;

	if (defined($DataArray)) {
		foreach my $Data (@{$DataArray}) {
			#Now checking if the heading exists and if the $Data is unique
			if (!defined($Unique) || $Unique ne 1 || $self->data_exists($Data,$Key) == 0) {
				#Adding the data
				if (defined($self->get_data($Key))) {
					push(@{$self->get_data($Key)},$Data);
				} else {
					$self->{$Key}->[0] = $Data;
				}
			}
		}
	}

	return 0;
}

=head3 data_exists
Definition:
	my $Result = $Object->data_exists($Data,$Key);
Description:
	Returns "1" if the input $Data matches one of the entries in the array stored in $Key.
Example:
	my $Result = $Object->data_exists($Data,$Key);
=cut

sub data_exists {
	my ($self,$Data,$Key) = @_;

	if ($self->get_data_size($Key) > 0) {
		for (my $i=0; $i < $self->get_data_size($Key); $i++) {
			if ($self->get_data($Key)->[$i] eq $Data) {
				return 1;
			}
		}
	}

	return 0;
}

=head3 delete_key
Definition:
	$Object->delete_key($Key);
Description:
	Deletes a key from the object.
Example:
	$Object->delete_key($Key);
=cut

sub delete_key {
	my ($self,$Key) = @_;

	if ($self->get_data_size($Key) > 0) {
		delete $self->{$Key};
		$self->remove_heading($Key);
	}
}

=head3 remove_data
Definition:
	$Object->remove_data(@Data,$Key);
Description:
	Removes the data specified in @Data from the array stored in $Key.
Example:
	$Object->remove_data(@Data,$Key);
=cut

sub remove_data {
	my ($self,@Data,$Key) = @_;

	if ($self->get_data_size($Key) > 0) {
		for (my $i=0; $i < $self->get_data_size($Key); $i++) {
			foreach my $Item (@Data) {
				if ($Item eq $self->get_data_size($Key)->[$i]) {
					splice(@{$self->get_data()},$i,1);
					$i--;
					last;
				}
			}
		}
	}

	if ($self->get_data_size($Key) == 0) {
		delete $self->{$Key};
		$self->remove_heading($Key);
	}
}

=head3 remove_heading
Definition:
	$Object->remove_heading($Key);
Description:
	Removes the specified heading from the heading list
Example:
	$Object->remove_heading($Key);
=cut

sub remove_heading {
	my ($self,$Key) = @_;

	for (my $i=0; $i < @{$self->headings()}; $i++) {
		if ($self->headings()->[$i] eq $Key) {
			splice(@{$self->headings()},$i,1);
			$i--;
		}
	}
}

=head3 rename_heading

Definition:
	FIGMODELObject->rename_heading(string:old name,string:new name);
Description:
	Renames a heading

=cut
sub rename_heading {
	my ($self,$old,$new) = @_;
	for (my $i=0; $i < @{$self->headings()}; $i++) {
		if ($self->headings()->[$i] eq $old) {
			$self->headings()->[$i] = $new;
			$self->{$new} = $self->{$old};
		}
	}
}

=head3 add_headings
Definition:
	$Object->add_headings(@Headings);
Description:
	Adds new headings to the table. This is needed to get the object to print the data under the new heading.
Example:
	$Object->add_headings("Notes");
=cut

sub add_headings {
	my ($self,@Headings) = @_;

	foreach my $Heading (@Headings) {
		if (defined($self->headings())) {

            #First check if the heading already exists
            foreach my $ExistingHeading (@{$self->headings()}) {
                if ($Heading eq $ExistingHeading) {
                    $Heading = "";
                    last;
                }
            }
        }
        if ($Heading ne "") {
            push(@{$self->{"file IO settings"}->{orderedkeys}},$Heading);
        }
	}
}

=head3 save
Definition:
	$Object->save($filename,$delimiter);
Description:
	Saves the object to a horizontal table file
Example:
	$Object->save("cpd00001.txt","\t");
=cut

sub save {
	my ($self,$filename,$delimiter) = @_;

	$self->filename($filename);
	$self->delimiter($delimiter);
	if (open (HASHTOHORIZONTALOUTPUT, ">".$self->filename())) {
		foreach my $Item (@{$self->headings()}) {
			if ($self->get_data_size($Item) > 0) {
				print HASHTOHORIZONTALOUTPUT $Item.$self->delimiter().join($self->delimiter(),@{$self->get_data($Item)})."\n";
			}
		}
		close(HASHTOHORIZONTALOUTPUT);
	}
}

=head3 load
Definition:
	my $Object = FIGMODELObject->load($filename,$delimiter);
Description:
	Loads an object from file.
Example:
	my $Object = FIGMODELObject->load($filename,$delimiter);
=cut

sub load {
	my ($ObjectType,$filename,$delimiter) = @_;

	if (!defined($filename) || !defined($delimiter)) {
		print STDERR "FIGMODELObject:new: cannot load object without filename and delimiter\n";
		return undef;
	}

	my $self = {};
    bless $self;
	$self->filename($filename);
	$self->delimiter($delimiter);
    if (open (INPUT, "<".$self->filename())) {
		while (my $Line = <INPUT>) {
			chomp($Line);
			my $Delimiter = $self->delimiter();
			my @Data = split(/$Delimiter/,$Line);
			my $Heading = shift(@Data);
			my $Temp;
			push(@{$Temp},@Data);
			$self->add_data($Temp,$Heading);
			$self->add_headings(($Heading));
		}
		close(INPUT);
		return $self;
	}
	print STDERR "FIGMODELObject:load: could not load ".$self->filename()."\n";
	return undef;
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3