in reply to Re: Getopt::Long subroutine usage
in thread Getopt::Long subroutine usage

Well, there is some cool stuff going on there, and thanks for the lightning response time, but I guess I was looking for a more indepth example. Perhaps the functionality I'm looking for in the module just isn't available and will be up to me to code. I'll try to outline the problem I'm encountering. Here's the script I'm working on currently. Please don't laugh. I'm new.

#!/usr/bin/perl -w use strict; use Getopt::Long; use Pod::Usage; my $autofs_conf = '/etc/auto.disks'; my $samba_conf = '/etc/samba/smb.conf'; my $device = ''; my $label = ''; my $prep = 0; my $configure = 0; my $reload = 0; my $makedirs = 0; Getopt::Long::Configure ("bundling", "permute", "auto_help", "auto_ver +sion"); GetOptions( 'autofs_conf|a=s' => \$autofs_conf, 'samba_conf|s=s' => \$samba_conf, 'configure|c' => \$configure, 'device|d=s' => \$device, 'label|l=s' => \$label, 'prep|p' => \$prep, 'reload|r' => \$reload, 'makedirs|m' => \$makedirs ); if ($prep) { if ($device && $label) { prep_disk($device, $label); } else { pod2usage(1); } } if ($configure) { if ($label) { make_conf(); } else { pod2usage(1); } } if ($makedirs) { if ($prep && $configure && $reload) { make_dirs(); } else { pod2usage(1); } } sub prep_disk { # saftey checks my ($device, $label) = @_; print "does $device exist? ... "; if (-e $device) { print "yes.\n"; } else { print "$device does not exist. exiting.\n"; exit } print "is $device a block device? ... "; if (-b $device) { print "yes.\n"; } else { print "no. you must use a block device. exiting.\n"; exit } print "checking for partition table ... "; unless ( `sfdisk -V -q $device` ) { $_ = `xfs_admin -l ${device}1`; /\".*/; print "$device contains a partition table and a filesystem labeled + $&. are you sure you want to continue? "; if ( <STDIN> =~ /n|no/i ) { exit; } } else { print "no partition table found.\n"; } # clean the disk print "cleaning the disk ...\n"; !system "dd", "if=/dev/zero", "of=$device", "bs=512", "count=1" or d +ie "couldn't clean disk\n"; print "done.\n"; # partition the disk print "partitioning the disk ...\n"; !system "/sbin/sfdisk -uM -q -L -O disksave --no-reread $device <<EO +F\n0,\nEOF" or die "couldn't partition the disk\n"; # create the filesystem print "creating the filesystem ... \n"; open DISKS, "/etc/auto.disks"; if ( grep( /$label/, <DISKS> ) ) { print "entry for $label exists. choose a different label. exiting. +\n"; close DISKS; exit; } else { !system "mkfs.xfs -f -L $label ${device}1" or die "couldn't create + filesystem\n"; print "done.\n"; } } sub make_conf { # add an entry to autofs &concat_conf ($autofs_conf, "$label -fstype=xfs :LABEL=$label +\n", $label); # add an entry to /etc/samba/smb.conf &concat_conf ($samba_conf, "[$label]\n path = /disks/$label\n +", $label); if ($reload) { reload_conf("autofs", "smb"); } } sub concat_conf { # concatenate an a text file and optionally check it for an existing + keyword first my ($file, $text, $test) = @_; print "adding entry to $file ... "; open FILE, "$file"; if ( $test && grep( /$test/, <FILE> ) ) { print "entry exists, skipping.\n"; close FILE; } else { open FILE, ">>$file"; print FILE "$text"; close FILE; print "done.\n"; } } sub remove_lines { my ($file, $search) = @_; my @lines; open INFILE, "<$file"; while (<INFILE>) { push @lines, $_ unless ($_ =~ /$search/i); } close INFILE; open OUTFILE, ">$file"; print OUTFILE @lines; close OUTFILE; } sub reload_conf { # reload samba and autofs print "reloading service configurations ...\n"; foreach (@_) { !system "service $_ restart" or die "couldn't restart $_\n"; } print "done.\n"; } sub make_dirs { # setup some dirs and chmod 'em print "creating dirs ... "; !system "ls /disks/$label" or die "couldn't list /disks/$label\n"; system "chmod -R 777 /disks/$label"; system "mkdir /disks/$label/Scans_In"; system "mkdir /disks/$label/Projects"; system "mkdir /disks/$label/Renders"; system "chmod -R 777 /disks/$label"; print "done.\n"; } sub get_line { print $_[0]; chomp (my $line = <STDIN>); $line; } __END__ =head1 NAME Prep Disk =head1 SYNOPSIS prep_disk [options] =head1 OPTIONS --configure|-c set for services configuration. used with -l --device|-d [device] block device name, such as /dev/sdb --help|-h this information --label|-l [label] xfs filesystem label --makedirs|-m set to create directory structure on target. d +epends on -c, -p, and -r --prep|-p set for disk preparation. used with -d and -l --reload|-r set to reload services =head1 DESCRIPTION B<This program> will read the given input file(s) and do someting useful with the contents thereof. =cut

