File Coverage

blib/lib/Finance/GeniusTrader/Eval.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Finance::GeniusTrader::Eval;

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

use strict;
use vars qw(@EXPORT @ISA);
#ALL#  use Log::Log4perl qw(:easy);

use Finance::GeniusTrader::Conf;
use Finance::GeniusTrader::ArgsTree;
use Finance::GeniusTrader::Tools qw(:conf);

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(create_standard_object create_db_object get_standard_name get_long_name);

=head1 NAME

Finance::GeniusTrader::Eval - Create unknown standard objects at run-time

=head1 DESCRIPTION

This modules provides several functions to manipulate objects
based on their type name.

=over

=item C<< $object = create_standard_object($object_type, ...) >>

This will create an object of type $object_type. The following parameters
will be passed to the object at creation time.

=cut
sub create_standard_object {
    my ($type, @rawparams) = @_;

    $type = long_name($type);
    $type =~ s#/\d+##g;

    my ($name, @args) = Finance::GeniusTrader::ArgsTree::parse_args(join(" ", @rawparams));
    if ($type =~ /^@(\S+)$/) {
	my $def = resolve_object_alias(long_name($1), @args);
	#DEB#  DEBUG  "Alias $1 maps to $def\n";
	if ($def =~ /^\s*{(.*)}\s*$/) {
	    $def = $1;
	}
	if ($def =~ /^\s*(\S+)\s*(.*)\s*$/) {
	    $type = long_name($1);
	    ($name, @args) = Finance::GeniusTrader::ArgsTree::parse_args($2);
	}
    }

    my $object;
    my $eval = "use Finance::GeniusTrader::$type;\n";
    $eval .= "\$object = Finance::GeniusTrader::$type->new(";
    if (scalar(@args))
    {
	$eval .= "[" . join(",", map { if (/^\d+$/) { $_ } else { "'$_'" } }
				 Finance::GeniusTrader::ArgsTree::args_to_ascii(@args)) . "]";
    }
    $eval .= ");";
    #DEB#  DEBUG  "create_standard_object with: $eval";
    eval $eval;
    die $@ if ($@);

    return $object;
}

=item C<< create_db_object() >>

Return a Finance::GeniusTrader::DB object created based on Finance::GeniusTrader::Conf data. Thus Finance::GeniusTrader::Conf::load()
should be called before this function. If DB::module doesn't exist in the
config, it tries to load the user configuration (supposing it has never been done
before).

=cut
our $db;
sub create_db_object {
    my $db_module = Finance::GeniusTrader::Conf::get("DB::module");
    if (! defined($db_module)) {
	Finance::GeniusTrader::Conf::load();
    }
    if (! defined($db)) {
	$db = create_standard_object("DB::" . Finance::GeniusTrader::Conf::get("DB::module"));
    }
    return $db;
}

=item C<< get_standard_name($object, $shorten, $number) >>

Return the standard name of an object that can be later used to
create it again.

=cut
sub get_standard_name {
    my ($object, $shorten, $number) = @_;
    $shorten = 1 if (! defined($shorten));
    my $n = ref($object);
    $n =~ s/Finance::GeniusTrader:://g;
    if ($shorten)
    {
	$n = short_name($n);
    }
    if (defined($number) && $number) {
	$n .= "/" . ($number + 1);
    }
    if (ref($object->{'args'}) =~ /Finance::GeniusTrader::ArgsTree/) {
	$n .= " " . join(" ", $object->{'args'}->get_arg_names());
    } elsif (scalar(@{$object->{'args'}})) {
	$n .= " " . join(" ", @{$object->{'args'}});
    }
    return $n;
}

=item C<< get_long_name ($code) >>

Returns the long name of the market (if defined).

See also ~/.gt/sharenames which contains lines of the form
\t
mapping a market code to its long name.

=cut
sub get_long_name {
    my $code = shift;

    $db = create_db_object() unless $db;
    return $db->get_name($code);
}

=pod

=back

=cut
1;