contrib/glilypond/subs.pl

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