File Coverage

blib/lib/Lingua/EN/Summarize.pm

Criterion	Covered	Total	%
statement	56	61	91.8
branch	11	16	68.7
condition	6	8	75.0
subroutine	9	9	100.0
pod	0	1	0.0
total	82	95	86.3

package Lingua::EN::Summarize;

use strict;
use Carp;
use Exporter;
use Text::Wrap qw(wrap);
use Text::Sentence qw(split_sentences);
use Lingua::EN::Summarize::Filters;

use vars qw($VERSION @ISA @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw(summarize);
$VERSION = '0.2';


sub summarize {
  my ($text, %options) = @_;

  ### This section massages the text into a usable format before summarizing.

  # Run each filter over the text.
  return unless $text;
  if ($options{filter}) {
    my @filters = ref $options{filter} eq 'ARRAY' ?
                            @{$options{filter}} : $options{filter};

    foreach (@filters) {
      no strict 'refs';

      if (ref $_ eq 'CODE') {
	$text = $_->( $text );
      } elsif (exists $Lingua::EN::Summarize::Filters::{$_}
	       and *{"Lingua::EN::Summarize::Filters::$_"}{CODE}) {
	$text = &{"Lingua::EN::Summarize::Filters::$_"}( $text );
      } else {
	croak "Unknown text filter \"$_\"";
      }
    }
  }

  # Strip whitespace and formatting out of the text.
  $text =~ s/^\s+//;
  $text =~ s/\s+/ /sg;
  $text =~ s/\s+$//;

  unless (exists $options{maxlength} and $options{maxlength} > 0) {
    $options{maxlength} = length( $text ) / 30;
  }


  ### Here's where the interesting logic happens.

  # First we break it into sentence pieces. Kind of. Sort of.
  my $keywords = "(is|are|was|were|will|have)";
  my @clauses = grep { /\b$keywords\b/i }
                   map { split /(,|;|--)/ } split_sentences( $text );

  my $stopwords = "(and|but|instead)";
  foreach (@clauses) {
    s/^\s+//;
    s/^$stopwords\s+//i;
    $_ = ucfirst;
    $_ .= ". " unless /[.!?]$/;
  }

  # Assemble the resulting phrases into the summary response.
  my $summary = '';
  while (@clauses and length $summary < $options{maxlength}) {
    $summary .= " " . shift @clauses;
  }


  ### Done! Do any necessary postprocessing before returning.

  # Prettyprint the summary to make it look nice on a terminal, if requested.
  if ($options{wrap}) {
    $Text::Wrap::columns = $options{wrap};
    $summary = wrap( '', '', $summary );
  }

  $summary =~ s/^\s+//mg;
  $summary =~ s/[ \t]+/ /g;    # if we use \s, that screws up the wrapping
  $summary =~ s/\s+$//mg;

  return $summary;
}


1;
__END__