NAME

Tie::Layers - read and write files pipelined through a stack of subroutine layers

SYNOPSIS

#####
# Subroutines
#
use Tie::Layers qw(is_handle);

$yes = is_handle( $file_handle );

require Tie::Layers;

#####
# Using support methods and file handle with
# the file subroutines such as open(), readline()
# print(), close()
#
tie *LAYERS_FILEHANDLE, 'Tie::Layers', @options
$layers = tied \*LAYERS_FILEHANDLE; 

#####
# Using support methods only, no file subroutines
# 
$layers = Tie::Layers->TIEHANDLE(@options);

$data = $layers->fin($filename, @options);

$data = $layers->fout($filename, $data, @options);

$yes = $layers->is_handle( $file_handle );

If a subroutine or method will process a list of options, @options, that subroutine will also process an array reference, \@options, [@options], or hash reference, \%options, {@options}.

DESCRIPTION

The Tie::Layers program module contains the tie file handle Tie::Layers package. The Tie::Layers package provides the ability to insert a stack of subroutines between file subroutines print and realine and the underlying $file. The syntax of the subroutines of each layer of the readline stack and the print stack must comply to the the requirements described herein below. This is necessary so that the Tie::Layers READLINE and PRINT subroutines know how to transfer the output from one layer to the input of another layer. The stacks are setup by supplying options with a reference to the subroutine for each layer in the print stack and the readline stack. The Tie::Layers are line orientated and do not support any character file subrouintes. The getc, read, and write file subroutines are supported by the Tie::Layers package. The seek routines are line oriented in that the seek and tell subroutine positions are the line in the underlying file and not the character position in the file.

options

The Tie::Layers program module subroutines/methods and the file subroutines using a filehandle that was created with a tie to 'Tie::Layers, use the following options:

option            default            description
----------------------------------------------------------------------
binary       =>   0,                 apply binmode to the $file
warn         =>   1,                 issue a warn for events
print_layers =>   [],                stack of print subroutines 
print_record =>   undef,             print to $file
read_layers  =>   [],                stack of readline subroutines
read_record  =>   \&layer_readline,  read a line from $file

readline stack

The stack for readline is setup with the read_layers and read_record options. Say the layers are numbered so that layer 0 reads a line from the underlying $file, and the line data is processing layer_1 to layer_2 and so forth to the last layer_n. The reference to the subroutine for each layer would be as follows:

read_record  => \&realine_0    #layer 0

read_layers => 
    [ \&read_layer_routine_1,  # layer 1

      # ....
                 
      \&read_layer_routine_n,  # layer n
    ];

The synopsis for the read_record and read_layers subroutine references are as follow:

$line = read_record($self);  # layer 0
$lineref = read_layer_routines($self, $lineref); # layers 1 - n

If the read_record option does not exist, the Tie::Layers methods will supply a default read_record.

Events are passed from the layer routines by as follows:

$self->{current_event} = $event;

The $lineref may be either a scalar text or any valid Perl reference. When the layer $lineref are references, the

@array = readline(LAYER)  # or
@array = <LAYER>

will return an @array of references; otherwise, they behave as usual and return an @array of text scalar lines. The added feature of allowing returns of an array of references gives layered Tie::Layers the capability to decode database files such as comma delimited variable files.

print stack

The stack for print is setup with the print_layers and print_record options. Say the layers are numbered so that layer 0 prints a line from the underlying $file, and the line data is processing from top layer_n down to layer_2 and layer_1. The reference to the subroutine for each layer would be as follows:

print_record  => \&print_0    #layer 0

print_layers => 
    [ \&print_layer_routine_1,  # layer 1

      # ....
                 
      \&print_layer_routine_n,  # layer n
    ];

If the print_record option does not exist, the Tie::Layers methods will use print to print to the underlying file.

The synopsis for the print_record and print_layers subroutine references are as follow:

$success = print_record($self, $line);  # layer 0
$lineref = print_layer_subroutine($self, $lineref); # layers 1 - n

Events are passed from the layer routines by as follows:

$self->{current_event} = $event;

The $lineref may be either a scalar text or any valid Perl reference.

open

open  (LAYERS_FILEHANDLE, $mode, $filename, @options)
open  (LAYERS_FILEHANDLE, "$mode$filename", @options)

