File Coverage

blib/lib/DDC/Format/Text.pm
Criterion Covered Total %
statement 13 50 26.0
branch 0 24 0.0
condition 0 9 0.0
subroutine 5 9 55.5
pod 4 4 100.0
total 22 96 22.9


line stmt bran cond sub pod time code
1             #-*- Mode: CPerl -*-
2              
3             ## File: DDC::Format::Text.pm
4             ## Author: Bryan Jurish
5             ## Description:
6             ## + DDC Query utilities: output formatting
7             ##======================================================================
8              
9             package DDC::Format::Text;
10 26     26   13398 use Text::Wrap qw(wrap);
  26         72619  
  26         1544  
11 26     26   204 use IO::File;
  26         64  
  26         2907  
12 26     26   159 use Carp;
  26         52  
  26         1197  
13 26     26   148 use strict;
  26         55  
  26         1307  
14              
15             ##======================================================================
16             ## Globals
17             our @ISA = qw(DDC::Format);
18              
19             BEGIN {
20 26     26   17622 *isa = \&UNIVERSAL::isa;
21             }
22              
23             ##======================================================================
24             ## Constructors, etc.
25              
26             ## $fmt = $CLASS_OR_OBJ->new(%args)
27             ## + %args:
28             ## (
29             ## start=>$previous_hit_num, ##-- pre-initial hit number (default=0)
30             ## highlight=>[$pre,$post], ##-- highlighting substrings
31             ## columns=>$ncols, ##-- for text wrapping [default=80]
32             ## useMatchIds=>$bool, ##-- whether to use match-ids if available; undef (default) if non-trivial match-ids are specified
33             ## )
34             sub new {
35 0     0 1   my $that = shift;
36 0   0       return bless {
37             highlight=>['__','__'],
38             columns=>80,
39             useMatchIds=>undef,
40             @_
41             }, ref($that)||$that;
42             }
43              
44             ## $fmt = $fmt->reset()
45             ## + reset counters, etc.
46             sub reset {
47 0     0 1   $_[0]{start}=0;
48 0           return $_[0]->SUPER::reset();
49             }
50              
51             ##======================================================================
52             ## Helper functions
53              
54             ## $hitStr = $fmt->hitString($hit, $fieldName, $hitNumber, $useMatchIds)
55             sub hitString {
56 0     0 1   my ($fmt,$hit,$fkey,$hnum,$useMatchIds) = @_;
57 0 0         $fkey = 'w' if (!defined($fkey));
58 0 0         $hnum = 0 if (!$hnum);
59 0           $Text::Wrap::columns = $fmt->{columns};
60 0           my $ctx = $hit->{ctx_};
61             my $ctxstr = join(' ',
62 0 0         (map {ref($_) ? $_->{$fkey} : $_} @{$ctx->[0]}),
  0            
63             ' ',
64 0 0         (map { $_->{hl_} ? "__$_->{$fkey}__".($useMatchIds ? "/$_->{hl_}" : '') : $_->{$fkey} } @{$ctx->[1]}),
  0 0          
65             ' ',
66 0 0         (map {ref($_) ? $_->{$fkey} : $_} @{$ctx->[2]}),
  0            
  0            
67             );
68             return ("${hnum}: "
69             .wrap('',(' ' x length("$hnum")).' ', $ctxstr)."\n"
70             .join('',
71 0           map { wrap("\t+ ", ("\t ".(' ' x length($_)).' '), "$_=\"$hit->{meta_}{$_}\"")."\n" }
72 0 0         grep {$_ ne 'indices_' && defined($hit->{meta_}{$_})} sort keys %{$hit->{meta_}||{}})
  0 0          
  0            
73             #."\n"
74             );
75             }
76              
77             ##======================================================================
78             ## API
79              
80             ## $str = $fmt->toString($hitList)
81             sub toString {
82 0     0 1   my ($fmt,$hits) = @_;
83 0 0 0       if ($hits->{counts_} && @{$hits->{counts_}}) {
  0 0 0        
84             ##-- count-query: return tab-separated strings
85 0           return join('', map {join("\t", @$_)."\n"} @{$hits->{counts_}});
  0            
  0            
86             }
87 0           elsif ($hits->{hits_} && @{$hits->{hits_}}) {
88             ##-- usual case: retrieve hit strings
89 0 0         my $useMatchIds = defined($fmt->{useMatchIds}) ? $fmt->{useMatchIds} : (grep {$_>0 && $_!=1} map {$_->{hl_}} map {@{$_->{ctx_}[1]}} @{$hits->{hits_}});
  0 0          
  0            
  0            
  0            
  0            
90             return join("\n",
91             map {
92 0           $fmt->hitString($hits->{hits_}[$_], $hits->{defaultField}, $_+$hits->{start}, $useMatchIds)
93 0           } (0..$#{$hits->{hits_}})
  0            
94             );
95             }
96             ##-- unknown: return empty string
97 0           return "(no hits)";
98             }
99              
100             1; ##-- be happy
101              
102             __END__