File Coverage

blib/lib/Util/CommandLine.pm

Criterion	Covered	Total	%
statement	34	66	51.5
branch	2	20	10.0
condition	0	14	0.0
subroutine	10	13	76.9
pod	3	3	100.0
total	49	116	42.2

package Util::CommandLine;
# ABSTRACT: Command-line interface helper utility

use 5.008;
use strict;
use warnings;

use Getopt::Long 'GetOptions';
use Pod::Usage 'pod2usage';
use Proc::PID::File;
use Term::ReadKey 'ReadMode';

our $VERSION = '1.06'; # VERSION

use constant EXPORT_OK => [ qw( options pod2usage singleton readmode ) ];

sub import {
    my $self = shift;

    # determine the caller and setup the exports hash
    my $callpkg = caller();
    my %exports = map { $_ => 1 } grep {
        my $x = $_;
        grep { $_ eq $x } @{(EXPORT_OK)};
    } @_;

    # method injection as appropriate
    {
        no strict 'refs';
        *{"$callpkg\::$_"} = \&{"$self\::$_"} for ( keys %exports );
    }

    singleton() if ( grep { $_ eq 'singleton' } @_ );
    options()   if ( grep { $_ eq 'podhelp'   } @_ );

    return;
}

sub singleton {
    my @dirs = (
        '/var/run',
        '/tmp',
        $ENV{HOME},
        '.',
        '/',
    );

    my $singleton;
    eval {
        if ( Proc::PID::File->running({ dir => shift @dirs }) ) {
            warn "Running as singleton; forcing exit of $0\n";
            exit 1;
        }
        $singleton = 1;
    } while ( not $singleton and @dirs );

    die "Unable to establish PID file for singleton functionality\n" unless ($singleton);

    return;
}

sub options {
    shift if ( index( ( $_[0] || '' ), '::' ) != -1 );

    my $settings = {};
    GetOptions(
        map {
            if (/\{/) {
                $settings->{ ( split(/[|=]/) )[0] } = [];
                $_ => $settings->{ ( split(/[|=]/) )[0] };
            }
            else {
                $_ => \$settings->{ ( split(/[|=]/) )[0] };
            }
        } map { split(/\s+/) } @_, qw( help man )
    ) || pod2usage(0);

    for ( keys %$settings ) {
        delete $settings->{$_} if (
            not defined $settings->{$_} or
            (
                ref $settings->{$_} eq 'ARRAY' and (
                    not @{ $settings->{$_} } or
                    (
                        @{ $settings->{$_} } == 1 and
                        $settings->{$_}[0] eq ''
                    )
                )
            )
        );
    }

    pod2usage( '-exitstatus' => 1, '-verbose' => 1 ) if ( $settings->{'help'} );
    pod2usage( '-exitstatus' => 0, '-verbose' => 2 ) if ( $settings->{'man'}  );

    return $settings;
}

sub readmode {
    return ReadMode(@_);
}

1;

__END__