[GT] Re: Re: Bug fixes in GT::Conf

[Nick Fantes Huege <nfhuege AT gmail.com>]

ras,

Attached is the corrected version of Conf.pm. It performs better than
the original one based on your test configuration file.
I also put all comments and pod back.

Regards,
Nick

package GT::Conf;

# Copyright 2000-2002 RaphaÃl Hertzog, Fabien Fulhaber
# enhancements by ras copyright 2007-2008
# This file is distributed under the terms of the General Public License
# version 2 or (at your option) any later version.

# $Id: Conf.pm 690 2009-07-30 05:18:51Z ras $

use strict;
use vars qw(%conf);

=head1 NAME

GT::Conf - Manage configuration

=head1 DESCRIPTION

This module provides functions to manage personal GeniusTrader configuration.
The configuration information are stored in file ~/.gt/options by default.

The configuration file format is similar to a perl hash, in other words, a key
followed by data for that key. keys are delimited from their value by whitespace.
key values can contain embedded whitespace.

key value strings can be continued across multiple lines by delimiting the
newline with a backslash (\) (watch out for trailing whitespace after the \ and
before the newline).

comments introduced with a # as the first character on a line. data lines
cannot contain a comment since the # character is used in many data strings.

blank lines and lines with only whitespace are ignored.

=head1 EXAMPLES of ~/.gt/options Entries

 # this is an example of a comment

 DB::module genericdbi

 DB::bean::dbname beancounter

 Graphic::Candle::UpBorderColor "[0,180,80]"

 Graphic::Candle::DownBorderColor "[180,0,80]"

this example shows how continuing key values across lines can be useful.

 DB::genericdbi::prices_sql SELECT day_open, day_high, day_low, \
   day_close, volume, date FROM stockprices WHERE symbol = '$code' ORDER \
   BY date DESC

