1my $License = q*
2########################################################################
3# Legalese
4########################################################################
5
6Subroutines for 'glilypond'.
7
8Source file position: '<groff-source>/contrib/glilypond/subs.pl'
9Installed position: '<prefix>/lib/groff/glilypond/subs.pl'
10
11Copyright (C) 2013-2018 Free Software Foundation, Inc.
12  Written by Bernd Warken <groff-bernd.warken-72@web.de>
13
14Last update: 10 Sep 2015
15
16This file is part of 'glilypond', which is part of 'GNU groff'.
17
18  'GNU groff' is free software: you can redistribute it and/or modify it
19under the terms of the 'GNU General Public License' as published by the
20'Free Software Foundation', either version 3 of the License, or (at your
21option) any later version.
22
23  'GNU groff' is distributed in the hope that it will be useful, but
24WITHOUT ANY WARRANTY; without even the implied warranty of
25MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 'GNU
26General Public License' for more details.
27
28  You should have received a copy of the 'GNU General Public License'
29along with 'groff', see the files 'COPYING' and 'LICENSE' in the top
30directory of the 'groff' source package.  If not, see
31<http://www.gnu.org/licenses/>.
32*;
33
34##### end legalese
35
36
37# use strict;
38# use warnings;
39# use diagnostics;
40
41use integer;
42use utf8;
43use feature 'state';
44
45my $P_PIC;
46# $P_PIC = '.PDFPIC';
47$P_PIC = '.PSPIC';
48
49########################################################################
50# subs for using several times
51########################################################################
52
53sub create_ly2eps {		       # '--ly2eps' default
54  our ( $out, $Read, $Temp );
55
56  my $prefix = $Read->{'file_numbered'};   # with dir change to temp dir
57
58  # '$ lilypond --ps -dbackend=eps -dgs-load-fonts \
59  #      output=file_without_extension file.ly'
60  # extensions are added automatically
61  my $opts = '--ps -dbackend=eps -dinclude-eps-fonts -dgs-load-fonts ' .
62    "--output=$prefix $prefix";
63  &run_lilypond("$opts");
64
65  Cwd::chdir $Temp->{'cwd'} or
66      die "Could not change to former directory '" .
67	$Temp->{'cwd'} . "': $!";
68
69  my $eps_dir = $Temp->{'eps_dir'};
70  my $dir = $Temp->{'temp_dir'};
71  opendir( my $dh, $dir ) or
72    die "could not open temporary directory '$dir': $!";
73
74  my $re = qr<
75	       ^
76	       $prefix
77	       -
78	       .*
79	       \.eps
80	       $
81	     >x;
82  my $file;
83  while ( readdir( $dh ) ) {
84    chomp;
85    $file = $_;
86    if ( /$re/ ) {
87      my $file_path = File::Spec->catfile($dir, $file);
88      if ( $eps_dir ) {
89	my $could_copy = FALSE;
90	File::Copy::copy($file_path, $eps_dir)
91	    and $could_copy = TRUE;
92	if ( $could_copy ) {
93	  unlink $file_path;
94	  $file_path = File::Spec->catfile($eps_dir, $_);
95	}
96      }
97      $out->print( $P_PIC . ' ' . $file_path );
98    }
99  }				# end while readdir
100  closedir( $dh );
101}				# end sub create_ly2eps()
102
103
104sub create_pdf2eps {		       # '--pdf2eps'
105  our ( $v, $stdout, $stderr, $out, $Read, $Temp );
106
107  my $prefix = $Read->{'file_numbered'};   # with dir change to temp dir
108
109  &run_lilypond("--pdf --output=$prefix $prefix");
110
111  my $file_pdf = $prefix . '.pdf';
112  my $file_ps = $prefix . '.ps';
113
114  # pdf2ps in temp dir
115  my $temp_file = &next_temp_file;
116  $v->print( "\n##### run of 'pdf2ps'" );
117  # '$ pdf2ps file.pdf file.ps'
118  my $output = `pdf2ps $file_pdf $file_ps 2> $temp_file`;
119  die 'Program pdf2ps does not work.' if ( $? );
120  &shell_handling($output, $temp_file);
121  $v->print( "##### end run of 'pdf2ps'\n" );
122
123  # ps2eps in temp dir
124  $temp_file = &next_temp_file;
125  $v->print( "\n##### run of 'ps2eps'" );
126  # '$ ps2eps file.ps'
127  $output = `ps2eps $file_ps 2> $temp_file`;
128  die 'Program ps2eps does not work.' if ( $? );
129  &shell_handling($output, $temp_file);
130  $v->print( "##### end run of 'ps2eps'\n" );
131
132  # change back to former dir
133  Cwd::chdir $Temp->{'cwd'} or
134      die "Could not change to former directory '" .
135	$Temp->{'cwd'} . "': $!";
136
137  # handling of .eps file
138  my $file_eps = $prefix . '.eps';
139  my $eps_path = File::Spec->catfile($Temp->{'temp_dir'}, $file_eps);
140  if ( $Temp->{'eps_dir'} ) {
141    my $has_copied = FALSE;
142    File::Copy::copy( $eps_path, $Temp->{'eps_dir'} )
143	and $has_copied = TRUE;
144    if ( $has_copied ) {
145      unlink $eps_path;
146      $eps_path = File::Spec->catfile( $Temp->{'eps_dir'}, $file_eps );
147    } else {
148      $stderr->print( "Could not use EPS-directory." );
149    } # end Temp->{'eps_dir'}
150  }
151  # print into groff output
152  $out->print( $P_PIC . ' ' . $eps_path );
153}				# end sub create_pdf2eps()
154
155
156sub is_subdir {			# arg1 is subdir of arg2 (is longer)
157  my ( $dir1, $dir2 ) = @_;
158  $dir1 = &path2abs( $dir1 );;
159  $dir2 = &path2abs( $dir2 );;
160  my @split1 = File::Spec->splitdir($dir1);
161  my @split2 = File::Spec->splitdir($dir2);
162  for ( @split2 ) {
163    next if ( $_ eq shift @split1 );
164    return FALSE;
165  }
166  return TRUE;
167}
168
169
170sub license {
171  our ( $Legalese, $stdout );
172  &version;
173  $stdout->print( $Legalese->{'license'} );
174} # end sub license()
175
176
177sub make_dir {			# make directory or check if it exists
178  our ( $v, $Args );
179
180  my $dir_arg = shift;
181  chomp $dir_arg;
182  $dir_arg =~ s/^\s*(.*)\s*$/$1/;
183
184  unless ( $dir_arg ) {
185    $v->print( "make_dir(): empty argument" );
186    return FALSE;
187  }
188
189  unless ( File::Spec->file_name_is_absolute($dir_arg) ) {
190    my $res = Cwd::realpath($dir_arg);
191    $res = File::Spec->canonpath($dir_arg) unless ( $res );
192    $dir_arg = $res if ( $res );
193  }
194
195  return $dir_arg if ( -d $dir_arg && -w $dir_arg );
196
197
198  # search thru the dir parts
199  my @dir_parts = File::Spec->splitdir($dir_arg);
200  my @dir_grow;
201  my $dir_grow;
202  my $can_create = FALSE;	# dir could be created if TRUE
203
204 DIRPARTS: for ( @dir_parts ) {
205    push @dir_grow, $_;
206    next DIRPARTS unless ( $_ ); # empty string for root directory
207
208    # from array to path dir string
209    $dir_grow = File::Spec->catdir(@dir_grow);
210
211    next DIRPARTS if ( -d $dir_grow );
212
213    if ( -e $dir_grow ) {  # exists, but not a dir, so must be removed
214      die "Couldn't create dir '$dir_arg', it is blocked by '$dir_grow'."
215	unless ( -w $dir_grow );
216
217      # now it's writable, but not a dir, so it can be removed
218      unlink ( $dir_grow ) or
219	die "Couldn't remove '$dir_grow', " .
220	  "so I cannot create dir '$dir_arg': $!";
221    }
222
223    # $dir_grow does no longer exist, so the former dir must be writable
224    # in order to create the directory
225    pop @dir_grow;
226    $dir_grow = File::Spec->catdir(@dir_grow);
227
228    die "'$dir_grow' is not writable, " .
229      "so directory '$dir_arg' can't be createdd."
230	unless ( -w $dir_grow );
231
232    # former directory is writable, so '$dir_arg' can be created
233
234    File::Path::make_path( $dir_arg,
235			   {
236			    mask => oct('0700'),
237			    verbose => $Args->{'verbose'},
238			   }
239			 )	#  'mkdir -P'
240	or die "Could not create directory '$dir_arg': $!";
241
242    last DIRPARTS;
243  }
244
245  die "'$dir_arg' is not a writable directory"
246    unless ( -d $dir_arg && -w $dir_arg );
247
248  return $dir_arg;
249
250} # end sub make_dir()
251
252
253my $number = 0;
254sub next_temp_file {
255  our ( $Temp, $v, $Args );
256  ++$number;
257  my $temp_basename = $Args->{'prefix'} . '_temp_' . $number;
258  my $temp_file = File::Spec->catfile( $Temp->{'temp_dir'} ,
259				       $temp_basename );
260  $v->print( "next temporary file: '$temp_file'" );
261  return $temp_file;
262}				# end sub next_temp_file()
263
264
265sub path2abs {
266  our ( $Temp, $Args );
267
268  my $path = shift;
269  $path =~ s/
270	      ^
271	      \s*
272	      (
273		.*
274	      )
275	      \s*
276	      $
277	    /$1/x;
278
279  die "path2abs(): argument is empty." unless ( $path );
280
281  # Perl does not support shell '~' for home dir
282  if ( $path =~ /
283		  ^
284		  ~
285		/x ) {
286    if ( $path eq '~' ) {	# only own home
287      $path = File::HomeDir->my_home;
288    } elsif ( $path =~ m<
289			  ^
290			  ~ /
291			  (
292			    .*
293			  )
294			  $
295			>x ) {	# subdir of own home
296      $path = File::Spec->catdir( $Temp->{'cwd'}, $1 );
297    } elsif ( $path =~ m<
298			  ^
299			  ~
300			  (
301			    [^/]+
302			  )
303			  $
304			>x ) {	# home of other user
305      $path = File::HomeDir->users_home($1);
306    } elsif ( $path =~ m<
307			  ^
308			  ~
309			  (
310			    [^/]+
311			  )
312			  /+
313			  (
314			    .*
315			  )
316			  $
317			>x ) {	# subdir of other home
318      $path = File::Spec->
319	catdir( File::HomeDir->users_home($1), $2 );
320    }
321  }
322
323  $path = File::Spec->rel2abs($path);
324
325  # now $path is absolute
326  return $path;
327} # end sub path2abs()
328
329
330sub run_lilypond {
331  # arg is the options collection for 'lilypond' to run
332  # either from ly or pdf
333
334  our ( $Temp, $v );
335
336  my $opts = shift;
337  chomp $opts;
338
339  my $temp_file = &next_temp_file;
340  my $output = EMPTYSTRING;
341
342  # change to temp dir
343  Cwd::chdir $Temp->{'temp_dir'} or
344      die "Could not change to temporary directory '" .
345	$Temp->{'temp_dir'} . "': $!";
346
347  $v->print( "\n##### run of 'lilypond " . $opts . "'" );
348  $output = `lilypond $opts 2>$temp_file`;
349  die "Program lilypond does not work, see '$temp_file': $?"
350    if ( $? );
351  chomp $output;
352  &shell_handling($output, $temp_file);
353  $v->print( "##### end run of 'lilypond'\n" );
354
355  # stay in temp dir
356} # end sub run_lilypond()
357
358
359sub shell_handling {
360  # Handle ``-shell-command output in a string (arg1).
361  # stderr goes to temporary file $TempFile.
362
363  our ( $out, $v, $Args );
364
365  my $out_string = shift;
366  my $temp_file = shift;
367
368  my $a = &string2array($out_string); # array ref
369  for ( @$a ) {
370    $out->print( $_ );
371  }
372
373  $temp_file && -f $temp_file && -r $temp_file ||
374    die "shell_handling(): $temp_file is not a readable file.";
375  my $temp = new FH_READ_FILE($temp_file);
376  my $res = $temp->read_all();
377  for ( @$res ) {
378    chomp;
379    $v->print($_);
380  }
381
382  unlink $temp_file unless ( $Args->{'keep_all'} );
383} # end sub shell_handling()
384
385
386sub string2array {
387  my $s = shift;
388  my @a = ();
389  for ( split "\n", $s ) {
390    chomp;
391    push @a, $_;
392  }
393  return \@a;
394} # end string2array()
395
396
397sub usage {			# for '--help'
398  our ( $Globals, $Args );
399
400  my $p = $Globals->{'prog'};
401  my $usage = EMPTYSTRING;
402  $usage = '###### usage:' . "\n" if ( $Args->{'verbose'} );
403  $usage .= qq*Options for $p:
404Read a 'roff' file or standard input and transform 'lilypond' parts
405(everything between '.lilypond start' and '.lilypond end') into
406'EPS'-files that can be read by groff using '.PSPIC'.
407
408There is also a command '.lilypond include <file_name>' that can
409include a complete 'lilypond' file into the 'groff' document.
410
411
412# Breaking options:
413$p -?|-h|--help|--usage    # usage
414$p --version               # version information
415$p --license               # the license is GPL >= 3
416
417
418# Normal options:
419$p [options] [--] [filename ...]
420
421There are 2 options for influencing the way how the 'EPS' files for the
422'roff' display are generated:
423--ly2eps           'lilypond' generates 'EPS' files directly (default)
424--pdf2eps          'lilypond' generates a 'PDF' file that is transformed
425
426-k|--keep_all      do not delete any temporary files
427-v|--verbose       print much information to STDERR
428
429Options with an argument:
430-e|--eps_dir=...   use a directory for the EPS files
431-o|--output=...    sent output in the groff language into file ...
432-p|--prefix=...    start for the names of temporary files
433-t|--temp_dir=...  provide the directory for temporary files.
434
435The directories set are created when they do not exist.
436*;
437
438  # old options:
439  # --keep_files       -k: do not delete any temporary files
440  # --file_prefix=...  -p: start for the names of temporary files
441
442  $main::stdout->print( $usage );
443} # end sub usage()
444
445
446sub version { # for '--version'
447  our ( $Globals, $Legalese, $stdout, $Args );
448  my $end;
449  if ( $Globals->{'groff_version'} ) {
450    $end = " version $Globals->{'groff_version'}";
451  } else {
452    $end = '.';
453  }
454
455  my $output = EMPTYSTRING;
456  $output = "###### version:\n" if ( $Args->{'verbose'} );
457  $output .= "'" . $Globals->{'prog'} . "' version '" .
458    $Legalese->{'version'} . "' is part of 'GNU groff'" . $end;
459
460  $stdout->print($output);
461} # end sub version()
462
463
464# end of subs
465
4661;
467########################################################################
468### Emacs settings
469# Local Variables:
470# mode: CPerl
471# End:
472