#! /usr/bin/perl
use strict;

# Demo usage here
my $sorter = Sort::Limited->new(
  comp => sub { $_[0] cmp $_[1] },
  limit => 20,
);
for (1..100) {
  $sorter->add($_);
}
print join "|", $sorter->extract();

# The silly module - not well tested, etc.
package Sort::Limited;
use Data::Dumper;
use Carp;

sub add {
  my $self = shift;
ELEM:  foreach my $elem (@_) {
    my $node = $self->{data};
    my $pos = 0;
    while (exists $node->{elem}) {
      # Traverse one level more
      if ($self->{comp}->($elem, $node->{elem}) < 0) {
        $node->{cnt}++;
        $node = $node->{left};
      }
      else {
        $pos += 1 + $node->{cnt};
    if ($self->{limit} < $pos) {
      # Filter data - we are past our limit
      $node->{right} = { cnt=>0 };
      next ELEM;
    }
        $node = $node->{right};
      }
    }
    # Fill in this node
    $node->{elem} = $elem;
    $node->{left} = { cnt=>0 };
    $node->{right} = { cnt=>0 };
    # And check whether to replace the root node...
    if ($self->{limit} < $self->{data}{cnt}) {
      $self->{data} = $self->{data}{left};
    }
  }
}

sub extract {
  my $self = shift;
  my @results = _extract($self->{data});
  my $last = @results < $self->{limit} ? @results : $self->{limit} - 1
+;
  return @results[0..$last];
}

sub _extract {
  my $node = shift;
  if (exists $node->{elem}) {
    return (
      _extract($node->{left}),
      $node->{elem},
      _extract($node->{right}),
    );
  }
  else {
    return ();
  }
}

sub new {
  my ($class, %args) = @_;
  my $self = {};
  $self->{comp} = delete $args{comp} || sub {$_[0] cmp $_[1]};
  $self->{limit} = delete $args{limit} || 10;
  if (%args) {
    $Data::Dumper::Indent = 1;
    confess ("Unprocessed arguments: ", Dumper(\%args));
  }
  $self->{data} = {
    cnt => 0,
  };
  return bless $self, $class;
}
[download]