comments are permitted on data lines provided they can be distinguished from
positional arguments markers (e.g. #1, #2, etc). in order to do this any
trailing data line comment marker (#) must be surrounded by whitespace.
the code is a bit more forgiving, using this regex (\s+#[\s\D]+.$)

note that the comment must follow the end of the logical data line
and terminates at the end of the logical line. logical line means the
line after continuation processing has completed.

examples:
 
  Aliases::Global::TFS2[]	SY:TFS #1 #2 | CS:SY:TFS #1 # comment
  graphic::positions::buycolor	"[0,135,0]" # very dark green
  graphic::buysellarrows::buycolor	"[0,135,0,64]" # semitransparent dark green

 note: configuration keys are lower cased automatically regardless of how
       they are defined, but their values are as specified when defined

=head1 FUNCTIONS

=item C<< GT::Conf::load([ $file ]) >>

Load the configuration from the indicated file. If the file is omitted
then it looks at ~/.gt/options by default.

=cut


BEGIN {
    $conf{'HOMEPATH'} = $ENV{'HOME'} || $ENV{'USERPROFILE'} || '';
}

sub load {
    my $file = $_[0] || "$conf{'HOMEPATH'}/.gt/options";

    if ( !-r $file ) {
        warn("Could not find configuration file: $file");
        return;
    }

    open( FILE, '<', $file ) || die "Can't read $file: $!\n";
    my $line = '';
    my $num  = 0;						
    while (<FILE>) {

        # Keep track of line numbers
        $num++;

        # Remove trailing spaces
        chop while /(\n|\r|\s)$/;

        # Remove leading spaces
        s/^\s+//;

        # Remove inline comments. Everything behind a '#' is a comment,
        # except a number
        s/\s*#\D+.*$//;

        # Remove first '#' comments.
        # Someone should merge this regex with the above.
        s/^#.*//;

        $line .= $_;
        next if $line =~ s/\\$/ / || !$line;

        # Remove extra spaces
        $line =~ tr/[ \t]/[ \t]/s;

        # Split the first two columns
        my ( $key, $val ) = split /\s+/, $line, 2;

        if ( exists $conf{ lc($key) } ) {
            warn "'$key' already defined, skipping. Line $num in $file\n";
        }
        else {

            # All config goes in lowercase
            $conf{ lc($key) } = $val;
        }
        $line = '';
    }
    close FILE;

    foreach my $kind (
        "Signals",         "Indicators",
        "Systems",         "CloseStrategy",
        "MoneyManagement", "TradeFilters",
        "OrderFactory",    "Analyzers"
      )
    {
        foreach my $file (
            "$conf{'HOMEPATH'}/.gt/aliases/" . lc($kind),
            GT::Conf::get("Path::Aliases::$kind")
          )
        {
            next unless defined $file;
            next if not -e $file;
            open( ALIAS, "<$file" ) || die "Can't open $file : $!\n";
            while (<ALIAS>) {
                if (/^\s*(\S+)\s+(.*)$/) {
                    GT::Conf::default( "Aliases::$kind\::$1", $2 );
                }
            }
            close ALIAS;
        }
    }

}

=item C<< GT::Conf::store($file) >>

Write all the current configuration in the given file. Note: all prior
commentary, if any is lost.

=cut
sub store {
    my $file = $_[0] || "$conf{'HOMEPATH'}/.gt/options";
    open( FILE, ">$file" ) || die "Can't write $file: $!\n";
    for ( sort keys %conf ) { printf FILE "$_\t$conf{$_}\n" }
    close FILE;
}

=item C<< GT::Conf::clear() >>

Clear all the configuration.

=cut
sub clear { %conf = () }

=item C<< GT::Conf::get($key,$defaultValue) >>

Return the configuration value for the given key. If the
key doesn't exist, it returns the optional defaultValue.

If neither the key nor defaultValue exist, it returns undef.

=cut
sub get { return $conf{ lc( $_[0] ) } || $_[1] || undef }

=item C<< GT::Conf::set($key, $value) >>

Set the given configuration item to the corresponding value. Replaces any
previous value.

=cut
sub set { $conf{ lc( $_[0] ) } = $_[1] }

=item C<< GT::Conf::vars >>

Returns all config values in a hash ref. Example:
my $conf = GT::Conf::vars();
print "My DB module is $conf->{'db::module'}\n";

=cut
sub vars { return \%conf }

=item C<< GT::Conf::default($key, $value) >>

Set a default value to the given item. Must be called by GT itself to
give reasonable default values to most of configurations items.

=cut
sub default {
    my ( $key, $val ) = @_;
    $key = lc($key);
    if ( !defined( $conf{$key} ) ) {
        $conf{$key} = $val;
    }
}

=item C<< GT::Conf::get_first($key, ...) >>

Return the value of the first item that does have a non-zero value.

=cut
sub get_first {
    my (@keys) = @_;
    foreach (@keys) {
        my $value = &get($_);
        return $value if ( defined($value) && $value );
    }
    return '';
}

=item C<< GT::Conf::=_get_home_path() >>

Helper function, returns the home directory environment variable HOME on Unix
or on windows the environment variables HOMEDRIVE . HOMEPATH

=cut
sub _get_home_path { return $conf{'HOMEPATH'} }

=item C<< GT::Conf::conf_dump( [ "regex" ] ) >>

Helper function, writes the entire configure key=value pairs on stderr.
code example: GT::Conf::conf_dump;

pass a perl regex string to filter the output

=cut
sub conf_dump {
    my $regex = $_[0] || '.*';
    print STDERR
      "gt configuration file keys and values filtered using \"$regex\"\n";
    printf STDERR "%s\t%-36s\t%-s\n", "item", "key", "value";
    my $i = 0;
    foreach ( sort keys %conf ) {
        ( grep m/$regex/i, $_ )
          ? printf STDERR "%3d\t%-36s\t%-s\n", $i, $_, $conf{$_}
          : ();
        ++$i;
    }
    print STDERR "\n\n";
}

=pod

=back

=cut

=item C<< my $gt_root_dir = GT::Conf::get_gt_root() >>

Helper function, returns the gt root directory
which is the directory that contains GT and Scripts
directories, along with any others that may be there.
if that configuration key-value is unset check for the
environment variable GT_ROOT otherwise returns an empty string

=cut
sub get_gt_root { return &get('GT::Root') || $ENV{'GT_ROOT'} || '' }

1;