contrib/glilypond/oop_fh.pl

   1 my $License = q*
   2 ########################################################################
   3 # Legalese
   4 ########################################################################
   5
   6 Source file position: `<groff-source>/contrib/glilypond/oop_fh.pl'
   7 Installed position: `<prefix>/lib/groff/glilypond/oop_fh.pl'
   8
   9 Copyright (C) 2013-2013  Free Software Foundation, Inc.
  10   Written by Bernd Warken <groff-bernd.warken-72@web.de>
  11
  12 This file is part of `glilypond', which is part of `GNU groff'.
  13
  14 glilypond - integrate `lilypond' into `groff' files
  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
  41 ########################################################################
  42 # OOP for writing file handles that are open by default, like STD*
  43 ########################################################################
  44
  45 # -------------------------- _FH_WRITE_OPENED --------------------------
  46
  47 {       # FH_OPENED: base class for all opened file handles, like $TD*
  48
  49   package _FH_WRITE_OPENED;
  50   use strict;
  51
  52   sub new {
  53     my ( $pkg, $std ) = @_;
  54     bless {
  55            'fh' => $std,
  56           }
  57   }
  58
  59   sub open {
  60   }
  61
  62   sub close {
  63   }
  64
  65   sub print {
  66     my $self = shift;
  67     for ( @_ ) {
  68       print { $self->{'fh'} } $_;
  69     }
  70   }
  71
  72 }
  73
  74
  75 # ------------------------------ FH_STDOUT ----------------------------
  76
  77 {                            # FH_STDOUT: print to noral output STDOUT
  78
  79   package FH_STDOUT;
  80   use strict;
  81   @FH_STDOUT::ISA = qw( _FH_WRITE_OPENED );
  82
  83   sub new {
  84     &_FH_WRITE_OPENED::new( '_FH_WRITE_OPENED', *STDOUT );
  85   }
  86
  87 }                               # end FH_STDOUT
  88
  89
  90 # ------------------------------ FH_STDERR -----------------------------
  91
  92 {                               # FH_STDERR: print to STDERR
  93
  94   package FH_STDERR;
  95   use strict;
  96   @FH_STDERR::ISA = qw( _FH_WRITE_OPENED );
  97
  98   sub new {
  99     &_FH_WRITE_OPENED::new( 'FH_OPENED', *STDERR );
 100   }
 101
 102 }                               # end FH_STDERR
 103
 104
 105 ########################################################################
 106 # OOP for file handles that write into a file or string
 107 ########################################################################
 108
 109 # ------------------------------- FH_FILE ------------------------------
 110
 111 {              # FH_FILE: base class for writing into a file or string
 112
 113   package FH_FILE;
 114   use strict;
 115
 116   sub new {
 117     my ( $pkg, $file ) = @_;
 118     bless {
 119            'fh' => undef,
 120            'file' => $file,
 121            'opened' => main::FALSE,
 122           }
 123   }
 124
 125   sub DESTROY {
 126     my $self = shift;
 127     $self->close();
 128   }
 129
 130   sub open {
 131     my $self = shift;
 132     my $file = $self->{'file'};
 133     if ( $file && -e $file ) {
 134       die "file $file is not writable" unless ( -w $file );
 135       die "$file is a directory" if ( -d $file );
 136     }
 137     open $self->{'fh'}, ">", $self->{'file'}
 138       or die "could not open file `$file' for writing: $!";
 139     $self->{'opened'} = main::TRUE;
 140   }
 141
 142   sub close {
 143     my $self = shift;
 144     close $self->{'fh'} if ( $self->{'opened'} );
 145     $self->{'opened'} = main::FALSE;
 146   }
 147
 148   sub print {
 149     my $self = shift;
 150     $self->open() unless ( $self->{'opened'} );
 151     for ( @_ ) {
 152       print { $self->{'fh'} } $_;
 153     }
 154   }
 155
 156 }                               # end FH_FILE
 157
 158
 159 # ------------------------------ FH_STRING -----------------------------
 160
 161 {                               # FH_STRING: write into a string
 162
 163   package FH_STRING;            # write to \string
 164   use strict;
 165   @FH_STRING::ISA = qw( FH_FILE );
 166
 167   sub new {
 168     my $pkg = shift;            # string is a reference to scalar
 169     bless
 170       {
 171        'fh' => undef,
 172        'string' => '',
 173        'opened' => main::FALSE,
 174       }
 175     }
 176
 177   sub open {
 178     my $self = shift;
 179     open $self->{'fh'}, ">", \ $self->{'string'}
 180       or die "could not open string for writing: $!";
 181     $self->{'opened'} = main::TRUE;
 182   }
 183
 184   sub get { # get string, move to array ref, close, and return array ref
 185     my $self = shift;
 186     return '' unless ( $self->{'opened'} );
 187     my $a = &string2array( $self->{'string'} );
 188     $self->close();
 189     return $a;
 190   }
 191
 192 }                               # end FH_STRING
 193
 194
 195 # -------------------------------- FH_NULL -----------------------------
 196
 197 {                               # FH_NULL: write to null device
 198
 199   package FH_NULL;
 200   use strict;
 201   @FH_NULL::ISA = qw( FH_FILE FH_STRING );
 202
 203   use File::Spec;
 204
 205   my $devnull = File::Spec->devnull();
 206   $devnull = '' unless ( -e $devnull && -w $devnull );
 207
 208   sub new {
 209     my $pkg = shift;
 210     if ( $devnull ) {
 211       &FH_FILE::new( $pkg, $devnull );
 212     } else {
 213       &FH_STRING::new( $pkg );
 214     }
 215   } # end new()
 216
 217 }                               # end FH_NULL
 218
 219
 220 ########################################################################
 221 # OOP for reading file handles
 222 ########################################################################
 223
 224 # ---------------------------- FH_READ_FILE ----------------------------
 225
 226 { # FH_READ_FILE: read a file
 227
 228   package FH_READ_FILE;
 229   use strict;
 230
 231   sub new {
 232     my ( $pkg, $file ) = @_;
 233     die "File `$file' cannot be read." unless ( -f $file && -r $file );
 234     bless {
 235            'fh' => undef,
 236            'file' => $file,
 237            'opened' => main::FALSE,
 238           }
 239   }
 240
 241   sub DESTROY {
 242     my $self = shift;
 243     $self->close();
 244   }
 245
 246   sub open {
 247     my $self = shift;
 248     my $file = $self->{'file'};
 249     if ( $file && -e $file ) {
 250       die "file $file is not writable" unless ( -r $file );
 251       die "$file is a directory" if ( -d $file );
 252     }
 253     open $self->{'fh'}, "<", $self->{'file'}
 254       or die "could not read file `$file': $!";
 255     $self->{'opened'} = main::TRUE;
 256   }
 257
 258   sub close {
 259     my $self = shift;
 260     close $self->{'fh'} if ( $self->{'opened'} );
 261     $self->{'opened'} = main::FALSE;
 262   }
 263
 264   sub read_line {
 265     # Read 1 line of the file into a chomped string.
 266     # Do not close the read handle at the end.
 267     my $self = shift;
 268     $self->open() unless ( $self->{'opened'} );
 269
 270     my $res;
 271     if ( defined($res = CORE::readline($self->{'fh'}) ) ) {
 272       chomp $res;
 273       return $res;
 274     } else {
 275       $self->close();
 276       return undef;
 277     }
 278   }
 279
 280   sub read_all {
 281     # Read the complete file into an array reference.
 282     # Close the read handle at the end.
 283     # Return array reference.
 284     my $self = shift;
 285     $self->open() unless ( $self->{'opened'} );
 286
 287     my $res = [];
 288     my $line;
 289     while ( defined ( $line = CORE::readline $self->{'fh'} ) ) {
 290       chomp $line;
 291       push @$res, $line;
 292     }
 293     $self->close();
 294     $self->{'opened'} = main::FALSE;
 295     return $res;
 296   }
 297
 298 }
 299
 300 # end of OOP definitions
 301
 302 package main;
 303
 304 1;
 305 ########################################################################
 306 ### Emacs settings
 307 # Local Variables:
 308 # mode: CPerl
 309 # End: