1# ex:ts=8 sw=4: 2# $OpenBSD: Getopt.pm,v 1.17 2023/06/16 06:44:14 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 v5.36; 22 23package OpenBSD::Getopt; 24require Exporter; 25 26our @ISA = qw(Exporter); 27our @EXPORT = qw(getopts); 28 29sub handle_option($opt, $hash, @params) 30{ 31 if (defined $hash->{$opt} and ref($hash->{$opt}) eq 'CODE') { 32 &{$hash->{$opt}}(@params); 33 } else { 34 no strict "refs"; 35 no strict "vars"; 36 37 if (@params > 0) { 38 ${"opt_$opt"} = $params[0]; 39 $hash->{$opt} = $params[0]; 40 } else { 41 ${"opt_$opt"}++; 42 $hash->{$opt}++; 43 } 44 push(@EXPORT, "\$opt_$opt"); 45 } 46} 47 48sub getopts($args, $hash = {}) 49{ 50 local @EXPORT; 51 52 while ($_ = shift @ARGV) { 53 last if /^--$/o; 54 unless (m/^-(.)(.*)/so) { 55 unshift @ARGV, $_; 56 last; 57 } 58 my ($opt, $other) = ($1, $2); 59 if ($args =~ m/\Q$opt\E(\:?)/) { 60 if ($1 eq ':') { 61 if ($other eq '') { 62 die "no argument for option -$opt" unless @ARGV; 63 $other = shift @ARGV; 64 } 65 handle_option($opt, $hash, $other); 66 } else { 67 handle_option($opt, $hash); 68 if ($other ne '') { 69 $_ = "-$other"; 70 redo; 71 } 72 } 73 } else { 74 delete $SIG{__DIE__}; 75 die "Unknown option -$opt"; 76 } 77 } 78 local $Exporter::ExportLevel = 1; 79 OpenBSD::Getopt->import; 80 return $hash; 81} 82 831; 84