File Coverage

blib/lib/Text/Format.pm
Criterion Covered Total %
statement 161 279 57.7
branch 104 276 37.6
condition 45 111 40.5
subroutine 12 29 41.3
pod 23 23 100.0
total 345 718 48.0


line stmt bran cond sub pod time code
1             package Text::Format;
2             $Text::Format::VERSION = '0.62';
3             require 5.006;
4              
5              
6 2     2   144392 use strict;
  2         22  
  2         61  
7 2     2   11 use warnings;
  2         3  
  2         52  
8              
9 2     2   11 use Carp;
  2         3  
  2         8913  
10              
11             # local abbreviations, you can add your own with abbrevs()
12             my %abbrev = (
13             Mr => 1,
14             Mrs => 1,
15             Ms => 1,
16             Jr => 1,
17             Sr => 1,
18             );
19              
20             # formats text into a nice paragraph format. can set a variety of
21             # attributes such as first line indent, body indent, left and right
22             # margin, right align, right fill with spaces, non-breaking spaces,
23             # justification to both margins
24             sub format($@)
25             {
26 11     11 1 682 my $this = shift;
27 11 50       26 croak "Bad method call"
28             unless ref $this;
29 11 50       44 my @wrap = @_
30             if @_ > 0;
31              
32 11 50       26 @wrap = @{ $_[0] }
  0         0  
33             if ref $_[0] eq 'ARRAY';
34 11 50       25 @wrap = @{ $this->{'_text'} }
  0         0  
35             if @wrap < 1;
36              
37 11         26 my $findent = ' ' x $this->{'_findent'};
38 11         20 my $bindent = ' ' x $this->{'_bindent'};
39              
40 11         214 my @words = split /\s+/, join ' ', @wrap;
41             shift @words
42 11 50 33     51 unless defined( $words[0] ) && $words[0] ne '';
43              
44             #if $words[0] eq '';
45              
46 11         22 @wrap = ();
47 11         18 my ( $line, $width, $abbrev );
48 11         14 $abbrev = 0;
49             $width =
50             $this->{'_cols'} -
51             $this->{'_findent'} -
52             $this->{'_lmargin'} -
53 11         23 $this->{'_rmargin'};
54 11         19 $line = shift @words;
55 11 50       36 $abbrev = $this->__is_abbrev($line)
56             if defined $line;
57 11         28 while ( defined( $_ = shift @words ) )
58             {
59              
60 44 100 33     140 if ( length($_) + length($line) < $width - 1
      33        
      66        
61             || ( $line !~ /[.?!]['"]?$/ || $abbrev )
62             && length($_) + length($line) < $width )
63             {
64 36 50 33     90 $line .= ' '
65             if $line =~ /[.?!]['"]?$/ && !$abbrev;
66 36         60 $line .= ' ' . $_;
67             }
68             else
69             {
70 8         16 last;
71             }
72 36         62 $abbrev = $this->__is_abbrev($_);
73             }
74             ( $line, $_ ) = $this->__do_break( $line, $_ )
75 11 50 33     27 if $this->{'_nobreak'} && defined $line;
76 11 50       32 push @wrap, $this->__make_line( $line, $findent, $width, defined $_ )
77             if defined $line;
78 11         23 $line = $_;
79             $width =
80             $this->{'_cols'} -
81             $this->{'_bindent'} -
82             $this->{'_lmargin'} -
83 11         19 $this->{'_rmargin'};
84 11         15 $abbrev = 0;
85 11 100       33 $abbrev = $this->__is_abbrev($line)
86             if defined $line;
87 11         32 while ( defined( $_ = shift @words ) )
88             {
89              
90 256 100 33     1039 if ( length($_) + length($line) < $width - 1
      66        
      100        
91             || ( $line !~ /[.?!]['"]?$/ || $abbrev )
92             && length($_) + length($line) < $width )
93             {
94 208 100 100     451 $line .= ' '
95             if $line =~ /[.?!]['"]?$/ && !$abbrev;
96 208         319 $line .= ' ' . $_;
97             }
98             else
99             {
100             ( $line, $_ ) = $this->__do_break( $line, $_ )
101 48 50       92 if $this->{'_nobreak'};
102 48 50       104 push @wrap,
103             $this->__make_line( $line, $bindent, $width, defined $_ )
104             if defined $line;
105 48         75 $line = $_;
106             }
107 256 50       498 $abbrev = $this->__is_abbrev($_)
108             if defined $_;
109             }
110 11 100       30 push @wrap, $this->__make_line( $line, $bindent, $width, 0 )
111             if defined $line;
112              
113 11 50 33     27 if ( $this->{'_hindent'} && @wrap > 0 )
114             {
115 0         0 my $caller = ( caller 1 )[3];
116 0 0       0 $caller = ''
117             unless defined $caller;
118             $this->{'_hindcurr'} = $this->{'_hindtext'}->[0]
119             if defined $this->{'_hindtext'}->[0]
120 0 0 0     0 && length( $this->{'_hindcurr'} ) < 1
      0        
121             && $caller ne 'Text::Format::paragraphs';
122 0         0 my ($fchar) = $wrap[0] =~ /(\S)/;
123 0         0 my $white = index $wrap[0], $fchar;
124 0 0       0 if ( $white - $this->{'_lmargin'} - 1 > length( $this->{'_hindcurr'} ) )
125             {
126 0         0 $white = length( $this->{'_hindcurr'} ) + $this->{'_lmargin'};
127 0         0 $wrap[0] =~
128 0         0 s/^ {$white}/' ' x $this->{'_lmargin'} . $this->{'_hindcurr'}/e;
129             }
130             else
131             {
132             unshift @wrap,
133 0         0 ' ' x $this->{'_lmargin'} . $this->{'_hindcurr'} . "\n";
134             }
135             }
136              
137             wantarray
138             ? @wrap
139 11 100       104 : join '', @wrap;
140             }
141              
142             # format lines in text into paragraphs with each element of @wrap a
143             # paragraph; uses Text::Format->format for the formatting
144             sub paragraphs($@)
145             {
146 1     1 1 8 my $this = shift;
147 1 50       5 croak "Bad method call"
148             unless ref $this;
149 1 50       6 my @wrap = @_
150             if @_ > 0;
151              
152 1 50       5 @wrap = @{ $_[0] }
  0         0  
153             if ref $_[0] eq 'ARRAY';
154 1 50       3 @wrap = @{ $this->{'_text'} }
  0         0  
155             if @wrap < 1;
156              
157 1         3 my ( @ret, $end, $cnt, $line );
158              
159             # if indents are same, use newline between paragraphs
160 1 50 33     11 if ( $this->{'_findent'} == $this->{'_bindent'}
161             || $this->{'_hindent'} )
162             {
163 0         0 $end = "\n";
164             }
165             else
166             {
167 1         3 $end = '';
168             }
169              
170 1         2 $cnt = 0;
171 1         3 for (@wrap)
172             {
173             $this->{'_hindcurr'} = $this->{'_hindtext'}->[$cnt]
174 2 50       6 if $this->{'_hindent'};
175             $this->{'_hindcurr'} = ''
176 2 50       6 unless defined $this->{'_hindcurr'};
177 2         6 $line = $this->format($_);
178 2 50 33     12 push @ret, $line . $end
179             if defined $line && length $line > 0;
180 2         4 ++$cnt;
181             }
182 1 50 33     8 chop $ret[$#ret]
183             if defined( $ret[$#ret] ) && $ret[$#ret] =~ /\n\n$/;
184              
185             #if $ret[$#ret] =~ /\n\n$/;
186              
187             wantarray
188             ? @ret
189 1 50       61 : join '', @ret;
190             }
191              
192             # center text using spaces on left side to pad it out
193             # empty lines are preserved
194             sub center($@)
195             {
196 1     1 1 549 my $this = shift;
197 1 50       5 croak "Bad method call"
198             unless ref $this;
199 1 50       5 my @center = @_
200             if @_ > 0;
201 1 50       5 @center = @{ $this->{'_text'} }
  0         0  
202             if @center < 1;
203 1         2 my ($tabs);
204 1         4 my $width = $this->{'_cols'} - $this->{'_lmargin'} - $this->{'_rmargin'};
205              
206 1         2 for (@center)
207             {
208 2         11 s/(?:^\s+|\s+$)|\n//g;
209 2         7 $tabs = tr/\t//; # count tabs
210             substr( $_, 0, 0 ) =
211             ' ' x
212             int(
213 2 50       15 ( $width - length($_) - $tabs * $this->{'_tabs'} + $tabs ) / 2 )
214             if length > 0;
215 2 50       7 substr( $_, 0, 0 ) = ' ' x $this->{'_lmargin'}
216             if length > 0;
217 2         5 substr( $_, length ) = "\n";
218             }
219              
220             wantarray
221             ? @center
222 1 50       6 : join '', @center;
223             }
224              
225             # expand tabs to spaces
226             # should be similar to Text::Tabs::expand
227             sub expand($@)
228             {
229 0     0 1 0 my $this = shift;
230 0 0       0 croak "Bad method call"
231             unless ref $this;
232 0 0       0 my @lines = @_
233             if @_ > 0;
234 0 0       0 @lines = @{ $this->{'_text'} }
  0         0  
235             if @lines < 1;
236              
237 0         0 for (@lines)
238             {
239 0         0 s/\t/' ' x $this->{'_tabs'}/eg;
  0         0  
240             }
241              
242             wantarray
243             ? @lines
244 0 0       0 : $lines[0];
245             }
246              
247             # turn tabstop number of spaces into tabs
248             # should be similar to Text::Tabs::unexpand
249             sub unexpand($@)
250             {
251 0     0 1 0 my $this = shift;
252 0 0       0 croak "Bad method call"
253             unless ref $this;
254 0         0 my @lines = $this->expand(@_);
255              
256 0         0 for (@lines)
257             {
258 0         0 s/ {$this->{'_tabs'}}/\t/g;
259             }
260              
261             wantarray
262             ? @lines
263 0 0       0 : $lines[0];
264             }
265              
266             # return a reference to the object, call as $text = Text::Format->new()
267             # can be used to clone the current reference $ntext = $text->new()
268             sub new($@)
269             {
270 2     2 1 1327 my $this = shift;
271 2         5 my $ref;
272 2 100       15 if ( ref $_[0] eq 'HASH' )
    50          
273             {
274 1         3 $ref = shift;
275             }
276             elsif ( scalar(@_) % 2 == 0 )
277             {
278 1         3 my %ref = @_;
279 1         3 $ref = \%ref;
280             }
281             else
282             {
283 0         0 $ref = '';
284             }
285 2 50       8 my %clone = %{$this}
  0         0  
286             if ref $this;
287              
288 2         32 my $conf = {
289             _cols => 72,
290             _tabs => 8,
291             _findent => 4,
292             _bindent => 0,
293             _fill => 0,
294             _align => 0,
295             _justify => 0,
296             _lmargin => 0,
297             _rmargin => 0,
298             _space => 0,
299             _abbrs => {},
300             _text => [],
301             _hindent => 0,
302             _hindtext => [],
303             _hindcurr => '',
304             _nobreak => 0,
305             _nobreakregex => {},
306             };
307              
308 2 50       10 if ( ref $ref eq 'HASH' )
309             {
310             $conf->{'_cols'} = abs int $ref->{'columns'}
311 2 100       10 if defined $ref->{'columns'};
312             $conf->{'_tabs'} = abs int $ref->{'tabstop'}
313 2 50       8 if defined $ref->{'tabstop'};
314             $conf->{'_findent'} = abs int $ref->{'firstIndent'}
315 2 100       8 if defined $ref->{'firstIndent'};
316             $conf->{'_bindent'} = abs int $ref->{'bodyIndent'}
317 2 50       6 if defined $ref->{'bodyIndent'};
318             $conf->{'_fill'} = abs int $ref->{'rightFill'}
319 2 50       43 if defined $ref->{'rightFill'};
320             $conf->{'_align'} = abs int $ref->{'rightAlign'}
321 2 50       8 if defined $ref->{'rightAlign'};
322             $conf->{'_justify'} = abs int $ref->{'justify'}
323 2 50       7 if defined $ref->{'justify'};
324             $conf->{'_lmargin'} = abs int $ref->{'leftMargin'}
325 2 50       6 if defined $ref->{'leftMargin'};
326             $conf->{'_rmargin'} = abs int $ref->{'rightMargin'}
327 2 50       8 if defined $ref->{'rightMargin'};
328             $conf->{'_space'} = abs int $ref->{'extraSpace'}
329 2 50       6 if defined $ref->{'extraSpace'};
330             $conf->{'_abbrs'} = $ref->{'abbrevs'}
331             if defined $ref->{'abbrevs'}
332 2 50 33     8 && ref $ref->{'abbrevs'} eq 'HASH';
333             $conf->{'_text'} = $ref->{'text'}
334             if defined $ref->{'text'}
335 2 50 33     8 && ref $ref->{'text'} eq 'ARRAY';
336             $conf->{'_hindent'} = abs int $ref->{'hangingIndent'}
337 2 50       7 if defined $ref->{'hangingIndent'};
338             $conf->{'_hindtext'} = $ref->{'hangingText'}
339             if defined $ref->{'hangingText'}
340 2 50 33     9 && ref $ref->{'hangingText'} eq 'ARRAY';
341             $conf->{'_nobreak'} = abs int $ref->{'noBreak'}
342 2 50       18 if defined $ref->{'noBreak'};
343             $conf->{'_nobreakregex'} = $ref->{'noBreakRegex'}
344             if defined $ref->{'noBreakRegex'}
345 2 50 33     9 && ref $ref->{'noBreakRegex'} eq 'HASH';
346             }
347              
348 2 50       25 ref $this
349             ? bless \%clone, ref $this
350             : bless $conf, $this;
351             }
352              
353             # configure all the attributes of the object
354             # returns the old object prior to configuration
355             sub config($@)
356             {
357 7     7 1 2694 my $this = shift;
358 7 50       24 croak "Bad method call"
359             unless ref $this;
360 7         20 my $conf;
361 7 50       21 if ( ref $_[0] eq 'HASH' )
    0          
362             {
363 7         9 $conf = shift;
364             }
365             elsif ( scalar(@_) % 2 == 0 )
366             {
367 0         0 my %conf = @_;
368 0         0 $conf = \%conf;
369             }
370             else
371             {
372 0         0 croak "Bad hash ref";
373             }
374 7         9 my %clone = %{$this};
  7         69  
375              
376             $this->{'_cols'} = abs int $conf->{'columns'}
377 7 100       25 if defined $conf->{'columns'};
378             $this->{'_tabs'} = abs int $conf->{'tabstop'}
379 7 50       15 if defined $conf->{'tabstop'};
380             $this->{'_findent'} = abs int $conf->{'firstIndent'}
381 7 50       16 if defined $conf->{'firstIndent'};
382             $this->{'_bindent'} = abs int $conf->{'bodyIndent'}
383 7 50       15 if defined $conf->{'bodyIndent'};
384             $this->{'_fill'} = abs int $conf->{'rightFill'}
385 7 50       17 if defined $conf->{'rightFill'};
386             $this->{'_align'} = abs int $conf->{'rightAlign'}
387 7 50       14 if defined $conf->{'rightAlign'};
388             $this->{'_justify'} = abs int $conf->{'justify'}
389 7 50       16 if defined $conf->{'justify'};
390             $this->{'_lmargin'} = abs int $conf->{'leftMargin'}
391 7 50       14 if defined $conf->{'leftMargin'};
392             $this->{'_rmargin'} = abs int $conf->{'rightMargin'}
393 7 50       24 if defined $conf->{'rightMargin'};
394             $this->{'_space'} = abs int $conf->{'extraSpace'}
395 7 100       16 if defined $conf->{'extraSpace'};
396             $this->{'_abbrs'} = $conf->{'abbrevs'}
397             if defined $conf->{'abbrevs'}
398 7 50 33     14 && ref $conf->{'abbrevs'} eq 'HASH';
399             $this->{'_text'} = $conf->{'text'}
400             if defined $conf->{'text'}
401 7 50 33     15 && ref $conf->{'text'} eq 'ARRAY';
402             $this->{'_hindent'} = abs int $conf->{'hangingIndent'}
403 7 50       14 if defined $conf->{'hangingIndent'};
404             $this->{'_hindtext'} = $conf->{'hangingText'}
405             if defined $conf->{'hangingText'}
406 7 50 33     15 && ref $conf->{'hangingText'} eq 'ARRAY';
407             $this->{'_nobreak'} = abs int $conf->{'noBreak'}
408 7 50       16 if defined $conf->{'noBreak'};
409             $this->{'_nobreakregex'} = $conf->{'noBreakRegex'}
410             if defined $conf->{'noBreakRegex'}
411 7 50 33     15 && ref $conf->{'noBreakRegex'} eq 'HASH';
412              
413 7         22 bless \%clone, ref $this;
414             }
415              
416             sub columns($;$)
417             {
418 1     1 1 544 my $this = shift;
419 1 50       6 croak "Bad method call"
420             unless ref $this;
421              
422             @_
423             ? $this->{'_cols'} = abs int shift
424 1 50       6 : $this->{'_cols'};
425             }
426              
427             sub tabstop($;$)
428             {
429 0     0 1 0 my $this = shift;
430 0 0       0 croak "Bad method call"
431             unless ref $this;
432              
433             @_
434             ? $this->{'_tabs'} = abs int shift
435 0 0       0 : $this->{'_tabs'};
436             }
437              
438             sub firstIndent($;$)
439             {
440 0     0 1 0 my $this = shift;
441 0 0       0 croak "Bad method call"
442             unless ref $this;
443              
444             @_
445             ? $this->{'_findent'} = abs int shift
446 0 0       0 : $this->{'_findent'};
447             }
448              
449             sub bodyIndent($;$)
450             {
451 1     1 1 6 my $this = shift;
452 1 50       2 croak "Bad method call"
453             unless ref $this;
454              
455             @_
456             ? $this->{'_bindent'} = abs int shift
457 1 50       5 : $this->{'_bindent'};
458             }
459              
460             sub rightFill($;$)
461             {
462 0     0 1 0 my $this = shift;
463 0 0       0 croak "Bad method call"
464             unless ref $this;
465              
466             @_
467             ? $this->{'_fill'} = abs int shift
468 0 0       0 : $this->{'_fill'};
469             }
470              
471             sub rightAlign($;$)
472             {
473 0     0 1 0 my $this = shift;
474 0 0       0 croak "Bad method call"
475             unless ref $this;
476              
477             @_
478             ? $this->{'_align'} = abs int shift
479 0 0       0 : $this->{'_align'};
480             }
481              
482             sub justify($;$)
483             {
484 0     0 1 0 my $this = shift;
485 0 0       0 croak "Bad method call"
486             unless ref $this;
487              
488             @_
489             ? $this->{'_justify'} = abs int shift
490 0 0       0 : $this->{'_justify'};
491             }
492              
493             sub leftMargin($;$)
494             {
495 0     0 1 0 my $this = shift;
496 0 0       0 croak "Bad method call"
497             unless ref $this;
498              
499             @_
500             ? $this->{'_lmargin'} = abs int shift
501 0 0       0 : $this->{'_lmargin'};
502             }
503              
504             sub rightMargin($;$)
505             {
506 0     0 1 0 my $this = shift;
507 0 0       0 croak "Bad method call"
508             unless ref $this;
509              
510             @_
511             ? $this->{'_rmargin'} = abs int shift
512 0 0       0 : $this->{'_rmargin'};
513             }
514              
515             sub extraSpace($;$)
516             {
517 0     0 1 0 my $this = shift;
518 0 0       0 croak "Bad method call"
519             unless ref $this;
520              
521             @_
522             ? $this->{'_space'} = abs int shift
523 0 0       0 : $this->{'_space'};
524             }
525              
526             # takes a reference to your hash or takes a list of abbreviations,
527             # returns the INTERNAL abbreviations
528             sub abbrevs($@)
529             {
530 0     0 1 0 my $this = shift;
531 0 0       0 croak "Bad method call"
532             unless ref $this;
533              
534 0 0       0 if ( ref $_[0] eq 'HASH' )
    0          
535             {
536 0         0 $this->{'_abbrs'} = shift;
537             }
538             elsif ( @_ > 0 )
539             {
540 0         0 my %tmp;
541 0         0 @tmp{@_} = @_;
542 0         0 $this->{'_abbrs'} = \%tmp;
543             }
544              
545             wantarray
546 0 0       0 ? sort keys %abbrev
547             : join ' ', sort keys %abbrev;
548             }
549              
550             sub text($;$)
551             {
552 0     0 1 0 my $this = shift;
553 0 0       0 croak "Bad method call"
554             unless ref $this;
555 0         0 my $text = shift;
556              
557 0 0       0 $this->{'_text'} = $text
558             if ref $text eq 'ARRAY';
559              
560             wantarray
561 0         0 ? @{ $this->{'_text'} }
562 0 0       0 : join ' ', @{ $this->{'_text'} };
  0         0  
563             }
564              
565             sub hangingIndent($;$)
566             {
567 0     0 1 0 my $this = shift;
568 0 0       0 croak "Bad method call"
569             unless ref $this;
570              
571             @_
572             ? $this->{'_hindent'} = abs int shift
573 0 0       0 : $this->{'_hindent'};
574             }
575              
576             sub hangingText($;$)
577             {
578 0     0 1 0 my $this = shift;
579 0 0       0 croak "Bad method call"
580             unless ref $this;
581 0         0 my $text = shift;
582              
583 0 0       0 $this->{'_hindtext'} = $text
584             if ref $text eq 'ARRAY';
585              
586             wantarray
587 0         0 ? @{ $this->{'_hindtext'} }
588 0 0       0 : join ' ', @{ $this->{'_hindtext'} };
  0         0  
589             }
590              
591             sub noBreak($;$)
592             {
593 0     0 1 0 my $this = shift;
594 0 0       0 croak "Bad method call"
595             unless ref $this;
596              
597             @_
598             ? $this->{'_nobreak'} = abs int shift
599 0 0       0 : $this->{'_nobreak'};
600             }
601              
602             sub noBreakRegex($;$)
603             {
604 0     0 1 0 my $this = shift;
605 0 0       0 croak "Bad method call"
606             unless ref $this;
607 0         0 my $nobreak = shift;
608              
609 0 0       0 $this->{'_nobreakregex'} = $nobreak
610             if ref $nobreak eq 'HASH';
611              
612 0         0 %{ $this->{'_nobreakregex'} };
  0         0  
613             }
614              
615             # internal routine, should not be called by an external routine
616             sub __make_line($$$$$)
617             {
618 67     67   91 my $this = shift;
619 67 50       119 croak "Bad method call"
620             unless ref $this;
621 67         125 my ( $line, $lead_white, $width, $not_last ) = @_;
622 67         92 my $fill = '';
623 67         94 my $lmargin = ' ' x $this->{'_lmargin'};
624              
625             $fill = ' ' x ( $width - length($line) )
626 67 100 66     171 if $this->{'_fill'} && !$this->{'_align'};
627 67 100 33     329 if ( $this->{'_justify'}
      66        
      66        
      66        
      100        
628             && !( $this->{'_fill'} || $this->{'_align'} )
629             && defined $line
630             && $line =~ /\S+\s+\S+/
631             && $not_last )
632             {
633 26         46 my $spaces = $width - length($line);
634 26         144 my @words = split /(\s+)/, $line;
635 26         72 my $ws = int( $spaces / int( @words / 2 ) ); # for filling all gaps
636 26 100       52 $spaces %= int( @words / 2 )
637             if $ws > 0; # if we must fill between every single word
638 26         49 for ( reverse @words )
639             {
640             next
641 248 100       531 if /^\S/;
642 111         172 substr( $_, 0, 0 ) = ' ' x $ws;
643 111 100       177 $spaces || next;
644 33         46 substr( $_, 0, 0 ) = ' ';
645 33         42 --$spaces;
646             }
647 26         75 $line = join '', @words;
648             }
649 67 50       173 $line = $lmargin . $lead_white . $line . $fill . "\n"
650             if defined $line;
651             substr( $line, 0, 0 ) =
652             ' ' x ( $this->{'_cols'} - $this->{'_rmargin'} - ( length($line) - 1 ) )
653 67 0 33     136 if $this->{'_align'} && !$this->{'_fill'} && defined $line;
      33        
654              
655 67         128 $line;
656             }
657              
658             # internal routine, should not be called by an external routine
659             sub __is_abbrev($$)
660             {
661 311     311   403 my $this = shift;
662 311 50       512 croak "Bad method call"
663             unless ref $this;
664 311         395 my $word = shift;
665              
666 311 50       589 $word =~ s/\.$//
667             if defined $word; # remove period if there is one
668             # if we have an abbreviation OR no extra space is wanted after
669             # sentence endings
670             return 1
671             if !$this->{'_space'}
672             || exists( $abbrev{$word} )
673 311 50 66     890 || exists( ${ $this->{'_abbrs'} }{$word} );
  136   33     322  
674              
675 136         308 0;
676             }
677              
678             # internal routine, should not be called by an external routine
679             sub __do_break($$$)
680             {
681 0     0     my $this = shift;
682 0 0         croak "Bad method call"
683             unless ref $this;
684 0           my ( $line, $next_line ) = @_;
685 0           my $no_break = 0;
686 0 0         my @words = split /\s+/, $line
687             if defined $line;
688 0           my $last_word = $words[$#words];
689              
690 0           for ( keys %{ $this->{'_nobreakregex'} } )
  0            
691             {
692 0 0 0       $no_break = 1
693             if $last_word =~ m$_
694 0           && $next_line =~ m${$this->{'_nobreakregex'}}{$_};
695             }
696              
697 0 0 0       if ( $no_break && @words > 1 )
698             {
699 0           my $i;
700 0           for ( $i = $#words ; $i > 0 ; --$i )
701             {
702 0           $no_break = 0;
703 0           for ( keys %{ $this->{'_nobreakregex'} } )
  0            
704             {
705 0 0 0       $no_break = 1
706             if $words[ $i - 1 ] =~ m$_
707 0           && $words[$i] =~ m${$this->{'_nobreakregex'}}{$_};
708             }
709             last
710 0 0         if !$no_break;
711             }
712 0 0         if ( $i > 0 )
713             { # found break point
714 0           $line =~ s/((?:\S+\s+){$i})(.+)/$1/;
715 0           $next_line = $2 . ' ' . $next_line;
716 0           $line =~ s/\s+$//;
717             }
718              
719             # else, no breakpoint found and must break here anyways :<
720             }
721 0           ( $line, $next_line );
722             }
723              
724             1;
725              
726             __END__