Getopt-Usaginator-0.0012000755001750001750 011402331121 13663 5ustar00robrob000000000000README000644001750001750 472511402331121 14633 0ustar00robrob000000000000Getopt-Usaginator-0.0012NAME Getopt::Usaginator - Conjure up a usage function for your applications VERSION version 0.0012 SYNOPSIS use Getopt::Usaginator <<_END_; Usage: xyzzy --derp Derp derp derp --durp Durp durp durp -h, --help This usage _END_ # The 'usage' subroutine is now installed ... $options = parse_options( @ARGV ); # Not supplied by Usaginator usage if $options{help}; # Print usage and exit with status 0 if ( ! $options{derp} ) { # Print warning and usage and exit with status -1 usage "You should really derp"; } if ( $options{durp} ) { # Print warning and usage and exit with status 2 usage 2 => "--durp is not ready yet"; } ... usage 3 # Print usage and exit with status 3 DESCRIPTION Getopt::Usaginator is a tool for creating a handy usage subroutine for commandline applications It does not do any option parsing, but is best paired with Getopt::Long or any of the other myriad of option parsers USAGE use Getopt::Usaginator Install a "usage" subroutine configured with the text $code = Getopt::Usaginator->usaginator( ) Return a subroutine configured with the text ... More advanced usage is possible, peek under the hood for more information perldoc -m Getopt::Usaginator An example: use Getopt::Usaginator # Called with the error error => sub { ... }, # Called when usage printing is needed usage => sub { ... }, ... ; An example with Getopt::Long parsing use Getopt::Usaginator ... sub run { my $self = shift; my @arguments = @_; usage 0 unless @arguments; my ( $help ); { local @ARGV = @arguments; GetOptions( 'help|h|?' => \$help, ); } usage 0 if $help; ... } AUTHOR Robert Krimen COPYRIGHT AND LICENSE This software is copyright (c) 2010 by Robert Krimen. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Changes000644001750001750 35411402331121 15220 0ustar00robrob000000000000Getopt-Usaginator-0.00120.0012 Friday June 04 19:08:27 PDT 2010: - Test only on Linux, FreeBSD, OpenBSD 0.0011 Wednesday June 02 19:49:22 PDT 2010: - Added an example to documentation 0.0010 Wednesday June 02 18:46:32 PDT 2010: - Initial release Getopt000755001750001750 011402331121 15614 5ustar00robrob000000000000Getopt-Usaginator-0.0012/libUsaginator.pm000644001750001750 1137111402331121 20450 0ustar00robrob000000000000Getopt-Usaginator-0.0012/lib/Getoptpackage Getopt::Usaginator; BEGIN { $Getopt::Usaginator::VERSION = '0.0012'; } # ABSTRACT: Conjure up a usage function for your applications use strict; use warnings; use Package::Pkg; sub import { my $package = caller; my $self = shift; if ( @_ ) { my @arguments = ( as => "${package}::usage" ); if ( 1 == @_ ) { push @arguments, usage => $_[0] } else { push @arguments, @_ } $self->usaginator( @arguments ); } } sub _is_status ($) { return defined $_[0] && $_[0] =~ m/^\-?\d+$/; } sub _print ($$$) { my ( $logger, $target, $context ) = @_; if ( ref $target eq 'CODE' ) { $target->( @$context ); return; } chomp $target if $target && ! ref $target; $target .= "\n"; if ( ref $logger eq 'CODE' ) { $logger->( $target, @$context ); return; } if ( ! ref $logger ) { s/^\s*//, s/\s*$// for $logger; $logger = lc $logger; if ( $logger eq 'warn' ) { warn $target } elsif ( $logger eq 'stdout' ) { print STDOUT $target } elsif ( $logger eq 'stderr' ) { print STDERR $target } else { die "Invalid print mechanism ($logger)" } } elsif ( ref $logger eq 'GLOB' || UNIVERSAL::isa( $logger, 'IO::Handle' ) ) { print $logger $target; } else { die "Invalid print mechanism ($logger)"; } } sub usaginator { my $self = shift; my ( $print, $error, $usage, $as ); if ( @_ == 1 ) { $usage = $_[0] } else { my %given = @_; ( $print, $error, $usage, $as ) = @given{qw/ print error usage as /} } $print = 'warn' unless defined $print; my $code = sub { my ( $status, $error ); if ( @_ > 1 ) { ( $status, $error ) = @_ } else { $error = shift } if ( defined $error ) { if ( $error ) { if ( ! defined $status && _is_status $error ) { $status = $error } else { _print $print, $error, [ @_ ] } $status = -1 unless defined $status; } } $status = 0 unless defined $status; _print $print, $usage, [ @_ ]; exit $status; }; if ( $as ) { pkg->install( { code => $code, as => $as, _into => scalar caller } ); } return $code; } 1; __END__ =pod =head1 NAME Getopt::Usaginator - Conjure up a usage function for your applications =head1 VERSION version 0.0012 =head1 SYNOPSIS use Getopt::Usaginator <<_END_; Usage: xyzzy --derp Derp derp derp --durp Durp durp durp -h, --help This usage _END_ # The 'usage' subroutine is now installed ... $options = parse_options( @ARGV ); # Not supplied by Usaginator usage if $options{help}; # Print usage and exit with status 0 if ( ! $options{derp} ) { # Print warning and usage and exit with status -1 usage "You should really derp"; } if ( $options{durp} ) { # Print warning and usage and exit with status 2 usage 2 => "--durp is not ready yet"; } ... usage 3 # Print usage and exit with status 3 =head1 DESCRIPTION Getopt::Usaginator is a tool for creating a handy usage subroutine for commandline applications It does not do any option parsing, but is best paired with L or any of the other myriad of option parsers =head1 USAGE =head2 use Getopt::Usaginator Install a C subroutine configured with the text =head2 $code = Getopt::Usaginator->usaginator( ) Return a subroutine configured with the text =head2 ... More advanced usage is possible, peek under the hood for more information perldoc -m Getopt::Usaginator An example: use Getopt::Usaginator # Called with the error error => sub { ... }, # Called when usage printing is needed usage => sub { ... }, ... ; =head1 An example with Getopt::Long parsing use Getopt::Usaginator ... sub run { my $self = shift; my @arguments = @_; usage 0 unless @arguments; my ( $help ); { local @ARGV = @arguments; GetOptions( 'help|h|?' => \$help, ); } usage 0 if $help; ... } =head1 AUTHOR Robert Krimen =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2010 by Robert Krimen. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut t000755001750001750 011402331121 14047 5ustar00robrob000000000000Getopt-Usaginator-0.001201-basic.t000644001750001750 173311402331121 15676 0ustar00robrob000000000000Getopt-Usaginator-0.0012/t#!/usr/bin/env perl use strict; use warnings; use Test::Most 'no_plan'; use File::Spec; use IPC::Open3; use Symbol qw/ gensym /; sub run { my $file = shift; local $/; $file = File::Spec->canonpath( $file ); my $handle = gensym; my $pid = open3 undef, undef, $handle, "$^X $file" or die $!; my $output = <$handle>; waitpid $pid, 0; my $status = $? >> 8; return ( $status, $output ); } # The testing is really more complicated than the actual module # Just test on "nice" platforms, for now if ( $^O =~ m/^(?:linux|freebsd|openbsd)/i ) { my ( $status, $output ); ( $status, $output ) = run 't/assets/t0'; is( $status, 255 ); is( $output, <<_END_ ); Apple Usage: t0 _END_ ( $status, $output ) = run 't/assets/t1'; is( $status, 2 ); is( $output, <<_END_ ); Banana Usage: t1 _END_ ( $status, $output ) = run 't/assets/t2'; is( $status, 0 ); is( $output, <<_END_ ); Usage: t2 _END_ } else { ok( 1 ); } assets000755001750001750 011402331121 15351 5ustar00robrob000000000000Getopt-Usaginator-0.0012/tt0000755001750001750 16411402331121 15742 0ustar00robrob000000000000Getopt-Usaginator-0.0012/t/assets#!/usr/bin/env perl use strict; use warnings; use Getopt::Usaginator <<_END_; Usage: t0 _END_ usage "Apple\n\n"; t2000644001750001750 15011402331121 15734 0ustar00robrob000000000000Getopt-Usaginator-0.0012/t/assets#!/usr/bin/env perl use strict; use warnings; use Getopt::Usaginator <<_END_; Usage: t2 _END_ usage; t1000644001750001750 17211402331121 15737 0ustar00robrob000000000000Getopt-Usaginator-0.0012/t/assets#!/usr/bin/env perl use strict; use warnings; use Getopt::Usaginator <<_END_; Usage: t1 _END_ usage 2 => "Banana\n\n"; META.yml000644001750001750 72311402331121 15176 0ustar00robrob000000000000Getopt-Usaginator-0.0012--- abstract: 'Conjure up a usage function for your applications' author: - 'Robert Krimen ' build_requires: File::Spec: 0 IPC::Open3: 0 Test::Most: 0 configure_requires: ExtUtils::MakeMaker: 6.31 generated_by: 'Dist::Zilla version 2.101170' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Getopt-Usaginator recommends: {} requires: Package::Pkg: 0.0014 version: 0.0012 Makefile.PL000644001750001750 332411402331121 15717 0ustar00robrob000000000000Getopt-Usaginator-0.0012 use strict; use warnings; use ExtUtils::MakeMaker 6.31; my %WriteMakefileArgs = ( 'test' => { 'TESTS' => 't/*.t' }, 'NAME' => 'Getopt::Usaginator', 'DISTNAME' => 'Getopt-Usaginator', 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.31' }, 'AUTHOR' => 'Robert Krimen ', 'BUILD_REQUIRES' => { 'File::Spec' => '0', 'Test::Most' => '0', 'IPC::Open3' => '0' }, 'ABSTRACT' => 'Conjure up a usage function for your applications', 'EXE_FILES' => [], 'VERSION' => '0.0012', 'PREREQ_PM' => { 'Package::Pkg' => '0.0014' }, 'LICENSE' => 'perl' ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); MANIFEST000644001750001750 16611402331121 15057 0ustar00robrob000000000000Getopt-Usaginator-0.0012Changes MANIFEST META.yml Makefile.PL README lib/Getopt/Usaginator.pm t/01-basic.t t/assets/t0 t/assets/t1 t/assets/t2