File Coverage

blib/lib/XML/Filter/Sort/BufferMgr.pm

Criterion	Covered	Total	%
statement	63	82	76.8
branch	14	26	53.8
condition	2	3	66.6
subroutine	10	10	100.0
pod	0	8	0.0
total	89	129	68.9

# $Id: BufferMgr.pm,v 1.1.1.1 2002/06/14 20:40:05 grantm Exp $

package XML::Filter::Sort::BufferMgr;

use strict;

require XML::Filter::Sort::Buffer;


##############################################################################
#                     G L O B A L   V A R I A B L E S
##############################################################################

use vars qw($VERSION);

$VERSION = '0.91';


##############################################################################
#                             M E T H O D S
##############################################################################

##############################################################################
# Constructor: new()
#
# Allocates in-memory structures for buffering records.
#

sub new {
  my $proto = shift;

  my $class = ref($proto) || $proto;

  my $self = { @_ };
  $self->{records} = {};

  return(bless($self, $class));
}


##############################################################################
# Method: compile_matches()
#
# Returns a list of closures for matching each of the sort keys.
#

sub compile_matches {
  my $self = shift;

  return(XML::Filter::Sort::Buffer->compile_matches(@_));
}


##############################################################################
# Method: new_buffer()
#
# Creates and returns an object for buffering a single record.
#

sub new_buffer {
  my $self = shift;

  my %opt = ( Keys => $self->{Keys} );
  if($self->{_match_subs}) {
    $opt{_match_subs} = [ @{$self->{_match_subs}} ];
  }
  return(XML::Filter::Sort::Buffer->new(%opt));
}


##############################################################################
# Method: close_buffer()
#
# Takes a buffer, calls its close() method to get the sort key values, filters
# the key values and stores the buffer using those values.
#

sub close_buffer {
  my $self   = shift;
  my $record = shift;

  my @sort_keys = $record->close();

  @sort_keys = $self->fix_keys(@sort_keys);

  $self->store($record, @sort_keys);
}


##############################################################################
# Method: fix_keys()
#
# Takes a list of sort key values and applies various fixes/cleanups to them.
#

sub fix_keys {
  my $self   = shift;

  my @sort_keys = @_;

  if($self->{IgnoreCase}) {
    @sort_keys = map { lc($_) } @sort_keys;
  }

  if($self->{NormaliseKeySpace}) {
    foreach (@sort_keys) {
      s/^\s+//s;
      s/\s+$//s;
      s/\s+/ /sg;
    }
  }

  if($self->{KeyFilterSub}) {
    @sort_keys = $self->{KeyFilterSub}->(@sort_keys);
  }

  return(@sort_keys);
}


##############################################################################
# Method: store()
#
# Takes a buffer, and a series of key values.  Stores the buffer using those
# values.
#

sub store {
  my $self   = shift;
  my $record = shift;
  my $key    = shift;

  if(@_) {
    unless($self->{records}->{$key}) {
      my @key_defs = @{$self->{Keys}};
      shift @key_defs;
      $self->{records}->{$key} = $self->new(Keys => \@key_defs);
    }
    $self->{records}->{$key}->store($record, @_);
  }
  else {
    unless($self->{records}->{$key}) {
      $self->{records}->{$key} = [];
    }
    push @{$self->{records}->{$key}}, $record;
  }

}


##############################################################################
# Method: to_sax()
#
# Takes a reference to the parent XML::Filter::Sort object.  Cycles through
# each of the buffered records (in appropriate sorted sequence) and streams
# them out to the handler object as SAX events.
#

sub to_sax {
  my $self   = shift;
  my $filter = shift;

  my $keys = $self->sorted_keys();

  foreach my $key (@$keys) {
    if(ref($self->{records}->{$key}) eq 'ARRAY') {
      foreach my $record (@{$self->{records}->{$key}}) {
	$record->to_sax($filter);
      }
    }
    else {
      $self->{records}->{$key}->to_sax($filter);
    }
  }

}


##############################################################################
# Method: sorted_keys()
#
# Returns a reference to an array of all the sort keys in order.
#

sub sorted_keys {
  my $self   = shift;

  my @keys = keys(%{$self->{records}});
  my $cmp = $self->{Keys}->[0]->[1];
  my $dir = $self->{Keys}->[0]->[2];

  # coderef sort comparator

  if(ref($cmp)) {
    if($dir eq 'desc') {
      @keys = sort { $cmp->($b, $a) } @keys;
    }
    else {
      @keys = sort { $cmp->($a, $b) } @keys;
    }
  }

  # numeric comparator

  elsif($cmp eq 'num') {
    if($dir eq 'desc') {
      @keys = sort { $b <=> $a } @keys;
    }
    else {
      @keys = sort { $a <=> $b } @keys;
    }
  }

  # alpha comparator (default)

  else {
    if($dir eq 'desc') {
      @keys = sort { $b cmp $a } @keys;
    }
    else {
      @keys = sort { $a cmp $b } @keys;
    }
  }

  return(\@keys);

}


1;

__END__