File Coverage

blib/lib/Getopt/Janus.pm

Criterion	Covered	Total	%
statement	32	41	78.0
branch	5	12	41.6
condition	7	16	43.7
subroutine	15	20	75.0
pod	10	14	71.4
total	69	103	66.9

require 5;
package Getopt::Janus;
use strict;

require Exporter;
# TODO: progress meters?

BEGIN {
  if(defined &DEBUG) {
    # no-op
  } elsif( ($ENV{'JANUSDEBUG'} || '') =~ m/^(-?\d+)$/s) {
    eval "sub DEBUG () {$1}";
    die "INSANE! $@" if $@;
  } else {
    *DEBUG = sub () {0};
  }
}

use vars qw(@ISA %EXPORT_TAGS @EXPORT $VERSION
  @New_files $Facade_class $facade_obj
);
@ISA = ('Exporter');
%EXPORT_TAGS = ('ALL' => \@EXPORT);
$VERSION = '1.03';
@EXPORT = qw{
 yes_no string file new_file choose
 license_artistic license_gnu license_either
 licence_artistic licence_gnu licence_either
 run
 note_new_files note_new_file
};
$Facade_class ||= __PACKAGE__ . '::Facade';
DEBUG and print "Facade class: $Facade_class\n";

# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
sub run      ($@)   { _self()->     run(@_) }

sub string   (\$$@) { _self()->  string(@_) }
sub new_file (\$$@) { _self()->new_file(@_) }
sub file     (\$$@) { _self()->    file(@_) }
sub yes_no   (\$$@) { _self()->  yes_no(@_) }
sub choose   (\$$@) { _self()->  choose(@_) }

sub license_artistic () { _self()->license_artistic(@_) }
sub license_gnu      () { _self()->license_gnu(@_) }
sub license_either   () { _self()->license_either(@_) }
# variant spelling:
sub licence_artistic () { _self()->license_artistic(@_) }
sub licence_gnu      () { _self()->license_gnu(@_) }
sub licence_either   () { _self()->license_either(@_) }

sub note_new_file     { push @New_files, @_; }
sub note_new_files    { goto ¬e_new_file; } # alias

# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

sub _self {   # This is the only place where we construct
  return $facade_obj ||=
    ( _require($Facade_class) || die "Can't load $Facade_class: $@"
    )->new()
}

sub _require {  # returns classname if loadable, or nil if not
  my $class = $_[0];
  unless( defined $class and length $class ) {
    require Carp;
    Carp::confess( "What class?" );
  }

  {
    no strict 'refs';
    unless( # unless it's already loaded...
      defined( ${"$class\::VERSION"} )
      or @{"$class\::ISA"}
      or defined &{"$class\::new"}
    ) {
      eval "require $class";
      return if $@;
      DEBUG and print "Loaded $class fine.\n";
    }
  }
  return $class;
}


# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

1;
__END__