File Coverage

blib/lib/Business/Shipping/Config.pm

Criterion	Covered	Total	%
statement	91	134	67.9
branch	13	24	54.1
condition	0	10	0.0
subroutine	28	33	84.8
pod	8	10	80.0
total	140	211	66.3

package Business::Shipping::Config;

=head1 NAME

Business::Shipping::Config - Configuration functions

=head1 DESCRIPTION

Among other things, this module implements a simple API on top of the
Config::IniFiles module.

=head1 METHODS

=cut

use strict;
use warnings;

use constant DEFAULT_CONFIG_DIR => '/usr/local/B_Shipping/config';

#use constant DEFAULT_CONFIG_DIR => '~_~DEFAULT_CONFIG_DIR~_~';

use constant DEFAULT_DATA_DIR => '/usr/local/B_Shipping/data';

#use constant DEFAULT_DATA_DIR => '~_~DEFAULT_DATA_DIR~_~';

use base ('Exporter');
use Config::IniFiles;
use Business::Shipping::Logging;
use Carp;
use Cwd;
use version; our $VERSION = qv('400');
use vars qw(@EXPORT);

@EXPORT = qw/ cfg cfg_obj config_to_hash config_to_ary_of_hashes /;
$Business::Shipping::Config::config_dir             = '';
$Business::Shipping::Config::data_dir               = '';
$Business::Shipping::Config::main_config_file       = '';
$Business::Shipping::Config::data_dir_test_filename = 'this_is_the_data_dir';

sub data_dir_test_filename {
    return $Business::Shipping::Config::data_dir_test_filename;
}

# Try the current directory first.
if (-f './config/config.ini') {
    $Business::Shipping::Config::config_dir = './config';
}
if (-f './data/' . data_dir_test_filename()) {
    $Business::Shipping::Config::data_dir = './data';
}
elsif (-f '../Business-Shipping-DataFiles/data/' . data_dir_test_filename()) {
    $Business::Shipping::Config::data_dir
        = '../Business-Shipping-DataFiles/data/';
}

# Then try environment variables
$Business::Shipping::Config::data_dir   ||= $ENV{B_SHIPPING_DATA_DIR};
$Business::Shipping::Config::config_dir ||= $ENV{B_SHIPPING_CONFIG_DIR};

# Then fall back on the default.
$Business::Shipping::Config::data_dir   ||= DEFAULT_DATA_DIR;
$Business::Shipping::Config::config_dir ||= DEFAULT_CONFIG_DIR;

my $cwd = Cwd::getcwd;
die "Config dir could not be found.  Current working dir: $cwd."
    if (!-d $Business::Shipping::Config::config_dir);
die "Data dir could not be found.  Current working dir: $cwd."
    if (!-d $Business::Shipping::Config::config_dir);

$Business::Shipping::Config::main_config_file
    = "$Business::Shipping::Config::config_dir/config.ini";

if (!-f $Business::Shipping::Config::main_config_file) {
    die "Could not open main configuration file: "
        . "$Business::Shipping::Config::main_config_file: $!";
}

# Number of times to try for online requrests.  See Online.pm.
$Business::Shipping::Config::Try_Limit = 2;

tie my %cfg, 'Config::IniFiles',
    (-file => $Business::Shipping::Config::main_config_file);
my $cfg_obj = Config::IniFiles->new(
    -file => $Business::Shipping::Config::main_config_file);

=head2 cfg()

Returns config hashref.

=head2 cfg_obj()

Returns config hashref.

=head2 support_files()

Returns the path of the support_files directory.

=cut

sub cfg        { return \%cfg; }
sub cfg_obj    { return $cfg_obj; }
sub data_dir   { return $Business::Shipping::Config::data_dir }
sub config_dir { return $Business::Shipping::Config::config_dir }

=head2 config_to_hash( $ary, $del )

 $ary   Key/value pairs
 $del   Delimiter for the above array (tab is default)

Builds a hash from an array of lines containing key / value pairs, like so:

 key1    value1
 key2    value2
 key3    value3

=cut

sub config_to_hash {
    my ($ary, $delimiter) = @_;
    return unless $ary and ref($ary) eq 'ARRAY';

    $delimiter ||= "\t";
    my $hash = {};

    foreach my $line (@$ary) {
        my ($key, $val) = split($delimiter, $line);
        $hash->{$key} = $val;
    }

    return $hash;
}