When using a LAYERS_FILEHANDLE tied to the Tie::Layers package methods with a c<open> subroutine, the open subroutine will process Tie::Layers package @options and the $filename may be either a file name or a file handle to the underlying file.

fin

$data = $layers->fin($filename, @options);

The fin method slurps in the entire $filename using the readline stack. The $layers-{event}> returns the events from each layer in the readline stack.

fout

$success = $layers->fout($filename, $data, @options);

The fout method

is_handle

$yes = is_handle( $file_handle );

The is_handle subroutine determines whether or not $file_handle is a file handle.

DEMONSTRATION

#########
# perl Layers.d
###

~~~~~~ Demonstration overview ~~~~~

The results from executing the Perl Code follow on the next lines as comments. For example,

2 + 2
# 4

~~~~~~ The demonstration follows ~~~~~

    use File::Package;

    my $uut = 'Tie::Layers'; # Unit Under Test
    my $fp = 'File::Package';
    my $loaded;

    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #
    # LAYER 2:  ENCODE/DECODE FIELDS
    #
    #~~~~~~   

    #####
    # 
    # Encodes a field a field_name, field_value pairs
    # into a scalar encoded_field. Also get a snap shot 
    # of the options.  
    #
    #
    sub encode_field
    {
        my ($self,$record) = @_;
        unless ($record) {
            $self->{current_event} = "No input\n" ;
            return undef;
        }

        return undef unless( $record);
        my @fields = @$record;

        ######
        # Record that called a stub layer
        #
        my $encoded_fields = "layer 2: encode_field\n";

        ######
        # Process the data and record it
        #
        my( $name, $data );
        for( my $i=0; $i < @fields; $i += 2) {
            ($name, $data) = ($fields[$i], $fields[$i+1]);   
            $encoded_fields .= "$name: $data\n";
        }

        #####
        # Get a snap-short of the options
        #
        my $options = $self->{options};
        foreach my $key (sort keys %$options ) {
            next if $key =~ /(print_record|print_layers|read_record|read_layers)/;
            $encoded_fields .= "option $key: $options->{$key}\n";
        }
        \$encoded_fields;
    }

    #####
    # 
    # Encodes a field a field_name, field_value pairs
    # into a scalar encoded_field. Also get a snap shot 
    # of the options.  
    #
    #
    sub decode_field
    {
        my ($self,$record) = @_;
        unless ($record) {
            $self->{current_event} = "No input\n" ;
            return undef;
        }
        $record  = "layer 2: decode_field\n" . $record;
        my @fields = split /\s*[:\n]\s*/,$record;
        return \@fields;
    }

    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #
    # LAYER 1:  ENCODE/DECODE RECORD
    #
    #~~~~~~   

    #########
    # This function un escapes the record separator
    #
    sub decode_record
    {
        my ($self,$record) = @_;
        unless ($record) {
            $self->{current_event} = "No input\n" ;
            return undef;
        }
        #######
        # Unless in strict mode, change CR and LF
        # to end of line string for current operating system
        #
        unless( $self->{options}->{binary} ) {
            $$record =~ s/\015\012|\012\015/\012/g;  # replace LFCR or CRLF with a LF
            $$record =~ s/\012|\015/\n/g;   # replace CR or LF with logical \n 
        }

        "layer 1: decode_record\n" . $$record;
     } 

    #############
    # encode the record
    #
    sub encode_record
    {
        my ($self, $record) = @_;
        unless ($record) {
            $self->{current_event} = "No input\n" ;
            return undef;
        }
        my $output = "layer 1: encode_record\n" . $$record;   
        \$output;
    } 

    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #
    # LAYER 0:  READ-WRITE FILE RECORD
    #
    #~~~~~~   

    #########
    # This function gets the next record from
    # the file and unescapes the record separator
    #
    sub read_record
    {
       my ($self) = @_;

       local($/);
       $/ = "\n\~-\~\n";

       my ($fh) = $self->{FH};
       $! = 0;
       my $record = <$fh>;
       unless($record) {
           $self->{current_event} = $!;
           return undef;
       }
       $record = substr($record, 0, length($record) - 4);
       $record = "layer 0: get_record\n" . $record;
       return $record;
    } 

    #######
    # append a record to the file and adding the
    # record separator
    #
    sub print_record
    {
        my ($self, $record) = @_;
        my ($fh) = $self->{FH};
        $record .= "\n" unless substr($record, -1, 1) eq "\n";
        $! = 0;
        my $success = print $fh "layer 0: put_record\n$record\~-\~\n";
        $self->{current_event} = $! unless($success);
        $success;
    }
    my (@records, $record);   # force context

