package Getopt::Tiny; use vars qw($VERSION); $VERSION = 1.02; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(getopt); use strict; use vars qw($usageHandle); $usageHandle = 'STDERR'; sub getopt { my ($avref, $flagref, $switchref, $remainder) = @_; unless (defined($avref)) { $avref = \@::ARGV; $flagref = \%::flags; $switchref = \%::switches; } while (@$avref) { $_ = shift @$avref; unless (/^-(no)?(.+)$/) { if ($remainder) { unshift(@$avref, $_); return; } callusage($_, $flagref, $switchref, $remainder); return; } if (@$avref) { if (exists $flagref->{$2}) { if (ref $flagref->{$2} eq 'ARRAY') { my $f = $2; for (;;) { push(@{$flagref->{$f}}, shift @$avref); last unless @$avref && $avref->[0] =~ /^[^-]/; } } elsif (ref $flagref->{$2} eq 'HASH') { my $f = $2; for (;;) { my $v = shift @$avref; if ($v =~ /^(.*)=(.*)/) { $flagref->{$f}->{$1} = $2; } else { callusage("$_ $v", $flagref, $switchref, $remainder); } last unless @$avref && $avref->[0] =~ /^[^-].*=/; } } else { ${$flagref->{$2}} = shift @$avref; } next; } } if (exists $switchref->{$2}) { # if (ref $switchref->{$2} eq 'HASH') { # if (@$avref) { # $switchref->{$2}->{shift @$avref} = ! $1; # } else { # callusage($_, $flagref, $switchref, $remainder); # } # } else { ${$switchref->{$2}} = ! $1; # } next; } callusage($_, $flagref, $switchref, $remainder); return; } } sub callusage { my ($arg, $flagref, $switchref, $remainder) = @_; my ($package, $filename) = (caller(1))[0,1]; { no strict; if (defined &{"${package}::usage"}) { &{"${package}::usage"}($arg); return; } } my $o = select($usageHandle || 'STDERR'); print "$0: unknown option '$arg'\n"; $remainder = 'args' if $remainder > 0; print "Usage: $0 [flags] [switches] $remainder\n"; usage($filename, $flagref, $switchref); select($o); } sub usage { my ($filename, $flagref, $switchref) = @_; unless (defined $filename) { $filename = (caller[0])[1]; $flagref = \%::flags; $switchref = \%::switches; } my %comment; open(USAGESOURCEFILE, "<$filename") or die "open $filename: $!"; while () { last if /^# begin usage info/; } while () { if (/^\s*["'](\S+?)["']\s*=\>.*?\#\s*(\S.*)/) { $comment{$1} = $2; } last if /^# end usage info/; } if (%$flagref) { for my $f (sort keys %$flagref) { if (ref $flagref->{$f} eq 'ARRAY') { printf "\t-%-25s %s\n", "$f value ...", $comment{$f}||''; } elsif (ref $flagref->{$f} eq 'HASH') { printf "\t-%-25s %s\n", "$f key=value ...", $comment{$f}||''; } else { printf "\t-%-25s %s\n", "$f value", $comment{$f}||''; } } } if (%$switchref) { for my $f (sort keys %$switchref) { # if (ref $switchref->{$f} eq 'HASH') { # printf "\t-%-25s %s\n", "[no]$f key", $comment{$f}||''; # } else { printf "\t-[no]%-21s %s\n", $f, $comment{$f}||''; # } } } } 1;