File "Line.pm"

Full Path: /home/analogde/www/php/Filter/Line.pm
File size: 4.16 KB
MIME-type: text/plain
Charset: utf-8

# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::IPC::Filter::Line
#   Author  : Scott Beck
#   $Id: Line.pm,v 1.7 2004/01/13 01:35:17 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description: Filter streams of input out to a line.
#

package GT::IPC::Filter::Line;
# ==================================================================

use strict;
use base 'GT::Base';

sub new {
# ----------------------------------------------------------------------------
    my $class = shift;

    if (@_ == 1) {
        @_ = (output => $_[0]);
    }
    $class->fatal(BADARGS => "Arguments to new() must be a hash")
        if @_ & 1;
    my %opts = @_;

    my $output = delete $opts{output};
    $class->fatal(BADARGS => "No output for new()")
        unless defined $output;
    $class->fatal(BADARGS => "No output passed to new() is not a code ref")
        unless ref($output) eq 'CODE';

    my $regex = delete $opts{regex};
    my $literal = delete $opts{literal};

    $class->fatal(BADARGS => "You can only specify one of literal and regex")
        if defined $regex and defined $literal;

    if (defined $literal) {
        $regex = quotemeta $literal;
    }

    if (!defined $regex) {
        $regex = '\x0D\x0A?|\x0A\x0D?';
    }

    return bless {
        regex  => $regex,
        output => $output,
    }, $class;
}

sub put {
# ----------------------------------------------------------------------------
    my ($self, $in) = @_;

    if (defined $self->{buffer}) {
        $$in = $self->{buffer} . $$in;
        undef $self->{buffer};
    }
    my $regex = $self->{regex};
    my @in = split /($regex)/ => $$in;

    # Not a complete line
    if ($in[$#in] !~ /$regex/) {
        $self->{buffer} = pop @in;
    }

    for (my $i = 0; $i < $#in; $i += 2) {
        $self->{output}->($in[$i]);
    }
}

sub flush {
# ----------------------------------------------------------------------------
    my ($self) = @_;
    $self->{output}->($self->{buffer}) if defined $self->{buffer};
    undef $self->{buffer};
}

1;

__END__

=head1 NAME

GT::IPC::Filter::Line - Implements line based filtering for output streams.

=head1 SYNOPSIS

    use GT::IPC::Filter::Line;

    my $filter = new GT::IPC::Filter::Line(
        sub { my $line = shift ... }
    );
    # -or-
    my $filter = new GT::IPC::Filter::Line(
        output => sub { my $out = shift; .. },
        regex  => '\r?\n'
    );

    $filter->put(\$data);

    $filter->flush;

=head1 DESCRIPTION

Implements line based filtering to an output code reference. Used mainly in
GT::IPC::Run, L<GT::IPC::Run> for details.

=head1 METHODS

There are three methods (as with all filters in this class).

=head2 new

Takes either a single argument, which is a code reference to call output with,
or a hash of options.

=over 4

=item output

This is the code reference you would like called with each line of output.  The
lines are stripped of there ending before this is called.

=item regex

Specify the regex to use in order to determine the end of line sequence. This
regex is used in a split on the input stream. If you capture in this regex it
will break the output.

=item literal

Specifies a literal new line sequence. The only difference between this option
and the C<regex> option is it is C<quotemeta>, See L<perlfunc/quotemeta>.

=back

=head2 put

This method takes a stream of data, it converted it into line based data and
passes each line to the code reference specified by C<new()>, see L<"new">.
There is buffering that happens here because we have no way of knowing if the
output stream does not end with a new line, also streams almost always get
partial lines.

=head2 flush

This method should be called last, when the data stream is over. It flushes the
remaining buffer out to the code reference.

=head1 SEE ALSO

See L<GT::IPC::Run>.

=head1 MAINTAINER

Scott Beck

=head1 COPYRIGHT

Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: Line.pm,v 1.7 2004/01/13 01:35:17 jagerman Exp $

=cut