File Coverage

blib/lib/Text/Format.pm
Criterion Covered Total %
statement 164 282 58.1
branch 104 276 37.6
condition 44 111 39.6
subroutine 13 30 43.3
pod 23 23 100.0
total 348 722 48.2


line stmt bran cond sub pod time code
1             package Text::Format;
2              
3             require 5.006;
4              
5             =head1 NAME
6              
7             B - Various subroutines to format text.
8              
9             =head1 SYNOPSIS
10              
11             use Text::Format;
12              
13             my $text = Text::Format->new (
14             {
15             text => [], # all
16             columns => 72, # format, paragraphs, center
17             leftMargin => 0, # format, paragraphs, center
18             rightMargin => 0, # format, paragraphs, center
19             firstIndent => 4, # format, paragraphs
20             bodyIndent => 0, # format, paragraphs
21             rightFill => 0, # format, paragraphs
22             rightAlign => 0, # format, paragraphs
23             justify => 0, # format, paragraphs
24             extraSpace => 0, # format, paragraphs
25             abbrevs => {}, # format, paragraphs
26             hangingIndent => 0, # format, paragraphs
27             hangingText => [], # format, paragraphs
28             noBreak => 0, # format, paragraphs
29             noBreakRegex => {}, # format, paragraphs
30             tabstop => 8, # expand, unexpand, center
31             }
32             ); # these are the default values
33              
34             my %abbr = (foo => 1, bar => 1);
35             $text->abbrevs(\%abbr);
36             $text->abbrevs();
37             $text->abbrevs({foo => 1,bar => 1});
38             $text->abbrevs(qw/foo bar/);
39             $text->text(\@text);
40              
41             $text->columns(132);
42             $text->tabstop(4);
43             $text->extraSpace(1);
44             $text->firstIndent(8);
45             $text->bodyIndent(4);
46             $text->config({tabstop => 4,firstIndent => 0});
47             $text->rightFill(0);
48             $text->rightAlign(0);
49              
50             =head1 DESCRIPTION
51              
52             The B routine will format under all circumstances even if the
53             width isn't enough to contain the longest words. I will die
54             under these circumstances, although I am told this is fixed. If columns
55             is set to a small number and words are longer than that and the leading
56             'whitespace' than there will be a single word on each line. This will
57             let you make a simple word list which could be indented or right
58             aligned. There is a chance for croaking if you try to subvert the
59             module. If you don't pass in text then the internal text is worked on,
60             though not modified.
61              
62             I is meant for more powerful text formatting than what
63             I allows. I also have a module called I that
64             is meant as a direct replacement for I. I
65             requires I since it uses Iformat> to do the
66             actual wrapping but gives you the interface of I.
67              
68             General setup should be explained with the below graph.
69              
70             columns
71             <------------------------------------------------------------>
72             <----------><------><---------------------------><----------->
73             leftMargin indent text is formatted into here rightMargin
74              
75             indent is firstIndent or bodyIndent depending on where we are in the
76             paragraph.
77              
78             =over 4
79              
80             =item B @ARRAY || \@ARRAY || [] || NOTHING
81              
82             Allows one to do some advanced formatting of text into a paragraph, with
83             indent for first line and body set separately. Can specify total width
84             of text, right fill with spaces or right align or justify (align to both
85             margins), right margin and left margin, non-breaking space, two spaces
86             at end of sentence, hanging indents (tagged paragraphs). Strips all
87             leading and trailing whitespace before proceeding. Text is first split
88             into words and then reassembled. If no text is passed in then the
89             internal text in the object is formatted.
90              
91             =item B @ARRAY || \@ARRAY || [] || NOTHING
92              
93             Considers each element of text as a paragraph and if the indents are the
94             same for first line and the body then the paragraphs are separated by a
95             single empty line otherwise they follow one under the other. If hanging
96             indent is set then a single empty line will separate each paragraph as
97             well. Calls I to do the actual formatting. If no text is
98             passed in then the internal text in the object is formatted, though not
99             changed.
100              
101             =item B
@ARRAY || NOTHING
102              
103             Centers a list of strings in @ARRAY or internal text. Empty lines
104             appear as, you guessed it, empty lines. Center strips all leading and
105             trailing whitespace before proceeding. Left margin and right margin can
106             be set. If no text is passed in then the internal text in the object is
107             formatted.
108              
109             =item B @ARRAY || NOTHING
110              
111             Expand tabs in the list of text to tabstop number of spaces in @ARRAY or
112             internal text. Doesn't modify the internal text just passes back the
113             modified text. If no text is passed in then the internal text in the
114             object is formatted.
115              
116             =item B @ARRAY || NOTHING
117              
118             Tabstop number of spaces are turned into tabs in @ARRAY or internal
119             text. Doesn't modify the internal text just passes back the modified
120             text. If no text is passed in then the internal text in the object is
121             formatted.
122              
123             =item B \%HASH || NOTHING
124              
125             Instantiates the object. If you pass a reference to a hash, or an
126             anonymous hash then it is used in setting attributes.
127              
128             =item B \%HASH
129              
130             Allows the configuration of all object attributes at once. Returns the
131             object prior to configuration. You can use it to make a clone of your
132             object before you change attributes.
133              
134             =item B NUMBER || NOTHING
135              
136             Set width of text or retrieve width. This is total width and includes
137             indentation and the right and left margins.
138              
139             =item B NUMBER || NOTHING
140              
141             Set tabstop size or retrieve tabstop size, only used by expand, unexpand
142             and center.
143              
144             =item B NUMBER || NOTHING
145              
146             Set or get indent for the first line of paragraph. This is the number
147             of spaces to indent.
148              
149             =item B NUMBER || NOTHING
150              
151             Set or get indent for the body of paragraph. This is the number of
152             spaces to indent.
153              
154             =item B NUMBER || NOTHING
155              
156             Set or get width of left margin. This is the number of spaces used for
157             the margin.
158              
159             =item B NUMBER || NOTHING
160              
161             Set or get width of right margin. This is the number of spaces used for
162             the margin.
163              
164             =item B 0 || 1 || NOTHING
165              
166             Set right fill or retrieve its value. The filling is done with spaces.
167             Keep in mind that if I is also set then both I
168             and I are ignored.
169              
170             =item B 0 || 1 || NOTHING
171              
172             Set right align or retrieve its value. Text is aligned with the right
173             side of the margin. Keep in mind that if I is also set then
174             both I and I are ignored.
175              
176             =item B 0 || 1 || NOTHING
177              
178             Set justify or retrieve its value. Text is aligned with both margins,
179             adding extra spaces as necessary to align text with left and right
180             margins. Keep in mind that if either of I or I
181             are set then I is ignored, even if both are set in which case
182             they are all ignored.
183              
184             =item B \@ARRAY || NOTHING
185              
186             Pass in a reference to your text, or an anonymous array of text that you
187             want the routines to manipulate. Returns the text held in the object.
188              
189             =item B 0 || 1 || NOTHING
190              
191             Use hanging indents in front of a paragraph, returns current value of
192             attribute. This is also called a tagged paragraph.
193              
194             =item B \@ARRAY || NOTHING
195              
196             The text that will be displayed in front of each paragraph, if you call
197             I then only the first element is used, if you call I
198             then I cycles through all of them. If you have more
199             paragraphs than elements in your array than the remainder of the
200             paragraphs will not have a hanging indented text. Pass a reference to
201             your array. This is also called a tagged paragraph.
202              
203             =item B 0 || 1 || NOTHING
204              
205             Set whether you want to use the non-breaking space feature (see
206             B below).
207              
208             =item B \%HASH || NOTHING
209              
210             Pass in a reference to a hash that would hold the regexes on which not
211             to break. In order for this to happen, it requires B to be set
212             to B - see above. Without any arguments, it
213             returns the hash. E.g:
214              
215             {'^Mrs?\.$' => '^\S+$','^\S+$' => '^(?:S|J)r\.$'}
216              
217             don't break names such as
218             Mr. Jones, Mrs. Jones, Jones Jr.
219              
220             The breaking algorithm is simple. If there should not be a break at the
221             current end of sentence, then a backtrack is done till there are two
222             words on which breaking is allowed. If no two such words are found then
223             the end of sentence is broken anyhow. If there is a single word on
224             current line then no backtrack is done and the word is stuck on the end.
225             This is so you can make a list of names for example.
226              
227             B: this feature requires B to be set to true.
228              
229             =item B 0 || 1 || NOTHING
230              
231             Add extra space after end of sentence, normally I would add 1
232             space after end of sentence, if this is set to 1 then 2 spaces are used.
233             Abbreviations are not followed by two spaces. There are a few internal
234             abbreviations and you can add your own to the object with I
235              
236             =item B \%HASH || @ARRAY || NOTHING
237              
238             Add to the current abbreviations, takes a reference to your hash or an
239             array of abbreviations, if called a second time the original reference
240             is removed and replaced by the new one. Returns the current INTERNAL
241             abbreviations.
242              
243             =back
244              
245             =head1 EXAMPLE
246              
247             use Text::Format;
248              
249             my $text = Text::Format->new;
250              
251             $text->rightFill(1);
252             $text->columns(65);
253             $text->tabstop(4);
254              
255             print $text->format("a line to format to an indented regular
256             paragraph using 65 character wide display");
257             print $text->paragraphs("paragraph one","paragraph two");
258             print $text->center("hello world","nifty line 2");
259             print $text->expand("\t\thello world\n","hmm,\twell\n");
260             print $text->unexpand(" hello world\n"," hmm");
261              
262             $text->config({columns => 132, tabstop => 4});
263              
264             $text = Text::Format->new();
265              
266             print $text->format(@text);
267             print $text->paragraphs(@text);
268             print $text->center(@text);
269             print $text->format([]);
270             print $text->format([$fh->getlines()]);
271             print $text->paragraphs([]);
272             print $text->expand(@text);
273             print $text->unexpand(@text);
274              
275             $text = Text::Format->new
276             ({tabstop => 4,bodyIndent => 4,text => \@text});
277              
278             print $text->format();
279             print $text->paragraphs();
280             print $text->center();
281             print $text->expand();
282             print $text->unexpand();
283              
284             print Text::Format->new({columns => 95})->format(@text);
285              
286             =head1 BUGS
287              
288             Line length can exceed the number of specified columns
289             if columns is set to a small number and long words plus leading whitespace
290             exceed the specified column length. Actually I see this as a feature since it
291             can be used to make up a nice word list.
292              
293             =head1 LICENSE
294              
295             Copyright (c) 1998 Gabor Egressy. All rights reserved.
296              
297             This program is free software; you can redistribute and/or
298             modify it under the same terms as Perl itself.
299              
300             =head1 AUTHOR
301              
302             Gabor Egressy B
303              
304             Copyright (c) 1998 Gabor Egressy. All rights reserved. All wrongs
305             reversed. This program is free software; you can redistribute and/or
306             modify it under the same terms as Perl itself.
307              
308             Adopted and modified by Shlomi Fish, L - all
309             rights disclaimed.
310              
311             =head1 ACKNOWLEDGMENTS
312              
313             B
314              
315             Found a bug with code for two spaces at the end of the sentence and provided
316             a code fragment for a better solution. Also some preliminary suggestions on
317             the design.
318              
319             B
320              
321             Suggestion and explanation of hanging indents, suggestion for
322             non-breaking whitespace, general suggestions with regard to interface
323             design.
324              
325             B
326              
327             Suggestion for better interface design and object design, code for
328             better implementation of getting abbreviations.
329              
330             B
331              
332             Suggestion for a justify feature and original code for doing the
333             justification. I changed the code to take into account the extra space
334             at end of sentence feature.
335              
336             B
337              
338             Inspired a documentation clarification about B required by
339             B , thanks to a report with a problem.
340              
341             =head1 TODO
342              
343             =cut
344              
345 2     2   25356 use strict;
  2         7  
  2         46  
346 2     2   7 use warnings;
  2         1  
  2         40  
347              
348 2     2   6 use Carp;
  2         2  
  2         117  
349              
350 2     2   7 use vars qw($VERSION);
  2         1  
  2         5352  
351              
352             $VERSION = '0.60';
353              
354             # local abbreviations, you can add your own with abbrevs()
355             my %abbrev = (
356             Mr => 1,
357             Mrs => 1,
358             Ms => 1,
359             Jr => 1,
360             Sr => 1,
361             );
362              
363             # formats text into a nice paragraph format. can set a variety of
364             # attributes such as first line indent, body indent, left and right
365             # margin, right align, right fill with spaces, non-breaking spaces,
366             # justification to both margins
367             sub format($@)
368             {
369 11     11 1 477 my $this = shift;
370 11 50       22 croak "Bad method call"
371             unless ref $this;
372 11 50       31 my @wrap = @_
373             if @_ > 0;
374              
375 11 50       18 @wrap = @{$_[0]}
  0         0  
376             if ref $_[0] eq 'ARRAY';
377 11 50       35 @wrap = @{$this->{'_text'}}
  0         0  
378             if @wrap < 1;
379              
380 11         18 my $findent = ' ' x $this->{'_findent'};
381 11         16 my $bindent = ' ' x $this->{'_bindent'};
382              
383 11         139 my @words = split /\s+/,join ' ',@wrap;
384             shift @words
385 11 50 33     44 unless defined($words[0]) && $words[0] ne '';
386             #if $words[0] eq '';
387              
388 11         14 @wrap = ();
389 11         21 my ($line,$width,$abbrev);
390 11         10 $abbrev = 0;
391             $width = $this->{'_cols'} - $this->{'_findent'}
392 11         17 - $this->{'_lmargin'} - $this->{'_rmargin'};
393 11         12 $line = shift @words;
394 11 50       31 $abbrev = $this->__is_abbrev($line)
395             if defined $line;
396 11         21 while (defined ($_ = shift @words)) {
397 44 100 33     116 if(length($_) + length($line) < $width - 1
      33        
      66        
398             || ($line !~ /[.?!]['"]?$/ || $abbrev)
399             && length($_) + length($line) < $width) {
400 36 50 33     67 $line .= ' '
401             if $line =~ /[.?!]['"]?$/ && ! $abbrev;
402 36         36 $line .= ' ' . $_;
403             }
404             else {
405 8         9 last;
406             }
407 36         36 $abbrev = $this->__is_abbrev($_);
408             }
409             ($line,$_) = $this->__do_break($line,$_)
410 11 50 33     31 if $this->{'_nobreak'} && defined $line;
411 11 50       29 push @wrap,$this->__make_line($line,$findent,$width,defined $_)
412             if defined $line;
413 11         11 $line = $_;
414             $width = $this->{'_cols'} - $this->{'_bindent'}
415 11         16 - $this->{'_lmargin'} - $this->{'_rmargin'};
416 11         9 $abbrev = 0;
417 11 100       24 $abbrev = $this->__is_abbrev($line)
418             if defined $line;
419 11         21 while (defined ($_ = shift @words)) {
420 256 100 33     581 if(length($_) + length($line) < $width - 1
      66        
      66        
421             || ($line !~ /[.?!]['"]?$/ || $abbrev)
422             && length($_) + length($line) < $width) {
423 208 100 100     330 $line .= ' '
424             if $line =~ /[.?!]['"]?$/ && ! $abbrev;
425 208         178 $line .= ' ' . $_;
426             }
427             else {
428             ($line,$_) = $this->__do_break($line,$_)
429 48 50       60 if $this->{'_nobreak'};
430 48 50       83 push @wrap,$this->__make_line($line,$bindent,$width,defined $_)
431             if defined $line;
432 48         43 $line = $_;
433             }
434 256 50       383 $abbrev = $this->__is_abbrev($_)
435             if defined $_;
436             }
437 11 100       24 push @wrap,$this->__make_line($line,$bindent,$width,0)
438             if defined $line;
439              
440 11 50 33     22 if($this->{'_hindent'} && @wrap > 0) {
441 0         0 my $caller = (caller 1)[3];
442 0 0       0 $caller = ''
443             unless defined $caller;
444             $this->{'_hindcurr'} = $this->{'_hindtext'}->[0]
445             if defined $this->{'_hindtext'}->[0]
446 0 0 0     0 && length($this->{'_hindcurr'}) < 1
      0        
447             && $caller ne 'Text::Format::paragraphs';
448 0         0 my ($fchar) = $wrap[0] =~ /(\S)/;
449 0         0 my $white = index $wrap[0],$fchar;
450 0 0       0 if($white - $this->{'_lmargin'} - 1 > length($this->{'_hindcurr'})) {
451 0         0 $white = length($this->{'_hindcurr'}) + $this->{'_lmargin'};
452 0         0 $wrap[0] =~
453 0         0 s/^ {$white}/' ' x $this->{'_lmargin'} . $this->{'_hindcurr'}/e;
454             }
455             else {
456 0         0 unshift @wrap,' ' x $this->{'_lmargin'} . $this->{'_hindcurr'} . "\n";
457             }
458             }
459              
460             wantarray ? @wrap
461 11 100       67 : join '', @wrap;
462             }
463              
464             # format lines in text into paragraphs with each element of @wrap a
465             # paragraph; uses Text::Format->format for the formatting
466             sub paragraphs($@)
467             {
468 1     1 1 6 my $this = shift;
469 1 50       3 croak "Bad method call"
470             unless ref $this;
471 1 50       6 my @wrap = @_
472             if @_ > 0;
473              
474 1 50       9 @wrap = @{$_[0]}
  0         0  
475             if ref $_[0] eq 'ARRAY';
476 1 50       3 @wrap = @{$this->{'_text'}}
  0         0  
477             if @wrap < 1;
478              
479 1         3 my (@ret,$end,$cnt,$line);
480              
481             # if indents are same, use newline between paragraphs
482 1 50 33     9 if($this->{'_findent'} == $this->{'_bindent'} ||
483             $this->{'_hindent'}) {
484 0         0 $end = "\n";
485             }
486             else {
487 1         2 $end = '';
488             }
489              
490 1         2 $cnt = 0;
491 1         3 for (@wrap) {
492             $this->{'_hindcurr'} = $this->{'_hindtext'}->[$cnt]
493 2 50       5 if $this->{'_hindent'};
494             $this->{'_hindcurr'} = ''
495 2 50       9 unless defined $this->{'_hindcurr'};
496 2         6 $line = $this->format($_);
497 2 50 33     13 push @ret,$line . $end
498             if defined $line && length $line > 0;
499 2         4 ++$cnt;
500             }
501 1 50 33     10 chop $ret[$#ret]
502             if defined($ret[$#ret]) && $ret[$#ret] =~ /\n\n$/;
503             #if $ret[$#ret] =~ /\n\n$/;
504              
505             wantarray ? @ret
506 1 50       8 : join '',@ret;
507             }
508              
509             # center text using spaces on left side to pad it out
510             # empty lines are preserved
511             sub center($@)
512             {
513 1     1 1 397 my $this = shift;
514 1 50       5 croak "Bad method call"
515             unless ref $this;
516 1 50       6 my @center = @_
517             if @_ > 0;
518 1 50       4 @center = @{$this->{'_text'}}
  0         0  
519             if @center < 1;
520 1         2 my ($tabs);
521 1         3 my $width = $this->{'_cols'} - $this->{'_lmargin'} - $this->{'_rmargin'};
522              
523 1         3 for (@center) {
524 2         11 s/(?:^\s+|\s+$)|\n//g;
525 2         4 $tabs = tr/\t//; # count tabs
526             substr($_,0,0) = ' ' x int(($width - length($_)
527 2 50       17 - $tabs * $this->{'_tabs'} + $tabs) / 2)
528             if length > 0;
529 2 50       7 substr($_,0,0) = ' ' x $this->{'_lmargin'}
530             if length > 0;
531 2         4 substr($_,length) = "\n";
532             }
533              
534             wantarray ? @center
535 1 50       8 : join '',@center;
536             }
537              
538             # expand tabs to spaces
539             # should be similar to Text::Tabs::expand
540             sub expand($@)
541             {
542 0     0 1 0 my $this = shift;
543 0 0       0 croak "Bad method call"
544             unless ref $this;
545 0 0       0 my @lines = @_
546             if @_ > 0;
547 0 0       0 @lines = @{$this->{'_text'}}
  0         0  
548             if @lines < 1;
549              
550 0         0 for (@lines) {
551 0         0 s/\t/' ' x $this->{'_tabs'}/eg;
  0         0  
552             }
553              
554             wantarray ? @lines
555 0 0       0 : $lines[0];
556             }
557              
558             # turn tabstop number of spaces into tabs
559             # should be similar to Text::Tabs::unexpand
560             sub unexpand($@)
561             {
562 0     0 1 0 my $this = shift;
563 0 0       0 croak "Bad method call"
564             unless ref $this;
565 0         0 my @lines = $this->expand(@_);
566              
567 0         0 for (@lines) {
568 0         0 s/ {$this->{'_tabs'}}/\t/g;
569             }
570              
571             wantarray ? @lines
572 0 0       0 : $lines[0];
573             }
574              
575             # return a reference to the object, call as $text = Text::Format->new()
576             # can be used to clone the current reference $ntext = $text->new()
577             sub new($@)
578             {
579 2     2 1 618 my $this = shift;
580 2         2 my $ref;
581 2 100       11 if(ref $_[0] eq 'HASH') {
    50          
582 1         2 $ref = shift;
583             }
584             elsif(scalar(@_) % 2 == 0) {
585 1         3 my %ref = @_;
586 1         2 $ref = \%ref;
587             }
588             else {
589 0         0 $ref = '';
590             }
591 2 50       7 my %clone = %{$this}
  0         0  
592             if ref $this;
593              
594 2         26 my $conf = {
595             _cols => 72,
596             _tabs => 8,
597             _findent => 4,
598             _bindent => 0,
599             _fill => 0,
600             _align => 0,
601             _justify => 0,
602             _lmargin => 0,
603             _rmargin => 0,
604             _space => 0,
605             _abbrs => {},
606             _text => [],
607             _hindent => 0,
608             _hindtext => [],
609             _hindcurr => '',
610             _nobreak => 0,
611             _nobreakregex => {},
612             };
613              
614 2 50       8 if(ref $ref eq 'HASH') {
615             $conf->{'_cols'} = abs int $ref->{'columns'}
616 2 100       10 if defined $ref->{'columns'};
617             $conf->{'_tabs'} = abs int $ref->{'tabstop'}
618 2 50       6 if defined $ref->{'tabstop'};
619             $conf->{'_findent'} = abs int $ref->{'firstIndent'}
620 2 100       6 if defined $ref->{'firstIndent'};
621             $conf->{'_bindent'} = abs int $ref->{'bodyIndent'}
622 2 50       5 if defined $ref->{'bodyIndent'};
623             $conf->{'_fill'} = abs int $ref->{'rightFill'}
624 2 50       11 if defined $ref->{'rightFill'};
625             $conf->{'_align'} = abs int $ref->{'rightAlign'}
626 2 50       4 if defined $ref->{'rightAlign'};
627             $conf->{'_justify'} = abs int $ref->{'justify'}
628 2 50       5 if defined $ref->{'justify'};
629             $conf->{'_lmargin'} = abs int $ref->{'leftMargin'}
630 2 50       6 if defined $ref->{'leftMargin'};
631             $conf->{'_rmargin'} = abs int $ref->{'rightMargin'}
632 2 50       4 if defined $ref->{'rightMargin'};
633             $conf->{'_space'} = abs int $ref->{'extraSpace'}
634 2 50       6 if defined $ref->{'extraSpace'};
635             $conf->{'_abbrs'} = $ref->{'abbrevs'}
636             if defined $ref->{'abbrevs'}
637 2 50 33     13 && ref $ref->{'abbrevs'} eq 'HASH';
638             $conf->{'_text'} = $ref->{'text'}
639             if defined $ref->{'text'}
640 2 50 33     7 && ref $ref->{'text'} eq 'ARRAY';
641             $conf->{'_hindent'} = abs int $ref->{'hangingIndent'}
642 2 50       5 if defined $ref->{'hangingIndent'};
643             $conf->{'_hindtext'} = $ref->{'hangingText'}
644             if defined $ref->{'hangingText'}
645 2 50 33     9 && ref $ref->{'hangingText'} eq 'ARRAY';
646             $conf->{'_nobreak'} = abs int$ref->{'noBreak'}
647 2 50       5 if defined $ref->{'noBreak'};
648             $conf->{'_nobreakregex'} = $ref->{'noBreakRegex'}
649             if defined $ref->{'noBreakRegex'}
650 2 50 33     7 && ref $ref->{'noBreakRegex'} eq 'HASH';
651             }
652              
653 2 50       9 ref $this ? bless \%clone, ref $this
654             : bless $conf, $this;
655             }
656              
657             # configure all the attributes of the object
658             # returns the old object prior to configuration
659             sub config($@)
660             {
661 7     7 1 1477 my $this = shift;
662 7 50       14 croak "Bad method call"
663             unless ref $this;
664 7         6 my $conf;
665 7 50       12 if(ref $_[0] eq 'HASH') {
    0          
666 7         4 $conf = shift;
667             }
668             elsif(scalar(@_) % 2 == 0) {
669 0         0 my %conf = @_;
670 0         0 $conf = \%conf;
671             }
672             else {
673 0         0 croak "Bad hash ref";
674             }
675 7         7 my %clone = %{$this};
  7         55  
676              
677             $this->{'_cols'} = abs int $conf->{'columns'}
678 7 100       16 if defined $conf->{'columns'};
679             $this->{'_tabs'} = abs int $conf->{'tabstop'}
680 7 50       11 if defined $conf->{'tabstop'};
681             $this->{'_findent'} = abs int $conf->{'firstIndent'}
682 7 50       9 if defined $conf->{'firstIndent'};
683             $this->{'_bindent'} = abs int $conf->{'bodyIndent'}
684 7 50       9 if defined $conf->{'bodyIndent'};
685             $this->{'_fill'} = abs int $conf->{'rightFill'}
686 7 50       15 if defined $conf->{'rightFill'};
687             $this->{'_align'} = abs int $conf->{'rightAlign'}
688 7 50       8 if defined $conf->{'rightAlign'};
689             $this->{'_justify'} = abs int $conf->{'justify'}
690 7 50       11 if defined $conf->{'justify'};
691             $this->{'_lmargin'} = abs int $conf->{'leftMargin'}
692 7 50       12 if defined $conf->{'leftMargin'};
693             $this->{'_rmargin'} = abs int $conf->{'rightMargin'}
694 7 50       15 if defined $conf->{'rightMargin'};
695             $this->{'_space'} = abs int $conf->{'extraSpace'}
696 7 100       11 if defined $conf->{'extraSpace'};
697             $this->{'_abbrs'} = $conf->{'abbrevs'}
698             if defined $conf->{'abbrevs'}
699 7 50 33     12 && ref $conf->{'abbrevs'} eq 'HASH';
700             $this->{'_text'} = $conf->{'text'}
701             if defined $conf->{'text'}
702 7 50 33     22 && ref $conf->{'text'} eq 'ARRAY';
703             $this->{'_hindent'} = abs int $conf->{'hangingIndent'}
704 7 50       12 if defined $conf->{'hangingIndent'};
705             $this->{'_hindtext'} = $conf->{'hangingText'}
706             if defined $conf->{'hangingText'}
707 7 50 33     10 && ref $conf->{'hangingText'} eq 'ARRAY';
708             $this->{'_nobreak'} = abs int $conf->{'noBreak'}
709 7 50       8 if defined $conf->{'noBreak'};
710             $this->{'_nobreakregex'} = $conf->{'noBreakRegex'}
711             if defined $conf->{'noBreakRegex'}
712 7 50 33     14 && ref $conf->{'noBreakRegex'} eq 'HASH';
713              
714 7         13 bless \%clone, ref $this;
715             }
716              
717             sub columns($;$)
718             {
719 1     1 1 385 my $this = shift;
720 1 50       5 croak "Bad method call"
721             unless ref $this;
722              
723             @_ ? $this->{'_cols'} = abs int shift
724 1 50       5 : $this->{'_cols'};
725             }
726              
727             sub tabstop($;$)
728             {
729 0     0 1 0 my $this = shift;
730 0 0       0 croak "Bad method call"
731             unless ref $this;
732              
733             @_ ? $this->{'_tabs'} = abs int shift
734 0 0       0 : $this->{'_tabs'};
735             }
736              
737             sub firstIndent($;$)
738             {
739 0     0 1 0 my $this = shift;
740 0 0       0 croak "Bad method call"
741             unless ref $this;
742              
743             @_ ? $this->{'_findent'} = abs int shift
744 0 0       0 : $this->{'_findent'};
745             }
746              
747             sub bodyIndent($;$)
748             {
749 1     1 1 6 my $this = shift;
750 1 50       3 croak "Bad method call"
751             unless ref $this;
752              
753             @_ ? $this->{'_bindent'} = abs int shift
754 1 50       5 : $this->{'_bindent'};
755             }
756              
757             sub rightFill($;$)
758             {
759 0     0 1 0 my $this = shift;
760 0 0       0 croak "Bad method call"
761             unless ref $this;
762              
763             @_ ? $this->{'_fill'} = abs int shift
764 0 0       0 : $this->{'_fill'};
765             }
766              
767             sub rightAlign($;$)
768             {
769 0     0 1 0 my $this = shift;
770 0 0       0 croak "Bad method call"
771             unless ref $this;
772              
773             @_ ? $this->{'_align'} = abs int shift
774 0 0       0 : $this->{'_align'};
775             }
776              
777             sub justify($;$)
778             {
779 0     0 1 0 my $this = shift;
780 0 0       0 croak "Bad method call"
781             unless ref $this;
782              
783             @_ ? $this->{'_justify'} = abs int shift
784 0 0       0 : $this->{'_justify'};
785             }
786              
787             sub leftMargin($;$)
788             {
789 0     0 1 0 my $this = shift;
790 0 0       0 croak "Bad method call"
791             unless ref $this;
792              
793             @_ ? $this->{'_lmargin'} = abs int shift
794 0 0       0 : $this->{'_lmargin'};
795             }
796              
797             sub rightMargin($;$)
798             {
799 0     0 1 0 my $this = shift;
800 0 0       0 croak "Bad method call"
801             unless ref $this;
802              
803             @_ ? $this->{'_rmargin'} = abs int shift
804 0 0       0 : $this->{'_rmargin'};
805             }
806              
807             sub extraSpace($;$)
808             {
809 0     0 1 0 my $this = shift;
810 0 0       0 croak "Bad method call"
811             unless ref $this;
812              
813             @_ ? $this->{'_space'} = abs int shift
814 0 0       0 : $this->{'_space'};
815             }
816              
817             # takes a reference to your hash or takes a list of abbreviations,
818             # returns the INTERNAL abbreviations
819             sub abbrevs($@)
820             {
821 0     0 1 0 my $this = shift;
822 0 0       0 croak "Bad method call"
823             unless ref $this;
824              
825 0 0       0 if(ref $_[0] eq 'HASH') {
    0          
826 0         0 $this->{'_abbrs'} = shift;
827             }
828             elsif(@_ > 0) {
829 0         0 my %tmp;
830 0         0 @tmp{@_} = @_;
831 0         0 $this->{'_abbrs'} = \%tmp;
832             }
833              
834 0 0       0 wantarray ? sort keys %abbrev
835             : join ' ',sort keys %abbrev;
836             }
837              
838             sub text($;$)
839             {
840 0     0 1 0 my $this = shift;
841 0 0       0 croak "Bad method call"
842             unless ref $this;
843 0         0 my $text = shift;
844              
845 0 0       0 $this->{'_text'} = $text
846             if ref $text eq 'ARRAY';
847              
848 0         0 wantarray ? @{$this->{'_text'}}
849 0 0       0 : join ' ', @{$this->{'_text'}};
  0         0  
850             }
851              
852             sub hangingIndent($;$)
853             {
854 0     0 1 0 my $this = shift;
855 0 0       0 croak "Bad method call"
856             unless ref $this;
857              
858             @_ ? $this->{'_hindent'} = abs int shift
859 0 0       0 : $this->{'_hindent'};
860             }
861              
862             sub hangingText($;$)
863             {
864 0     0 1 0 my $this = shift;
865 0 0       0 croak "Bad method call"
866             unless ref $this;
867 0         0 my $text = shift;
868              
869 0 0       0 $this->{'_hindtext'} = $text
870             if ref $text eq 'ARRAY';
871              
872 0         0 wantarray ? @{$this->{'_hindtext'}}
873 0 0       0 : join ' ', @{$this->{'_hindtext'}};
  0         0  
874             }
875              
876             sub noBreak($;$)
877             {
878 0     0 1 0 my $this = shift;
879 0 0       0 croak "Bad method call"
880             unless ref $this;
881              
882             @_ ? $this->{'_nobreak'} = abs int shift
883 0 0       0 : $this->{'_nobreak'};
884             }
885              
886             sub noBreakRegex($;$)
887             {
888 0     0 1 0 my $this = shift;
889 0 0       0 croak "Bad method call"
890             unless ref $this;
891 0         0 my $nobreak = shift;
892              
893 0 0       0 $this->{'_nobreakregex'} = $nobreak
894             if ref $nobreak eq 'HASH';
895              
896 0         0 %{$this->{'_nobreakregex'}};
  0         0  
897             }
898              
899             # internal routine, should not be called by an external routine
900             sub __make_line($$$$$)
901             {
902 67     67   45 my $this = shift;
903 67 50       86 croak "Bad method call"
904             unless ref $this;
905 67         69 my ($line,$lead_white,$width,$not_last) = @_;
906 67         47 my $fill = '';
907 67         61 my $lmargin = ' ' x $this->{'_lmargin'};
908              
909             $fill = ' ' x ($width - length($line))
910 67 100 66     154 if $this->{'_fill'} && ! $this->{'_align'};
911 67 100 33     303 if($this->{'_justify'} && ! ($this->{'_fill'} || $this->{'_align'})
      66        
      66        
      66        
      100        
912             && defined $line && $line =~ /\S+\s+\S+/ && $not_last) {
913 26         23 my $spaces = $width - length($line);
914 26         95 my @words = split /(\s+)/,$line;
915 26         38 my $ws = int ($spaces / int (@words / 2)); # for filling all gaps
916 26 100       37 $spaces %= int (@words / 2)
917             if $ws > 0; # if we must fill between every single word
918 26         32 for (reverse @words) {
919             next
920 248 100       333 if /^\S/;
921 111         76 substr($_,0,0) = ' ' x $ws;
922 111 100       118 $spaces || next;
923 33         24 substr($_,0,0) = ' ';
924 33         22 --$spaces;
925             }
926 26         51 $line = join '',@words;
927             }
928 67 50       133 $line = $lmargin . $lead_white . $line . $fill . "\n"
929             if defined $line;
930             substr($line,0,0) = ' ' x ($this->{'_cols'}
931             - $this->{'_rmargin'} - (length($line) - 1))
932 67 0 33     95 if $this->{'_align'} && ! $this->{'_fill'} && defined $line;
      33        
933              
934 67         83 $line;
935             }
936              
937             # internal routine, should not be called by an external routine
938             sub __is_abbrev($$)
939             {
940 311     311   194 my $this = shift;
941 311 50       365 croak "Bad method call"
942             unless ref $this;
943 311         226 my $word = shift;
944              
945 311 50       400 $word =~ s/\.$//
946             if defined $word; # remove period if there is one
947             # if we have an abbreviation OR no extra space is wanted after
948             # sentence endings
949             return 1
950             if ! $this->{'_space'}
951 311 50 66     659 || exists($abbrev{$word}) || exists(${$this->{'_abbrs'}}{$word});
  136   33     178  
952              
953 136         221 0;
954             }
955              
956             # internal routine, should not be called by an external routine
957             sub __do_break($$$)
958             {
959 0     0     my $this = shift;
960 0 0         croak "Bad method call"
961             unless ref $this;
962 0           my ($line,$next_line) = @_;
963 0           my $no_break = 0;
964 0 0         my @words = split /\s+/,$line
965             if defined $line;
966 0           my $last_word = $words[$#words];
967              
968 0           for (keys %{$this->{'_nobreakregex'}}) {
  0            
969 0 0 0       $no_break = 1
970             if $last_word =~ m$_
971 0           && $next_line =~ m${$this->{'_nobreakregex'}}{$_};
972             }
973              
974 0 0 0       if($no_break && @words > 1) {
975 0           my $i;
976 0           for($i = $#words;$i > 0;--$i) {
977 0           $no_break = 0;
978 0           for (keys %{$this->{'_nobreakregex'}}) {
  0            
979 0 0 0       $no_break = 1
980             if $words[$i - 1] =~ m$_
981             && $words[$i] =~
982 0           m${$this->{'_nobreakregex'}}{$_};
983             }
984             last
985 0 0         if ! $no_break;
986             }
987 0 0         if($i > 0) { # found break point
988 0           $line =~ s/((?:\S+\s+){$i})(.+)/$1/;
989 0           $next_line = $2 . ' ' . $next_line;
990 0           $line =~ s/\s+$//;
991             }
992             # else, no breakpoint found and must break here anyways :<
993             }
994 0           ($line,$next_line);
995             }
996              
997             1;