Gecko [ nrupathungauniversityblr.ac.in ]

Name	Size	Permission
args.pl	11.74 KB	-rw-r--r--
oop_fh.pl	6.94 KB	-rw-r--r--
subs.pl	11.68 KB	-rw-r--r--

Code Editor : oop_fh.pl

my $License = q*
########################################################################
# Legalese
########################################################################

Source file position: `<groff-source>/contrib/glilypond/oop_fh.pl'
Installed position: `<prefix>/lib/groff/glilypond/oop_fh.pl'

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;
########################################################################
### Emacs settings
# Local Variables:
# mode: CPerl
# End:

${this.title}

Code Editor : oop_fh.pl