diff options
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/Pod/Perldoc/GetOptsOO.pm')
-rw-r--r-- | Master/tlpkg/tlperl.old/lib/Pod/Perldoc/GetOptsOO.pm | 106 |
1 files changed, 0 insertions, 106 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/Pod/Perldoc/GetOptsOO.pm b/Master/tlpkg/tlperl.old/lib/Pod/Perldoc/GetOptsOO.pm deleted file mode 100644 index b29aeb10906..00000000000 --- a/Master/tlpkg/tlperl.old/lib/Pod/Perldoc/GetOptsOO.pm +++ /dev/null @@ -1,106 +0,0 @@ - -require 5; -package Pod::Perldoc::GetOptsOO; -use strict; - -# Rather like Getopt::Std's getopts -# Call Pod::Perldoc::GetOptsOO::getopts($object, \@ARGV, $truth) -# Given -n, if there's a opt_n_with, it'll call $object->opt_n_with( ARGUMENT ) -# (e.g., "-n foo" => $object->opt_n_with('foo'). Ditto "-nfoo") -# Otherwise (given -n) if there's an opt_n, we'll call it $object->opt_n($truth) -# (Truth defaults to 1) -# Otherwise we try calling $object->handle_unknown_option('n') -# (and we increment the error count by the return value of it) -# If there's no handle_unknown_option, then we just warn, and then increment -# the error counter -# -# The return value of Pod::Perldoc::GetOptsOO::getopts is true if no errors, -# otherwise it's false. -# -## sburke@cpan.org 2002-10-31 - -BEGIN { # Make a DEBUG constant ASAP - *DEBUG = defined( &Pod::Perldoc::DEBUG ) - ? \&Pod::Perldoc::DEBUG - : sub(){10}; -} - - -sub getopts { - my($target, $args, $truth) = @_; - - $args ||= \@ARGV; - - $target->aside( - "Starting switch processing. Scanning arguments [@$args]\n" - ) if $target->can('aside'); - - return unless @$args; - - $truth = 1 unless @_ > 2; - - DEBUG > 3 and print " Truth is $truth\n"; - - - my $error_count = 0; - - while( @$args and ($_ = $args->[0]) =~ m/^-(.)(.*)/s ) { - my($first,$rest) = ($1,$2); - if ($_ eq '--') { # early exit if "--" - shift @$args; - last; - } - my $method = "opt_${first}_with"; - if( $target->can($method) ) { # it's argumental - if($rest eq '') { # like -f bar - shift @$args; - warn "Option $first needs a following argument!\n" unless @$args; - $rest = shift @$args; - } else { # like -fbar (== -f bar) - shift @$args; - } - - DEBUG > 3 and print " $method => $rest\n"; - $target->$method( $rest ); - - # Otherwise, it's not argumental... - } else { - - if( $target->can( $method = "opt_$first" ) ) { - DEBUG > 3 and print " $method is true ($truth)\n"; - $target->$method( $truth ); - - # Otherwise it's an unknown option... - - } elsif( $target->can('handle_unknown_option') ) { - DEBUG > 3 - and print " calling handle_unknown_option('$first')\n"; - - $error_count += ( - $target->handle_unknown_option( $first ) || 0 - ); - - } else { - ++$error_count; - warn "Unknown option: $first\n"; - } - - if($rest eq '') { # like -f - shift @$args - } else { # like -fbar (== -f -bar ) - DEBUG > 2 and print " Setting args->[0] to \"-$rest\"\n"; - $args->[0] = "-$rest"; - } - } - } - - - $target->aside( - "Ending switch processing. Args are [@$args] with $error_count errors.\n" - ) if $target->can('aside'); - - $error_count == 0; -} - -1; - |