The script works, but it's clunky. I wanted to be able to reference a subroutine with the --prep option for instance, but the --prep option uses two scalars --device and --label. Those two variables can be set on the command line. If I reference --prep as a subroutine instead of using my cludgey IF expressions, --disk and --label MUST preceed --prep on the command line. I was hoping to be able to require the dependent options within the getopt module, but I'm not sure if it's possible or what the syntax would be. I am guessing that it isn't possible or that I will have to think harder about what's going on here and learn more about programming in general. :-D

2005-01-05 Janitored by Arunbear - added readmore tags, as per Monastery guidelines

Replies are listed 'Best First'.
Re^3: Getopt::Long subroutine usage
by graff (Chancellor) on Jan 05, 2005 at 06:02 UTC
    You have an interesting case here. Personally, I don't see anything wrong with the approach you've started with, and I think trying to stuff subroutine refs into the GetOpt::Long usage to handle option dependencies is just going to obfuscate things. You don't need to go there, IMO. (I would especially advise against any approach the requires the options to be given in a specific order; this goes against the nature of option usage as most command-line users understand it.)

    Apart from that, I have just a few nit-picks:

    • Running the script with no args looks like a no-op; this should be treated the same as using the "-h|--help" option.
    • You might consider working on the pod a bit... see if you can indicate some of the option dependencies in the synopsis, and/or re-order the list of options so the dependencies are more salient and make sense on first glance.
    • For heaven's sake, provide an appropriate DESCRIPTION that at least gives an idea about what happens when the various settings are activated.
    • Your "make_dirs" sub could be using the Perl-internal "mkdir" and "chmod" functions, rather than running a bunch of system calls, and I'm not sure what you gain by using  !system "ls ..." or die as opposed to, say,  ( -d "..." ) or die
    • You have a "get_line" sub that is never called; I think it's very good that you never actually use this sub, and it would be fine to remove it from the script.
      I guess the path I'm taking will work. I just assumed that someone had been down this path before and had come up with a comprehensive way of handling options in a multi-purpose script. I definitely agree that the script should not require that options be given in a specific order. Thanks for the nit-picks! I plan to add a --help option or use auto_help built in to the module. The POD needs work, that's for certain. Hah! The description was nabbed straight from the Getopt::Long docs. I'll change it. Um, I forgot about mkdir and chmod builtins. The ls function is necessary, but the die is not. Since I'm using automount, the filesystem isn't mounted until the path is read. I suppose I could mount the filesystem to a temp location, but that seems like more work, more lines of code, more cleanup. The get_line sub and the remove_line subs are not currently being used. I should have removed them before posting.
Re^3: Getopt::Long subroutine usage
by Solo (Deacon) on Jan 05, 2005 at 15:40 UTC
    I was hoping to be able to require the dependent options within the getopt module

    This is how I handle option dependecies. Whether it's clearer than your method is largely a matter of taste. You keep a dependecy near the code that mandates it. I group all of them near the GetOptions call.

    use Getopt::Long; use Pod::Usage; my %opt; GetOptions( \%opt, 'help', 'man', 'V|version', 't|timeout=i', 'H|hostname=s', 'p|port=i', 'U|uri=s', ) or pod2usage(2); # standard opt handling; $opt{h} && pod2usage(1); $opt{man} && pod2usage( -exitstatus => 0, -verbose => 2 ); $opt{V} && version(); # option dependencies ( defined($opt{U}) xor defined($opt{H}) ) || pod2usage(1); defined($opt{H}) && defined($opt{p}) || pod2usage(1); # ... go on your merry way knowing dependencies are satisfied __END__ =head1 NAME opttest - Check out Getopt::Long and Pod::Usage =head1 SYNOPSIS opttest [options] -U uri - or - opttest [options] -H <hostname> -p <port> Options: U | -uri uri to check H | -hostname hostname to check p | -port tcp port to check (required with hostname!) ... =head1 DESCRIPTION Optest provides some basic option handling and demonstrates how to handle option dependencies for most-likely cases. =cut

    Adding some feedback to the user also helps the code self-document, but does create some clutter:

    ( defined($opt{U}) xor defined($opt{H}) ) || do { print "Only one of 'hostname' or 'uri' must be specified\n"; pod2usage(1); }; defined($opt{H}) && defined($opt{p}) || do { print "Hostname option requires port option\n"; pod2usage(1); };

    --Solo

    --
    You said you wanted to be around when I made a mistake; well, this could be it, sweetheart.
      Thank you. This will help me. I learn best by example for some reason. I would rather use a method for grouping the dependencies near the top. My method comes from a shallow bag of tricks.