File Coverage

blib/lib/RTF/Writer.pm
Criterion Covered Total %
statement 177 262 67.5
branch 75 176 42.6
condition 33 112 29.4
subroutine 26 47 55.3
pod 21 33 63.6
total 332 630 52.7


line stmt bran cond sub pod time code
1              
2             require 5.005; # we need m/...\z/
3             package RTF::Writer;
4 6     6   66003 use strict; # Time-stamp: "2003-11-04 02:13:08 AST"
  6         14  
  6         426  
5              
6 6 50   6   11 BEGIN { eval {require utf8}; $INC{"utf8.pm"} = "dummy_value" if $@ }
  6         6811  
  6         196  
7             # hack to allow "use utf8" under old Perls
8 6     6   29 use utf8;
  6         16  
  6         30  
9              
10             die sprintf "%s can't work (yet) in a non-ASCII world", __PACKAGE__
11             unless chr(65) eq 'A';
12              
13 6         1065 use vars qw($VERSION @ISA @EXPORT_OK
14 6     6   497 $AUTOLOAD $AUTO_NL $WRAP @Escape);
  6         11  
15              
16             $AUTO_NL = 1 unless defined $AUTO_NL; # TODO: document
17             $WRAP = 1 unless defined $WRAP; # TODO: document
18              
19             require Exporter;
20             @ISA = ('Exporter');
21             $VERSION = '1.11';
22             @EXPORT_OK = qw( inch inches in point points pt cm rtfesc );
23              
24             sub DEBUG () {0}
25 6     6   31 use Carp ();
  6         12  
  6         106  
26 6     6   3799 use RTF::Writer::TableRowDecl ();
  6         15  
  6         18843  
