[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Groff-commit] groff/contrib/lilypond ChangeLog groff_lilypond...
|
From: |
Bernd Warken |
|
Subject: |
[Groff-commit] groff/contrib/lilypond ChangeLog groff_lilypond... |
|
Date: |
Mon, 11 Mar 2013 00:45:24 +0000 |
CVSROOT: /cvsroot/groff
Module name: groff
Changes by: Bernd Warken <bwarken> 13/03/11 00:45:24
Modified files:
contrib/lilypond: ChangeLog groff_lilypond.man groff_lilypond.pl
Log message:
Publishing groff_lilypond version v0.6.
New options: -e|--eps_dir, -l|--license, -k|--keep_files,
-p|--prefix=...,
-t|--temp_dir=...
Add section SEE ALSO to man-page.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/groff/contrib/lilypond/ChangeLog?cvsroot=groff&r1=1.8&r2=1.9
http://cvs.savannah.gnu.org/viewcvs/groff/contrib/lilypond/groff_lilypond.man?cvsroot=groff&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/groff/contrib/lilypond/groff_lilypond.pl?cvsroot=groff&r1=1.7&r2=1.8
Patches:
Index: ChangeLog
===================================================================
RCS file: /cvsroot/groff/groff/contrib/lilypond/ChangeLog,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- ChangeLog 2 Mar 2013 23:53:32 -0000 1.8
+++ ChangeLog 11 Mar 2013 00:45:23 -0000 1.9
@@ -1,3 +1,12 @@
+2013-03-11 Bernd Warken <address@hidden>
+
+ * groff_lilypond.pl: Publishing groff_lilypond version v0.6.
+ New options: -e|--eps_dir, -l|--license, -k|--keep_files,
+ -p|--prefix=..., -t|--temp_dir=...
+ Install --eps_dir as directory for the useful EPS files.
+ * groff_lilypond.man: Include the new options. Add section
+ SEE ALSO.
+
2013-03-03 Bernd Warken <address@hidden>
* groff_lilypond.pl: New code with Perl references.
Index: groff_lilypond.man
===================================================================
RCS file: /cvsroot/groff/groff/contrib/lilypond/groff_lilypond.man,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- groff_lilypond.man 2 Mar 2013 23:53:32 -0000 1.7
+++ groff_lilypond.man 11 Mar 2013 00:45:24 -0000 1.8
@@ -13,7 +13,7 @@
.MT address@hidden
.ME .
.
-Last update: 03 Mar 2013
+Last update: 11 Mar 2013
..
.
.
@@ -199,9 +199,13 @@
.RS
.P
.SY
-.OP -h\~\fR|\fB\~--help
-.OP -v\~\fR|\fB\~--version\fR|\fB\~--usage
-.OP \fB\~--license
+.OP -h\~\fR|\fB\~--help\fR|\fB\~--usage
+.YS
+.SY
+.OP -v\~\fR|\fB\~--version
+.YS
+.SY
+.OP -l\~\fR|\fB\~--license
.YS
.RE
.
@@ -244,7 +248,20 @@
.RS
.
.TP
-.OP --file_prefix name
+.OP -e\fR|\fB\~--eps_dir directory_name
+Normally all
+.FONT CI EPS
+files are sent to the temporary directory.
+.
+With this option, you can generate your own directory, in which all useful
+.FONT CI EPS
+files are send.
+.
+So at last, the temporary directory can be removed.
+.
+.
+.TP
+.OP -p\fR|\fB\~--prefix begin_of_name
Normally all temporary files get names that start with the
.FONT CB ly CI \*[Ellipsis]
prefix.
@@ -253,7 +270,7 @@
.
.
.TP
-.OP --keep_files
+.OP -k\fR|\fB\~--keep_files
Normally all temporary files without the
.FONT CI eps
files are deleted.
@@ -264,7 +281,7 @@
.
.
.TP
-.OP --temp_dir dir
+.OP -t\fR|\fB\~--temp_dir dir
With this option, you can change the directory in which the temporary
files are stored.
.
@@ -285,7 +302,7 @@
Normally all
.FONT CI groff
output is sent to
-FONT CB STDOUT R .
+.FONT CB STDOUT R .
.
With this option that can be stored in a
.IR file .
@@ -299,6 +316,16 @@
.RE
.
.
+.P
+In an old version of this program, there was an additional option called
+.FONT CB --file_prefix R .
+.
+This is now replaced by
+.FONT CB --prefix
+and
+.FONT CB -p R .
+.
+.
.\" --------------------------------------------------------------------
.SH "FINDING THE LILYPOND PARTS IN A ROFF FILE OR STANDARD INPUT"
.\" --------------------------------------------------------------------
@@ -372,7 +399,7 @@
may not be used between
.FONT CB ".lilypond start"
and
-.FONT CB ".lilypond end" .R .
+.FONT CB ".lilypond end" R .
.
.
.\" --------------------------------------------------------------------
@@ -574,6 +601,46 @@
.
.
.\" --------------------------------------------------------------------
+.SH "SEE ALSO"
+.\" --------------------------------------------------------------------
+.
+.TP
+.BR groff (@MAN1EXT@)
+the usage of the groff program and pointers to the documentation and
+availability of the
+.FONT CI groff
+system.
+.
+The main source of information for the
+.FONT CI groff
+language is the
+.FONT CB groff
+.BR info (1)
+file.
+.
+.
+.TP
+.BR groff_tmac (@MAN5EXT@)
+contains documentation of the
+.FONT CB .PSPIC
+request.
+.
+.
+.TP
+.BR lilypond (1)
+The documentation of the
+.FONT CB lilypond
+program.
+.
+The main source of information for the
+.FONT CI lilypond
+language is the
+.FONT CB lilypond
+.BR info (1)
+file.
+.
+.
+.\" --------------------------------------------------------------------
.SH "AUTHORS"
.\" --------------------------------------------------------------------
.authors
Index: groff_lilypond.pl
===================================================================
RCS file: /cvsroot/groff/groff/contrib/lilypond/groff_lilypond.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- groff_lilypond.pl 2 Mar 2013 23:53:32 -0000 1.7
+++ groff_lilypond.pl 11 Mar 2013 00:45:24 -0000 1.8
@@ -6,19 +6,22 @@
# use warnings;
-
########################################################################
-# legalese
+# main: global stuff
########################################################################
{
package main;
use strict;
+########################################################################
+# legalese
+########################################################################
+
use vars '$VERSION';
- $VERSION = 'v0.5'; # version of groff_lilypond
+ $VERSION = 'v0.6'; # version of groff_lilypond
- $main::last_update = '03 Mar 2013';
+ $main::last_update = '11 Mar 2013';
### This `$License' is the license for this file, `GPL' >= 3
$main::License = q*
@@ -55,8 +58,13 @@
# global variables
########################################################################
+ use Cwd qw[];
+ use File::Basename qw[];
+ use File::Copy qw[];
+ use File::HomeDir qw[];
use File::Spec qw[];
use File::Path qw[];
+
use Time::HiRes qw[];
use constant FALSE => 0;
@@ -67,350 +75,382 @@
$main::at_version_at = '@VERSION@'; # @...@ is replaced for the installation
- # `$prog_is_installed' is TRUE if groff is installed,
+ # `$prog_is_installed' is TRUE if the groff package is installed,
# FALSE when in source package
$main::prog_is_installed = ( $main::at_version_at =~ /address@hidden@]$/ )
? FALSE : TRUE;
- {
- ( my $v, my $d, $main::prog) = File::Spec->splitpath($0);
- }
- # is `groff_lilypond' when installed, `groff_lilypond.pl' when not
-
$main::groff_version = $main::prog_is_installed
? $main::at_version_at : main::EMPTYSTRING;
+ {
+ ( my $volume, my $directory, $main::prog ) = File::Spec->splitpath($0);
+ }
+ # $main::prog is `groff_lilypond' when installed,
+ # `groff_lilypond.pl' when not
+
$\ = "\n"; # adds newline at each print
$main::fh_verbose; # file handle only for `--verbose'
$main::fh_out; # file handle for `--output'
+
} # end of package `main'
##### end global variables
########################################################################
-# command line arguments
+# Args: command line arguments
########################################################################
-{
+# command line arguments are handled in 2 runs:
+# 1) split short option collections, `=' optargs, and transfer abbrevs
+# 2) handle the transferred options with subs
+
+{ # package `Args'
+
package Args;
use strict;
- # command line arguments
- $Args::keep_files = main::FALSE;
- # default `--ly2eps', another `--pdf2eps'
- $Args::eps_func = 'ly2eps';
-
- $Args::temp_dir = main::EMPTYSTRING; # temporary directory
- # can be overwritten by `--temp_dir'
+ # ----------
+ # variables for package `Args'
+ # ----------
+
+ $Args::eps_dir = main::EMPTYSTRING; # directory for the used EPS-files
+ # can be overwritten by `--eps_dir'
+
+ # 2 possible values:
+ # 1) `ly' from `--ly2eps' (default)
+ # 2) `pdf' `--pdf2eps'
+ $Args::eps_func = 'ly';
$Args::file_prefix = 'ly';
# names of temporary files in $main::TempDir start with this string
# can be overwritten by `--file_prefix'
- $Args::verbose = main::FALSE;
- $Args::output = $1;
-
-
- my $double_minus = main::FALSE;
- my @args = main::EMPTYARRAY;
-
- {
- my %single_opts =
- (
- 'h' => main::FALSE,
- 'o' => main::TRUE, # has argument
- 'v' => main::FALSE,
- 'V' => main::FALSE,
- );
-
- my @splitted_args;
-
-
- SINGLE: foreach (@ARGV) {
-
- if ( $double_minus ) {
- push @splitted_args, $_;
- next SINGLE;
- }
+ # do not delete temporary files
+ $Args::keep_files = main::FALSE;
- s/^\s*(.*)\s*$/$1/; # remove leading and final spaces
+ # the roff output goes normally to STDOUT, can be a file with `--output'
+ $Args::output = main::EMPTYSTRING;
- if ( /^--$/ ) { # `--'
- push @splitted_args, $_;
- $double_minus = main::TRUE;
- next SINGLE;
- }
+ $Args::temp_dir = main::EMPTYSTRING; # temporary directory
+ # can be overwritten by `--temp_dir'
- if ( /^--/ ) {
- if ( /=/ ) { # `--opt' with `=' for arg
- /^([^=]*)=(.*)$/;
- push @splitted_args, $1;
- push @splitted_args, $2;
- next SINGLE;
- }
- push @splitted_args, $_;
- next SINGLE;
- }
+ # regulates verbose output (on STDERR), overwritten by `--verbose'
+ $Args::verbose = main::FALSE;
- if ( /^-([^-].*)$/ ) { # single minus
- my @chars = split //, $1;
- while ( @chars ) {
- my $c = shift @chars;
- if ( exists $single_opts{ $c } ) {
- push @splitted_args, "-" . $c;
- next SINGLE unless ( $single_opts{ $c } ); # opt without arg
-
- # single opt with arg
- my $opt_arg = join '', @chars;
- push @splitted_args, $opt_arg;
- @chars = main::EMPTYARRAY;
- next SINGLE
- } else { # not in %single_opts
- print STDERR "Unknown option `-$c'";
- }
- }
- }
- push @splitted_args, $_;
- next SINGLE;
- }
+ # ----------
+ # subs for second run, for remaining long options after splitting and
+ # transfer
+ # ----------
- @ARGV = @splitted_args;
+ my %opts_with_arg =
+ (
- }
- $double_minus = main::FALSE;
+ '--eps_dir' => sub {
+ $Args::eps_dir = shift;
+ },
+ '--output' => sub {
+ $Args::output = shift;
+ },
- # arguments are splitted
+ '--prefix' => sub {
+ $Args::file_prefix = shift;
+ },
+ '--temp_dir' => sub {
+ $Args::temp_dir = shift;
+ },
- my $has_arg;
- my $arg;
- my $former_arg;
- my $exit = main::FALSE;
- my @files;
+ ); # end of %opts_with_arg
- my %only_minus =
+ my %opts_noarg =
(
- '-' => sub { push @files, '-'; },
- '--' => sub { push @args, '--'; $double_minus = main::TRUE; },
- );
+ '--help' => sub {
+ &Subs::usage;
+ exit;
+ },
- my @opt;
+ '--keep_files' => sub {
+ $Args::keep_files = main::TRUE;
+ },
- $opt[2] =
- { # option abbreviations of 2 characters
+ '--license' => sub {
+ &Subs::license;
+ exit;
+ },
- '-h' => sub {
- &Subs::usage;
- push @args, '--help';
- $exit = main::TRUE;
- }, # `-h'
-
- '-o' => sub { # `-o'
- $has_arg = '--output';
- $former_arg = $has_arg;
- next ARGS;
+ '--ly2eps' => sub {
+ $Args::eps_func = 'ly';
},
- '-v' => sub { # `-v'
- &Subs::version;
- push @args, '--version';
- $exit = main::TRUE;
- next ARGS;
+ '--pdf2eps' => sub {
+ $Args::eps_func = 'pdf';
},
- '-V' => sub { # `-V'
+ '--verbose' => sub {
$Args::verbose = main::TRUE;
- push @args, '--verbose';
- next ARGS;
},
- };
-
+ '--version' => sub {
+ $Subs::version;
+ },
- $opt[3] =
- { # option abbreviations of 3 characters
+ ); # end of %opts_noarg
- '--f' => sub { # `--file_prefix'
- $has_arg = '--file_prefix';
- $former_arg = $has_arg;
- next ARGS;
- }, # end `--file_prefix'
- '--h' => sub { # `--help'
- &Subs::usage;
- push @args, '--help';
- $exit = main::TRUE;
- },
+ # used variables in both runs
- '--k' => sub { # `--keep_files'
- $Args::keep_files = main::TRUE;
- push @args, '--keep_files';
- next ARGS;
- },
+ my @files = main::EMPTYARRAY;
- '--o' => sub { # `--output'
- # next command line argument is the option argument
- $has_arg = '--output';
- $former_arg = $has_arg;
- next ARGS;
- }, # end sub of `--o'
+ {
+ #----------
+ # first run for command line arguments
+ #----------
- # `--pdf2eps'
- '--p' => sub {
- $Args::eps_func = 'pdf2eps';
- push @args, '--pdf2eps';
- next ARGS;
- },
+ # global variables for first run
- '--t' => sub { # `--temp_dir'
- # next command line argument is the option argument
- $has_arg = '--temp_dir';
- $former_arg = $has_arg;
- next ARGS;
- }, # end sub of `--t'
+ my @splitted_args;
+ my $double_minus = main::FALSE;
+ my $arg = main::EMPTYSTRING;
+ my $has_arg = main::FALSE;
- '--u' => sub {
- &Subs::usage;
- push @args, '--help';
- $exit = main::TRUE;
- }, # `--usage'
- '--V' => sub { # `--Verbose'
- $Args::verbose = main::TRUE;
- push @args, '--verbose';
- next ARGS; },
+ # split short option collections and transfer these to suitable
+ # long options from above
- }; # end `$opt[3]'
+ my %short_opts =
+ (
+ 'e' => '--eps_dir',
+ 'h' => '--help',
+ 'l' => '--license',
+ 'k' => '--keep_files',
+ 'o' => '--output',
+ 'p' => '--prefix',
+ 't' => '--temp_dir',
+ 'v' => '--version',
+ 'V' => '--verbose',
+ );
- $opt[4] =
- { # option abbreviations of 4 characters
+ # transfer long option abbreviations to the long options from above
- '--li' => sub { # `--license'
- &Subs::license;
- push @args, '--license';
- $exit = main::TRUE;
- },
+ my @long_opts;
- '--ly' => sub { # `--ly2eps'
- $Args::eps_func = 'ly2eps';
- push @args, '--ly2eps';
- next ARGS;
- },
+ $long_opts[3] =
+ { # option abbreviations of 3 characters
+ '--e' => '--eps_dir',
+ '--f' => '--prefix',
+ '--h' => '--help',
+ '--k' => '--keep_files',
+ '--o' => '--output',
+ '--t' => '--temp_dir',
+ '--u' => '--help', # '--usage' is mapped to `--help'
+ '--V' => '--verbose', # `--Verbose' is mapped to `--verbose'
};
+ $long_opts[4] =
+ { # option abbreviations of 4 characters
+ '--li' => '--license',
+ '--ly' => '--ly2eps',
+ '--pd' => '--pdf2eps',
+ '--pr' => '--prefix',
+ };
- $opt[6] =
+ $long_opts[6] =
{ # option abbreviations of 6 characters
+ '--verb' => '--verbose',
+ '--vers' => '--version',
+ };
- '--verb' => sub { # `--verbose'
- $Args::verbose = main::TRUE;
- push @args, '--verbose';
- next ARGS;
- },
- '--vers' => sub { # `--version'
- &Subs::version;
- push @args, '==version';
- $exit = main::TRUE;
- },
+ # subs for short splitting and replacing long abbreviations
- };
+ my %split_subs =
+ (
+ 'short_opt_collection' => sub { # %split_subs
- # for optarg that is a complete argument
- my $arg_is_optarg =
- {
+ my @chars = split //, $1; # omit leading dash
+ CHARS: while ( @chars ) {
+ my $c = shift @chars;
- '--file_prefix' => sub {
- $Args::file_prefix = $arg;
- },
+ unless ( exists $short_opts{ $c } ) {
+ print STDERR "Unknown short option `-$c'.";
+ next CHARS;
+ }
- '--output' => sub {
- die "file name expected for option `--output'"
- unless ( $arg );
- $Args::output = $arg;
- },
+ # short option exists
- '--temp_dir' => sub {
- $Args::temp_dir = $arg;
- },
+ # map or transfer to special long option from above
+ my $transopt = $short_opts{ $c };
- };
+ if ( exists $opts_noarg{ $transopt } ) {
+ push @splitted_args, $transopt;
+ $Args::verbose = main::TRUE if ( $transopt eq '--verbose' );
+ next CHARS;
+ }
+ if ( exists $opts_with_arg{ $transopt } ) {
+ push @splitted_args, $transopt;
- my $check_arg = sub { # is used in `ARGS:' foreach
- # 2 arguments:
- # - content of $arg
- # - a number of 2, 3, 4, or 6
- my ( $from_arg, $n ) = @_;
-
- my $re = qr/^(.{$n})/;
- if ( $from_arg =~ $re ) {
- $from_arg = $1;
- if ( exists $opt[ $n ]-> { $from_arg } ) {
- &{ $opt[ $n ] -> { $from_arg } };
- next ARGS;
- } # end exists
- } # end match $n characters
- }; # end sub check_args()
+ if ( @chars ) {
+ # if @chars is not empty, option $transopt has argument
+ # in this arg, the rest of characters in @chars
+ shift @chars if ( $chars[0] eq '=' );
+ push @splitted_args, join "", @chars;
+ @chars = main::EMPTYARRAY;
+ next SPLIT;
+ }
+ # optarg is the next argument
+ $has_arg = $transopt;
+ next SPLIT;
+ } # end of if %opts_with_arg
+ } # end of while CHARS
+ }, # end of sub for short_opt_collection
- ARGS: foreach ( @ARGV ) {
- chomp;
- s/^\s*(.*)\s*$/$1/;
- $arg = $_;
- # former option needs this argument as optarg
- if ( exists $arg_is_optarg -> { $has_arg } ) {
- &{ $arg_is_optarg -> { $has_arg } };
- push @args, $former_arg . " " . $arg;
- $has_arg = main::EMPTYSTRING;
- $former_arg = main::EMPTYSTRING;
- next ARGS;
- }
+ 'long_option' => sub { # %split_subs
+ my $from_arg = shift;
+ N: for my $n ( qw/6 4 3/ ) {
+ $from_arg =~ / # match $n characters
+ ^
+ (
+ .{$n}
+ )
+ /x;
+ my $argn = $1; # get the first $n characters
+
+ # no match, so luck for fewer number of chars
+ next N unless ( $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 };
+
+ # test on option without arg
+ if ( exists $opts_noarg{ $transopt } ) { # opt has no arg
+ push @splitted_args, $transopt;
+ $Args::verbose = main::TRUE if ( $transopt eq '--verbose' );
+ next SPLIT;
+ } # end of if %opts_noarg
+
+ # test on option with arg
+ if ( exists $opts_with_arg{ $transopt } ) { # opt has arg
+ push @splitted_args, $transopt;
+
+ # test on optarg in arg
+ if ( $from_arg =~ / # optarg is in arg, has `='
+ ^
+ [^=]+
+ =
+ (
+ .*
+ )
+ $
+ /x ) {
+ push @splitted_args, $1;
+ next SPLIT;
+ } # end of if optarg in arg
- if ( $double_minus # `--' was former arg
- or $arg =~ /^[^-].*$/ ) { # arg is a file name without `-'
- push @files, $arg;
- next ARGS;
- } # after integration of file arg
+ # has optarg in next arg
+ $has_arg = $transopt;
+ next SPLIT;
+ } # end of if %opts_with_arg
+
+ # not with and without option, so is not permitted
+ print main::fh_verbose
+ "`$transopt' is unknown long option from `$from_arg'";
+ next SPLIT;
+ } # end of for N
+ }, # end of sub for long option
+ ); # end of %split_subs
+
+
+ #----------
+ # do split and transfer arguments
+ #----------
+
+ SPLIT: foreach (@ARGV) {
+ # Transform long and short options into some given long options.
+ # Split long opts with arg into 2 args (no `=').
+ # Transform short option collections into given long options.
+ chomp;
+ if ( $has_arg ) {
+ push @splitted_args, $_;
+ $has_arg = main::EMPTYSTRING;
+ next SPLIT;
+ }
- # now only args with starting '-'
+ if ( $double_minus ) {
+ push @files, $_;
+ next SPLIT;
+ }
- if ( exists $only_minus{ $arg } ) {
- &{ $only_minus{ $arg } };
- next ARGS;
+ if ( $_ eq '-' ) { # file arg `-'
+ push @files, $_;
+ next SPLIT;
}
- # deal with @opt
- &$check_arg( $arg, $_ ) foreach ( qw[ 6 4 3 2 ] );
+ if ( $_ eq '--' ) { # POSIX arg `--'
+ push @splitted_args, $_;
+ $double_minus = main::TRUE;
+ next SPLIT;
+ }
+ if ( / # short option or collection of short options
+ ^
+ -
+ (
+ [^-]
+ .*
+ )
+ $
+ /x ) {
+ $split_subs{ 'short_opt_collection' } -> ( $1 );
+ next SPLIT;
+ } # end of short option
+
+ if ( /^--/ ) { # starts with 2 dashes, a long option
+ $split_subs{ 'long_option' } -> ( $_ );
+ next SPLIT;
+ } # end of long option
+
+ # unknown option without leading dash is a file name
+ push @files, $_;
+ next SPLIT;
+ } # end of foreach SPLIT
- # wrong argument
- print STDERR "Wrong argument for groff_lilypond: `$arg'";
- next ARGS;
+ # all args are considered
+ print STDERR "Option `$has_arg' needs an argument." if ( $has_arg );
- } # end ARGS: foreach @ARGV
+ push @files, '-' unless ( @files );
+ @ARGV = @splitted_args;
+ } # end of splitting with map or transfer
- if ( $has_arg ) { # after last argument
- die "Option `$has_arg' needs an argument.";
- }
+ #----------
+ # open $main::fh_verbose
+ #----------
+ {
# install `$main::fh_verbose'
if ( $Args::verbose ) { # `--verbose' was used
# make verbose output, i.e. make `$main::fh_verbose' visible
@@ -421,53 +461,139 @@
# in /dev/null or in a string
my $opened = main::FALSE;
- my $null = '/dev/null';
- if ( -e $null && -w $null ) {
- open $main::fh_verbose, ">", $null or
- die "Could not open `$null': $!";
+ my $devnull = File::Spec->devnull();
+ if ( -e $devnull && -w $devnull ) {
+ open $main::fh_verbose, ">", $devnull or
+ die "Could not open `$devnull': $!";
# `/dev/null' will now be used for verbose output
$opened = main::TRUE;
}
- unless ( $opened ) { # couldn't use /dev/null, so print into a string
+ unless ( $opened ) { # couldn't use `$devnull', so print into a string
my $print_to_string;
open $main::fh_verbose, ">", \ $print_to_string or
die "Could not open `\$main::fh_verbose': $!";
# now verbose output will go into a string, which is ignored
}
- } # if-else about verbose
- # $main::fh_verbose is now active
+ } # end if-else about verbose
+ # $main::fh_verbose is now active
{
+ print $main::fh_verbose "Verbose output was chosen.";
+
my $s = $main::prog_is_installed ? '' : ' not';
print $main::fh_verbose "$main::prog is$s installed.";
+
print $main::fh_verbose 'The command line options are:';
- print $main::fh_verbose " @args";
- print $main::fh_verbose "files: @files";
+
+ $s = " options:";
+ $s .= " `$_'" for ( @ARGV );
+ print $main::fh_verbose $s;
+
+ $s = " file names:";
+ $s .= " `$_'\n" for ( @files );
+ print $main::fh_verbose $s;
+
+ }
+
+ } # end fh_verbose
+
+
+ #----------
+ # second run of command line arguments
+ #----------
+
+ {
+ # second run of args with new @ARGV from the formere splitting
+ # arguments are now splitted and transformed into special long options
+ my $double_minus = main::FALSE;
+ my $has_arg = main::FALSE;
+
+ my $has_arg = main::FALSE;
+
+ ARGS: for my $arg ( @ARGV ) {
+
+ # ignore `--', file names are handled later on
+ last ARGS if ( $arg eq '--' );
+
+ if ( $has_arg ) {
+ unless ( exists $opts_with_arg{ $has_arg } ) {
+ print STDERR "`\%opts_with_args' does not have key `$has_arg'.";
+ next ARGS;
}
+ $opts_with_arg{ $has_arg } -> ( $arg );
+ $has_arg = main::FALSE;
+ next ARGS;
+ } # end of $has_arg
- exit if ( $exit );
+ if ( exists $opts_with_arg{ $arg } ) {
+ $has_arg = $arg;
+ next ARGS;
+ }
+
+ if ( exists $opts_noarg{ $arg } ) {
+ $opts_noarg { $arg } -> ();
+ next ARGS;
+ }
+
+ # not a suitable option
+ print STDERR "Wrong option `$arg'.";
+ next ARGS;
+
+ } # end of for ARGS:
+
+
+ if ( $has_arg ) { # after last argument
+ die "Option `$has_arg' needs an argument.";
+ }
+
+ } # end ot second run
if ( $Args::output ) {
- open $main::fh_out, ">", $Args::output or
- die "could not write to `$Args::output': $!";
+ my $out_path = &Subs::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 )
+ 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'" unless ( $dir );
+ 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 = &Subs::make_dir( $dir );
+ die "Could not create output directory in: `$out_path'." unless ( $dir );
+ }
+
+ # now $dir is a writable directory
+
+ if ( -e $out_path ) {
+ die "Could not write to output file" unless ( -w $out_path );
+ }
+
+ open $main::fh_out, ">", $out_path or
+ die "could not write to output file `$out_path': $!";
+ print main::fh_verbose "Output goes to file `$out_path'";
} else {
$main::fh_out = *STDOUT;
}
- $Args::file_prefix .= '_' . $Args::eps_func;
+ $Args::file_prefix .= '_' . $Args::eps_func . '2eps';
@ARGV = @files;
-
}
# end package `Args'
@@ -481,72 +607,118 @@
package Temp;
use strict;
- use Cwd qw[];
# `$Cwd' stores the current directory
- ( $Temp::Cwd = Cwd::getcwd ) =~ s</*$></>; # add final slash
+ $Temp::cwd = Cwd::getcwd;
+ $Temp::temp_dir = main::EMPTYSTRING;
- if ( $Args::temp_dir ) { # temporary directory was set by `--temp_dir'
- my $dir = $Args::temp_dir;
- unless ( $dir =~ m<^/> ) { # not starting with a slash
- $dir = $Temp::Cwd . $dir;
- }
+ if ( $Args::temp_dir ) {
- # now $dir starts with a slash
+ #----------
+ # temporary directory was set by `--temp_dir'
+ #----------
- $dir =~ s{/*$}{/};
- if ( -e $dir ) {
- die "Could not write to temporary directory: $dir"
- unless ( -w $dir );
- unless ( -d $dir ) {
- unlink $dir;
- die "Could not remove $dir" if ( -e $dir );
+ my $dir = $Args::temp_dir;
+
+ $dir = &Subs::path2abs( $dir );
+ $dir = &Subs::make_dir ( $dir ) or
+ die "The directory `$dir' cannot be used temporarily: $!";
+
+
+ # now `$dir' is a writable directory
+
+ opendir( my $dh, $dir ) or
+ die "Could not open temporary directory `$dir': $!";
+ my $file_name;
+ my $found = main::FALSE;
+ my $re = qr<
+ ^
+ $Args::file_prefix
+ _
+ >x;
+
+ READDIR: while ( defined( $file_name = readdir ( $dh ) ) ) {
+ chomp $file_name;
+ if ( $file_name =~ /$re/ ) { # file name starts with $prefix_
+ $found = main::TRUE;
+ last READDIR;
}
+ next;
}
- if ( -d $dir ) { # is a directory
- my $files = glob $dir . $Args::file_prefix . "_*";
- $Args::file_prefix .= "_" . &Subs::dir_time if ( $files );
- } else { # not a directory
- my $dir = &Subs::make_dir ( $dir ) or
- die "The directory $dir cannot be used.";
+ $Temp::temp_dir = $dir;
+ my $n = 0;
+ while ( $found ) {
+ $dir = File::Spec -> catdir( $Temp::temp_dir, ++$n );
+ next if ( -e $dir );
+
+ $dir = &Subs::make_dir ( $dir ) or next;
+
+ $found = main::FALSE;
+ last;
}
- $Args::temp_dir = $dir;
+ $Temp::temp_dir = $dir;
} else { # $Args::temp_dir not given by `--temp_dir'
+ #----------
+ # temporary directory was not set
+ #----------
+
{ # search for or create a temporary directory
- my $path_extension = 'groff/';
+ my @tempdirs = main::EMPTYARRAY;
+ {
+ my $tmpdir = File::Spec -> tmpdir();
+ push @tempdirs, $tmpdir if ( $tmpdir && -d $tmpdir && -w $tmpdir );
+
+ my $root_dir = File::Spec -> rootdir(); # `/' in Unix
+ my $root_tmp = File::Spec -> catdir( $root_dir, 'tmp' );
+ push @tempdirs, $root_tmp
+ if ( $root_tmp ne $tmpdir && -d $root_tmp && -w $root_tmp );
+
+ # home directory of the actual user
+ my $home = File::HomeDir -> my_home;
+ my $home_tmp = File::Spec -> catdir ( $home, 'tmp' );
+ push @tempdirs, $home_tmp if ( -d $home_tmp && -w $home_tmp );
+
+ # `/var/tmp' in Unix
+ my $var_tmp = File::Spec -> catdir( '', 'var', 'tmp' );
+ push @tempdirs, $var_tmp if ( -d $var_tmp && -w $var_tmp );
+ }
+
+
+ my @path_extension = qw( groff ); # TEMPDIR/groff/USER/lilypond/<NUMBER>
{
- ( my $user = $ENV{ 'USER' } ) =~ s([\s/])()g;
- $path_extension .= $user. '/' if ($user);
+ # `$<' is UID of actual user,
+ # `getpwuid' gets user name in scalar context
+ my $user = getpwuid( $< );
+ push @path_extension, $user if ( $user );
+
+ push @path_extension, qw( lilypond );
}
- $path_extension .= 'lilypond/';
- ( my $home = $ENV{'HOME'} ) =~ s(/*$)(/);
+ TEMPS: foreach ( @tempdirs ) {
- TEMPS: foreach ( '/', $home, $Temp::Cwd ) {
- # temorary dirs by appending `tmp/'
+ my $dir; # final directory name in `while' loop
+ $dir = &Subs::path2abs ( $_ );
+ next TEMPS unless ( $dir );
# beginning of directory name
- my $dir_begin = $_ . 'tmp/' . $path_extension;
+ my @dir_begin =
+ ( File::Spec -> splitdir( $dir ), @path_extension );
- # `TRUE' when dir doesn't exist, free for creating
- my $dir; # final directory name in `until' loop
+ my $n = 0;
my $dir_blocked = main::TRUE;
BLOCK: while ( $dir_blocked ) {
# should become the final dir name
- $dir = $dir_begin . &Subs::dir_time;
- if ( -d $dir ) { # dir exists, so wait
- Time::HiRes::usleep(1); # wait 1 microsecond
- next BLOCK;
- }
+ $dir = File::Spec -> catdir ( @dir_begin, ++$n );
+ next BLOCK if ( -d $dir );
# dir name is now free, create it, and end the blocking
my $res = &Subs::make_dir( $dir );
@@ -558,25 +730,103 @@
next TEMPS unless ( -d $dir && -w $dir );
- $Args::temp_dir = $dir; # tmp/groff/USER/lilypond/TIME
+ # $dir is now a writable directory
+ $Temp::temp_dir = $dir; # tmp/groff/USER/lilypond/TIME
last TEMPS;
} # end foreach tmp directories
} # end to create a temporary directory
- $Args::temp_dir =~ s(/*$)(/);
+ die "Could not find a temporary directory" unless
+ ( $Temp::temp_dir && -d $Temp::temp_dir && -w $Temp::temp_dir );
} # end temporary directory
- print $main::fh_verbose "Temporary directory: `$Args::temp_dir'";
+ print $main::fh_verbose "Temporary directory: `$Temp::temp_dir'\n";
print $main::fh_verbose "file_prefix: `$Args::file_prefix'";
-}
-# end package `Temp'
+ #----------
+ # EPS directory
+ #----------
+
+ $Temp::eps_dir = main::EMPTYSTRING;
+ if ( $Args::eps_dir ) { # set by `--eps_dir'
+ my $dir = $Args::eps_dir;
+ my $make_dir = main::FALSE;
+
+ $dir = &Subs::path2abs( $dir );
+
+ if ( -e $dir ) {
+ goto EMPTY unless ( -w $dir );
+
+ # `$dir' is writable
+ if ( -d $dir ) {
+ my $upper_dir = $dir;
+
+ my $found = main::FALSE;
+ opendir( my $dh, $upper_dir ) or $found = main::TRUE;
+ my $re = qr<
+ ^
+ $Args::file_prefix
+ _
+ >x;
+ while ( not $found ) {
+ my $file_name = readdir ( $dh );
+ if ( $file_name =~ /$re/ ) { # file name starts with $prefix_
+ $found = main::TRUE;
+ last;
+ }
+ next;
+ }
+
+ my $n = 0;
+ while ( $found ) {
+ $dir = File::Spec -> catdir( $upper_dir, ++$n );
+ next if ( -d $dir );
+ $found = main::FALSE;
+ }
+ $make_dir = main::TRUE;
+ $Temp::eps_dir = $dir;
+ } else { # `$dir' is not a dir, so unlink it to create it as dir
+ if ( unlink $dir ) { # could remove `$dir'
+ $Temp::eps_dir = $dir;
+ $make_dir = main::TRUE;
+ } else { # could not remove
+ print STDERR "Could not use EPS dir `$dir', use temp dir.";
+ } # end of unlink
+ } # end test of -d $dir
+ } else {
+ $make_dir = main::TRUE;
+ } # end of if -e $dir
+
+
+ if ( $make_dir ) { # make directory `$dir'
+ my $made = main::FALSE;
+ $dir = &Subs::make_dir ( $dir ) and $made = main::TRUE;
+
+ if ( $made ) {
+ $Temp::eps_dir = $dir;
+ print $main::fh_verbose "Directory for useful EPS files is `$dir'.";
+ } else {
+ print main::fh_verbose "The EPS directory $dir cannot be used: $!";
+ }
+ } else { # `--eps_dir' was not set, so take the temporary directory
+ $Temp::eps_dir = $Args::temp_dir;
+ } # end of make dir
+ }
+
+ EMPTY: unless ( $Temp::eps_dir ) {
+ # EPS-dir not set or available, use temp dir,
+ # but leave $Temp::eps_dir empty
+ print $main::fh_verbose "Directory for useful EPS files is the " .
+ "temporary directory `$Temp::temp_dir'.";
+ }
+
+} # end package `Temp'
########################################################################
-# read files or stdin
+# Read: read files or stdin
########################################################################
{ # read files or stdin
@@ -595,17 +845,20 @@
my $arg1; # first argument for `.lilypond'
my $arg2; # argument for `.lilypond include'
+ my $path_ly; # path of ly-file
+
my $check_file = sub { # for argument of `.lilypond include'
- my $file = shift;
+ my $file = shift; # argument is a file name
+ $file = &Subs::path2abs( $file );
unless ( $file ) {
die "Line `.lilypond include' without argument";
- return '';;
+ return '';
}
unless ( -f $file && -r $file ) {
die "Argument `$file' in `.lilypond include' is not a readable file";
- return main::EMPTYSTRING;
}
+
return $file;
}; # end sub &$check_file()
@@ -614,15 +867,17 @@
++$ly_number;
$Read::file_numbered = $Args::file_prefix . '_' . $ly_number;
$Read::file_ly = $Read::file_numbered . '.ly';
+ $path_ly = File::Spec -> catdir ( $Temp::temp_dir, $Read::file_ly );
};
- my %eps_subs = (
- 'ly2eps' => \&Subs::create_ly2eps,
- 'pdf2eps' => \&Subs::create_pdf2eps,
+ my %eps_subs =
+ (
+ 'ly' => \&Subs::create_ly2eps, # lilypond creates eps files
+ 'pdf' => \&Subs::create_pdf2eps, # lilypond creates pdf file
);
- # about lines starting with `.lilypobnd'
+ # about lines starting with `.lilypond'
my $fh_write_ly;
my $fh_include_file;
@@ -630,23 +885,23 @@
(
'start' => sub {
- print $main::fh_verbose "line: `.lilypond start'";
+ print $main::fh_verbose "\nline: `.lilypond start'";
die "Line `.lilypond stop' expected." if ( $lilypond_mode );
$lilypond_mode = main::TRUE;
&$increase_ly_number;
print $main::fh_verbose
- "ly-file: `" . $Args::temp_dir . $Read::file_ly . "'";
+ "ly-file: `" . $path_ly . "'";
- open $fh_write_ly, ">", $Args::temp_dir . $Read::file_ly or
- die "Cannot open file `$Args::temp_dir$Read::file_ly': $!";
+ open $fh_write_ly, ">", $path_ly or
+ die "Cannot open file `$path_ly': $!";
next LILYPOND;
},
'end' => sub {
- print $main::fh_verbose "line: `.lilypond end'";
+ print $main::fh_verbose "line: `.lilypond end'\n";
die "Expected line `.lilypond start'." unless ( $lilypond_mode );
$lilypond_mode = main::FALSE;
@@ -672,11 +927,12 @@
next LILYPOND unless ( $file );
# file can be read now
+
# `$fh_write_ly' must be opened
&$increase_ly_number;
- open $fh_write_ly, ">", $Args::temp_dir . $Read::file_ly or
- die "Cannot open file `$Read::file_ly': $!";
+ open $fh_write_ly, ">", $path_ly or
+ die "Cannot open file `$path_ly': $!";
open $fh_include_file, "<", $file # for reading
or die "File `$file' could not be read: $!";
@@ -699,7 +955,6 @@
); # end definition %lilypond_args
-
LILYPOND: foreach (<>) {
chomp;
my $line = $_;
@@ -707,11 +962,32 @@
# now the lines with '.lilypond ...'
- if ( /^[.']\s*lilypond(.*)$/ ) { # .lilypond ...
+ if ( /
+ ^
+ [.']
+ \s*
+ lilypond
+ (
+ .*
+ )
+ $
+ /x ) { # .lilypond ...
my $args = $1;
- $args =~ s/^\s*//;
- $args =~ s/\s*$//;
- $args =~ s/^(\S*)\s*//;
+ $args =~ s/
+ ^
+ \s*
+ //x;
+ $args =~ s/
+ \s*
+ $
+ //x;
+ $args =~ s/
+ ^
+ (
+ \S*
+ )
+ \s*
+ //x;
my $arg1 = $1; # `start', `end' or `include'
$args =~ s/["'`]//g;
my $arg2 = $args; # file argument for `.lilypond include'
@@ -721,7 +997,7 @@
} else {
# not a suitable argument of `.lilypond'
- print STDERR "Unknown command: `$arg1' `$arg2': `$_'";
+ print STDERR "Unknown command: `$arg1' `$arg2': `$line'";
}
next LILYPOND;
@@ -735,7 +1011,12 @@
} # do lilypond-mode
# unknown line without lilypond
- unless ( /^[.']\s*lilypond/ ) { # not a `.lilypond' line
+ unless ( /
+ ^
+ [.']
+ \s*
+ lilypond
+ /x ) { # not a `.lilypond' line
print $main::fh_out $line;
next LILYPOND;
}
@@ -753,37 +1034,118 @@
use strict;
- # With --keep_files, no temporary files are removed.
if ( $Args::keep_files ) {
+ # With --keep_files, no temporary files are removed.
print $main::fh_verbose "keep_files: `TRUE'";
print $main::fh_verbose "No temporary files will be deleted:";
- opendir my $dh_temp, $Args::temp_dir or
- die "Cannot open $Args::temp_dir: $!";
-
+ opendir my $dh_temp, $Temp::temp_dir or
+ die "Cannot open $Temp::temp_dir: $!";
for ( sort readdir $dh_temp ) {
- next if ( /^\./ );
- my $prefix = $Args::file_prefix . '_';
- my $re = qr/^$prefix/;
- if ( $_ =~ $re ) {
- print $main::fh_verbose "- " . $Args::temp_dir . $_;
+ next if ( / # omit files starting with a dot
+ ^
+ \.
+ /x );
+ if ( /
+ ^
+ $Args::file_prefix
+ _
+ /x ) {
+ my $file = File::Spec -> catfile( $Temp::temp_dir, $_ );
+ print $main::fh_verbose "- " . $file ;
next;
}
next;
- }
-
+ } # end for sort readdir
closedir $dh_temp;
- } else {
+
+ } else { # keep_files is not set
# Remove all temporary files except the eps files.
+
print $main::fh_verbose "keep_files: `FALSE'";
print $main::fh_verbose
"All temporary files except *.eps will be deleted";
- unlink glob $Args::temp_dir . $Args::file_prefix . "*.[a-df-zA-Z0-9]*";
- unlink glob $Args::temp_dir . $Args::file_prefix . "_temp*";
+
+ if ( $Temp::eps_dir ) {
+ # EPS files are in another dir, remove temp dir
+
+ if ( &Subs::is_subdir( $Temp::eps_dir, $Temp::temp_dir ) ) {
+ print $main::fh_verbose "EPS dir is subdir of temp dir, so keep both.";
+ } else { # remove temp dir
+ print $main::fh_verbose
+ "Try to remove temporary directory `$Temp::temp_dir':";
+ if ( File::Path::remove_tree( $Temp::temp_dir ) ) { # remove succeeds
+ print $main::fh_verbose "...done.";
+ } else { # did not remove
+ print $main::fh_verbose "Failure to remove temporary directory.";
+ } # end test on remove
+ } # end is subdir
+
+ } else { # no EPS dir, so keep EPS files
+
+ opendir my $dh_temp, $Temp::temp_dir or
+ die "Cannot open $Temp::temp_dir: $!";
+ for ( sort readdir $dh_temp ) {
+ next if ( / # omit files starting with a dot
+ ^
+ \.
+ /x );
+ next if ( / # omit EPS-files
+ \.eps
+ $
+ /x );
+ if ( /
+ ^
+ $Args::file_prefix
+ _
+ /x ) { # this includes `PREFIX_temp*'
+ my $file = File::Spec -> catfile( $Temp::temp_dir, $_ );
+ print $main::fh_verbose "Remove " . $file;
+ unlink $file or print STDERR "Could not remove $file: $!";
+ next;
+ } # end if prefix
+ next;
+ } # end for readdir temp dir
+ closedir $dh_temp;
+ } # end if-else EPS files
+ } # end if-else keep files
+
+
+
+
+ if ( $Temp::eps_dir ) {
+ # EPS files in $Temp::eps_dir are always kept
+ print $main::fh_verbose "As EPS directrory is set as `$Temp::eps_dir'" .
+ ", noEPS files there will be deleted:";
+
+ opendir my $dh_temp, $Temp::eps_dir or
+ die "Cannot open $Temp::eps_dir: $!";
+ for ( sort readdir $dh_temp ) {
+ next if ( / # omit files starting with a dot
+ ^
+ \.
+ /x );
+ if ( /
+ ^
+ $Args::file_prefix
+ _
+ .*
+ \.eps
+ $
+ /x ) {
+ my $file = File::Spec -> catfile( $Temp::eps_dir, $_ );
+ print $main::fh_verbose "- " . $file ;
+ next;
+ } # end if *.eps
+ next;
+ } # end for sort readdir
+ closedir $dh_temp;
+
}
+
close $main::fh_out unless ( $main::fh_out =~ /STD/ );
close $main::fh_verbose unless ( $main::fh_verbose =~ /STD/ );
@@ -810,13 +1172,43 @@
"--output=$prefix $prefix";
&Subs::run_lilypond("$opts");
- chdir $Temp::Cwd or
- die "Could not change to former directory `$Temp::Cwd': $!";
+ Cwd::chdir $Temp::cwd or
+ die "Could not change to former directory `$Temp::cwd': $!";
+
+ my $eps_dir = $Temp::eps_dir;
+ my $dir = $Temp::temp_dir;
+ opendir( my $dh, $dir ) or
+ die "could not open temporary directory `$dir': $!";
+
+ my $re = qr<
+ ^
+ $prefix
+ -
+ .*
+ \.eps
+ $
+ >x;
+ my $file;
+ while ( readdir( $dh ) ) {
+ chomp;
+ $file = $_;
+ if ( /$re/ ) {
+ my $file_path = File::Spec -> catfile( $dir, $file );
+ if ( $eps_dir ) {
+ my $could_copy = main::FALSE;
+ File::Copy::copy ( $file_path, $eps_dir )
+ and $could_copy = main::TRUE;
+ if ( $could_copy ) {
+ unlink $file_path;
+ $file_path = File::Spec -> catfile( $eps_dir, $_ );
+ }
+ }
+ print $main::fh_out '.PSPIC ' . $file_path;
+ }
+ } # end while readdir
+ closedir( $dh );
+ } # end sub create_ly2eps()
- foreach ( glob $Args::temp_dir . $prefix . '-*' . '.eps' ) {
- print $main::fh_out '.PSPIC ' . $_;
- } # end foreach
- }
sub create_pdf2eps { # `--pdf2eps'
my $prefix = $Read::file_numbered; # with dir change to temp dir
@@ -845,84 +1237,198 @@
print $main::fh_verbose "##### end run of `ps2eps'\n";
# change back to former dir
- chdir $Temp::Cwd or
- die "Could not change to former directory `$Temp::Cwd': $!";
+ Cwd::chdir $Temp::cwd or
+ die "Could not change to former directory `$Temp::cwd': $!";
# handling of .eps file
- my $file_eps = $Args::temp_dir . $prefix . '.eps';
+ my $file_eps = $prefix . '.eps';
+ my $eps_path = File::Spec -> catfile( $Temp::temp_dir, $file_eps );
+ if ( $Temp::eps_dir ) {
+ my $has_copied = main::FALSE;
+ File::Copy::copy( $eps_path, $Temp::eps_dir )
+ and $has_copied = main::TRUE;
+ if ( $has_copied ) {
+ unlink $eps_path;
+ $eps_path = File::Spec -> catfile( $Temp::eps_dir, $file_eps );
+ } else {
+ print STDERR "Could not use EPS-directory.";
+ } # end Temp::eps_dir
+ }
# print into groff output
- print $main::fh_out '.PSPIC ' . $file_eps;
+ print $main::fh_out '.PSPIC ' . $eps_path;
+ } # end sub create_pdf2eps()
+
+
+ sub is_subdir { # arg1 is subdir of arg2 (is longer)
+ my ( $dir1, $dir2 ) = @_;
+ $dir1 = &Subs::path2abs( $dir1 );;
+ $dir2 = &Subs::path2abs( $dir2 );;
+ my @split1 = File::Spec -> splitdir( $dir1 );
+ my @split2 = File::Spec -> splitdir( $dir2 );
+ for ( @split2 ) {
+ next if ( $_ eq shift @split1 );
+ return main::FALSE;
+ }
+ return main::TRUE;
}
- sub dir_time { # time and microseconds for temporary directory name
- my $res;
- my ( $sec, $min, $hour, $day_of_month, $month, $year,
- $weak_day, $day_of_year, $is_summer_time ) =
- localtime( time() );
-
- $year += 1900;
- $month += 1;
- $month = '0' . $month if ( $month < 10 );
- $day_of_month = '0' . $day_of_month if ( $day_of_month < 10 );
- $hour = '0' . $hour if ( $hour < 10 );
- $min = '0' . $min if ( $min < 10 );
- $sec = '0' . $sec if ( $sec < 10 );
-
- $res = $year . '-' . $month . '-' . $day_of_month . '_';
- $res .= $hour . '-' . $min . '-' . $sec;
-
- (my $second, my $micro_second) = Time::HiRes::gettimeofday();
- $res .= '_' . $micro_second;
- } # end sub dir_time(). time for temporary directory
sub license {
&version;
print STDOUT $main::License;
+ } # end sub license()
+
+
+ sub make_dir { # make directory or check if it exists
+ my $dir_arg = shift;
+ chomp $dir_arg;
+ $dir_arg =~ s/^\s*(.*)\s*$/$1/;
+
+ unless ( $dir_arg ) {
+ print $main::fh_verbose "make_dir(): empty argument";
+ return $main::FALSE;
}
- sub make_dir { # make directory or check if exists
- my $arg = shift;
- $arg =~ s/^\s*(.*)\s*$/$1/;
+ unless ( File::Spec->file_name_is_absolute( $dir_arg ) ) {
+ my $res = Cwd::realpath( $dir_arg );
+ $res = File::Spec -> canonpath ( $dir_arg ) unless ( $res );
+ $dir_arg = $res if ( $res );
+ }
+
+ return $dir_arg if ( -d $dir_arg && -w $dir_arg );
+
+
+ # search thru the dir parts
+ my @dir_parts = File::Spec -> splitdir( $dir_arg );
+ my @dir_grow;
+ my $dir_grow;
+ my $can_create = main::FALSE; # dir could be created if TRUE
+
+ DIRPARTS: for ( @dir_parts ) {
+ push @dir_grow, $_;
+ next DIRPARTS unless ( $_ ); # empty string for root directory
- unless ( $arg =~ m<^/> ) { # starts not with `/', so it's not absolute
- my $cwd = $Temp::Cwd;
- chomp $cwd;
+ # from array to path dir string
+ $dir_grow = File::Spec -> catdir ( @dir_grow );
- die "Could not create directory $arg because current working " .
- "directory is not writable." unless ( -w $cwd );
+ next DIRPARTS if ( -d $dir_grow );
- $cwd =~ s(/*$)(/);
+ if ( -e $dir_grow ) { # exists, but not a dir, so must be removed
+ die "Couldn't create dir `$dir_arg', it is blocked by `$dir_grow'."
+ unless ( -w $dir_grow );
- $arg = $cwd . $arg;
+ # now it's writable, but not a dir, so it can be removed
+ unlink ( $dir_grow ) or
+ die "Couldn't remove `$dir_grow', " .
+ "so I cannot create dir `$dir_arg': $!";
}
- return main::FALSE unless ( $arg );
+ # $dir_grow does no longer exist, so the former dir must be writable
+ # in order to create the directory
+ pop @dir_grow;
+ $dir_grow = File::Spec -> catdir ( @dir_grow );
- if ( -d $arg ) { # $arg is a directory
- return main::FALSE unless ( -w $arg );
- } else { # $arg is not a directory
- if ( -e $arg ) { # $arg exists
- -w $arg && unlink $arg ||
- die "could not delete `" . $arg . "': $!";
- } # end of if, existing $arg
+ die "`$dir_grow' is not writable, " .
+ "so directory `$dir_arg' can't be createdd."
+ unless ( -w $dir_grow );
- File::Path::make_path( $arg, {mask=>oct('0700')}) # `mkdir -P'
- or die "Could not create directory `$arg': $!";
+ # former directory is writable, so `$dir_arg' can be created
+
+ File::Path::make_path( $dir_arg,
+ {
+ mask => oct( '0700' ),
+ verbose => $Args::verbose,
+ }
+ ) # `mkdir -P'
+ or die "Could not create directory `$dir_arg': $!";
+
+ last DIRPARTS;
+ }
+
+ die "`$dir_arg' is not a writable directory"
+ unless ( -d $dir_arg && -w $dir_arg );
+
+ return $dir_arg;
- } # end if, else: not a directory
- return $arg;
} # end sub make_dir()
+
sub next_temp_file {
state $n = 0;
- my $temp_file = $Args::temp_dir . $Args::file_prefix . '_temp_' . ++$n;
+ ++$n;
+ my $temp_basename = $Args::file_prefix . '_temp_' . $n;
+ my $temp_file = File::Spec -> catfile( $Temp::temp_dir, $temp_basename );
print $main::fh_verbose "next temporary file: `$temp_file'";
return $temp_file;
+ } # end sub next_temp_file()
+
+
+ sub path2abs {
+ my $path = shift;
+ $path =~ s/
+ ^
+ \s*
+ (
+ .*
+ )
+ \s*
+ $
+ /$1/x;
+
+ die "path2abs(): argument is empty." unless ( $path );
+
+ # Perl does not support shell `~' for home dir
+ if ( $path =~ /
+ ^
+ ~
+ /x ) {
+ if ( $path eq '~' ) { # only own home
+ $path = File::HomeDir -> my_home;
+ } elsif ( $path =~ m<
+ ^
+ ~ /
+ (
+ .*
+ )
+ $
+ >x ) { # subdir of own home
+ $path = File::Spec -> catdir( $Temp::cwd, $1 );
+ } elsif ( $path =~ m<
+ ^
+ ~
+ (
+ [^/]+
+ )
+ $
+ >x ) { # home of other user
+ $path = File::HomeDir -> users_home( $1 );
+ } elsif ( $path =~ m<
+ ^
+ ~
+ (
+ [^/]+
+ )
+ /+
+ (
+ .*
+ )
+ $
+ >x ) { # subdir of other home
+ $path = File::Spec ->
+ catdir( File::HomeDir -> users_home( $1 ), $2 );
+ }
+ }
+
+ $path = File::Spec -> rel2abs ( $path );
+
+ # now $path is absolute
+ return $path;
}
+
sub run_lilypond {
- # arg is the options collection for lilypond to run
- # either from ly2eps or pdf2eps
+ # arg is the options collection for `lilypond' to run
+ # either from ly or pdf
my $opts = shift;
chomp $opts;
@@ -930,10 +1436,10 @@
my $output = main::EMPTYSTRING;
# change to temp dir
- chdir $Args::temp_dir or
- die "Could not change to temporary directory `$Args::temp_dir': $!";
+ Cwd::chdir $Temp::temp_dir or
+ die "Could not change to temporary directory `$Temp::temp_dir': $!";
- print $main::fh_verbose "\n##### run of `lilypond'";
+ print $main::fh_verbose "\n##### run of `lilypond $opts'";
$output = `lilypond $opts 2>$temp_file`;
die "Program lilypond does not work: $?" if ( $? );
chomp $output;
@@ -941,11 +1447,12 @@
print $main::fh_verbose "##### end run of `lilypond'\n";
# stay in temp dir
- }
+ } # end sub run_lilypond()
+
sub shell_handling {
# Handle ``-shell-command output in a string (arg1).
- # stderr goes to temporarty file $TempFile.
+ # stderr goes to temporary file $TempFile.
my $out_string = shift;
my $temp_file = shift;
@@ -970,7 +1477,8 @@
close $fh_temp;
unlink $temp_file unless ( $Args::keep_files );
- }
+ } # end sub shell_handling()
+
sub usage { # for `--help'
my $p = $main::prog;
@@ -998,20 +1506,26 @@
--ly2eps `lilypond' generates `EPS' files directly (default)
--pdf2eps `lilypond' generates a `PDF' file that is transformed
---keep_files do not delete any temporary files
+-k|--keep_files do not delete any temporary files
-V|--Verbose|--verbose print much information to STDERR
Options with an argument:
---file_prefix=... start for the names of temporary files
+-e|--eps_dir=... use a directory for the EPS files
-o|--output=... sent output in the groff language into file ...
---temp_dir=... provide the directory for temporary files.
- This is created if it does not exist.
+-p|--prefix=... start for the names of temporary files
+-t|--temp_dir=... provide the directory for temporary files.
+
+The set directories are created when they do not exist.
+
+In a former version of $p, there was an additional option `--file_+prefix',
+this is now replaced by `--prefix'.
Perl >=5.10.0 needed.*;
print STDOUT $usage;
} # end sub usage()
+
sub version { # for `--version'
my $end;
if ( $main::groff_version ) {
@@ -1027,6 +1541,7 @@
print STDOUT $output;
} # end sub version()
+
} # end package `Subs'