view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2/Utils.pm  view on Meta::CPAN

package Astro::App::Satpass2::Utils;

use 5.008;

use strict;
use warnings;

use parent qw{ Exporter };

use Cwd ();
use File::HomeDir;
use File::Spec;
use Getopt::Long 2.33;
use Scalar::Util 1.26 qw{ blessed looks_like_number };
use Text::ParseWords ();

our $VERSION = '0.057';

our @CARP_NOT = qw{
    Astro::App::Satpass2
    Astro::App::Satpass2::Copier
    Astro::App::Satpass2::Format
    Astro::App::Satpass2::Format::Dump
    Astro::App::Satpass2::Format::Template
    Astro::App::Satpass2::Format::Template::Provider
    Astro::App::Satpass2::FormatTime
    Astro::App::Satpass2::FormatTime::Cldr
    Astro::App::Satpass2::FormatTime::DateTime
    Astro::App::Satpass2::FormatTime::DateTime::Cldr
    Astro::App::Satpass2::FormatTime::DateTime::Strftime
    Astro::App::Satpass2::FormatTime::POSIX::Strftime
    Astro::App::Satpass2::FormatTime::Strftime
    Astro::App::Satpass2::FormatValue
    Astro::App::Satpass2::FormatValue::Formatter
    Astro::App::Satpass2::Geocode
    Astro::App::Satpass2::Geocode::OSM
    Astro::App::Satpass2::Locale
    Astro::App::Satpass2::Locale::C
    Astro::App::Satpass2::Macro
    Astro::App::Satpass2::Macro::Code
    Astro::App::Satpass2::Macro::Command
    Astro::App::Satpass2::ParseTime
    Astro::App::Satpass2::ParseTime::Code
    Astro::App::Satpass2::ParseTime::Date::Manip
    Astro::App::Satpass2::ParseTime::Date::Manip::v5
    Astro::App::Satpass2::ParseTime::Date::Manip::v6
    Astro::App::Satpass2::ParseTime::ISO8601
    Astro::App::Satpass2::Utils
    Astro::App::Satpass2::Warner
    Astro::App::Satpass2::Wrap::Array
};

our @EXPORT_OK = qw{
    __arguments
    back_end
    __back_end_class_name_of_record
    expand_tilde find_package_pod
    has_method instance load_package merge_hashes my_dist_config quoter
    __date_manip_backend
    __legal_options
    __parse_class_and_args
    ARRAY_REF CODE_REF HASH_REF REGEXP_REF SCALAR_REF
    HAVE_DATETIME
    OS_IS_WINDOWS
    @CARP_NOT
};

our %EXPORT_TAGS = (
    os	=> [ grep { m/ \A OS_ /smx } @EXPORT_OK ],
    ref	=> [ grep { m/ _REF \z /smx } @EXPORT_OK ],
);

use constant ARRAY_REF	=> ref [];
use constant CODE_REF	=> ref sub {};

lib/Astro/App/Satpass2/Utils.pm  view on Meta::CPAN

    foreach my $hash ( @args ) {
	@rslt{ keys %{ $hash } } = values %{ $hash };
    }
    return \%rslt;
}

use constant MY_PACKAGE_NAME	=> 'Astro-App-Satpass2';

sub my_dist_config {
    my ( $opt ) = @_;

    defined $ENV{ASTRO_APP_SATPASS2_CONFIG_DIR}
	and return Cwd::abs_path( $ENV{ASTRO_APP_SATPASS2_CONFIG_DIR} );

    my $code = __PACKAGE__->can( "_my_dist_config_$^O" ) || \&_my_dist_config_;
    return $code->( $opt );
}

sub _my_dist_config_ {
    my ( $opt ) = @_;
    return File::HomeDir->my_dist_config(
	MY_PACKAGE_NAME,
	{ create => $opt->{'create-directory'} },
    );
}

# Called dynamically by my_dist_config() if $^O is 'darwin'.
sub _my_dist_config_darwin {	## no critic (ProhibitUnusedPrivateSubroutines)
    # my ( $opt ) = @_;
    my $rslt = File::HomeDir->my_dist_data( MY_PACKAGE_NAME )
	or goto &_my_dist_config_;
    return $rslt;
}

sub __parse_class_and_args {
    my ( $self, $arg, @rest ) = @_;
    my ( $cls, @val ) =
	Text::ParseWords::parse_line( qr{ , }smx, 0, $arg );
    unless ( defined $cls &&
	$cls =~ m/ \A [_[:alpha:]] \w* (?: :: \w+ )* \z /smx ) {
	$cls = defined $cls ? "'$cls'" : 'undef';
	my $warner = $self->can( 'wail' ) ? $self : $self->warner();
	$warner->wail( "Invalid class name $cls" );
    }
    foreach ( @val ) {
	m/ = /smx
	    or $_ .= '=';
    };
    return ( $cls, ( map { split qr{ = }smx, $_, 2 } @val ), @rest );
}

sub quoter {
    my @args = @_;
    my @rslt = map { _quoter( $_ ) } @args;
    return wantarray ? @rslt : join ' ', @rslt;
}

sub _quoter {
    my ( $string ) = @_;
    return 'undef' unless defined $string;
    return $string if looks_like_number ($string);
    return q{''} unless $string;
    return $string unless $string =~ m/ [\s'"\$] /smx;
    $string =~ s/ ( [\\'] ) /\\$1/smxg;
    return qq{'$string'};
}

1;

__END__

=head1 NAME

Astro::App::Satpass2::Utils - Utilities for Astro::App::Satpass2

=head1 SYNOPSIS

 use Astro::App::Satpass2::Utils qw{ instance };
 instance( $foo, 'Bar' )
    or die '$foo is not an instance of Bar';

=head1 DESCRIPTION

This module is a grab-bag of utilities needed by
L<Astro::App::Satpass2|Astro::App::Satpass2>.

This module is B<private> to the
L<Astro::App::Satpass2|Astro::App::Satpass2> package. Any and all
functions in it can be modified or revoked without prior notice. The
documentation is for the convenience of the author.

All documented subroutines can be exported, but none are exported by
default.

=head1 SUBROUTINES

This module supports the following exportable subroutines:

=head2 back_end

 my ( $class, @args ) = $self->back_end();
 my $back_end = $self->back_end();
 $self->back_end( 'Christian,reform_date=uk' );
 $self->back_end( 'Christian', reform_date => 'uk' );
 $self->back_end( undef );

This mixin is both accessor and mutator for the C<back_end> attribute,
which defines the class name for a L<DateTime|DateTime> back end module,
and any class-specific arguments to be passed to its C<new()> method.

If called without arguments it is an accessor. If called in list context
it returns the class name as specified when it was set, followed by any
arguments to C<new()> that were specified when it was set. If called in
scalar context it returns the class name, with the arguments to C<new()>
appended as C<"name=value"> strings, comma-delimited.

If called with arguments it is a mutator. The first argument is the
class name, possibly with leading C<'DateTime::Calendar::'> omitted)
followed optionally by comma-delimited C<"name=value"> arguments to
C<new()>. Subsequent arguments are name/value pairs of arguments to
C<new()>.