[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[groff] 22/39: [glilypond]: Make script stand alone.
|
From: |
G. Branden Robinson |
|
Subject: |
[groff] 22/39: [glilypond]: Make script stand alone. |
|
Date: |
Sun, 9 Oct 2022 23:53:38 -0400 (EDT) |
gbranden pushed a commit to branch master
in repository groff.
commit 427a5cb1fc6761a0fd6e338d23732522b02804b0
Author: G. Branden Robinson <g.branden.robinson@gmail.com>
AuthorDate: Sun Oct 9 07:00:05 2022 -0500
[glilypond]: Make script stand alone.
* contrib/glilypond/args.pl:
* contrib/glilypond/oop_fh.pl
* contrib/glilypond/subs.pl: Delete, moving their content into...
* contrib/glilypond/glilypond.pl: ...here. Also bump overall license to
GPLv3 from GPLv2 because all of the deleted files were GPLv3.
* contrib/glilypond/glilypond.am (dist_glilypond_DATA): Delete.
---
contrib/glilypond/ChangeLog | 11 +
contrib/glilypond/args.pl | 499 -----------------
contrib/glilypond/glilypond.am | 4 -
contrib/glilypond/glilypond.pl | 1158 +++++++++++++++++++++++++++++++++++++++-
contrib/glilypond/oop_fh.pl | 306 -----------
contrib/glilypond/subs.pl | 466 ----------------
6 files changed, 1162 insertions(+), 1282 deletions(-)
diff --git a/contrib/glilypond/ChangeLog b/contrib/glilypond/ChangeLog
index 28f3ce354..2c60c3634 100644
--- a/contrib/glilypond/ChangeLog
+++ b/contrib/glilypond/ChangeLog
@@ -1,3 +1,14 @@
+2022-10-19 G. Branden Robinson <g.branden.robinson@gmail.com>
+
+ Make glilypond script stand alone.
+
+ * args.pl:
+ * oop_fh.pl
+ * subs.pl: Delete, moving their content into...
+ * glilypond.pl: ...here. Also bump overall license to GPLv3
+ from GPLv2 because all of the deleted files were GPLv3.
+ * glilypond.am (dist_glilypond_DATA): Delete.
+
2022-05-03 G. Branden Robinson <g.branden.robinson@gmail.com>
* glilypond.am (glilypond): Spell dependency on
diff --git a/contrib/glilypond/args.pl b/contrib/glilypond/args.pl
deleted file mode 100644
index 56e379fba..000000000
--- a/contrib/glilypond/args.pl
+++ /dev/null
@@ -1,499 +0,0 @@
-########################################################################
-# Legalese
-########################################################################
-
-my $License = q*
-groff_lilypond - integrate 'lilypond' into 'groff' files
-
-Copyright (C) 2013-2020 Free Software Foundation, Inc.
- Written by Bernd Warken <groff-bernd.warken-72@web.de>
-
-This file is part of 'GNU groff'.
-
- 'GNU groff' is free software: you can redistribute it and/or modify it
-under the terms of the 'GNU General Public License' as published by the
-'Free Software Foundation', either version 3 of the License, or (at your
-option) any later version.
-
- 'GNU groff' is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 'GNU
-General Public License' for more details.
-
- You should have received a copy of the 'GNU General Public License'
-along with 'groff', see the files 'COPYING' and 'LICENSE' in the top
-directory of the 'groff' source package. If not, see
-<http://www.gnu.org/licenses/>.
-*;
-
-##### end legalese
-
-
-# use strict;
-# use warnings;
-# use diagnostics;
-
-use integer;
-
-our ( $Globals, $Args, $stderr, $v, $out );
-
-# ----------
-# subs for second run, for remaining long options after splitting and
-# transfer
-# ----------
-
-my %opts_with_arg =
- (
-
- '--eps_dir' => sub {
- $Args->{'eps_dir'} = shift;
- },
-
- '--output' => sub {
- $Args->{'output'} = shift;
- },
-
- '--prefix' => sub {
- $Args->{'prefix'} = shift;
- },
-
- '--temp_dir' => sub {
- $Args->{'temp_dir'} = shift;
- },
-
- ); # end of %opts_with_arg
-
-
-my %opts_noarg =
- (
-
- '--help' => sub {
- &usage;
- exit;
- },
-
- '--keep_all' => sub {
- $Args->{'keep_all'} = TRUE;
- },
-
- '--license' => sub {
- &license;
- exit;
- },
-
- '--ly2eps' => sub {
- $Args->{'eps_func'} = 'ly';
- },
-
- '--pdf2eps' => sub {
- $Args->{'eps_func'} = 'pdf';
- },
-
- '--verbose' => sub {
- $Args->{'verbose'} = TRUE;
- },
-
- '--version' => sub {
- &version;
- exit;
- },
-
- ); # end of %opts_noarg
-
-
-# used variables in both runs
-
-my @files = EMPTYARRAY;
-
-
-#----------
-# first run for command-line arguments
-#----------
-
-# global variables for first run
-
-my @splitted_args;
-my $double_minus = FALSE;
-my $arg = EMPTYSTRING;
-my $has_arg = FALSE;
-
-
-# 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 =
- (
- '?' => '--help',
- 'e' => '--eps_dir',
- 'h' => '--help',
- 'l' => '--license',
- 'k' => '--keep_all',
- 'o' => '--output',
- 'p' => '--prefix',
- 't' => '--temp_dir',
- 'v' => '--verbose',
- 'V' => '--verbose',
- );
-
-
-# transfer long option abbreviations to the long options from above
-
-my @long_opts;
-
-$long_opts[3] =
- { # option abbreviations of 3 characters
- '--e' => '--eps_dir',
- '--f' => '--prefix', # --f for --file_prefix
- '--h' => '--help',
- '--k' => '--keep_all', # and --keep_files
- '--o' => '--output',
- '--p' => '--prefix', # and --file_prefix
- '--t' => '--temp_dir',
- '--u' => '--help', # '--usage' is mapped to '--help'
- };
-
-$long_opts[4] =
- { # option abbreviations of 4 characters
- '--li' => '--license',
- '--ly' => '--ly2eps',
- '--pd' => '--pdf2eps',
- '--pr' => '--prefix',
- };
-
-$long_opts[6] =
- { # option abbreviations of 6 characters
- '--verb' => '--verbose',
- '--vers' => '--version',
- };
-
-
-# subs for short splitting and replacing long abbreviations
-
-my $split_short = sub {
-
- my @chars = split //, $1; # omit leading dash
-
- # if result is TRUE: run 'next SPLIT' afterwards
-
- CHARS: while ( @chars ) {
- my $c = shift @chars;
-
- 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};
-
- if ( exists $opts_noarg{$transopt} ) {
- push @splitted_args, $transopt;
- $Args->{'verbose'} = TRUE if ( $transopt eq '--verbose' );
- next CHARS;
- }
-
- if ( exists $opts_with_arg{$transopt} ) {
- push @splitted_args, $transopt;
-
- if ( @chars ) {
- # if @chars is not empty, option $transopt has argument
- # in this arg, the rest of characters in @chars
- push @splitted_args, join "", @chars;
- @chars = EMPTYARRAY;
- return TRUE; # use 'next SPLIT' afterwards
- }
-
- # optarg is the next argument
- $has_arg = $transopt;
- return TRUE; # use 'next SPLIT' afterwards
- } # end of if %opts_with_arg
- } # end of while CHARS
- return FALSE; # do not do anything
-}; # end of sub for short_opt_collection
-
-
-my $split_long = sub {
- my $from_arg = shift;
- $from_arg =~ /^([^=]+)/;
- my $opt_part = lc($1);
- my $optarg = undef;
- if ( $from_arg =~ /=(.*)$/ ) {
- $optarg = $1;
- }
-
- N: for my $n ( qw/6 4 3/ ) {
- $opt_part =~ / # 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
- $stderr->print( 'Option ' . $transopt . 'has no argument: ' .
- $from_arg . '.' ) if ( defined($optarg) );
- push @splitted_args, $transopt;
- $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
- push @splitted_args, $transopt;
-
- # test on optarg in arg
- if ( defined($optarg) ) {
- push @splitted_args, $1;
- return TRUE; # use 'next SPLIT' afterwards
- } # end of if optarg in arg
-
- # has optarg in next arg
- $has_arg = $transopt;
- return TRUE; # use 'next SPLIT' afterwards
- } # 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 . "'" );
- return TRUE; # use 'next SPLIT' afterwards
- } # end of for N
- return FALSE; # do nothing
-}; # end of split_long()
-
-
-#----------
-# do split and transfer arguments
-#----------
-sub run_first {
-
- 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 = EMPTYSTRING;
- next SPLIT;
- }
-
- if ( $double_minus ) {
- push @files, $_;
- next SPLIT;
- }
-
- if ( $_ eq '-' ) { # file arg '-'
- push @files, $_;
- next SPLIT;
- }
-
- if ( $_ eq '--' ) { # POSIX arg '--'
- push @splitted_args, $_;
- $double_minus = TRUE;
- next SPLIT;
- }
-
- if ( / # short option or collection of short options
- ^
- -
- (
- [^-]
- .*
- )
- $
- /x ) {
- $split_short->($1);
- next SPLIT;
- } # end of short option
-
- if ( /^--/ ) { # starts with 2 dashes, a long option
- $split_long->($_);
- next SPLIT;
- } # end of long option
-
- # unknown option without leading dash is a file name
- push @files, $_;
- next SPLIT;
- } # end of foreach SPLIT
-
- # all args are considered
- $stderr->print( "Option '$has_arg' needs an argument." )
- if ( $has_arg );
-
-
- push @files, '-' unless ( @files );
- @ARGV = @splitted_args;
-
-}; # end of first run, splitting with map or transfer
-
-
-#----------
-# open or ignore verbose output
-#----------
-sub install_verbose {
- 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
-
- $v = new FH_STDERR(); # make verbose output into STDERR
- if ( $s ) {
- for ( @$s ) {
- # print the file content into new verbose output
- $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 = 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( "Verbose output was chosen." );
-
- my $s = $Globals->{'prog_is_installed'} ? '' : ' not';
- $v->print( $Globals->{'prog'} . " is" . $s .
- " installed." );
-
- $v->print( 'The command-line options are:' );
-
- $s = " options:";
- $s .= " '" . $_ . "'" for ( @ARGV );
- $v->print( $s );
-
- $s = " file names:";
- $s .= " '" . $_ . "'\n" for ( @files );
- $v->print( $s );
-} # end install_verbose()
-
-
-#----------
-# second run of command-line arguments
-#----------
-sub run_second {
- # Second run of args with new @ARGV from the former splitting.
- # Arguments are now splitted and transformed into special long options.
-
- my $double_minus = FALSE;
- my $has_arg = 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} ) {
- $stderr->print( "'\%opts_with_args' does not have key '" .
- $has_arg . "'." );
- next ARGS;
- }
-
- $opts_with_arg{$has_arg}->($arg);
- $has_arg = FALSE;
- next ARGS;
- } # end of $has_arg
-
- 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
- $stderr->print( "Wrong option '" . $arg . "'." );
- next ARGS;
-
- } # end of for ARGS:
-
-
- if ( $has_arg ) { # after last argument
- die "Option '$has_arg' needs an argument.";
- }
-
- }; # end of second run
-
-
-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."
- 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 = &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 '" . $out_path . "'."
- unless ( -w $out_path );
- }
-
- $out = new FH_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';
-
- @ARGV = @files;
-}
-
-
-1;
-# Local Variables:
-# fill-column: 72
-# mode: CPerl
-# End:
-# vim: set autoindent textwidth=72:
diff --git a/contrib/glilypond/glilypond.am b/contrib/glilypond/glilypond.am
index d31c8314d..d18049f44 100644
--- a/contrib/glilypond/glilypond.am
+++ b/contrib/glilypond/glilypond.am
@@ -28,10 +28,6 @@ man1_MANS += contrib/glilypond/glilypond.1
# files going to lib directory '$(glilypond_dir)'
# TODO glilypond_dir is subsitued by configure.ac, check if this could be
removed
glilyponddir = $(glilypond_dir)
-dist_glilypond_DATA = \
- contrib/glilypond/subs.pl \
- contrib/glilypond/oop_fh.pl \
- contrib/glilypond/args.pl
EXTRA_DIST += \
contrib/glilypond/ChangeLog \
diff --git a/contrib/glilypond/glilypond.pl b/contrib/glilypond/glilypond.pl
index 1cde0be5e..daf3bdd1d 100755
--- a/contrib/glilypond/glilypond.pl
+++ b/contrib/glilypond/glilypond.pl
@@ -26,7 +26,7 @@ our $Legalese;
{
use constant VERSION => 'v1.3.1'; # version of glilypond
-### This constant 'LICENSE' is the license for this file 'GPL' >= 2
+### This constant 'LICENSE' is the license for this file 'GPL' >= 3
use constant LICENSE => q*
glilypond - integrate 'lilypond' into 'groff' files
@@ -37,7 +37,7 @@ This file is part of 'GNU groff'.
'GNU groff' is free software: you can redistribute it and/or modify it
under the terms of the 'GNU General Public License' as published by the
-'Free Software Foundation', either version 2 of the License, or (at your
+'Free Software Foundation', either version 3 of the License, or (at your
option) any later version.
'GNU groff' is distributed in the hope that it will be useful, but
@@ -134,7 +134,427 @@ BEGIN {
umask 0077; # octal output: 'printf "%03o", umask;'
}
- require 'subs.pl';
+ use integer;
+ use utf8;
+ use feature 'state';
+
+ my $P_PIC;
+ # $P_PIC = '.PDFPIC';
+ $P_PIC = '.PSPIC';
+
+ ######################################################################
+ # subs for using several times
+ ######################################################################
+
+ sub create_ly2eps { # '--ly2eps' default
+ our ( $out, $Read, $Temp );
+
+ my $prefix = $Read->{'file_numbered'}; # w/ dir change to temp dir
+
+ # '$ lilypond --ps -dbackend=eps -dgs-load-fonts \
+ # output=file_without_extension file.ly'
+ # extensions are added automatically
+ my $opts = '--ps -dbackend=eps -dinclude-eps-fonts -dgs-load-fonts'
+ . " --output=$prefix $prefix";
+ &run_lilypond("$opts");
+
+ 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 = FALSE;
+ File::Copy::copy($file_path, $eps_dir)
+ and $could_copy = TRUE;
+ if ( $could_copy ) {
+ unlink $file_path;
+ $file_path = File::Spec->catfile($eps_dir, $_);
+ }
+ }
+ $out->print( $P_PIC . ' ' . $file_path );
+ }
+ } # end while readdir
+ closedir( $dh );
+ } # end sub create_ly2eps()
+
+
+ sub create_pdf2eps { # '--pdf2eps'
+ our ( $v, $stdout, $stderr, $out, $Read, $Temp );
+
+ my $prefix = $Read->{'file_numbered'}; # w/ dir change to temp dir
+
+ &run_lilypond("--pdf --output=$prefix $prefix");
+
+ my $file_pdf = $prefix . '.pdf';
+ my $file_ps = $prefix . '.ps';
+
+ # pdf2ps in temp dir
+ my $temp_file = &next_temp_file;
+ $v->print( "\n##### run of 'pdf2ps'" );
+ # '$ pdf2ps file.pdf file.ps'
+ my $output = `pdf2ps $file_pdf $file_ps 2> $temp_file`;
+ die 'Program pdf2ps does not work.' if ( $? );
+ &shell_handling($output, $temp_file);
+ $v->print( "##### end run of 'pdf2ps'\n" );
+
+ # ps2eps in temp dir
+ $temp_file = &next_temp_file;
+ $v->print( "\n##### run of 'ps2eps'" );
+ # '$ ps2eps file.ps'
+ $output = `ps2eps $file_ps 2> $temp_file`;
+ die 'Program ps2eps does not work.' if ( $? );
+ &shell_handling($output, $temp_file);
+ $v->print( "##### end run of 'ps2eps'\n" );
+
+ # change back to former dir
+ Cwd::chdir $Temp->{'cwd'} or
+ die "Could not change to former directory '" .
+ $Temp->{'cwd'} . "': $!";
+
+ # handling of .eps file
+ my $file_eps = $prefix . '.eps';
+ my $eps_path = File::Spec->catfile($Temp->{'temp_dir'}, $file_eps);
+ if ( $Temp->{'eps_dir'} ) {
+ my $has_copied = FALSE;
+ File::Copy::copy( $eps_path, $Temp->{'eps_dir'} )
+ and $has_copied = TRUE;
+ if ( $has_copied ) {
+ unlink $eps_path;
+ $eps_path = File::Spec->catfile( $Temp->{'eps_dir'}, $file_eps );
+ } else {
+ $stderr->print( "Could not use EPS-directory." );
+ } # end Temp->{'eps_dir'}
+ }
+ # print into groff output
+ $out->print( $P_PIC . ' ' . $eps_path );
+ } # end sub create_pdf2eps()
+
+
+ sub is_subdir { # arg1 is subdir of arg2 (is longer)
+ my ( $dir1, $dir2 ) = @_;
+ $dir1 = &path2abs( $dir1 );;
+ $dir2 = &path2abs( $dir2 );;
+ my @split1 = File::Spec->splitdir($dir1);
+ my @split2 = File::Spec->splitdir($dir2);
+ for ( @split2 ) {
+ next if ( $_ eq shift @split1 );
+ return FALSE;
+ }
+ return TRUE;
+ }
+
+
+ sub license {
+ our ( $Legalese, $stdout );
+ &version;
+ $stdout->print( $Legalese->{'license'} );
+ } # end sub license()
+
+
+ sub make_dir { # make directory or check if it exists
+ our ( $v, $Args );
+
+ my $dir_arg = shift;
+ chomp $dir_arg;
+ $dir_arg =~ s/^\s*(.*)\s*$/$1/;
+
+ unless ( $dir_arg ) {
+ $v->print( "make_dir(): empty argument" );
+ return FALSE;
+ }
+
+ 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 = FALSE; # dir could be created if TRUE
+
+ DIRPARTS: for ( @dir_parts ) {
+ push @dir_grow, $_;
+ next DIRPARTS unless ( $_ ); # empty string for root directory
+
+ # from array to path dir string
+ $dir_grow = File::Spec->catdir(@dir_grow);
+
+ next DIRPARTS if ( -d $dir_grow );
+
+ 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 );
+
+ # 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': $!";
+ }
+
+ # $dir_grow no longer exists, so the former dir must be writable
+ # in order to create the directory
+ pop @dir_grow;
+ $dir_grow = File::Spec->catdir(@dir_grow);
+
+ die "'$dir_grow' is not writable, " .
+ "so directory '$dir_arg' can't be createdd."
+ unless ( -w $dir_grow );
+
+ # 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 sub make_dir()
+
+
+ my $number = 0;
+ sub next_temp_file {
+ our ( $Temp, $v, $Args );
+ ++$number;
+ my $temp_basename = $Args->{'prefix'} . '_temp_' . $number;
+ my $temp_file = File::Spec->catfile( $Temp->{'temp_dir'} ,
+ $temp_basename );
+ $v->print( "next temporary file: '$temp_file'" );
+ return $temp_file;
+ } # end sub next_temp_file()
+
+
+ sub path2abs {
+ our ( $Temp, $Args );
+
+ 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;
+ } # end sub path2abs()
+
+
+ sub run_lilypond {
+ # arg is the options collection for 'lilypond' to run
+ # either from ly or pdf
+
+ our ( $Temp, $v );
+
+ my $opts = shift;
+ chomp $opts;
+
+ my $temp_file = &next_temp_file;
+ my $output = EMPTYSTRING;
+
+ # change to temp dir
+ Cwd::chdir $Temp->{'temp_dir'} or
+ die "Could not change to temporary directory '" .
+ $Temp->{'temp_dir'} . "': $!";
+
+ $v->print( "\n##### run of 'lilypond " . $opts . "'" );
+ $output = `lilypond $opts 2>$temp_file`;
+ die "Program lilypond does not work, see '$temp_file': $?"
+ if ( $? );
+ chomp $output;
+ &shell_handling($output, $temp_file);
+ $v->print( "##### 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 temporary file $TempFile.
+
+ our ( $out, $v, $Args );
+
+ my $out_string = shift;
+ my $temp_file = shift;
+
+ my $a = &string2array($out_string); # array ref
+ for ( @$a ) {
+ $out->print( $_ );
+ }
+
+ $temp_file && -f $temp_file && -r $temp_file ||
+ die "shell_handling(): $temp_file is not a readable file.";
+ my $temp = new FH_READ_FILE($temp_file);
+ my $res = $temp->read_all();
+ for ( @$res ) {
+ chomp;
+ $v->print($_);
+ }
+
+ unlink $temp_file unless ( $Args->{'keep_all'} );
+ } # end sub shell_handling()
+
+
+ sub string2array {
+ my $s = shift;
+ my @a = ();
+ for ( split "\n", $s ) {
+ chomp;
+ push @a, $_;
+ }
+ return \@a;
+ } # end string2array()
+
+
+ sub usage { # for '--help'
+ our ( $Globals, $Args );
+
+ my $p = $Globals->{'prog'};
+ my $usage = EMPTYSTRING;
+ $usage = '###### usage:' . "\n" if ( $Args->{'verbose'} );
+ $usage .= qq*Options for $p:
+Read a 'roff' file or standard input and transform 'lilypond' parts
+(everything between '.lilypond start' and '.lilypond end') into
+'EPS'-files that can be read by groff using '.PSPIC'.
+
+There is also a command '.lilypond include <file_name>' that can
+include a complete 'lilypond' file into the 'groff' document.
+
+
+# Breaking options:
+$p -?|-h|--help|--usage # usage
+$p --version # version information
+$p --license # the license is GPL >= 3
+
+
+# Normal options:
+$p [options] [--] [filename ...]
+
+There are 2 options for influencing the way how the 'EPS' files for the
+'roff' display are generated:
+--ly2eps 'lilypond' generates 'EPS' files directly (default)
+--pdf2eps 'lilypond' generates a 'PDF' file that is transformed
+
+-k|--keep_all do not delete any temporary files
+-v|--verbose print much information to STDERR
+
+Options with an argument:
+-e|--eps_dir=... use a directory for the EPS files
+-o|--output=... sent output in the groff language into file ...
+-p|--prefix=... start for the names of temporary files
+-t|--temp_dir=... provide the directory for temporary files.
+
+The directories set are created when they do not exist.
+*;
+
+ # old options:
+ # --keep_files -k: do not delete any temporary files
+ # --file_prefix=... -p: start for the names of temporary files
+
+ $main::stdout->print( $usage );
+ } # end sub usage()
+
+
+ sub version { # for '--version'
+ our ( $Globals, $Legalese, $stdout, $Args );
+ my $end;
+ if ( $Globals->{'groff_version'} ) {
+ $end = " version $Globals->{'groff_version'}";
+ } else {
+ $end = '.';
+ }
+
+ my $output = EMPTYSTRING;
+ $output = "###### version:\n" if ( $Args->{'verbose'} );
+ $output .= "'" . $Globals->{'prog'} . "' version '" .
+ $Legalese->{'version'} . "' is part of 'GNU groff'" . $end;
+
+ $stdout->print($output);
+ } # end sub version()
}
#die "test: ";
@@ -142,7 +562,269 @@ BEGIN {
# OOP declarations for some file handles
########################################################################
-require 'oop_fh.pl';
+use integer;
+
+########################################################################
+# OOP for writing file handles that are open by default, like STD*
+########################################################################
+
+# -------------------------- _FH_WRITE_OPENED --------------------------
+
+{ # FH_OPENED: base class for all opened file handles, like $TD*
+
+ package _FH_WRITE_OPENED;
+ use strict;
+
+ sub new {
+ my ( $pkg, $std ) = @_;
+ bless {
+ 'fh' => $std,
+ }
+ }
+
+ sub open {
+ }
+
+ sub close {
+ }
+
+ sub print {
+ my $self = shift;
+ for ( @_ ) {
+ print { $self->{'fh'} } $_;
+ }
+ }
+
+}
+
+
+# ------------------------------ FH_STDOUT ----------------------------
+
+{ # FH_STDOUT: print to noral output STDOUT
+
+ package FH_STDOUT;
+ use strict;
+ @FH_STDOUT::ISA = qw( _FH_WRITE_OPENED );
+
+ sub new {
+ &_FH_WRITE_OPENED::new( '_FH_WRITE_OPENED', *STDOUT );
+ }
+
+} # end FH_STDOUT
+
+
+# ------------------------------ FH_STDERR -----------------------------
+
+{ # FH_STDERR: print to STDERR
+
+ package FH_STDERR;
+ use strict;
+ @FH_STDERR::ISA = qw( _FH_WRITE_OPENED );
+
+ sub new {
+ &_FH_WRITE_OPENED::new( 'FH_OPENED', *STDERR );
+ }
+
+} # end FH_STDERR
+
+
+########################################################################
+# OOP for file handles that write into a file or string
+########################################################################
+
+# ------------------------------- FH_FILE ------------------------------
+
+{ # FH_FILE: base class for writing into a file or string
+
+ package FH_FILE;
+ use strict;
+
+ sub new {
+ my ( $pkg, $file ) = @_;
+ bless {
+ 'fh' => undef,
+ 'file' => $file,
+ 'opened' => main::FALSE,
+ }
+ }
+
+ sub DESTROY {
+ my $self = shift;
+ $self->close();
+ }
+
+ sub open {
+ my $self = shift;
+ my $file = $self->{'file'};
+ if ( $file && -e $file ) {
+ die "file $file is not writable" unless ( -w $file );
+ die "$file is a directory" if ( -d $file );
+ }
+ open $self->{'fh'}, ">", $self->{'file'}
+ or die "could not open file '$file' for writing: $!";
+ $self->{'opened'} = main::TRUE;
+ }
+
+ sub close {
+ my $self = shift;
+ close $self->{'fh'} if ( $self->{'opened'} );
+ $self->{'opened'} = main::FALSE;
+ }
+
+ sub print {
+ my $self = shift;
+ $self->open() unless ( $self->{'opened'} );
+ for ( @_ ) {
+ print { $self->{'fh'} } $_;
+ }
+ }
+
+} # end FH_FILE
+
+
+# ------------------------------ FH_STRING -----------------------------
+
+{ # FH_STRING: write into a string
+
+ package FH_STRING; # write to \string
+ use strict;
+ @FH_STRING::ISA = qw( FH_FILE );
+
+ sub new {
+ my $pkg = shift; # string is a reference to scalar
+ bless
+ {
+ 'fh' => undef,
+ 'string' => '',
+ 'opened' => main::FALSE,
+ }
+ }
+
+ sub open {
+ my $self = shift;
+ open $self->{'fh'}, ">", \ $self->{'string'}
+ or die "could not open string for writing: $!";
+ $self->{'opened'} = main::TRUE;
+ }
+
+ sub get { # get string, move to array ref, close, and return array ref
+ my $self = shift;
+ return '' unless ( $self->{'opened'} );
+ my $a = &string2array( $self->{'string'} );
+ $self->close();
+ return $a;
+ }
+
+} # end FH_STRING
+
+
+# -------------------------------- FH_NULL -----------------------------
+
+{ # FH_NULL: write to null device
+
+ package FH_NULL;
+ use strict;
+ @FH_NULL::ISA = qw( FH_FILE FH_STRING );
+
+ use File::Spec;
+
+ my $devnull = File::Spec->devnull();
+ $devnull = '' unless ( -e $devnull && -w $devnull );
+
+ sub new {
+ my $pkg = shift;
+ if ( $devnull ) {
+ &FH_FILE::new( $pkg, $devnull );
+ } else {
+ &FH_STRING::new( $pkg );
+ }
+ } # end new()
+
+} # end FH_NULL
+
+
+########################################################################
+# OOP for reading file handles
+########################################################################
+
+# ---------------------------- FH_READ_FILE ----------------------------
+
+{ # FH_READ_FILE: read a file
+
+ package FH_READ_FILE;
+ use strict;
+
+ sub new {
+ my ( $pkg, $file ) = @_;
+ die "File '$file' cannot be read." unless ( -f $file && -r $file );
+ bless {
+ 'fh' => undef,
+ 'file' => $file,
+ 'opened' => main::FALSE,
+ }
+ }
+
+ sub DESTROY {
+ my $self = shift;
+ $self->close();
+ }
+
+ sub open {
+ my $self = shift;
+ my $file = $self->{'file'};
+ if ( $file && -e $file ) {
+ die "file $file is not writable" unless ( -r $file );
+ die "$file is a directory" if ( -d $file );
+ }
+ open $self->{'fh'}, "<", $self->{'file'}
+ or die "could not read file '$file': $!";
+ $self->{'opened'} = main::TRUE;
+ }
+
+ sub close {
+ my $self = shift;
+ close $self->{'fh'} if ( $self->{'opened'} );
+ $self->{'opened'} = main::FALSE;
+ }
+
+ sub read_line {
+ # Read 1 line of the file into a chomped string.
+ # Do not close the read handle at the end.
+ my $self = shift;
+ $self->open() unless ( $self->{'opened'} );
+
+ my $res;
+ if ( defined($res = CORE::readline($self->{'fh'}) ) ) {
+ chomp $res;
+ return $res;
+ } else {
+ $self->close();
+ return undef;
+ }
+ }
+
+ sub read_all {
+ # Read the complete file into an array reference.
+ # Close the read handle at the end.
+ # Return array reference.
+ my $self = shift;
+ $self->open() unless ( $self->{'opened'} );
+
+ my $res = [];
+ my $line;
+ while ( defined ( $line = CORE::readline $self->{'fh'} ) ) {
+ chomp $line;
+ push @$res, $line;
+ }
+ $self->close();
+ $self->{'opened'} = main::FALSE;
+ return $res;
+ }
+
+}
+
+# end of OOP definitions
+
our $stdout = new FH_STDOUT();
our $stderr = new FH_STDERR();
@@ -194,7 +876,468 @@ our $Args =
};
{ # 'Args'
- require 'args.pl';
+ use integer;
+
+ our ( $Globals, $Args, $stderr, $v, $out );
+
+ # ----------
+ # subs for second run, for remaining long options after splitting and
+ # transfer
+ # ----------
+
+ my %opts_with_arg =
+ (
+
+ '--eps_dir' => sub {
+ $Args->{'eps_dir'} = shift;
+ },
+
+ '--output' => sub {
+ $Args->{'output'} = shift;
+ },
+
+ '--prefix' => sub {
+ $Args->{'prefix'} = shift;
+ },
+
+ '--temp_dir' => sub {
+ $Args->{'temp_dir'} = shift;
+ },
+
+ ); # end of %opts_with_arg
+
+
+ my %opts_noarg =
+ (
+
+ '--help' => sub {
+ &usage;
+ exit;
+ },
+
+ '--keep_all' => sub {
+ $Args->{'keep_all'} = TRUE;
+ },
+
+ '--license' => sub {
+ &license;
+ exit;
+ },
+
+ '--ly2eps' => sub {
+ $Args->{'eps_func'} = 'ly';
+ },
+
+ '--pdf2eps' => sub {
+ $Args->{'eps_func'} = 'pdf';
+ },
+
+ '--verbose' => sub {
+ $Args->{'verbose'} = TRUE;
+ },
+
+ '--version' => sub {
+ &version;
+ exit;
+ },
+
+ ); # end of %opts_noarg
+
+
+ # used variables in both runs
+
+ my @files = EMPTYARRAY;
+
+
+ #----------
+ # first run for command-line arguments
+ #----------
+
+ # global variables for first run
+
+ my @splitted_args;
+ my $double_minus = FALSE;
+ my $arg = EMPTYSTRING;
+ my $has_arg = FALSE;
+
+
+ # 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 =
+ (
+ '?' => '--help',
+ 'e' => '--eps_dir',
+ 'h' => '--help',
+ 'l' => '--license',
+ 'k' => '--keep_all',
+ 'o' => '--output',
+ 'p' => '--prefix',
+ 't' => '--temp_dir',
+ 'v' => '--verbose',
+ 'V' => '--verbose',
+ );
+
+
+ # transfer long option abbreviations to the long options from above
+
+ my @long_opts;
+
+ $long_opts[3] =
+ { # option abbreviations of 3 characters
+ '--e' => '--eps_dir',
+ '--f' => '--prefix', # --f for --file_prefix
+ '--h' => '--help',
+ '--k' => '--keep_all', # and --keep_files
+ '--o' => '--output',
+ '--p' => '--prefix', # and --file_prefix
+ '--t' => '--temp_dir',
+ '--u' => '--help', # '--usage' is mapped to '--help'
+ };
+
+ $long_opts[4] =
+ { # option abbreviations of 4 characters
+ '--li' => '--license',
+ '--ly' => '--ly2eps',
+ '--pd' => '--pdf2eps',
+ '--pr' => '--prefix',
+ };
+
+ $long_opts[6] =
+ { # option abbreviations of 6 characters
+ '--verb' => '--verbose',
+ '--vers' => '--version',
+ };
+
+
+ # subs for short splitting and replacing long abbreviations
+
+ my $split_short = sub {
+
+ my @chars = split //, $1; # omit leading dash
+
+ # if result is TRUE: run 'next SPLIT' afterwards
+
+ CHARS: while ( @chars ) {
+ my $c = shift @chars;
+
+ 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};
+
+ if ( exists $opts_noarg{$transopt} ) {
+ push @splitted_args, $transopt;
+ $Args->{'verbose'} = TRUE if ( $transopt eq '--verbose' );
+ next CHARS;
+ }
+
+ if ( exists $opts_with_arg{$transopt} ) {
+ push @splitted_args, $transopt;
+
+ if ( @chars ) {
+ # if @chars is not empty, option $transopt has argument
+ # in this arg, the rest of characters in @chars
+ push @splitted_args, join "", @chars;
+ @chars = EMPTYARRAY;
+ return TRUE; # use 'next SPLIT' afterwards
+ }
+
+ # optarg is the next argument
+ $has_arg = $transopt;
+ return TRUE; # use 'next SPLIT' afterwards
+ } # end of if %opts_with_arg
+ } # end of while CHARS
+ return FALSE; # do not do anything
+ }; # end of sub for short_opt_collection
+
+
+ my $split_long = sub {
+ my $from_arg = shift;
+ $from_arg =~ /^([^=]+)/;
+ my $opt_part = lc($1);
+ my $optarg = undef;
+ if ( $from_arg =~ /=(.*)$/ ) {
+ $optarg = $1;
+ }
+
+ N: for my $n ( qw/6 4 3/ ) {
+ $opt_part =~ / # 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
+ $stderr->print( 'Option ' . $transopt . 'has no argument: ' .
+ $from_arg . '.' ) if ( defined($optarg) );
+ push @splitted_args, $transopt;
+ $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
+ push @splitted_args, $transopt;
+
+ # test on optarg in arg
+ if ( defined($optarg) ) {
+ push @splitted_args, $1;
+ return TRUE; # use 'next SPLIT' afterwards
+ } # end of if optarg in arg
+
+ # has optarg in next arg
+ $has_arg = $transopt;
+ return TRUE; # use 'next SPLIT' afterwards
+ } # 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 . "'" );
+ return TRUE; # use 'next SPLIT' afterwards
+ } # end of for N
+ return FALSE; # do nothing
+ }; # end of split_long()
+
+
+ #----------
+ # do split and transfer arguments
+ #----------
+ sub run_first {
+
+ 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 = EMPTYSTRING;
+ next SPLIT;
+ }
+
+ if ( $double_minus ) {
+ push @files, $_;
+ next SPLIT;
+ }
+
+ if ( $_ eq '-' ) { # file arg '-'
+ push @files, $_;
+ next SPLIT;
+ }
+
+ if ( $_ eq '--' ) { # POSIX arg '--'
+ push @splitted_args, $_;
+ $double_minus = TRUE;
+ next SPLIT;
+ }
+
+ if ( / # short option or collection of short options
+ ^
+ -
+ (
+ [^-]
+ .*
+ )
+ $
+ /x ) {
+ $split_short->($1);
+ next SPLIT;
+ } # end of short option
+
+ if ( /^--/ ) { # starts with 2 dashes, a long option
+ $split_long->($_);
+ next SPLIT;
+ } # end of long option
+
+ # unknown option without leading dash is a file name
+ push @files, $_;
+ next SPLIT;
+ } # end of foreach SPLIT
+
+ # all args are considered
+ $stderr->print( "Option '$has_arg' needs an argument." )
+ if ( $has_arg );
+
+
+ push @files, '-' unless ( @files );
+ @ARGV = @splitted_args;
+
+ }; # end of first run, splitting with map or transfer
+
+
+ #----------
+ # open or ignore verbose output
+ #----------
+ sub install_verbose {
+ if ( $Args->{'verbose'} ) { # '--verbose' was used
+ # make verbose output into $v
+ # get content of string so far as array ref, close
+ my $s = $v->get();
+
+ $v = new FH_STDERR(); # make verbose output into STDERR
+ if ( $s ) {
+ for ( @$s ) {
+ # print the file content into new verbose output
+ $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 = 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( "Verbose output was chosen." );
+
+ my $s = $Globals->{'prog_is_installed'} ? '' : ' not';
+ $v->print( $Globals->{'prog'} . " is" . $s .
+ " installed." );
+
+ $v->print( 'The command-line options are:' );
+
+ $s = " options:";
+ $s .= " '" . $_ . "'" for ( @ARGV );
+ $v->print( $s );
+
+ $s = " file names:";
+ $s .= " '" . $_ . "'\n" for ( @files );
+ $v->print( $s );
+ } # end install_verbose()
+
+
+ #----------
+ # second run of command-line arguments
+ #----------
+ sub run_second {
+ # Second run of args with new @ARGV from the former splitting.
+ # Arguments are now splitted and transformed into special long
+ # options.
+
+ my $double_minus = FALSE;
+ my $has_arg = 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} ) {
+ $stderr->print( "'\%opts_with_args' does not have key '" .
+ $has_arg . "'." );
+ next ARGS;
+ }
+
+ $opts_with_arg{$has_arg}->($arg);
+ $has_arg = FALSE;
+ next ARGS;
+ } # end of $has_arg
+
+ 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
+ $stderr->print( "Wrong option '" . $arg . "'." );
+ next ARGS;
+
+ } # end of for ARGS:
+
+
+ if ( $has_arg ) { # after last argument
+ die "Option '$has_arg' needs an argument.";
+ }
+
+ }; # end of second run
+
+
+ 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."
+ 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 = &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 '" . $out_path . "'."
+ unless ( -w $out_path );
+ }
+
+ $out = new FH_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';
+
+ @ARGV = @files;
+ }
+
&run_first();
&install_verbose();
&run_second();
@@ -283,7 +1426,8 @@ our $Temp =
my @tempdirs = EMPTYARRAY;
{
my $tmpdir = File::Spec->tmpdir();
- push @tempdirs, $tmpdir if ( $tmpdir && -d $tmpdir && -w $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');
@@ -301,7 +1445,7 @@ our $Temp =
}
- my @path_extension = qw( groff ); # TEMPDIR/groff/USER/lilypond/<NUMBER>
+ my @path_extension = qw( groff ); # TEMPDIR/groff/USER/lilypond/N
{
# '$<' is UID of actual user,
# 'getpwuid' gets user name in scalar context
diff --git a/contrib/glilypond/oop_fh.pl b/contrib/glilypond/oop_fh.pl
deleted file mode 100644
index 1d158e42d..000000000
--- a/contrib/glilypond/oop_fh.pl
+++ /dev/null
@@ -1,306 +0,0 @@
-my $License = q*
-########################################################################
-# Legalese
-########################################################################
-
-Copyright (C) 2013-2013 Free Software Foundation, Inc.
- Written by Bernd Warken <groff-bernd.warken-72@web.de>
-
-This file is part of 'glilypond', which is part of 'GNU groff'.
-
-glilypond - integrate 'lilypond' into 'groff' files
-
- 'GNU groff' is free software: you can redistribute it and/or modify it
-under the terms of the 'GNU General Public License' as published by the
-'Free Software Foundation', either version 3 of the License, or (at your
-option) any later version.
-
- 'GNU groff' is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 'GNU
-General Public License' for more details.
-
- You should have received a copy of the 'GNU General Public License'
-along with 'groff', see the files 'COPYING' and 'LICENSE' in the top
-directory of the 'groff' source package. If not, see
-<http://www.gnu.org/licenses/>.
-*;
-
-##### end legalese
-
-
-# use strict;
-# use warnings;
-# use diagnostics;
-
-use integer;
-
-########################################################################
-# OOP for writing file handles that are open by default, like STD*
-########################################################################
-
-# -------------------------- _FH_WRITE_OPENED --------------------------
-
-{ # FH_OPENED: base class for all opened file handles, like $TD*
-
- package _FH_WRITE_OPENED;
- use strict;
-
- sub new {
- my ( $pkg, $std ) = @_;
- bless {
- 'fh' => $std,
- }
- }
-
- sub open {
- }
-
- sub close {
- }
-
- sub print {
- my $self = shift;
- for ( @_ ) {
- print { $self->{'fh'} } $_;
- }
- }
-
-}
-
-
-# ------------------------------ FH_STDOUT ----------------------------
-
-{ # FH_STDOUT: print to noral output STDOUT
-
- package FH_STDOUT;
- use strict;
- @FH_STDOUT::ISA = qw( _FH_WRITE_OPENED );
-
- sub new {
- &_FH_WRITE_OPENED::new( '_FH_WRITE_OPENED', *STDOUT );
- }
-
-} # end FH_STDOUT
-
-
-# ------------------------------ FH_STDERR -----------------------------
-
-{ # FH_STDERR: print to STDERR
-
- package FH_STDERR;
- use strict;
- @FH_STDERR::ISA = qw( _FH_WRITE_OPENED );
-
- sub new {
- &_FH_WRITE_OPENED::new( 'FH_OPENED', *STDERR );
- }
-
-} # end FH_STDERR
-
-
-########################################################################
-# OOP for file handles that write into a file or string
-########################################################################
-
-# ------------------------------- FH_FILE ------------------------------
-
-{ # FH_FILE: base class for writing into a file or string
-
- package FH_FILE;
- use strict;
-
- sub new {
- my ( $pkg, $file ) = @_;
- bless {
- 'fh' => undef,
- 'file' => $file,
- 'opened' => main::FALSE,
- }
- }
-
- sub DESTROY {
- my $self = shift;
- $self->close();
- }
-
- sub open {
- my $self = shift;
- my $file = $self->{'file'};
- if ( $file && -e $file ) {
- die "file $file is not writable" unless ( -w $file );
- die "$file is a directory" if ( -d $file );
- }
- open $self->{'fh'}, ">", $self->{'file'}
- or die "could not open file '$file' for writing: $!";
- $self->{'opened'} = main::TRUE;
- }
-
- sub close {
- my $self = shift;
- close $self->{'fh'} if ( $self->{'opened'} );
- $self->{'opened'} = main::FALSE;
- }
-
- sub print {
- my $self = shift;
- $self->open() unless ( $self->{'opened'} );
- for ( @_ ) {
- print { $self->{'fh'} } $_;
- }
- }
-
-} # end FH_FILE
-
-
-# ------------------------------ FH_STRING -----------------------------
-
-{ # FH_STRING: write into a string
-
- package FH_STRING; # write to \string
- use strict;
- @FH_STRING::ISA = qw( FH_FILE );
-
- sub new {
- my $pkg = shift; # string is a reference to scalar
- bless
- {
- 'fh' => undef,
- 'string' => '',
- 'opened' => main::FALSE,
- }
- }
-
- sub open {
- my $self = shift;
- open $self->{'fh'}, ">", \ $self->{'string'}
- or die "could not open string for writing: $!";
- $self->{'opened'} = main::TRUE;
- }
-
- sub get { # get string, move to array ref, close, and return array ref
- my $self = shift;
- return '' unless ( $self->{'opened'} );
- my $a = &string2array( $self->{'string'} );
- $self->close();
- return $a;
- }
-
-} # end FH_STRING
-
-
-# -------------------------------- FH_NULL -----------------------------
-
-{ # FH_NULL: write to null device
-
- package FH_NULL;
- use strict;
- @FH_NULL::ISA = qw( FH_FILE FH_STRING );
-
- use File::Spec;
-
- my $devnull = File::Spec->devnull();
- $devnull = '' unless ( -e $devnull && -w $devnull );
-
- sub new {
- my $pkg = shift;
- if ( $devnull ) {
- &FH_FILE::new( $pkg, $devnull );
- } else {
- &FH_STRING::new( $pkg );
- }
- } # end new()
-
-} # end FH_NULL
-
-
-########################################################################
-# OOP for reading file handles
-########################################################################
-
-# ---------------------------- FH_READ_FILE ----------------------------
-
-{ # FH_READ_FILE: read a file
-
- package FH_READ_FILE;
- use strict;
-
- sub new {
- my ( $pkg, $file ) = @_;
- die "File '$file' cannot be read." unless ( -f $file && -r $file );
- bless {
- 'fh' => undef,
- 'file' => $file,
- 'opened' => main::FALSE,
- }
- }
-
- sub DESTROY {
- my $self = shift;
- $self->close();
- }
-
- sub open {
- my $self = shift;
- my $file = $self->{'file'};
- if ( $file && -e $file ) {
- die "file $file is not writable" unless ( -r $file );
- die "$file is a directory" if ( -d $file );
- }
- open $self->{'fh'}, "<", $self->{'file'}
- or die "could not read file '$file': $!";
- $self->{'opened'} = main::TRUE;
- }
-
- sub close {
- my $self = shift;
- close $self->{'fh'} if ( $self->{'opened'} );
- $self->{'opened'} = main::FALSE;
- }
-
- sub read_line {
- # Read 1 line of the file into a chomped string.
- # Do not close the read handle at the end.
- my $self = shift;
- $self->open() unless ( $self->{'opened'} );
-
- my $res;
- if ( defined($res = CORE::readline($self->{'fh'}) ) ) {
- chomp $res;
- return $res;
- } else {
- $self->close();
- return undef;
- }
- }
-
- sub read_all {
- # Read the complete file into an array reference.
- # Close the read handle at the end.
- # Return array reference.
- my $self = shift;
- $self->open() unless ( $self->{'opened'} );
-
- my $res = [];
- my $line;
- while ( defined ( $line = CORE::readline $self->{'fh'} ) ) {
- chomp $line;
- push @$res, $line;
- }
- $self->close();
- $self->{'opened'} = main::FALSE;
- return $res;
- }
-
-}
-
-# end of OOP definitions
-
-package main;
-
-1;
-# Local Variables:
-# fill-column: 72
-# mode: CPerl
-# End:
-# vim: set autoindent textwidth=72:
diff --git a/contrib/glilypond/subs.pl b/contrib/glilypond/subs.pl
deleted file mode 100644
index dde6ebbf4..000000000
--- a/contrib/glilypond/subs.pl
+++ /dev/null
@@ -1,466 +0,0 @@
-my $License = q*
-########################################################################
-# Legalese
-########################################################################
-
-Subroutines for 'glilypond'.
-
-Copyright (C) 2013-2020 Free Software Foundation, Inc.
- Written by Bernd Warken <groff-bernd.warken-72@web.de>
-
-This file is part of 'glilypond', which is part of 'GNU groff'.
-
- 'GNU groff' is free software: you can redistribute it and/or modify it
-under the terms of the 'GNU General Public License' as published by the
-'Free Software Foundation', either version 3 of the License, or (at your
-option) any later version.
-
- 'GNU groff' is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 'GNU
-General Public License' for more details.
-
- You should have received a copy of the 'GNU General Public License'
-along with 'groff', see the files 'COPYING' and 'LICENSE' in the top
-directory of the 'groff' source package. If not, see
-<http://www.gnu.org/licenses/>.
-*;
-
-##### end legalese
-
-
-# use strict;
-# use warnings;
-# use diagnostics;
-
-use integer;
-use utf8;
-use feature 'state';
-
-my $P_PIC;
-# $P_PIC = '.PDFPIC';
-$P_PIC = '.PSPIC';
-
-########################################################################
-# subs for using several times
-########################################################################
-
-sub create_ly2eps { # '--ly2eps' default
- our ( $out, $Read, $Temp );
-
- my $prefix = $Read->{'file_numbered'}; # with dir change to temp dir
-
- # '$ lilypond --ps -dbackend=eps -dgs-load-fonts \
- # output=file_without_extension file.ly'
- # extensions are added automatically
- my $opts = '--ps -dbackend=eps -dinclude-eps-fonts -dgs-load-fonts ' .
- "--output=$prefix $prefix";
- &run_lilypond("$opts");
-
- 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 = FALSE;
- File::Copy::copy($file_path, $eps_dir)
- and $could_copy = TRUE;
- if ( $could_copy ) {
- unlink $file_path;
- $file_path = File::Spec->catfile($eps_dir, $_);
- }
- }
- $out->print( $P_PIC . ' ' . $file_path );
- }
- } # end while readdir
- closedir( $dh );
-} # end sub create_ly2eps()
-
-
-sub create_pdf2eps { # '--pdf2eps'
- our ( $v, $stdout, $stderr, $out, $Read, $Temp );
-
- my $prefix = $Read->{'file_numbered'}; # with dir change to temp dir
-
- &run_lilypond("--pdf --output=$prefix $prefix");
-
- my $file_pdf = $prefix . '.pdf';
- my $file_ps = $prefix . '.ps';
-
- # pdf2ps in temp dir
- my $temp_file = &next_temp_file;
- $v->print( "\n##### run of 'pdf2ps'" );
- # '$ pdf2ps file.pdf file.ps'
- my $output = `pdf2ps $file_pdf $file_ps 2> $temp_file`;
- die 'Program pdf2ps does not work.' if ( $? );
- &shell_handling($output, $temp_file);
- $v->print( "##### end run of 'pdf2ps'\n" );
-
- # ps2eps in temp dir
- $temp_file = &next_temp_file;
- $v->print( "\n##### run of 'ps2eps'" );
- # '$ ps2eps file.ps'
- $output = `ps2eps $file_ps 2> $temp_file`;
- die 'Program ps2eps does not work.' if ( $? );
- &shell_handling($output, $temp_file);
- $v->print( "##### end run of 'ps2eps'\n" );
-
- # change back to former dir
- Cwd::chdir $Temp->{'cwd'} or
- die "Could not change to former directory '" .
- $Temp->{'cwd'} . "': $!";
-
- # handling of .eps file
- my $file_eps = $prefix . '.eps';
- my $eps_path = File::Spec->catfile($Temp->{'temp_dir'}, $file_eps);
- if ( $Temp->{'eps_dir'} ) {
- my $has_copied = FALSE;
- File::Copy::copy( $eps_path, $Temp->{'eps_dir'} )
- and $has_copied = TRUE;
- if ( $has_copied ) {
- unlink $eps_path;
- $eps_path = File::Spec->catfile( $Temp->{'eps_dir'}, $file_eps );
- } else {
- $stderr->print( "Could not use EPS-directory." );
- } # end Temp->{'eps_dir'}
- }
- # print into groff output
- $out->print( $P_PIC . ' ' . $eps_path );
-} # end sub create_pdf2eps()
-
-
-sub is_subdir { # arg1 is subdir of arg2 (is longer)
- my ( $dir1, $dir2 ) = @_;
- $dir1 = &path2abs( $dir1 );;
- $dir2 = &path2abs( $dir2 );;
- my @split1 = File::Spec->splitdir($dir1);
- my @split2 = File::Spec->splitdir($dir2);
- for ( @split2 ) {
- next if ( $_ eq shift @split1 );
- return FALSE;
- }
- return TRUE;
-}
-
-
-sub license {
- our ( $Legalese, $stdout );
- &version;
- $stdout->print( $Legalese->{'license'} );
-} # end sub license()
-
-
-sub make_dir { # make directory or check if it exists
- our ( $v, $Args );
-
- my $dir_arg = shift;
- chomp $dir_arg;
- $dir_arg =~ s/^\s*(.*)\s*$/$1/;
-
- unless ( $dir_arg ) {
- $v->print( "make_dir(): empty argument" );
- return FALSE;
- }
-
- 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 = FALSE; # dir could be created if TRUE
-
- DIRPARTS: for ( @dir_parts ) {
- push @dir_grow, $_;
- next DIRPARTS unless ( $_ ); # empty string for root directory
-
- # from array to path dir string
- $dir_grow = File::Spec->catdir(@dir_grow);
-
- next DIRPARTS if ( -d $dir_grow );
-
- 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 );
-
- # 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': $!";
- }
-
- # $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);
-
- die "'$dir_grow' is not writable, " .
- "so directory '$dir_arg' can't be createdd."
- unless ( -w $dir_grow );
-
- # 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 sub make_dir()
-
-
-my $number = 0;
-sub next_temp_file {
- our ( $Temp, $v, $Args );
- ++$number;
- my $temp_basename = $Args->{'prefix'} . '_temp_' . $number;
- my $temp_file = File::Spec->catfile( $Temp->{'temp_dir'} ,
- $temp_basename );
- $v->print( "next temporary file: '$temp_file'" );
- return $temp_file;
-} # end sub next_temp_file()
-
-
-sub path2abs {
- our ( $Temp, $Args );
-
- 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;
-} # end sub path2abs()
-
-
-sub run_lilypond {
- # arg is the options collection for 'lilypond' to run
- # either from ly or pdf
-
- our ( $Temp, $v );
-
- my $opts = shift;
- chomp $opts;
-
- my $temp_file = &next_temp_file;
- my $output = EMPTYSTRING;
-
- # change to temp dir
- Cwd::chdir $Temp->{'temp_dir'} or
- die "Could not change to temporary directory '" .
- $Temp->{'temp_dir'} . "': $!";
-
- $v->print( "\n##### run of 'lilypond " . $opts . "'" );
- $output = `lilypond $opts 2>$temp_file`;
- die "Program lilypond does not work, see '$temp_file': $?"
- if ( $? );
- chomp $output;
- &shell_handling($output, $temp_file);
- $v->print( "##### 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 temporary file $TempFile.
-
- our ( $out, $v, $Args );
-
- my $out_string = shift;
- my $temp_file = shift;
-
- my $a = &string2array($out_string); # array ref
- for ( @$a ) {
- $out->print( $_ );
- }
-
- $temp_file && -f $temp_file && -r $temp_file ||
- die "shell_handling(): $temp_file is not a readable file.";
- my $temp = new FH_READ_FILE($temp_file);
- my $res = $temp->read_all();
- for ( @$res ) {
- chomp;
- $v->print($_);
- }
-
- unlink $temp_file unless ( $Args->{'keep_all'} );
-} # end sub shell_handling()
-
-
-sub string2array {
- my $s = shift;
- my @a = ();
- for ( split "\n", $s ) {
- chomp;
- push @a, $_;
- }
- return \@a;
-} # end string2array()
-
-
-sub usage { # for '--help'
- our ( $Globals, $Args );
-
- my $p = $Globals->{'prog'};
- my $usage = EMPTYSTRING;
- $usage = '###### usage:' . "\n" if ( $Args->{'verbose'} );
- $usage .= qq*Options for $p:
-Read a 'roff' file or standard input and transform 'lilypond' parts
-(everything between '.lilypond start' and '.lilypond end') into
-'EPS'-files that can be read by groff using '.PSPIC'.
-
-There is also a command '.lilypond include <file_name>' that can
-include a complete 'lilypond' file into the 'groff' document.
-
-
-# Breaking options:
-$p -?|-h|--help|--usage # usage
-$p --version # version information
-$p --license # the license is GPL >= 3
-
-
-# Normal options:
-$p [options] [--] [filename ...]
-
-There are 2 options for influencing the way how the 'EPS' files for the
-'roff' display are generated:
---ly2eps 'lilypond' generates 'EPS' files directly (default)
---pdf2eps 'lilypond' generates a 'PDF' file that is transformed
-
--k|--keep_all do not delete any temporary files
--v|--verbose print much information to STDERR
-
-Options with an argument:
--e|--eps_dir=... use a directory for the EPS files
--o|--output=... sent output in the groff language into file ...
--p|--prefix=... start for the names of temporary files
--t|--temp_dir=... provide the directory for temporary files.
-
-The directories set are created when they do not exist.
-*;
-
- # old options:
- # --keep_files -k: do not delete any temporary files
- # --file_prefix=... -p: start for the names of temporary files
-
- $main::stdout->print( $usage );
-} # end sub usage()
-
-
-sub version { # for '--version'
- our ( $Globals, $Legalese, $stdout, $Args );
- my $end;
- if ( $Globals->{'groff_version'} ) {
- $end = " version $Globals->{'groff_version'}";
- } else {
- $end = '.';
- }
-
- my $output = EMPTYSTRING;
- $output = "###### version:\n" if ( $Args->{'verbose'} );
- $output .= "'" . $Globals->{'prog'} . "' version '" .
- $Legalese->{'version'} . "' is part of 'GNU groff'" . $end;
-
- $stdout->print($output);
-} # end sub version()
-
-
-# end of subs
-
-1;
-# Local Variables:
-# fill-column: 72
-# mode: CPerl
-# End:
-# vim: set autoindent textwidth=72:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [groff] 22/39: [glilypond]: Make script stand alone.,
G. Branden Robinson <=