view release on metacpan or  search on metacpan

lib/Crane/Options.pm  view on Meta::CPAN

    return state $options = do {
        load_options(scalar @_ ? @_ : ( $OPT_VERSION, $OPT_HELP ));
    };
    
}


sub args {
    
    return state $args = [ @ARGV ];
    
}


sub load_options {
    
    my @options = grep { ref $_ eq 'ARRAY' } @_;
    my $options = {};
    
    {
        local $WARNING = 0;
        
        # Parse command line
        GetOptionsFromArray(\@ARGV, $options, grep { defined } map { $_->[0] } @options);
    }
    
    # Application file name
    my $app = basename($PROGRAM_NAME);
    
    # Show version information and exit
    if ( $options->{'version'} ) {
        my $version = $main::VERSION // 'not specified';
        
        print { *STDOUT } "$app version is $version\n" or confess($OS_ERROR);
        
        exit 0;
    }
    
    # Create help ...
    my $help = "$app <options> <args>\n\n";
    
    if ( scalar @options ) {
        $help .= "OPTIONS:\n";
    }
    
    # ... and check options
    foreach my $opt ( @options ) {
        if ( ref $opt ne 'ARRAY' ) {
            next;
        }
        
        my $spec   = $opt->[0];
        my $desc   = $opt->[1];
        my $params = $opt->[2];
        
        # Separator
        if ( not defined $spec and not defined $desc and not defined $params ) {
            $help .= "\n";
        # Option
        } elsif ( defined $spec and $spec =~ m{^([^!+=:]+)}si ) {
            my @names = split m{[|]}si, $1;
            my $name  = $names[0];
            my $short = ( grep { length == 1 } @names )[0];
            my $long  = ( grep { length >= 2 } @names )[0];
            
            # Check params
            if ( ref $params eq 'HASH' ) {
                # Default value
                if ( exists $params->{'default'} and not exists $options->{ $name } ) {
                    $options->{ $name } = $params->{'default'};
                }
                
                # Is required
                if ( $params->{'required'} and not $options->{'help'} and not exists $options->{ $name } ) {
                    die "Option required: $name\n";
                }
            }
            
            # Add to help
            $help .= sprintf q{  %-2s %-20s %s},
                defined $short ? "-$short" : '',
                defined $long  ? "--$long" : '',
                
                $desc // '';
            
            $help .= "\n";
        } else {
            confess("Invalid option specification: $spec");
        }
    }
    
    # Show help and exit
    if ( $options->{'help'} ) {
        print { *STDOUT } $help or confess($OS_ERROR);
        
        exit 0;
    }
    
    return $options;
    
}


1;


=head1 NAME

Crane::Options - Command line options and arguments parser


=head1 SYNOPSIS

  use Crane::Options;
  
  my $option = options->{'version'};
  my $arg2   = args->[1];


=head1 DESCRIPTION