home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Grep.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-21  |  4.5 KB  |  171 lines
  1. # 2001/01/25 shizukesa@pobox.com
  2.  
  3. package POE::Filter::Grep;
  4.  
  5. use strict;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = do {my@r=(q$Revision: 1.5 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  9.  
  10. use Carp qw(croak);
  11.  
  12. sub CODEBOTH () { 0 }
  13. sub CODEGET  () { 1 }
  14. sub CODEPUT  () { 2 }
  15. sub BUFFER   () { 3 }
  16.  
  17. #------------------------------------------------------------------------------
  18.  
  19. sub new {
  20.   my $type = shift;
  21.   croak "$type must be given an even number of parameters" if @_ & 1;
  22.   my %params = @_;
  23.  
  24.   # -><- It might be better here for Code to set Get and Put first,
  25.   # and then have Get and/or Put override that.  During the filter's
  26.   # normal running (in the hotter code path), you won't need to keep
  27.   # checking CODEBOTH or (CODEGET OR CODEPUT).  Rather, you'll just
  28.   # check CODEGET or CODEPUT (depending on the direction data is
  29.   # headed).
  30.  
  31.   croak "$type requires a Code or both Get and Put parameters"
  32.     unless ( defined($params{Code}) ||
  33.              ( defined($params{Get}) && defined($params{Put}) )
  34.            );
  35.  
  36.   my $self = bless
  37.     [ $params{Code}, # CODEBOTH
  38.       $params{Get},  # CODEGET
  39.       $params{Put},  # CODEPUT
  40.       [ ],           # BUFFER
  41.     ], $type;
  42. }
  43.  
  44. #------------------------------------------------------------------------------
  45. # The get() method doesn't keep state.  Right on!
  46.  
  47. sub get {
  48.   my ($self, $data) = @_;
  49.   [ grep &{$self->[CODEGET] || $self->[CODEBOTH]}, @$data ];
  50. }
  51.  
  52. #------------------------------------------------------------------------------
  53. # 2001-07-27 RCC: The get_one variant of get() allows Wheel::Xyz to
  54. # retrieven one filtered record at a time.  This is necessary for
  55. # filter changing and proper input flow control.
  56.  
  57. sub get_one_start {
  58.   my ($self, $stream) = @_;
  59.   push( @{$self->[BUFFER]}, @$stream ) if defined $stream;
  60. }
  61.  
  62. sub get_one {
  63.   my $self = shift;
  64.  
  65.   # Must be a loop so that the buffer will be altered as items are
  66.   # tested.
  67.   while (@{$self->[BUFFER]}) {
  68.     my $next_record = shift @{$self->[BUFFER]};
  69.     return [ $next_record ]
  70.       if grep &{$self->[CODEGET] || $self->[CODEBOTH]}, $next_record;
  71.   }
  72.  
  73.   return [ ];
  74. }
  75.  
  76. #------------------------------------------------------------------------------
  77.  
  78. sub put {
  79.   my ($self, $data) = @_;
  80.   [ grep &{$self->[CODEPUT] || $self->[CODEBOTH]}, @$data ];
  81. }
  82.  
  83. #------------------------------------------------------------------------------
  84. # 2001-07-27 RCC: This filter now tracks state, so get_pending has
  85. # become useful.
  86.  
  87. sub get_pending {
  88.   my $self = shift;
  89.   return undef unless @{$self->[BUFFER]};
  90.   [ @{$self->[BUFFER]} ];
  91. }
  92.  
  93. #------------------------------------------------------------------------------
  94.  
  95. sub modify {
  96.   my ($self, %params) = @_;
  97.   for (keys %params) {
  98.     next unless ($_ eq 'Put') || ($_ eq 'Get') || ($_ eq 'Code');
  99.     $self->[ {Put  => CODEPUT,
  100.               Get  => CODEGET,
  101.               Code => CODEBOTH
  102.              }->{$_}
  103.            ] = $params{$_};
  104.   }
  105. }
  106.  
  107. ###############################################################################
  108.  
  109. 1;
  110.  
  111. __END__
  112.  
  113. =head1 NAME
  114.  
  115. POE::Filter::Grep - POE Data Grepping Filter
  116.  
  117. =head1 SYNOPSIS
  118.  
  119.   $filter = POE::Filter::Grep->new(Code => sub {...});
  120.   $filter = POE::Filter::Grep->new(Put => sub {...}, Get => sub {...});
  121.   $arrayref_of_transformed_data = $filter->get($arrayref_of_raw_data);
  122.   $arrayref_of_streamable_data = $filter->put($arrayref_of_data);
  123.   $arrayref_of_streamable_data = $filter->put($single_datum);
  124.   $filter->modify(Code => sub {...});
  125.   $filter->modify(Put => sub {...}, Get => sub {...});
  126.  
  127. =head1 DESCRIPTION
  128.  
  129. The Grep filter takes the coderef or coderefs it is given using the
  130. Code, Get, or Put parameters and applies them to all data passing
  131. through get(), put(), or both, as appropriate.  It it very similar to
  132. the C<grep> builtin function.
  133.  
  134. =head1 PUBLIC FILTER METHODS
  135.  
  136. =over 4
  137.  
  138. =item *
  139.  
  140. POE::Filter::Grep::modify
  141.  
  142. Takes a list of parameters like the new() method, which should
  143. correspond to the new get(), put(), or general coderef that you wish
  144. to use.
  145.  
  146. =item *
  147.  
  148. See POE::Filter.
  149.  
  150. =back
  151.  
  152. =head1 SEE ALSO
  153.  
  154. POE::Filter; POE::Filter::Grep; POE::Filter::Line;
  155. POE::Filter::Stackable; POE::Filter::Reference; POE::Filter::Stream;
  156. POE::Filter::RecordBlock; POE::Filter::HTTPD
  157.  
  158. =head1 BUGS
  159.  
  160. None known.
  161.  
  162. =head1 AUTHORS & COPYRIGHTS
  163.  
  164. The Grep filter was contributed by Dieter Pearcey.  Rocco Caputo is
  165. sure to have had his hands in it.
  166.  
  167. Please see the POE manpage for more information about authors and
  168. contributors.
  169.  
  170. =cut
  171.