=head2 config_to_ary_of_hashes( 'configuration_parameter' )

Reads in the configuration hashref ( e.g. cfg()->{ primary }->{ secondary } ),
then returns an array of hashes.  For example:

This:

 [invalid_rate_requests]
 invalid_rate_requests_ups=<
 service=XDM    to_country=Canada    reason=Not available.
 service=XDM    to_country=Brazil
 EOF

When called with this:

 my @invalid_rate_requests_ups = config_to_ary_of_hashes(
     cfg()->{ invalid_rate_requests }->{ invalid_rate_requests_ups }
 );

Returns this:

 [
     {
         service    => 'XDM',
         to_country => 'Canada',
	 reason     => 'Not available.',
     },
     {
         service    => 'XDM',
         to_country => 'Brazil',
     },
 ]

=cut

sub config_to_ary_of_hashes {
    my ($cfg) = @_;

    my @ary;
    foreach my $line (@$cfg) {

        # Convert multiple tabs into one tab, remove the leading tab.
        # Split on the tabs to get key=val pairs, then split on the '='.
        $line =~ s/\t+/\t/g;
        $line =~ s/^\t//;
        my @key_val_pairs = split("\t", $line);
        next unless @key_val_pairs;

        # Each line becomes a hash.
        my $hash = {};
        foreach my $key_val_pair (@key_val_pairs) {
            my ($key, $val) = split('=', $key_val_pair);
            next unless (defined $key and defined $val);
            $hash->{$key} = $val;
        }

        push @ary, $hash if (%$hash);
    }

    return @ary;
}

=head2 data_dir_name()

The name of the data_dir (e.g. "data").

=cut

sub data_dir_name {

    # name only.
    return cfg()->{general}->{data_dir_name} || 'data';
}

=head2 data_dir()

The path of the data_dir (e.g. "/var/perl/Business-Shipping/data").

=cut

=head2 get_req_mod()

Return a list of the required modules for a given shipper.  Return all if no
shipper is given.

=cut

sub get_req_mod {
    my (%opt) = @_;
    my $shipper = $opt{shipper};

    my $req_mod = {
        'Minimum' => [
            qw/
                Any::Moose
                Log::Log4perl
                Business::Shipping
                /
        ],
        'UPS_Offline' => [
            qw/
                Business::Shipping::DataFiles
                Config::IniFiles
                /
        ],
        'UPS_Online' => [
            qw/
                CHI
                Crypt::SSLeay
                Date::Parse
                LWP::UserAgent
                XML::DOM
                XML::Simple
                /
        ],
        'USPS_Online' => [
            qw/
                CHI
                Crypt::SSLeay
                Date::Parse
                LWP::UserAgent
                XML::DOM
                XML::Simple
                /
        ],

    };
    if ($opt{get_hash}) {
        return $req_mod;
    }
    if ($shipper) {
        my $module_list = $req_mod->{$shipper};
        return @$module_list;
    }
    else {
        my @all_modules;
        foreach my $key (keys %$req_mod) {
            my $module_list = $req_mod->{$shipper};
            push @all_modules, @$module_list;
        }
        return @all_modules;
    }
}

=head2 calc_req_mod()

Determine if the required modules for each shipper are available, in turn.

=cut

sub calc_req_mod {
    my ($one_shipper) = @_;

    my @avail;
    my $req_mod = get_req_mod(get_hash => 1);

    if ($one_shipper) {
        foreach my $shipper (keys %$req_mod) {
            if ($shipper ne $one_shipper) {
                delete $req_mod->{$shipper};
            }
        }
    }
    my @to_load;
SHIPPER: while (my ($shipper, $list) = each %$req_mod) {
        @to_load = ();
    MODULE: foreach my $module (@$list) {
            eval "use $module";
            if ($@) {
                $@ = '';

                # "Could not load $module";
                next SHIPPER;
            }
            else {
                push @to_load, $module;
                next MODULE;
            }
        }
        if (!$@) {
            push @avail, $shipper;
        }
    }
    if ($one_shipper) {
        if (grep $one_shipper, @avail) {
            return 1;
        }
        else {
            return 0;
        }
    }
    else {
        return @avail;
    }
}
1;

__END__