27              
28             #**************************************************************************
29              
30             sub CHARSET_LATIN1 {
31 0     0 0 0 $Escape[0xA0] = "\\~";
32 0         0 $Escape[0xAD] = "\\-";
33 0         0 return;
34             }
35              
36             sub CHARSET_UNICODE {
37 0     0 0 0 $Escape[0xA0] = "\\~";
38 0         0 $Escape[0xAD] = "\\-";
39 0         0 return;
40             }
41              
42             sub CHARSET_OTHER {
43 0     0 0 0 $Escape[0xA0] = "\\'a0";
44 0         0 $Escape[0xAD] = "\\'ad";
45 0         0 return;
46             }
47              
48             #--------------------------------------------------------------------------
49             # Init:
50              
51             # Using an array for this avoids some problems with nasty UTF8 bugs in
52             # hash lookup algorithms.
53              
54             @Escape = map sprintf("\\'%02x", $_), 0x00 .. 0xFF;
55             foreach my $i ( 0x20 .. 0x7E ) { $Escape[$i] = chr($i) }
56              
57             {
58             my @refinements = (
59             "\\" => "\\'5c",
60             "{" => "\\'7b",
61             "}" => "\\'7d",
62            
63             "\cm" => '',
64             "\cj" => '',
65             "\n" => "\n\\line ",
66             # This bit of voodoo means that whichever of \cm | \cj isn't synonymous
67             # with \n, is aliased to empty-string, and whichever of them IS "\n",
68             # turns into the "\n\\line ".
69            
70             "\t" => "\\tab ", # Tabs (altho theoretically raw \t's might be okay)
71             "\f" => "\n\\page\n", # Formfeed
72             "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen
73             # I /think/ that's for the best.
74             "\xA0" => "\\~", # \xA0 is Latin-1/Unicode non-breaking space
75             "\xAD" => "\\-", # \xAD is Latin-1/Unicode soft (optional) hyphen
76             '.' => "\\'2e",
77             'F' => "\\'46",
78             );
79             my($char, $esc);
80             while(@refinements) {
81             ($char, $esc) = splice @refinements,0,2;
82             $Escape[ord $char] = $esc;
83             }
84             }
85              
86             #--------------------------------------------------------------------------
87              
88             # The conversion functions, for export:
89 0     0 1 0 sub inch { int(.5 + $_[0] * 1440) }
90 0     0 1 0 sub inches { int(.5 + $_[0] * 1440) }
91 0     0 1 0 sub in { int(.5 + $_[0] * 1440) }
92 0     0 1 0 sub points { int(.5 + $_[0] * 20) }
93 0     0 1 0 sub point { int(.5 + $_[0] * 20) }
94 0     0 1 0 sub pt { int(.5 + $_[0] * 20) }
95 0     0 1 0 sub cm { int(.5 + $_[0] * (1440 / 2.54) ) } # approx 567
96              
97             sub rtfesc {
98             # Note that this doesn't apply our wrapping algorithm, because
99             # I don't forsee this being used for many-line things.
100            
101 1 50 50 1 1 2430 shift if @_ and ref($_[0] || '') and UNIVERSAL::isa($_[0], __PACKAGE__);
      33        
      33        
102             # that's so we can double as a method
103            
104 1         2 my $x; # scratch
105 1 50       9 if(!defined wantarray) { # void context: alter in-place!
    50          
106 0         0 for(@_) {
107 0         0 s/([F\.\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape[ord$1]/g; # ESCAPER
108 0 0       0 s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
  0         0  
109             # We escape F and . because when they're line-initial (or alone
110             # on a line), some mailers eat them or freak out.
111             }
112 0         0 return;
113             } elsif(wantarray) { # return an array
114 0         0 return map {;
115 0         0 ($x = $_) =~
116             s/([F\.\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape[ord$1]/g; # ESCAPER
117 0         0 $x =~
118 0 0       0 s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
119 0         0 $x;
120             } @_;
121             } else { # return a single scalar
122 1 50       18 ($x = ((@_ == 1) ? $_[0] : join '', @_)
123             ) =~
124             s/([F\.\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape[ord$1]/g; # ESCAPER
125             # Escape \, {, }, -, control chars, and 7f-ff.
126 1         4 $x =~
127 0 0       0 s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
128              
129 1         5 return $x;
130             }
131             }
132              
133              
134             #**************************************************************************
135              
136             sub new_to_file {
137             # just a wrapper around new_to_fh
138 6     6 1 3958 my $class = shift;
139 6 50       29 defined $_[0] or Carp::croak "undef isn't a good filename for new_to_file";
140 6 50       27 length $_[0] or Carp::croak "\"\" isn't a good filename for new_to_file";
141 6         19 local(*FH);
142 6 50       741 open(FH, ">$_[0]") or Carp::croak "Can't write-open $_[0]: $!";
143 6         13 DEBUG and print "Opened-file $_[0] -> ", *FH{IO}, "\n";
144 6         52 my $new = $class->new_to_fh(*FH{IO});
145 6         23 return $new;
146             }
147              
148 0     0 0 0 sub new_to_filehandle { shift->new_to_handle(@_) }
149 0     0 1 0 sub new_to_handle { shift->new_to_fh( @_) }
150              
151             sub new_to_fh { # legacy
152 6 50 33 6 0 65 Carp::croak "Open to what filehandle?"
153             unless defined $_[1] and length $_[1];
154 6         12 my $fh = $_[1];
155 6         10 DEBUG and print "Opened-fh $fh\n";
156              
157 6         12 my $class = shift;
158 6         13 my $last_was_command = 0;
159 6   33     28 my $new = bless [
160             _make_emitter_closure($fh),
161             '', # things to be printed, on closing
162             $fh,
163             ], ref($class) || $class;
164 6         20 return $new;
165             }
166              
167             sub new_to_string {
168 1 50 33 1 1 202 Carp::croak "Open to what scalar-ref?"
169             unless defined $_[1] and ref($_[1]) eq 'SCALAR';
170 1         3 my($class, $sr) = @_;
171 1         2 DEBUG and print "Opened-sr $sr\n";
172              
173 1   33     5 my $new = bless [
174             _make_emitter_closure(undef,$sr),
175             '', # things to be printed, on closing
176             undef,
177             ], ref($class) || $class;
178 1         3 return $new;
179             }
180              
181             #**************************************************************************
182             # Think twice before outright overriding this method:
183              
184             sub print {
185 520 50   520 1 1145 ref $_[0] or Carp::croak(__PACKAGE__ .
186             "'s print(...) is supposed to be an object method!");
187 520         527 DEBUG > 1 and print "Calling $_[0][0]\n";
188             goto &{
189 520 50       504 $_[0][0] || # call the closure
  520         1857  
190             Carp::croak("That " . __PACKAGE__ . " object has been closed!?")
191             };
192             }
193              
194             #**************************************************************************
195             sub printf {
196 0 0   0 1 0 ref $_[0] or Carp::croak(__PACKAGE__ .
197             "'s printf(...) is supposed to be an object method!");
198 0         0 my($it,$format) = splice(@_,0,2);
199 0 0       0 $format = '' unless defined $format;
200            
201 0 0       0 if(ref($format) ne 'SCALAR') {
202             # Example: $it->printf("%04d: %s\n", @stuff)
203 0         0 DEBUG and print "Nonescaped format <$format> on <@_>\n";
204 0         0 my $x = sprintf($format, @_);
205 0         0 DEBUG and print "Formatted (not yet esc): $x\n";
206 0         0 $it->print( $x );
207             # And, in escaping, this will be wrapped.
208             } else {
209             # Example: $it->printf(\'{\f30\b %s:} {\i %d}', @stuff)
210 0         0 DEBUG and print "Escaped format <", $$format, "> on <@_>\n";
211              
212 0         0 my $str; # scratch
213            
214             # Escape anything non-numeric:
215 0         0 for(my $i = 0; $i < @_; ++$i) {
216 0 0 0     0 next if !defined($_[$i]) or !length($_[$i]) or
      0        
217             $_[$i] =~ m/^[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?\z/s;
218            
219 0         0 ($str = $_[$i]) =~
220             s/([F\.\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape[ord$1]/g; # ESCAPER
221 0         0 $str =~
222 0 0       0 s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
223              
224             # Don't bother applying wrapping, I guess.
225            
226 0         0 DEBUG > 2 and print "Escaping <$_[$i]> to <$str>\n";
227 0         0 splice @_, $i, 1, $str;
228             # MAGIC! makes it so we don't alter the original.
229             }
230              
231 0         0 my $x = sprintf $$format, @_;
232 0         0 DEBUG and print "Formatted (esc): $x\n";
233 0         0 $it->print( \$x ); # No wrapping applied.
234              
235             # We mustn't escape things that we might intend, in the sprintf
236             # format, to treat as numbers, since escaping would turn '-'
237             # to '\_', and that would turn something numeric like "-14"
238             # or "1.5E-9" into something non-numeric like "\_14"
239             # or "1.5E\_9". So we use this regexp.
240             # The solution here /could/ fail to apply the escaping of
241             # "-" -> "\_", to number-seeming things we were really going
242             # to use as strings, but that seems relatively harmless.
243             # The only completely correct way to do that would be to
244             # completely reimplement sprintf in pure Perl, or at least
245             # enough of it that we parse the format -- so not only could we
246             # tell what items from @_ were to be treated as numbers and
247             # which as strings, but also so we could take the output of
248             # formatting numbers, and /then/ apply the '-' -> '\_'
249             # escaping.
250             # However, the /only/ benefit of this would be to get the
251             # '-' -> '\_' escaping to apply. And in practice, this could
252             # be a problem only in two cases: a leading minus-sign, as
253             # in '-53.3', which presumably won't occur in a context
254             # where a word-processor would hyphenate; and after an "E",
255             # as in "1.5E-9". While it's more likely that a word-precessor
256             # might hyphenate there, I that think scientific-notation
257             # numbers are in practive relatively rare. So there.
258             }
259             }
260              
261             #--------------------------------------------------------------------------
262             sub AUTOLOAD {
263 0     0   0 DEBUG and print "**** $_[0] hits autoload for $AUTOLOAD\n";
264 0 0 0     0 if(ref($_[0]) and $AUTOLOAD =~ m<::([A-Z][a-z]*(?:_?[0-9]+)?)$>s) {
265 0         0 my $cmd = "\\" . lc($1);
266 0         0 $cmd =~ tr<_><->; # So: $x->fi_180 -> $x->print(\'\fs-180')
267 0         0 my $it = shift;
268 0 0       0 if(@_) {
269 0         0 return $it->print(\'{', \$cmd, @_, \'}');
270             # So: $it->Lang1234(...) -> $it->print([\'\lang123', ... ]);
271             # (Well, the { ... } is just an incidental optimization.)
272             } else {
273 0         0 return $it->print(\$cmd);
274             # So: $it->Lang1234() -> $it->print(\'\lang123');
275             }
276             } else {
277 0   0     0 Carp::croak "Can't locate object method \"$AUTOLOAD\" via package \""
278             . (ref($_[0]) || $_[0]) . '"';
279             }
280             }
281              
282             #--------------------------------------------------------------------------
283             sub close {
284 7 50   7 1 71 return unless $_[0][0]; # Already closed?!
285 7         64 DEBUG > 1 and print "Closing $_[0]\n";
286 7 100       55 $_[0]->print(\$_[0][1]) if length $_[0][1];
287 7         21 undef $_[0][0]; # ...presumably clausing any FH to close and destroy.
288 7         136 $_[0][1] = '';
289 7         70 return;
290             }
291              
292             #--------------------------------------------------------------------------
293             sub DESTROY {
294             # just a rudimentary version of $fh->close()
295 7 50 33 7   2737 $_[0]->print(\$_[0][1]) if $_[0][0] and $_[0][1];
296             }
297              
298             #**************************************************************************
299 6     6   6965 use UNIVERSAL ();
  6         89  
  6         25338  
300              
301             sub table {
302             # Wrapper around row().
303 0     0 1 0 my $it = shift;
304 0 0       0 Carp::croak "table isn't a class method" unless ref $it;
305 0 0 0     0 my $decl = shift
      0        
      0        
306             if @_ and defined $_[0] and ref($_[0])
307             and UNIVERSAL::isa($_[0], __PACKAGE__ . '::TableRowDecl');
308             # Remaining items are row-arrayrefs.
309              
310 0 0       0 push @_, [''] unless @_; # avoid table with no rows!
311              
312 0   0     0 $decl ||= RTF::Writer::TableRowDecl->new_auto_for_rows(@_);
313              
314 0         0 $it->print(\'\par\pard');
315             # Because ill things happen unless the paragraph
316             # that the table starts in, is virgin.
317 0         0 foreach my $row_content (@_) {
318 0 0 0     0 Carp::croak "table's row-parameters have to be arrayrefs"
319             unless ref($row_content || '') eq 'ARRAY';
320 0         0 $it->row($decl, @$row_content);
321             }
322 0         0 return scalar @_;
323             }
324              
325             #--------------------------------------------------------------------------
326              
327             sub row {
328             # Generate a table row.
329 5     5 1 19 my $it = shift;
330 5 50       52 Carp::croak "row isn't a class method" unless ref $it;
331 5 50 33     82 Carp::croak "row's first parameter has to be a table row declaration"
      33        
      33        
332             unless @_ and defined $_[0] and ref($_[0])
333             and UNIVERSAL::isa($_[0], __PACKAGE__ . '::TableRowDecl');
334 5         18 my $decl = shift;
335              
336             # Pad with blank cells, if need be:
337 5 50       7 push @_, (\'') x scalar(@{$decl->[0]} - @_) if @{$decl->[0]} > @_;
  0         0  
  5         18  
338             # We have to avoid having a cell-less row:
339 5 50       14 push @_, \'' unless @_;
340            
341 5         8 my $cell_count = @_;
342            
343            
344 5         22 my @inits = $decl->cell_content_init;
345            
346 5   100     34 unshift @_,
347             \(
348             '\pard\intbl' . ( shift(@inits) || '' )
349             );
350 5         19 for(my $i = 1; $i < @_; $i += 2) {
351 20 0 33     56 if(defined($_) and ref($_) eq '' and -1 != index($_[$i], "\f")) {
      33        
352             # The one case where we need to mess with things: if there's a
353             # formfeed in this plaintext.
354 0         0 my $x = $_[$i];
355 0         0 $x =~ tr/\f/\n/;
356 0         0 splice @_, $i, 1, $x; # Swap in the copy, not touching the original.
357             }
358 20   100     124 splice(@_, $i + 1, 0, \(
359             '\cell\pard\intbl' . (shift(@inits) || '')
360             ));
361             }
362 5         9 $_[-1] = \'\cell\row\pard';
363              
364 5         22 $it->print(
365             \'{',
366             $decl->decl_code($cell_count),
367             @_,
368             \'}',
369             );
370 5         23 return $cell_count; # Might as well return somehting.
371             }
372              
373             #--------------------------------------------------------------------------
374              
375             sub number_pages {
376 4     4 1 24 my $r = shift;
377 4         15 $r->print(
378             \"\n{\\header \\pard\\qr\\plain\\f0",
379             @_,
380             \"\\chpgn\\par}\n\n"
381             );
382             # This is actually a section attribute. To reset, \'\sect\sectd'
383             # to start a new section.
384             }
385              
386             #**************************************************************************
387              
388             sub paragraph {
389 10     10 1 64 my $r = shift;
390 10         50 $r->print(\"{\\pard\n", @_, \"\n\\par}\n\n");
391             }
392              
393             #**************************************************************************
394              
395             sub image_paragraph {
396 2     2 1 537 my $r = shift;
397 2         9 my($filename, $declcode) = $r->_image_params(@_);
398 2 50       27 return unless $r->print( \"{\\pard\\qc\n{\\pict\n", \$declcode);
399 2 50       16 $r->_image_data($filename) or return;
400 2         26 $r->print( \"}\n\\par}\n\n" );
401             }
402              
403 0     0 0 0 sub paragraph_image { shift->image_paragraph(@_) }
404 0     0 0 0 sub paragraph_picture { shift->image_paragraph(@_) }
405 0     0 0 0 sub picture_paragraph { shift->image_paragraph(@_) }
406              
407 0     0 0 0 sub pict { shift->image(@_) }
408              
409             sub image {
410 2 50   2 1 612 Carp::croak "Don't call \$rtf->image(...) in void context!"
411             unless defined wantarray;
412 2         5 my $r = shift;
413 2         9 my($filename, $declcode) = $r->_image_params(@_);
414 2         8 my $out = "{\\pict\n$declcode";
415 2         17 $r->_image_data($filename, \$out );
416 2         5 $out .= "}\n";
417 2         47 return \$out;
418             }
419              
420             #--------------------------------------------------------------------------
421              
422             sub _image_params {
423 4     4   7 my $self = shift;
424            
425 4         21 my %o = @_;
426 4         7 my $decl;
427 4   33     15 my $filespec = $o{'filename'} || Carp::croak "What filename?";
428 4 50 33     87 Carp::croak "No such file as $filespec"
429             unless $filespec and -e $filespec;
430              
431 4 50       13 if(defined $o{'picspecs'}) {
432 0         0 $decl = $o{'picspecs'};
433 0 0       0 $decl = $$decl if ref $decl;
434             } else {
435 4         2444 require Image::Size;
436 4         9973 my($h,$w, $type) = Image::Size::imgsize( $filespec );
437 4 50 33     24474 Carp::croak "$filespec - $type" unless $h and $w;
438              
439 4 50       68 my $tag =
    100          
440             ($type eq 'PNG') ? '\pngblip'
441             : ($type eq 'JPG') ? '\jpegblip'
442             : Carp::croak("I can't handle images of type $type like $filespec");
443             ;
444 4         28 $decl = "$tag\\picw$w\\pich$h\n";
445              
446             # Now glom on any extra parameters specified:
447 4         71 $decl .= join '',
448             map sprintf("\\pic%s%s", $_, int $o{$_}),
449             grep defined($o{$_}),
450             qw
451             ;
452             }
453 4         14 $decl .= "\n"; # So it doesn't run together with the image data.
454              
455 4         80 return( $filespec, $decl );
456             }
457              
458              
459             sub _image_data {
460 4     4   13 my($r, $filename, $to) = @_;
461              
462 4         93 my $buffer;
463             my $in;
464             {
465 4         10 local(*IMAGE);
  4         18  
466 4 50       140 open(IMAGE, $filename) or Carp::croak "Can't read-open $filename: $!";
467 4         50 $in = *IMAGE;
468             }
469 4         13 binmode($in);
470 4         92 while( read($in, $buffer, 32) ) {
471 968 100       1616 if($to) {
472 484         1982 $$to .= unpack("H*", $buffer) . "\n" ;
473             } else {
474 484 50       2418 $r->print( \( unpack("H*", $buffer) . "\n" ) ) or return 0;
475             }
476             # Turn 32 bytes into 64 hex characters, and then add a newline.
477             # (If the last chunk of data is under 32 bytes, then the unpack()
478             # does the right thing.)
479             }
480 4         82 CORE::close($in);
481 4         23 return 1;
482             }
483              
484             #**************************************************************************
485              
486             # two tolerated variant forms:
487 0     0 0 0 sub prologue { shift->prolog(@_) }
488 0     0 0 0 sub premable { shift->prolog(@_) }
489              
490             sub prolog {
491             # Emit prolog with given parameters
492 6     6 1 43 DEBUG and print "Prolog args: <@_>\n";
493 6         22 my($it, %h) = (@_);
494              
495 6         11 my $x; #scratch
496             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
497              
498 6 50       67 $h{'revtim' } = time unless exists $h{'revtim'};
499 6 50       38 $h{'creatim'} = time unless exists $h{'creatim'};
500 6 50       166 $h{'doccomm'} =
501             escape_broadly(sprintf 'written by %s [Perl %s v%s]',
502             $0, ref($it), $it->VERSION())
503             unless exists $h{'doccomm'};
504             # So you can set each to undef if you want it suppressed.
505              
506             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
507 6   50     165 my $fonts = $h{'fonts'} || $h{'font_table'} || $h{'fonttable'} || [];
508 6 50       34 $fonts = [$fonts] unless ref $fonts;
509 6 50 33     65 push @$fonts, \'\froman Times New Roman'
510             if ref($fonts) eq 'ARRAY' and ! @$fonts; # avoid having an empty font table
511              
512 6         13 my $font_count = -1;
513 6 50       91 $fonts = \join '',
    50          
514             # '{' \fonttbl ( | ('{' '}'))+ '}'
515             "{\\fonttbl\n",
516             map( ref($_)
517             ? ("{\\f", ++$font_count, ' ', $$_, ";}\n")
518             : ("{\\f", ++$font_count, '\fnil ', escape_broadly($_), ";}\n"),
519             @$fonts
520             #
521             # ? ? ? ? ? ?
522             # ? ';'
523             ), "}\n"
524             if ref $fonts eq 'ARRAY'
525             ;
526            
527             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
528 0         0 my $info = join '',
529             # And the info group:
530             "\n{\\info \n",
531              
532             # \version? & \vern? & \edmins? & \nofpages? & \nofwords? \nofchars?
533             # & \id?
534             # & ? & <subject>? & <author>? & <manager>? & <company>? </td> </tr> <tr> <td class="h" > <a name="535">535</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # & <operator>? & <category>? & <keywords>? & <comment>? & <doccomm>? </td> </tr> <tr> <td class="h" > <a name="536">536</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="537">537</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Time things, all optional: </td> </tr> <tr> <td class="h" > <a name="538">538</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map( </td> </tr> <tr> <td class="h" > <a name="539">539</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (!defined($x = $h{$_})) ? () : ( </td> </tr> <tr> <td class="h" > <a name="540">540</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "{\\$_ ", ( </td> </tr> <tr> <td class="h" > <a name="541">541</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ref($x) eq 'SCALAR' ? $$x : </td> </tr> <tr> <td class="h" > <a name="542">542</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ref($x) eq 'ARRAY' ? _time_to_rtf(@$x) : </td> </tr> <tr> <td class="h" > <a name="543">543</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $x =~ m<^\d+$> ? _time_to_rtf( $x) : </td> </tr> <tr> <td class="h" > <a name="544">544</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $x, # dubious, but let it thru </td> </tr> <tr> <td class="h" > <a name="545">545</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="546">546</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "}\n" </td> </tr> <tr> <td class="h" > <a name="547">547</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="548">548</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qw(creatim revtim printim buptim) </td> </tr> <tr> <td class="h" > <a name="549">549</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="550">550</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="551">551</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map( # Optional integer things: </td> </tr> <tr> <td class="h" > <a name="552">552</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (!defined($x = $h{$_})) ? () : </td> </tr> <tr> <td class="h" > <a name="553">553</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $x =~ m<^[0-9]+$> ? "\\$_$x\n" : </td> </tr> <tr> <td class="h" > <a name="554">554</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Carp::croak("value for \"$_\" must be an integer, not \"$_\""), </td> </tr> <tr> <td class="h" > <a name="555">555</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="556">556</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qw(version vern edmins nofpages nofwords nofchars nofcharsws id) </td> </tr> <tr> <td class="h" > <a name="557">557</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="558">558</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="559">559</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Optional non-time non-integer things: </td> </tr> <tr> <td class="h" > <a name="560">560</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map( </td> </tr> <tr> <td class="h" > <a name="561">561</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (!defined($x = $h{$_})) ? () : ( </td> </tr> <tr> <td class="h" > <a name="562">562</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "{\\$_ ", </td> </tr> <tr> <td class="h" > <a name="563">563</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (ref($x) eq 'SCALAR') ? $$x : $x, </td> </tr> <tr> <td class="h" > <a name="564">564</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "}\n" </td> </tr> <tr> <td class="h" > <a name="565">565</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="566">566</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qw(title subject author manager company operator category </td> </tr> <tr> <td class="h" > <a name="567">567</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> keywords comment doccomm hlinkbase) </td> </tr> <tr> <td class="h" > <a name="568">568</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="569">569</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="570">570</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ref( $h{'more_info'} || '' ) eq 'SCALAR' </td> </tr> <tr> <td class="h" > <a name="571">571</a> </td> <td class="c3" > 6 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#571-1"> 50 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#571-1"> 50 </a> </td> <td >   </td> <td >   </td> <td > 122 </td> <td class="s"> ? ${ $h{'more_info'} } : ( $h{'more_info'} || '' ), </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-2"> 50 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-2"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-3"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#-4"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-5"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-6"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-7"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#-8"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-9"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="572">572</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="573">573</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "}\n\n", # end of info group </td> </tr> <tr> <td class="h" > <a name="574">574</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ; </td> </tr> <tr> <td class="h" > <a name="575">575</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="576">576</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - </td> </tr> <tr> <td class="h" > <a name="577">577</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Cook up the color table. </td> </tr> <tr> <td class="h" > <a name="578">578</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # </td> </tr> <tr> <td class="h" > <a name="579">579</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Note that you might want to feed this a null 0th entry: </td> </tr> <tr> <td class="h" > <a name="580">580</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # as in: [ undef, [255,0,0], [0,0,255], ... ] </td> </tr> <tr> <td class="h" > <a name="581">581</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="582">582</a> </td> <td class="c3" > 6 </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#582-1"> 50 </a> </td> <td >   </td> <td >   </td> <td > 160 </td> <td class="s"> my $color_table = ($h{'colors'} || $h{'color_table'} </td> </tr> <tr> <td class="h" > <a name="583">583</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> || $h{'colortable'} || $h{'colortbl'} || ''); </td> </tr> <tr> <td class="h" > <a name="584">584</a> </td> <td class="c3" > 6 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#584-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 32 </td> <td class="s"> if(ref($color_table) eq 'ARRAY') { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-2"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="585">585</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #print "R ", ref($color_table), "<", @$color_table, "> =$color_table\n"; </td> </tr> <tr> <td class="h" > <a name="586">586</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#586-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#586-1"> 0 </a> </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $color_table = \join '', </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-2"> 0 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-3"> 0 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-3"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-4"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-5"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="587">587</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> '{\colortbl ', </td> </tr> <tr> <td class="h" > <a name="588">588</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map( </td> </tr> <tr> <td class="h" > <a name="589">589</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (ref($_ || '') eq 'ARRAY' ) ? sprintf('\red%d\green%d\blue%d;', </td> </tr> <tr> <td class="h" > <a name="590">590</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $_->[0] || 0, </td> </tr> <tr> <td class="h" > <a name="591">591</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $_->[1] || 0, </td> </tr> <tr> <td class="h" > <a name="592">592</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $_->[2] || 0, </td> </tr> <tr> <td class="h" > <a name="593">593</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ) </td> </tr> <tr> <td class="h" > <a name="594">594</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> : (ref($_ || '') eq 'SCALAR') ? ( </td> </tr> <tr> <td class="h" > <a name="595">595</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($$_ =~ m/;[\cm\cj\n]*\z/s) ? $$_ : ($$_ . ';') ) </td> </tr> <tr> <td class="h" > <a name="596">596</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Make sure it ends with a semicolon </td> </tr> <tr> <td class="h" > <a name="597">597</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> : ';', # null entry </td> </tr> <tr> <td class="h" > <a name="598">598</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @$color_table </td> </tr> <tr> <td class="h" > <a name="599">599</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="600">600</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> '}' </td> </tr> <tr> <td class="h" > <a name="601">601</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ; </td> </tr> <tr> <td class="h" > <a name="602">602</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif(ref($color_table) eq 'SCALAR') { </td> </tr> <tr> <td class="h" > <a name="603">603</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # pass it thru </td> </tr> <tr> <td class="h" > <a name="604">604</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="605">605</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 10 </td> <td class="s"> $color_table = \'{\colortbl;\red255\green0\blue0;\red0\green0\blue255;}'; </td> </tr> <tr> <td class="h" > <a name="606">606</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="607">607</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="608">608</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 19 </td> <td class="s"> $h{'colortbl'} = $color_table; </td> </tr> <tr> <td class="h" > <a name="609">609</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #print "Color table: <", ${$h{'colortbl'}}, ">\n"; </td> </tr> <tr> <td class="h" > <a name="610">610</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="611">611</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - </td> </tr> <tr> <td class="h" > <a name="612">612</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - </td> </tr> <tr> <td class="h" > <a name="613">613</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # </td> </tr> <tr> <td class="h" > <a name="614">614</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Now emit the table: </td> </tr> <tr> <td class="h" > <a name="615">615</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # </td> </tr> <tr> <td class="h" > <a name="616">616</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # \rtf <charset> \deff? <fonttbl> <filetbl>? <colortbl>? <stylesheet>? </td> </tr> <tr> <td class="h" > <a name="617">617</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # <listtables>? <revtbl>? </td> </tr> <tr> <td class="h" > <a name="618">618</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="619">619</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 135 </td> <td class="s"> $it->print( \join '', </td> </tr> <tr> <td class="h" > <a name="620">620</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> '{\rtf' , </td> </tr> <tr> <td class="h" > <a name="621">621</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> defined($h{'rtf_version'}) ? $h{'rtf_version'} : '1', </td> </tr> <tr> <td class="h" > <a name="622">622</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="623">623</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "\\" . ($h{'charset'} || 'ansi'), </td> </tr> <tr> <td class="h" > <a name="624">624</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "\\deff" . int($h{'deff'} || 0), </td> </tr> <tr> <td class="h" > <a name="625">625</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="626">626</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (!defined($x = $h{'more_default'})) ? '' # place to sneak in more stuff </td> </tr> <tr> <td class="h" > <a name="627">627</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> : ref($x) eq 'SCALAR' ? $$x </td> </tr> <tr> <td class="h" > <a name="628">628</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> : $x, </td> </tr> <tr> <td class="h" > <a name="629">629</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="630">630</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $$fonts, </td> </tr> <tr> <td class="h" > <a name="631">631</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="632">632</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map( ref( $h{$_} || '' ) eq 'SCALAR' </td> </tr> <tr> <td class="h" > <a name="633">633</a> </td> <td class="c3" > 6 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#633-1"> 50 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#633-1"> 50 </a> </td> <td >   </td> <td >   </td> <td > 246 </td> <td class="s"> ? ${ $h{$_} } : ( $h{$_} || '' ), </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-2"> 0 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-2"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-3"> 50 </a> </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--condition.html#-3"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#-4"> 100 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-4"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="634">634</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qw( filetbl colortbl stylesheet listtables revtbl ) </td> </tr> <tr> <td class="h" > <a name="635">635</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="636">636</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="637">637</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $info, </td> </tr> <tr> <td class="h" > <a name="638">638</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="639">639</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="640">640</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - </td> </tr> <tr> <td class="h" > <a name="641">641</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - </td> </tr> <tr> <td class="h" > <a name="642">642</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="643">643</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 18 </td> <td class="s"> $it->[1] .= '}'; </td> </tr> <tr> <td class="h" > <a name="644">644</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 9 </td> <td class="s"> DEBUG > 2 and print "Setting $it\'s out-buffer to <$it->[1]>\n"; </td> </tr> <tr> <td class="h" > <a name="645">645</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # to close the group that this document opened in its first char </td> </tr> <tr> <td class="h" > <a name="646">646</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 27 </td> <td class="s"> return 1; </td> </tr> <tr> <td class="h" > <a name="647">647</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="648">648</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="649">649</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="650">650</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Two subs used in the "prolog" method: </td> </tr> <tr> <td class="h" > <a name="651">651</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="652">652</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub escape_broadly { </td> </tr> <tr> <td class="h" > <a name="653">653</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Non-destructively quote anything fishy. </td> </tr> <tr> <td class="h" > <a name="654">654</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--subroutine.html#654-1"> 6 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--subroutine.html#654-1"> 0 </a> </td> <td > 23 </td> <td class="s"> my $scratch = $_[0]; </td> </tr> <tr> <td class="h" > <a name="655">655</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 42 </td> <td class="s"> $scratch =~ </td> </tr> <tr> <td class="h" > <a name="656">656</a> </td> <td class="c3" > 18 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 105 </td> <td class="s"> s/([F\.\x00-\x1F\\\{\}\x7F-\xFF])/"\\'".(unpack("H2",$1))/eg; # ESCAPER </td> </tr> <tr> <td class="h" > <a name="657">657</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 28 </td> <td class="s"> $scratch =~ </td> </tr> <tr> <td class="h" > <a name="658">658</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#658-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; </td> </tr> <tr> <td class="h" > <a name="659">659</a> </td> <td class="c3" > 6 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 24 </td> <td class="s"> return $scratch; </td> </tr> <tr> <td class="h" > <a name="660">660</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="661">661</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="662">662</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _time_to_rtf { </td> </tr> <tr> <td class="h" > <a name="663">663</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # accepts no-params (meaning now), an epoch time, or a timelist </td> </tr> <tr> <td class="h" > <a name="664">664</a> </td> <td class="c3" > 12 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#664-1"> 50 </a> </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--subroutine.html#664-1"> 12 </a> </td> <td >   </td> <td > 40 </td> <td class="s"> push @_, time() unless @_; </td> </tr> <tr> <td class="h" > <a name="665">665</a> </td> <td class="c3" > 12 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#665-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 34 </td> <td class="s"> if(@_ == 1) { # normal case </td> </tr> <tr> <td class="h" > <a name="666">666</a> </td> <td class="c3" > 12 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 428 </td> <td class="s"> @_ = (localtime(shift @_))[5,4,3,2,1,0]; </td> </tr> <tr> <td class="h" > <a name="667">667</a> </td> <td class="c3" > 12 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 29 </td> <td class="s"> $_[0] += 1900; # RTF counts 2023 as 2023, not 123. </td> </tr> <tr> <td class="h" > <a name="668">668</a> </td> <td class="c3" > 12 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 16 </td> <td class="s"> $_[1]++; # RTF counts January as 1, not 0. </td> </tr> <tr> <td class="h" > <a name="669">669</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="670">670</a> </td> <td class="c3" > 12 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 378 </td> <td class="s"> return sprintf '\yr%d\mo%d\dy%d\hr%d\min%d\sec%d', @_; </td> </tr> <tr> <td class="h" > <a name="671">671</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="672">672</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="673">673</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #************************************************************************** </td> </tr> <tr> <td class="h" > <a name="674">674</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # </td> </tr> <tr> <td class="h" > <a name="675">675</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # The following makes the scary scary emitter-closure: </td> </tr> <tr> <td class="h" > <a name="676">676</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # </td> </tr> <tr> <td class="h" > <a name="677">677</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="678">678</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $counter = 0; # for debug purposes </td> </tr> <tr> <td class="h" > <a name="679">679</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="680">680</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _make_emitter_closure { </td> </tr> <tr> <td class="h" > <a name="681">681</a> </td> <td class="c3" > 7 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--subroutine.html#681-1"> 7 </a> </td> <td >   </td> <td > 16 </td> <td class="s"> my($fh, $sr) = @_; </td> </tr> <tr> <td class="h" > <a name="682">682</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # sr should either be undef, or a scalar-ref </td> </tr> <tr> <td class="h" > <a name="683">683</a> </td> <td class="c3" > 7 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 14 </td> <td class="s"> my $scratch; </td> </tr> <tr> <td class="h" > <a name="684">684</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="685">685</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # A closure on $fh or $sr, for printing to it. </td> </tr> <tr> <td class="h" > <a name="686">686</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="687">687</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub { </td> </tr> <tr> <td class="h" > <a name="688">688</a> </td> <td class="c3" > 523 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--subroutine.html#688-1"> 523 </a> </td> <td >   </td> <td > 773 </td> <td class="s"> my $this = shift; </td> </tr> <tr> <td class="h" > <a name="689">689</a> </td> <td class="c3" > 523 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 512 </td> <td class="s"> DEBUG > 1 and print "Writing (@_) to ", $sr ? "S_$sr\n" : "F_$fh\n"; </td> </tr> <tr> <td class="h" > <a name="690">690</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="691">691</a> </td> <td class="c3" > 523 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 744 </td> <td class="s"> foreach my $x (@_) { </td> </tr> <tr> <td class="h" > <a name="692">692</a> </td> <td class="c3" > 615 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#692-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 1125 </td> <td class="s"> next unless defined $x; </td> </tr> <tr> <td class="h" > <a name="693">693</a> </td> <td class="c3" > 615 </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#693-1"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 1708 </td> <td class="s"> if(ref($x) eq 'ARRAY') { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#-2"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#-3"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="694">694</a> </td> <td class="c3" > 3 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#694-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 9 </td> <td class="s"> next if @$x == 0; </td> </tr> <tr> <td class="h" > <a name="695">695</a> </td> <td class="c3" > 3 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#695-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 12 </td> <td class="s"> $sr ? ( $$sr .= '{' ) : print $fh '{'; </td> </tr> <tr> <td class="h" > <a name="696">696</a> </td> <td class="c3" > 3 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s"> DEBUG > 1 and print " $counter: wrote {\n"; </td> </tr> <tr> <td class="h" > <a name="697">697</a> </td> <td class="c3" > 3 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 17 </td> <td class="s"> $this->[0]->($this, @$x); # recurse! </td> </tr> <tr> <td class="h" > <a name="698">698</a> </td> <td class="c3" > 3 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#698-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 10 </td> <td class="s"> $sr ? ( $$sr .= '}' ) : print $fh '}'; </td> </tr> <tr> <td class="h" > <a name="699">699</a> </td> <td class="c3" > 3 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> DEBUG > 2 and print " wrote }\n"; </td> </tr> <tr> <td class="h" > <a name="700">700</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif(ref($x) eq 'SCALAR') { </td> </tr> <tr> <td class="h" > <a name="701">701</a> </td> <td class="c3" > 579 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#701-1"> 50 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#701-1"> 33 </a> </td> <td >   </td> <td >   </td> <td > 4657 </td> <td class="s"> if(!defined($$x) or !length($$x)) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#-2"> 100 </a> </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--condition.html#-2"> 66 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="702">702</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # no-op </td> </tr> <tr> <td class="h" > <a name="703">703</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> DEBUG > 2 and print " $counter: skipping null sr\n"; </td> </tr> <tr> <td class="h" > <a name="704">704</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif( not( $AUTO_NL and $$x =~ m<[a-zA-Z0-9]\z>s )) { </td> </tr> <tr> <td class="h" > <a name="705">705</a> </td> <td class="c3" > 543 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#705-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 2665 </td> <td class="s"> $sr ? ( $$sr .= $$x ) : print $fh $$x; </td> </tr> <tr> <td class="h" > <a name="706">706</a> </td> <td class="c3" > 543 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 1414 </td> <td class="s"> DEBUG > 2 and print " $counter: wrote sr $$x\n"; </td> </tr> <tr> <td class="h" > <a name="707">707</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="708">708</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # $AUTO_NL is true, and $$x's last char is in [a-zA-Z0-9] </td> </tr> <tr> <td class="h" > <a name="709">709</a> </td> <td class="c3" > 36 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#709-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 135 </td> <td class="s"> $sr ? ( $$sr .= $$x . "\n" ) : print $fh $$x, "\n"; </td> </tr> <tr> <td class="h" > <a name="710">710</a> </td> <td class="c3" > 36 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 83 </td> <td class="s"> DEBUG > 2 and print " $counter: wrote sr $$x +nl\n"; </td> </tr> <tr> <td class="h" > <a name="711">711</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="712">712</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Why emit a newline? Because that string might end in a </td> </tr> <tr> <td class="h" > <a name="713">713</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # command, and we want to do the Right Thing in the case of: </td> </tr> <tr> <td class="h" > <a name="714">714</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # $r->print(\'\i', 'donuts') </td> </tr> <tr> <td class="h" > <a name="715">715</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # i.e., printing "\i[newline]donuts", not "\idonuts" </td> </tr> <tr> <td class="h" > <a name="716">716</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # </td> </tr> <tr> <td class="h" > <a name="717">717</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # And why not emit "\i[space]donuts"? because we if we emit a </td> </tr> <tr> <td class="h" > <a name="718">718</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # space and the thing we emitted WASN'T a control word, then </td> </tr> <tr> <td class="h" > <a name="719">719</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # we did a bad thing! Spaces are tricky -- sometimes they're </td> </tr> <tr> <td class="h" > <a name="720">720</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # meaningless, and sometimes they mean a literal space. </td> </tr> <tr> <td class="h" > <a name="721">721</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # But newlines are always ignored -- well, unless preceded </td> </tr> <tr> <td class="h" > <a name="722">722</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # by an escaping backslash, but to get that, the user would </td> </tr> <tr> <td class="h" > <a name="723">723</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # have to have the previous group end in an unmatched backslash, </td> </tr> <tr> <td class="h" > <a name="724">724</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # as in $h->print(\"\\foo\\", ...) So don't do that! </td> </tr> <tr> <td class="h" > <a name="725">725</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="726">726</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="727">727</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif(length $x) { # It's plaintext </td> </tr> <tr> <td class="h" > <a name="728">728</a> </td> <td class="c3" > 33 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 165 </td> <td class="s"> ($scratch = $x) =~ </td> </tr> <tr> <td class="h" > <a name="729">729</a> </td> <td class="c3" > 29 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 138 </td> <td class="s"> s/([F\.\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape[ord$1]/eg; # ESCAPER </td> </tr> <tr> <td class="h" > <a name="730">730</a> </td> <td class="c3" > 33 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 88 </td> <td class="s"> $scratch =~ </td> </tr> <tr> <td class="h" > <a name="731">731</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#731-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; </td> </tr> <tr> <td class="h" > <a name="732">732</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="733">733</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Escape \, {, }, -, control chars, and 7f-ff, and Unicode. </td> </tr> <tr> <td class="h" > <a name="734">734</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="735">735</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # And now: a not terribly clever algorithm for inserting newlines </td> </tr> <tr> <td class="h" > <a name="736">736</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # at a guaranteed harmless place: after a block of whitespace </td> </tr> <tr> <td class="h" > <a name="737">737</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # after the 65th column. </td> </tr> <tr> <td class="h" > <a name="738">738</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Why not before the block of whitespace? Consider: </td> </tr> <tr> <td class="h" > <a name="739">739</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # q<\foo bar> If we break that into q<\foo>+NL+q< bar>, then </td> </tr> <tr> <td class="h" > <a name="740">740</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # suddenly the space after the newline is significant, instead </td> </tr> <tr> <td class="h" > <a name="741">741</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # of just being the dummy space that ends the \foo command token. </td> </tr> <tr> <td class="h" > <a name="742">742</a> </td> <td class="c3" > 33 </td> <td class="c0" > <a href="blib-lib-RTF-Writer-pm--branch.html#742-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 106 </td> <td class="s"> $scratch =~ </td> </tr> <tr> <td class="h" > <a name="743">743</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> s/( </td> </tr> <tr> <td class="h" > <a name="744">744</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> [^\cm\cj\n]{65} # Snare 65 characters from a line </td> </tr> <tr> <td class="h" > <a name="745">745</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> [^\cm\cj\n\x20]{0,50} # and finish any current word </td> </tr> <tr> <td class="h" > <a name="746">746</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ) </td> </tr> <tr> <td class="h" > <a name="747">747</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (\x20{1,10})(?![\cm\cj\n]) # capture some spaces not at line-end </td> </tr> <tr> <td class="h" > <a name="748">748</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> /$1$2\n/gx # and put a NL after those spaces </td> </tr> <tr> <td class="h" > <a name="749">749</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if $WRAP; </td> </tr> <tr> <td class="h" > <a name="750">750</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # This may wrap at well past the 65th column, but not past the 120th. </td> </tr> <tr> <td class="h" > <a name="751">751</a> </td> <td class="c3" > 33 </td> <td class="c3" > <a href="blib-lib-RTF-Writer-pm--branch.html#751-1"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 119 </td> <td class="s"> $sr ? ( $$sr .= $scratch ) : print $fh $scratch; </td> </tr> <tr> <td class="h" > <a name="752">752</a> </td> <td class="c3" > 33 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 47 </td> <td class="s"> DEBUG > 2 and print " $counter: wrote scalar <$scratch>\n"; </td> </tr> <tr> <td class="h" > <a name="753">753</a> </td> <td class="c3" > 33 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 73 </td> <td class="s"> $scratch = ''; </td> </tr> <tr> <td class="h" > <a name="754">754</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="755">755</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # otherwise it's 0-length plaintext, so ignore. </td> </tr> <tr> <td class="h" > <a name="756">756</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="757">757</a> </td> <td class="c3" > 523 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 601 </td> <td class="s"> DEBUG > 3 and print $fh "{\\v $^T/", ++$counter, "}\n"; </td> </tr> <tr> <td class="h" > <a name="758">758</a> </td> <td class="c3" > 523 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 2410 </td> <td class="s"> return 1; </td> </tr> <tr> <td class="h" > <a name="759">759</a> </td> <td class="c3" > 7 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 150 </td> <td class="s"> }; </td> </tr> <tr> <td class="h" > <a name="760">760</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="761">761</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="762">762</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #-------------------------------------------------------------------------- </td> </tr> <tr> <td class="h" > <a name="763">763</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> <tr> <td class="h" > <a name="764">764</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="765">765</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> </table> </body> </html>