Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2005 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Perl Package
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : This package contains functions to 'properties' files
#                 These are used in a few placed to simplify Perl/Java
#                 interoperatbility
#
#                 A properteis file is a simple text file
#                 Line comments atsrt with a "#" and are not preserved
#                 Non-empty lines are of the form
#                     tag=value
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

package JatsProperties;

use JatsError;

#-------------------------------------------------------------------------------
# Function        : New
#
# Description     : Create a new properties object
#                   Reads in  file and populates the internal data
#
# Inputs          : $filename           - Optional File Name
#
# Returns         : Object
#
sub New
{
    my ($filename) = @_;
    my ($self) = {
            FILE            => undef,
            PROP            => {},
        };

    #
    #   Read in an existing properties file
    #
    load ($self, $filename) if ( $filename );

    #
    #   Now I am a class
    #
    return bless $self, __PACKAGE__;
}

#-------------------------------------------------------------------------------
# Function        : load
#
# Description     : Load properties from a file
#
# Inputs          : $filename to file to read
#
# Returns         : 
#
sub load
{
    my ($self, $filename) = @_;
    $self->{FILE} = $filename;

    open (PF, "<$filename") || Error ("Cannot open file: $filename", "Reason: $!");
    while ( <PF> )
    {
        next if ( m~^\s*#~ );
        next unless ( m~^\s*(.+)=(.*)\s*~ );
        $self->{PROP}{$1} = $2;
    }
    close PF;
}

#-------------------------------------------------------------------------------
# Function        : getProperty
#
# Description     : 
#
# Inputs          : $name       - Property to get
#                   $default    - Optional default value
#
# Returns         : 
#
sub getProperty
{
    my ($self, $name, $default) = @_;
    
    if ( exists $self->{PROP}{$name} )
    {
        return $self->{PROP}{$name};
    }
    else
    {
        return $default;
    }
}

#-------------------------------------------------------------------------------
# Function        : setProperty
#
# Description     : 
#
# Inputs          : $name       - Property to set
#                   $value      - VAlue to set
#
# Returns         : 
#
sub setProperty
{
    my ($self, $name, $value) = @_;

    $self->{PROP}{$name} = $value;
}

#-------------------------------------------------------------------------------
# Function        : enum
#
# Description     : Enumerat all properties
#
# Inputs          : None
#
# Returns         : Array of properties names
#
sub enum
{
    my ($self) = @_;
    return sort keys %{$self->{PROP}}
}

#-------------------------------------------------------------------------------
# Function        : store
#
# Description     : Store properties into a file
#
# Inputs          : $filename       - to file to create
#                                     Will use the 'load' file
#                                     if not provided.
#
# Returns         : 
#
sub store
{
    my ($self, $filename) = @_;

    $filename = $self->{FILE} unless ( $filename );
    Error ("No file to store properties") unless ( $filename );

    open (PF, ">$filename") || Error ("Cannot create file: $filename", "Reason: $!");
    print PF  '#' . localtime() . "\n";
    foreach my $name ( sort keys %{$self->{PROP}} )
    {
        my $value = $self->{PROP}{$name};
        print PF "$name=$value\n";
    }
    close PF;
}

#-------------------------------------------------------------------------------
# Function        : Dump
#
# Description     : Debugging aid only
#                   Will dump the properties list as 'Information'
#
# Inputs          : text            - Prefix text (optional)
#
# Returns         : 
#
sub Dump
{
    my ($self, $text) = @_;
    $text .= ': ' if ( $text );
    $text = '' unless ( $text );

    foreach my $name ( sort keys %{$self->{PROP}} )
    {
        Information ("$text$name=" . $self->{PROP}{$name} );
    }
}

1;