File Coverage

blib/lib/DDC/Format/Kwic.pm

Criterion	Covered	Total	%
statement	10	87	11.4
branch	0	36	0.0
condition	0	22	0.0
subroutine	4	9	44.4
pod	3	5	60.0
total	17	159	10.6

##-*- Mode: CPerl -*-

## File: DDC::Format::Kwic.pm
## Author: Bryan Jurish
## Description:
##  + DDC Query utilities: output formatting: keywords-in-context
##======================================================================

package DDC::Format::Kwic;
use File::Basename;
use Carp;
use strict;

##======================================================================
## Globals
our @ISA = qw(DDC::Format);

BEGIN {
  *isa = \&UNIVERSAL::isa;
}

##======================================================================
## Constructors, etc.

## $fmt = $CLASS_OR_OBJ->new(%args)
##  + %args:
##    (
##     start=>$previous_hit_num, ##-- pre-initial hit number (default=0)
##     highlight=>[$pre,$post],  ##-- highlighting substrings
##     width=>$nchars,           ##-- context width; default=32
##     useMatchIds=>$bool,       ##-- whether to use match-ids if available; undef (default) if non-trivial match-ids are specified
##     wsAttr=>$wskey,            ##-- token attribute to use for preceding whitespace (default='ws')
##    )
sub new {
  my $that = shift;
  return bless {
		highlight=>['__','__'],
		width=>32,
		useMatchIds=>undef,
		wsAttr=>'ws',
		@_
	       }, ref($that)||$that;
}

## $fmt = $fmt->reset()
##  + reset counters, etc.
sub reset {
  $_[0]{start}=0;
  return $_[0]->SUPER::reset();
}

##======================================================================
## Helper functions

## $len = maxlen(@strings)
sub maxlen {
  my $l = 0;
  do { $l=length($_) if (length($_) > $l) } foreach (@_);
  return $l;
}

## $wsStr = $fmt->wsStr($token)
sub wsStr {
  my ($fmt,$w) = @_;
  return (!$fmt->{wsAttr} || !ref($w) || !defined($w->{$fmt->{wsAttr}}) || $w->{$fmt->{wsAttr}} ? ' ' : '');
}

##======================================================================
## API

## $str = $fmt->toString($hitList)
sub toString {
  my ($fmt,$hits) = @_;

  if ($hits->{counts_} && @{$hits->{counts_}}) {
    ##-- count-query: format as text
    my ($i);
    my @lens = map {$i=$_; maxlen(map {$_->[$i]} @{$hits->{counts_}})} (0..$#{$hits->{counts_}[0]});
    my $fmt  = join("\t", map {"%-${_}s"} @lens)."\n";
    return join('', map {sprintf($fmt,@$_)} @{$hits->{counts_}});
  }

  my $xlen = $fmt->{width} || 2**31;
  my $hnum = $hits->{start};
  my $useMatchIds = defined($fmt->{useMatchIds}) ? $fmt->{useMatchIds} : (grep {$_>0 && $_!=1} map {$_->{hl_}} map {@{$_->{ctx_}[1]}} @{$hits->{hits_}});

  my (@hits);
  foreach my $hit (@{$hits->{hits_}}) {
    ##-- hit key: number + file basename + page
    my $f = basename($hit->{meta_}{file_});
    $f =~ s/\..*$//;
    my $p     = defined($hit->{meta_}{page_}) ? $hit->{meta_}{page_} : 0;
    my $pagei = (grep {$hit->{meta_}{indices_}[$_] eq 'page'} (0..$#{$hit->{meta_}{indices_}}))[0];
    my $targetMatchId = $useMatchIds ? (sort {$a<=>$b} grep {$_} map {$_->{hl_}} @{$hit->{ctx_}[1]})[0] : undef;

    ##-- hit context
    my $fkey = $hits->{defaultField} || $hit->{meta_}{indices_}[0] || 'w';
    my (@l,@c,@r);
    my $ary = \@l;
    my $hl  = '__';
    foreach (map {@$_} @{$hit->{ctx_}}) {
      if ($ary eq \@l && ref($_) && ($useMatchIds ? $_->{hl_}==$targetMatchId : $_->{hl_})) {
	$ary=\@c;
	$p=$_->{page} if (!$p && defined($_->{page}));
      }
      elsif ($ary eq \@c) {
	$ary = \@r;
      }
      $hl = ($ary eq \@c ? '__' : '_');
      push(@$ary, ($fmt->wsStr($_)
		   .(ref($_)
		     ? ($_->{hl_}
			? ($hl.$_->{$fkey}.$hl.($useMatchIds ? "/$_->{hl_}" : ''))
			: $_->{$fkey})
		     : $_)));
    }

    my $ls = join('', @l);
    my $rs = join('', @r);
    substr($ls, 0,       length($ls)-$xlen+3, '...') if (length($ls) > $xlen);
    substr($rs, $xlen-3, length($rs)-$xlen+3, '...') if (length($rs) > $xlen);

    push(@hits,[$hnum++, "[$f:$p]", $ls, join('',@c), $rs]);
  }

  my $ln = maxlen(map {$_->[0]} @hits);
  my $lf = maxlen(map {$_->[1]} @hits);
  my $ll = maxlen(map {$_->[2]} @hits);
  my $lc = maxlen(map {$_->[3]} @hits);
  my $lr = maxlen(map {$_->[4]} @hits);
  return (
	  "# Hit(s) $hits[0][0]-$hits[$#hits][0] of $hits->{nhits_}"
	  .($hits->{hint_} ? " {hint_}>" : '')
	  ."\n"
	  .join('', map {sprintf("%${ln}d: %-${lf}s  %${ll}s  %-${lc}s  %-${lr}s\n", @$_)} @hits)
	 );
}

1; ##-- be happy

__END__