##################
# Load UUT
# 

my $errors = $fp->load_package($uut)
$errors

# ''
#
    my $version = $Tie::Layers::VERSION;
    $version = '' unless $version;

##################
# Tie::Layers Version 0.03 loaded
# 

$fp->is_package_loaded($uut)

# 1
#
    tie *LAYERS, 'Tie::Layers', 
        print_record => \&print_record, # layer 0
        print_layers => [
           \&encode_record, # layer 1
           \&encode_field,  # layer 2
        ],
        read_record => \&read_record, # layer 0
        read_layers => [
           \&decode_record,  # layer 1
           \&decode_field,    # layer 2
        ];

    my $layers = tied *LAYERS;
    unlink 'layers1.txt';

##################
# open( *LAYERS,'>layers1.txt')
# 

open( \*LAYERS,'>layers1.txt')

# 1
#

##################
# print LAYERS [qw(field1 value1 field2 value2)]
# 

(print LAYERS [qw(field1 value1 field2 value2)])

# '1'
#

##################
# print LAYERS [qw(field3 value3)]
# 

(print LAYERS [qw(field3 value3)])

# '1'
#

##################
# print LAYERS [qw(field4 value4 field5 value5 field6 value6)]
# 

(print LAYERS [qw(field4 value4 field5 value5 field6 value6)])

# '1'
#

##################
# print close(LAYERS)
# 

close(LAYERS)

# 1
#
    local(*FIN);
    tie *FIN, 'Tie::Layers', 
        binary => 1,
        read_layers => [
            sub 
            {
                my ($self,$record) = @_;
                unless ($record) {
                   $self->{current_event} = "No input\n" ;
                   return undef;
                }
                #######
                # Unless in strict mode, change CR and LF
                # to end of line string for current operating system
                #
                $$record =~ s/\015\012|\012\015/\012/g;  # replace LFCR or CRLF with a LF
                $$record =~ s/\012|\015/\n/g;   # replace CR or LF with logical \n 
                $$record;
            }
        ];
    my $slurp = tied *FIN;

##################
# Verify file layers1.txt content
# 

$slurp->fin('layers1.txt')

# 'layer 0: put_record
#layer 1: encode_record
#layer 2: encode_field
#field1: value1
#field2: value2
#option binary: 0
#option warn: 1
#~-~
#layer 0: put_record
#layer 1: encode_record
#layer 2: encode_field
#field3: value3
#option binary: 0
#option warn: 1
#~-~
#layer 0: put_record
#layer 1: encode_record
#layer 2: encode_field
#field4: value4
#field5: value5
#field6: value6
#option binary: 0
#option warn: 1
#~-~
#'
#

##################
# open( *LAYERS,'<layers1.txt')
# 

open( \*LAYERS,'<layers1.txt')

# 1
#

##################
# readline record 1
# 

$record = <LAYERS>

# [
#          'layer 2',
#          'decode_field',
#          'layer 1',
#          'decode_record',
#          'layer 0',
#          'get_record',
#          'layer 0',
#          'put_record',
#          'layer 1',
#          'encode_record',
#          'layer 2',
#          'encode_field',
#          'field1',
#          'value1',
#          'field2',
#          'value2',
#          'option binary',
#          '0',
#          'option warn',
#          '1'
#        ]
#

##################
# readline record 2
# 

$record = <LAYERS>

# [
#          'layer 2',
#          'decode_field',
#          'layer 1',
#          'decode_record',
#          'layer 0',
#          'get_record',
#          'layer 0',
#          'put_record',
#          'layer 1',
#          'encode_record',
#          'layer 2',
#          'encode_field',
#          'field3',
#          'value3',
#          'option binary',
#          '0',
#          'option warn',
#          '1'
#        ]
#

##################
# readline record 3
# 

$record = <LAYERS>

