1# ex:ts=8 sw=4: 2# $OpenBSD: Getopt.pm,v 1.12 2012/04/10 16:57:12 espie Exp $ 3# 4# Copyright (c) 2006 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17# 18# This is inspired by Getopt::Std, except for the ability to invoke subs 19# on options. 20 21use strict; 22use warnings; 23 24package OpenBSD::Getopt; 25require Exporter; 26 27our @ISA = qw(Exporter); 28our @EXPORT = qw(getopts); 29 30sub handle_option 31{ 32 my ($opt, $hash, $params) = @_; 33 34 if (defined $hash->{$opt} and ref($hash->{$opt}) eq 'CODE') { 35 &{$hash->{$opt}}($params); 36 } else { 37 no strict "refs"; 38 no strict "vars"; 39 40 if (defined $params) { 41 ${"opt_$opt"} = $params; 42 $hash->{$opt} = $params; 43 } else { 44 ${"opt_$opt"}++; 45 $hash->{$opt}++; 46 } 47 push(@EXPORT, "\$opt_$opt"); 48 } 49} 50 51sub getopts($;$) 52{ 53 my ($args, $hash) = @_; 54 55 $hash = {} unless defined $hash; 56 local @EXPORT; 57 58 while ($_ = shift @ARGV) { 59 last if /^--$/o; 60 unless (m/^-(.)(.*)/so) { 61 unshift @ARGV, $_; 62 last; 63 } 64 my ($opt, $other) = ($1, $2); 65 if ($args =~ m/\Q$opt\E(\:?)/) { 66 if ($1 eq ':') { 67 if ($other eq '') { 68 die "no argument for option -$opt" unless @ARGV; 69 $other = shift @ARGV; 70 } 71 handle_option($opt, $hash, $other); 72 } else { 73 handle_option($opt, $hash); 74 if ($other ne '') { 75 $_ = "-$other"; 76 redo; 77 } 78 } 79 } else { 80 delete $SIG{__DIE__}; 81 die "Unknown option -$opt"; 82 } 83 } 84 local $Exporter::ExportLevel = 1; 85 import OpenBSD::Getopt; 86 return $hash; 87} 88 891; 90