Create New Item
Item Type
File
Folder
Item Name
Search file in folder and subfolders...
Are you sure want to rename?
File Manager
/
php
/
Filter
:
Line.pm
Advanced Search
Upload
New Item
Settings
Back
Back Up
Advanced Editor
Save
# ================================================================== # 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