# [
#          'layer 2',
#          'decode_field',
#          'layer 1',
#          'decode_record',
#          'layer 0',
#          'get_record',
#          'layer 0',
#          'put_record',
#          'layer 1',
#          'encode_record',
#          'layer 2',
#          'encode_field',
#          'field4',
#          'value4',
#          'field5',
#          'value5',
#          'field6',
#          'value6',
#          'option binary',
#          '0',
#          'option warn',
#          '1'
#        ]
#

##################
# seek(LAYERS,0,0)
# 

seek(LAYERS,0,0)
$record = <LAYERS>

# [
#          'layer 2',
#          'decode_field',
#          'layer 1',
#          'decode_record',
#          'layer 0',
#          'get_record',
#          'layer 0',
#          'put_record',
#          'layer 1',
#          'encode_record',
#          'layer 2',
#          'encode_field',
#          'field1',
#          'value1',
#          'field2',
#          'value2',
#          'option binary',
#          '0',
#          'option warn',
#          '1'
#        ]
#

##################
# seek(LAYERS,2,0)
# 

seek(LAYERS,2,0)
$record = <LAYERS>

# [
#          'layer 2',
#          'decode_field',
#          'layer 1',
#          'decode_record',
#          'layer 0',
#          'get_record',
#          'layer 0',
#          'put_record',
#          'layer 1',
#          'encode_record',
#          'layer 2',
#          'encode_field',
#          'field4',
#          'value4',
#          'field5',
#          'value5',
#          'field6',
#          'value6',
#          'option binary',
#          '0',
#          'option warn',
#          '1'
#        ]
#

##################
# seek(LAYERS,-1,1)
# 

seek(LAYERS,-1,1)
$record = <LAYERS>

# [
#          'layer 2',
#          'decode_field',
#          'layer 1',
#          'decode_record',
#          'layer 0',
#          'get_record',
#          'layer 0',
#          'put_record',
#          'layer 1',
#          'encode_record',
#          'layer 2',
#          'encode_field',
#          'field3',
#          'value3',
#          'option binary',
#          '0',
#          'option warn',
#          '1'
#        ]
#

##################
# readline close(LAYERS)
# 

close(LAYERS)

# 1
#

##################
# Verify fout content
# 

$slurp->fout('layers1.txt', $test_data1);
$slurp->fin('layers1.txt')

# 'layer 0: put_record
#layer 1: encode_record
#layer 2: encode_field
#field1: value1
#field2: value2
#option binary: 0
#option warn: 1
#~-~
#layer 0: put_record
#layer 1: encode_record
#layer 2: encode_field
#field3: value3
#option binary: 0
#option warn: 1
#~-~
#layer 0: put_record
#layer 1: encode_record
#layer 2: encode_field
#field4: value4
#field5: value5
#field6: value6
#option binary: 0
#option warn: 1
#~-~
#'
#

QUALITY ASSURANCE

Running the test script Layers.t verifies the requirements for this module. The tmake.pl cover script for Test::STDmaker automatically generated the Layers.t test script, Layers.d demo script, and t::Tie::Layers Software Test Description (STD) program module POD, from the t::Tie::Layers program module contents. The tmake.pl cover script automatically ran the Layers.d demo script and inserted the results into the 'DEMONSTRATION' section above. The t::Tie::Layers program module is in the distribution file Tie-Layers-$VERSION.tar.gz.

NOTES

Author

The holder of the copyright and maintainer is

< support@SoftwareDiamonds.com >

Copyright Notice

Binding Requirements Notice

Binding requirements are indexed with the

pharse 'shall[dd]' where dd is an unique number for each header section. This conforms to standard federal government practices, 490A 3.2.3.6. In accordance with the License for 'Tie::Gzip', Software Diamonds is not liable for meeting any requirement, binding or otherwise.

License

Software Diamonds permits the redistribution and use in source and binary forms, with or without modification, provided that the following conditions are met:

Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

SOFTWARE DIAMONDS, http://www.softwarediamonds.com, PROVIDES THIS SOFTWARE 'AS IS' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SOFTWARE DIAMONDS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING USE OF THIS SOFTWARE, EVEN IF ADVISED OF NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE POSSIBILITY OF SUCH DAMAGE.

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)