summaryrefslogtreecommitdiff
path: root/contrib/glilypond/args.pl
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/glilypond/args.pl')
-rw-r--r--contrib/glilypond/args.pl120
1 files changed, 62 insertions, 58 deletions
diff --git a/contrib/glilypond/args.pl b/contrib/glilypond/args.pl
index 8b2fc0e2..dbfe7562 100644
--- a/contrib/glilypond/args.pl
+++ b/contrib/glilypond/args.pl
@@ -1,8 +1,8 @@
-my $License = q*
########################################################################
# Legalese
########################################################################
+my $License = q*
groff_lilypond - integrate `lilypond' into `groff' files
Source file position: `<groff-source>/contrib/lilypond/groff_lilypond.pl'
@@ -11,7 +11,7 @@ Installed position: `<prefix>/bin/groff_lilypond'
Copyright (C) 2013 Free Software Foundation, Inc.
Written by Bernd Warken <groff-bernd.warken-72@web.de>
-Last update: 26 Mar 2013
+Last update: 25 Apr 2013
This file is part of `GNU groff'.
@@ -51,19 +51,19 @@ my %opts_with_arg =
(
'--eps_dir' => sub {
- $Args -> { 'eps_dir' } = shift;
+ $Args->{'eps_dir'} = shift;
},
'--output' => sub {
- $Args -> { 'output' } = shift;
+ $Args->{'output'} = shift;
},
'--prefix' => sub {
- $Args -> { 'prefix' } = shift;
+ $Args->{'prefix'} = shift;
},
'--temp_dir' => sub {
- $Args -> { 'temp_dir' } = shift;
+ $Args->{'temp_dir'} = shift;
},
); # end of %opts_with_arg
@@ -78,7 +78,7 @@ my %opts_noarg =
},
'--keep_all' => sub {
- $Args -> { 'keep_all' } = TRUE;
+ $Args->{'keep_all'} = TRUE;
},
'--license' => sub {
@@ -87,15 +87,15 @@ my %opts_noarg =
},
'--ly2eps' => sub {
- $Args -> { 'eps_func' } = 'ly';
+ $Args->{'eps_func'} = 'ly';
},
'--pdf2eps' => sub {
- $Args -> { 'eps_func' } = 'pdf';
+ $Args->{'eps_func'} = 'pdf';
},
'--verbose' => sub {
- $Args -> { 'verbose' } = TRUE;
+ $Args->{'verbose'} = TRUE;
},
'--version' => sub {
@@ -123,8 +123,9 @@ my $arg = EMPTYSTRING;
my $has_arg = FALSE;
-# split short option collections and transfer these to suitable
-# long options from above
+# Split short option collections and transfer these to suitable long
+# options from above. Note that `-v' now means `--verbose' in version
+# `v1.1', earlier versions had `--version' for `-v'.
my %short_opts =
(
@@ -136,7 +137,7 @@ my %short_opts =
'o' => '--output',
'p' => '--prefix',
't' => '--temp_dir',
- 'v' => '--version',
+ 'v' => '--verbose',
'V' => '--verbose',
);
@@ -183,23 +184,23 @@ my $split_short = sub {
CHARS: while ( @chars ) {
my $c = shift @chars;
- unless ( exists $short_opts{ $c } ) {
- $stderr -> print( "Unknown short option `-$c'." );
+ unless ( exists $short_opts{$c} ) {
+ $stderr->print( "Unknown short option `-$c'." );
next CHARS;
}
# short option exists
# map or transfer to special long option from above
- my $transopt = $short_opts{ $c };
+ my $transopt = $short_opts{$c};
- if ( exists $opts_noarg{ $transopt } ) {
+ if ( exists $opts_noarg{$transopt} ) {
push @splitted_args, $transopt;
- $Args -> { 'verbose' } = TRUE if ( $transopt eq '--verbose' );
+ $Args->{'verbose'} = TRUE if ( $transopt eq '--verbose' );
next CHARS;
}
- if ( exists $opts_with_arg{ $transopt } ) {
+ if ( exists $opts_with_arg{$transopt} ) {
push @splitted_args, $transopt;
if ( @chars ) {
@@ -240,25 +241,25 @@ my $split_long = sub {
# no match, so luck for fewer number of chars
next N unless ( $argn );
- next N unless ( exists $long_opts[ $n ] -> { $argn } );
+ next N unless ( exists $long_opts[$n]->{$argn} );
# not in $n hash, so go on to next loop for $n
# now $n-hash has arg
# map or transfer to special long opt from above
- my $transopt = $long_opts[ $n ] -> { $argn };
+ my $transopt = $long_opts[$n]->{$argn};
# test on option without arg
- if ( exists $opts_noarg{ $transopt } ) { # opt has no arg
+ if ( exists $opts_noarg{$transopt} ) { # opt has no arg
$stderr->print( 'Option ' . $transopt . 'has no argument: ' .
- $from_arg . '.') if ( defined($optarg) );
+ $from_arg . '.' ) if ( defined($optarg) );
push @splitted_args, $transopt;
- $Args -> { 'verbose' } = TRUE if ( $transopt eq '--verbose' );
+ $Args->{'verbose'} = TRUE if ( $transopt eq '--verbose' );
return TRUE; # use `next SPLIT' afterwards
} # end of if %opts_noarg
# test on option with arg
- if ( exists $opts_with_arg{ $transopt } ) { # opt has arg
+ if ( exists $opts_with_arg{$transopt} ) { # opt has arg
push @splitted_args, $transopt;
# test on optarg in arg
@@ -273,8 +274,8 @@ my $split_long = sub {
} # end of if %opts_with_arg
# not with and without option, so is not permitted
- $stderr -> print( "`" . $transopt .
- "' is unknown long option from `" . $from_arg . "'" );
+ $stderr->print( "`" . $transopt .
+ "' is unknown long option from `" . $from_arg . "'" );
return TRUE; # use `next SPLIT' afterwards
} # end of for N
return FALSE; # do nothing
@@ -323,12 +324,12 @@ sub run_first {
)
$
/x ) {
- $split_short -> ( $1 );
+ $split_short->($1);
next SPLIT;
} # end of short option
if ( /^--/ ) { # starts with 2 dashes, a long option
- $split_long -> ( $_ );
+ $split_long->($_);
next SPLIT;
} # end of long option
@@ -338,7 +339,7 @@ sub run_first {
} # end of foreach SPLIT
# all args are considered
- $stderr -> print( "Option `$has_arg' needs an argument." )
+ $stderr->print( "Option `$has_arg' needs an argument." )
if ( $has_arg );
@@ -352,45 +353,48 @@ sub run_first {
# open or ignore verbose output
#----------
sub install_verbose {
- if ( $Args -> { 'verbose' } ) { # `--verbose' was used
+ if ( $Args->{'verbose'} ) { # `--verbose' was used
# make verbose output into $v
- my $s = $v -> get(); # get content of string so far as array ref, close
+ my $s = $v->get(); # get content of string so far as array ref, close
$v = new FH_STDERR(); # make verbose output into STDERR
if ( $s ) {
for ( @$s ) {
# print the file content into new verbose output
- $v -> print( $_ );
+ $v->print($_);
}
}
# verbose output is now active (into STDERR)
+ $v->print( "Option `-v' means `--verbose'." );
+ $v->print( "Version information is printed by option `--version'." );
+ $v->print( "#" x 72 );
} else { # `--verbose' was not used
# do not be verbose, make verbose invisible
- $v -> close(); # close and ignore the string content
+ $v->close(); # close and ignore the string content
$v = new FH_NULL();
# this is either into /dev/null or in an ignored string
} # end if-else about verbose
- # `$v -> print' works now in any case
+ # `$v->print' works now in any case
- $v -> print( "Verbose output was chosen." );
+ $v->print( "Verbose output was chosen." );
- my $s = $Globals -> { 'prog_is_installed' } ? '' : ' not';
- $v -> print( $Globals -> { 'prog' } . " is" . $s .
- " installed." );
+ my $s = $Globals->{'prog_is_installed'} ? '' : ' not';
+ $v->print( $Globals->{'prog'} . " is" . $s .
+ " installed." );
- $v -> print( 'The command line options are:' );
+ $v->print( 'The command line options are:' );
$s = " options:";
$s .= " `" . $_ . "'" for ( @ARGV );
- $v -> print( $s );
+ $v->print( $s );
$s = " file names:";
$s .= " `" . $_ . "'\n" for ( @files );
- $v -> print( $s );
+ $v->print( $s );
} # end install_verbose()
@@ -410,29 +414,29 @@ sub run_second {
last ARGS if ( $arg eq '--' );
if ( $has_arg ) {
- unless ( exists $opts_with_arg{ $has_arg } ) {
- $stderr -> print( "`\%opts_with_args' does not have key `" .
+ unless ( exists $opts_with_arg{$has_arg} ) {
+ $stderr->print( "`\%opts_with_args' does not have key `" .
$has_arg . "'." );
next ARGS;
}
- $opts_with_arg{ $has_arg } -> ( $arg );
+ $opts_with_arg{$has_arg}->($arg);
$has_arg = FALSE;
next ARGS;
} # end of $has_arg
- if ( exists $opts_with_arg{ $arg } ) {
+ if ( exists $opts_with_arg{$arg} ) {
$has_arg = $arg;
next ARGS;
}
- if ( exists $opts_noarg{ $arg } ) {
- $opts_noarg { $arg } -> ();
+ if ( exists $opts_noarg{$arg} ) {
+ $opts_noarg{$arg}->();
next ARGS;
}
# not a suitable option
- $stderr -> print( "Wrong option `" . $arg . "'." );
+ $stderr->print( "Wrong option `" . $arg . "'." );
next ARGS;
} # end of for ARGS:
@@ -448,26 +452,26 @@ sub run_second {
sub handle_args {
# handling the output of args
- if ( $Args -> { 'output' } ) { # `--output' was set in the arguments
- my $out_path = &path2abs( $Args -> { 'output' } );
- die "Output file name `$Args -> { 'output' } cannot be used."
+ if ( $Args->{'output'} ) { # `--output' was set in the arguments
+ my $out_path = &path2abs($Args->{'output'});
+ die "Output file name $Args->{'output'} cannot be used."
unless ( $out_path );
my ( $file, $dir );
- ( $file, $dir ) = File::Basename::fileparse( $out_path )
+ ( $file, $dir ) = File::Basename::fileparse($out_path)
or die "Could not handle output file path `" . $out_path . "': " .
"directory name `" . $dir . "' and file name `" . $file . "'.";
- die "Could not find output directory for `" . $Args -> { 'output' } . "'"
+ die "Could not find output directory for `" . $Args->{'output'} . "'"
unless ( $dir );
- die "Could not find output file: `" . $Args -> { 'output' } .
+ die "Could not find output file: `" . $Args->{'output'} .
"'" unless ( $file );
if ( -d $dir ) {
die "Could not write to output directory `" . $dir . "'."
unless ( -w $dir );
} else {
- $dir = &make_dir( $dir );
+ $dir = &make_dir($dir);
die "Could not create output directory in: `" . $out_path . "'."
unless ( $dir );
}
@@ -480,13 +484,13 @@ sub handle_args {
}
$out = new FH_FILE( $out_path );
- $v -> print( "Output goes to file `" . $out_path . "'." );
+ $v->print( "Output goes to file `" . $out_path . "'." );
} else { # `--output' was not set
$out = new FH_STDOUT();
}
# no $out is the right behavior for standard output
-# $Args -> { 'prefix' } .= '_' . $Args -> { 'eps_func' } . '2eps';
+# $Args->{'prefix'} .= '_' . $Args->{'eps_func'} . '2eps';
@ARGV = @files;
}