<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Simple length-prepended block filter.
# Copyright 2004 by Rocco Caputo.  Free software.
# Same terms as Perl itself.  Have fun!

package LPBFilter;

use warnings;
use strict;
use bytes;

sub new {
  my $class = shift;
  my $self = bless {
    wanted =&gt; undef,
    buffer =&gt; "",
  }, $class;
  return $self;
}

sub put {
  my ($self, $blocks) = @_;
  substr($_, 0, 0) = pack("N", length($_))
    foreach @$blocks;
  return $blocks;
}

sub get_one_start {
  my ($self, $chunks) = @_;
  $self-&gt;{buffer} .= join("", @$chunks);
}

sub get_one {
  my $self = shift;

  unless (defined $self-&gt;{wanted}) {
    return [] if length $self-&gt;{buffer} &lt; 4;
    $self-&gt;{wanted} = unpack(
      "N", substr($self-&gt;{buffer}, 0, 4, "")
    );
  }

  return []
    if length($self-&gt;{buffer}) &lt; $self-&gt;{wanted};
  my $wanted = delete $self-&gt;{wanted};
  return [
    substr($self-&gt;{buffer}, 0, $wanted, "")
  ];
}

sub get_pending {
  my $self = shift;
  return $self-&gt;{buffer};
}

1;
</pre></body></html>