File Coverage

blib/lib/Data/HexDump/Range/Gather.pm
Criterion Covered Total %
statement 37 255 14.5
branch 0 126 0.0
condition 0 37 0.0
subroutine 13 25 52.0
pod 0 6 0.0
total 50 449 11.1


line stmt bran cond sub pod time code
1              
2             package Data::HexDump::Range ; ## no critic (Modules::RequireFilenameMatchesPackage)
3              
4 2     2   9 use strict;
  2         3  
  2         65  
5 2     2   8 use warnings ;
  2         3  
  2         47  
6 2     2   38 use Carp ;
  2         3  
  2         154  
7              
8             BEGIN
9 2     2   42 {
10              
11 2         26 use Sub::Exporter -setup =>
12             {
13             exports => [ qw() ],
14             groups =>
15             {
16             all => [ qw() ],
17             }
18 2     2   12 };
  2         3  
19            
20 2     2   1043 use vars qw ($VERSION);
  2         4  
  2         83  
21             }
22              
23             #-------------------------------------------------------------------------------
24              
25 2     2   11 use English qw( -no_match_vars ) ;
  2         3  
  2         12  
26              
27 2     2   561 use Readonly ;
  2         4  
  2         179  
28             Readonly my $EMPTY_STRING => q{} ;
29             Readonly my $SCALAR_TYPE=> q{} ;
30              
31             Readonly my $RANGE_DEFINITON_FIELDS => 4 ;
32              
33 2     2   15 use Carp qw(carp croak confess) ;
  2         3  
  2         3142  
34              
35             #-------------------------------------------------------------------------------
36              
37             =head1 NAME
38              
39             Data::HexDump::Range::Gather - Handles gathering of binary data for Data::HexDump::Range
40              
41             =head1 SUBROUTINES/METHODS
42              
43             Subroutines prefixed with B<[P]> are not part of the public API and shall not be used directly.
44              
45             =cut
46              
47             #-------------------------------------------------------------------------------
48              
49             sub _gather
50             {
51              
52             =head2 [P] _gather($range_description, $data, $offset, $size)
53              
54             Creates an internal data structure from the data to dump.
55              
56             $hdr->_gather($container, $range_description, $data, $size)
57              
58             I - See L
59              
60             =over 2
61              
62             =item * $container - an array reference or undef - where the gathered data
63              
64             =item * $range_description - See L
65              
66             =item * $data - See L
67              
68             =item * $offset - See L
69              
70             =item * $size - See L
71              
72             =back
73              
74             I -
75              
76             =over 2
77              
78             =item * $container - the gathered data
79              
80             =item * $used_data - integer - the location in the data where the dumping ended
81              
82             =back
83              
84             I dies if passed invalid parameters
85              
86             =cut
87              
88 0     0     my ($self, $collected_data, $range_description, $data, $offset, $size) = @_ ;
89              
90 0           my $location = "$self->{FILE}:$self->{LINE}" ;
91              
92 0   0       my $used_data = $offset || 0 ;
93 0 0         $self->{INTERACTION}{DIE}("Error: Invalid negative offset at '$location'.\n") if($used_data < 0) ;
94              
95 0           my $data_size = length($data) ;
96              
97 0 0         $self->{INTERACTION}{DIE}("Error: offset greater than data size at '$location'.\n") if($data_size <= $used_data) ;
98              
99 0 0         $size = defined $size ? min($size, $data_size - $used_data) : $data_size - $used_data ;
100 0 0         $self->{INTERACTION}{DIE}("Error: Invalid negative size at '$location'.\n") if($size < 0) ;
101 0 0         $self->{INTERACTION}{DIE}("Error: Invalid size '0' at '$location'.\n") if($size == 0) ;
102              
103 0           my $skip_remaining_ranges = 0 ;
104 0           my $last_data = '' ;
105              
106 0           my $range_provider = $self->create_range_provider($range_description);
107              
108 0           while(my $range = $range_provider->($self, $data, $used_data))
109             {
110 0 0         if($self->{DUMP_ORIGINAL_RANGE_DESCRIPTION})
111             {
112 0           $self->{INTERACTION}{INFO}
113             (
114             DumpTree $range, 'Original range description', QUOTE_VALUES => 1, DISPLAY_ADDRESS => 0, DISPLAY_PERL_DATA => 1, DISPLAY_INHERITANCE => 1
115             ) ;
116             }
117            
118 0 0 0       if('CODE' eq ref($range->[0]) && ! defined $range->[1] && ! defined $range->[2] && ! defined $range->[3]) # eek!
      0        
      0        
119             {
120 0           my ($range_from_sub, $comment) = $range->[0]($self, $data, $used_data) ;
121            
122 0 0         if(defined $range_from_sub)
123             {
124 0 0         if('ARRAY' eq ref($range))
125             {
126 0 0         if( @{$range} == 4)
  0            
127             {
128 0           $range = $range_from_sub ;
129             }
130             else
131             {
132 0 0         $self->{INTERACTION}{DIE}->
133             (
134             "Error: Sub range definition did not return 4 elements array reference, ["
135 0           . join(', ', map {defined $_ ? $_ : 'undef'}@{$range_from_sub})
  0            
136             . "] at '$location'."
137             ) ;
138             }
139             }
140             else
141             {
142 0           $self->{INTERACTION}{DIE}->("Error: Sub range definition did not return an array reference at '$location'." ) ;
143             }
144             }
145             else
146             {
147 0 0         if($self->{DUMP_RANGE_DESCRIPTION})
148             {
149 0   0       $comment ||= 'No comment returned from sub' ;
150 0           $self->{INTERACTION}{INFO}("Information: Sub range definition returned no range at '$location'. $comment.\n" ) ;
151             }
152            
153 0           next ;
154             }
155             }
156            
157 0           my ($range_name, $range_size_definition, $range_color, $range_user_information) = @{$range} ;
  0            
158 0           my $range_size = $range_size_definition;
159              
160 0           for my $range_field ($range_name, $range_size, $range_color, $range_user_information)
161             {
162 0 0         $range_field = $range_field->($self, $data, $used_data, $size, $range) if 'CODE' eq ref($range_field) ;
163             }
164              
165 0           my ($is_header, $is_comment, $is_bitfield, $is_skip, $unpack_format) ;
166              
167             # handle maximum_size
168 0 0         if($SCALAR_TYPE eq ref($range_size))
    0          
169             {
170 0           ($is_header, $is_comment, $is_bitfield, $is_skip, $range_size, undef) = $self->unpack_range_size($range_name, $range_size, $used_data) ;
171             }
172             elsif('CODE' eq ref($range_size))
173             {
174 0           ($is_header, $is_comment, $is_bitfield, $is_skip, $range_size, undef) = $self->unpack_range_size($range_name, $range_size->(), $used_data) ;
175             }
176             else
177             {
178 0           $self->{INTERACTION}{DIE}("Error: size '$range_size' doesn't look like a number or a code reference in range '$range_name' at '$location'.\n")
179             }
180              
181 0           my $truncated_size ;
182 0 0         if($data_size - $used_data < $range_size)
    0          
183             {
184 0           $range_size = $truncated_size = max($data_size - $used_data, 0) ;
185 0           $skip_remaining_ranges++ ;
186             }
187             elsif($size < $range_size)
188             {
189 0           $range_size = $truncated_size = $size ;
190 0           $skip_remaining_ranges++ ;
191             }
192            
193             # get the unpack format with the justified size
194             # note that we keep $is_comment and $is_bitfield from first run
195             # as the those are extracted from the size field and we have modified it
196 0           (undef,undef, undef, undef, $range_size, $unpack_format) = $self->unpack_range_size($range_name, $range_size, $used_data) ;
197            
198 0 0         if($data_size == $used_data)
199             {
200 0 0 0       if($is_header || $is_comment || $is_bitfield)
      0        
201             {
202             # display bitfields even for ranges that pass maximim_size (truncated ranges)
203             }
204             else
205             {
206 0           my $next_range = $range_provider->($self, $data, $used_data) ;
207            
208 0 0         if(defined $next_range)
209             {
210 0           my ($next_range_name, $next_range_size_definition) = @{$next_range} ;
  0            
211 0           $self->{INTERACTION}{WARN}("Warning: More ranges to display but no more data.Next range name '$next_range_name'\n") ;
212             }
213            
214 0           $skip_remaining_ranges++ ;
215             }
216             }
217            
218 0 0 0       if(!$is_header && ! $is_comment && ! $is_bitfield)
      0        
219             {
220 0 0 0       if($range_size == 0 && $self->{DISPLAY_ZERO_SIZE_RANGE_WARNING})
221             {
222 0           $self->{INTERACTION}{WARN}("Warning: range '$range_name' requires zero bytes.\n") ;
223             }
224            
225 0 0         if(defined $truncated_size)
226             {
227 0           $self->{INTERACTION}{WARN}("Warning: range '$range_name' size was reduced from $range_size_definition to $truncated_size due to size limit at '$location'.\n") ;
228 0           $range_name = "$range_size_definition->$truncated_size:$range_name" ;
229             }
230             else
231             {
232 0 0         if($self->{DISPLAY_RANGE_SIZE})
233             {
234 0           $range_name = "$range_size:$range_name" ;
235             }
236             }
237            
238 0           $last_data = unpack($unpack_format, $data) # get out data from the previous range for bitfield
239             }
240            
241 0 0         my $chunk =
    0          
242             {
243             NAME => $range_name,
244             COLOR => $range_color,
245             OFFSET => $used_data,
246             DATA => $is_comment ? undef : $last_data,
247             IS_BITFIELD => $is_bitfield ? $range_size_definition : 0,
248             IS_HEADER => $is_header,
249             IS_SKIP => $is_skip,
250             IS_COMMENT => $is_comment,
251             USER_INFORMATION => $range_user_information,
252             } ;
253            
254 0 0         if(defined $self->{GATHERED_CHUNK})
255             {
256 0           my @chunks = $self->{GATHERED_CHUNK}($self, $chunk) ;
257 0           push @{$collected_data}, @chunks ;
  0            
258             }
259             else
260             {
261 0           push @{$collected_data}, $chunk ;
  0            
262             }
263            
264 0 0         if($self->{DUMP_RANGE_DESCRIPTION})
265             {
266 0           $self->{INTERACTION}{INFO}
267             (
268             DumpTree
269             {
270 0 0         %{$chunk},
271             'unpack format' => $is_bitfield ? $range_size_definition : $unpack_format,
272             },
273             $range_name,
274             QUOTE_VALUES => 1, DISPLAY_ADDRESS => 0,
275             ) ;
276             }
277              
278 0           $used_data += $range_size ;
279 0           $size -= $range_size ;
280              
281 0 0         last if $skip_remaining_ranges ;
282             }
283            
284 0           return $collected_data, $used_data ;
285             }
286              
287             #-------------------------------------------------------------------------------
288              
289             sub create_range_provider
290             {
291              
292             =head2 [P] create_range_provider($range_description)
293              
294             Transforms the user supplied ranges into an internal format
295              
296             I -
297              
298             =over 2
299              
300             =item * $range_description - An array reference or a subroutine reference
301              
302             =back
303              
304             I - Array reference - ranges in internal format
305              
306             I - None
307              
308             =cut
309              
310 0     0 0   my ($self, $range_description) = @_ ;
311              
312 0           my $range_provider ;
313              
314 0 0         if('CODE' eq ref($range_description))
315             {
316 0           my $ranges ;
317            
318             $range_provider =
319             sub
320             {
321 0     0     my ($dumper, $data, $offset) = @_ ;
322            
323 0 0 0       if(! defined $ranges || ! @{$ranges})
  0            
324             {
325 0           my $generated_range_description = $range_description->($dumper, $data, $offset) ;
326            
327 0 0         return undef unless defined $generated_range_description ;
328            
329 0           my $created_ranges = $self->create_ranges($generated_range_description) ;
330            
331 0           push @{$ranges}, @{$created_ranges}, $range_description ;
  0            
  0            
332             }
333            
334             RANGE:
335 0           my $local_description = shift@{$ranges} ;
  0            
336            
337 0 0         if('CODE' eq ref $local_description)
338             {
339 0           my $sub_range_description = $local_description->($dumper, $data, $offset) ;
340            
341 0 0         if(defined $sub_range_description)
342             {
343 0           unshift @{$ranges}, $local_description ;
  0            
344            
345 0 0         if('CODE' eq ref $sub_range_description )
346             {
347 0           unshift @{$ranges}, $sub_range_description ;
  0            
348             }
349             else
350             {
351 0           my $created_ranges = $self->create_ranges($sub_range_description) ;
352 0           unshift @{$ranges}, @{$created_ranges} ;
  0            
  0            
353             }
354             }
355             #else
356             # sub generating ranges is done
357            
358 0           goto RANGE ;
359             }
360            
361 0           return $local_description ;
362             }
363 0           }
364             else
365             {
366 0           my $ranges = $self->create_ranges($range_description) ;
367            
368             $range_provider =
369             sub
370             {
371 0     0     return shift @{$ranges} ;
  0            
372             }
373 0           }
374              
375 0           return $range_provider ;
376             }
377              
378             #-------------------------------------------------------------------------------
379              
380             sub unpack_range_size
381             {
382              
383             =head2 [P] unpack_range_size($self, $range_name, $size, $used_data)
384              
385             Verifies the size field from a range descritpion and generates unpack format
386              
387             I -
388              
389             =over 2
390              
391             =item * $self
392              
393             =item * $range_name
394              
395             =item * $size
396              
397             =item * $used_data
398              
399             =back
400              
401             I - A list
402              
403             =over 2
404              
405             =item * $is_header - Boolean -
406              
407             =item * $is_comment - Boolean -
408              
409             =item * $is_bitfield - Boolean -
410              
411             =item * $range_size - Integer
412              
413             =item * $unpack_format - A String - formated according to I.
414              
415             =back
416              
417             I - Croaks with an error messge if the input data is invalid
418              
419             =cut
420              
421 0     0 0   my ($self, $range_name, $size, $used_data) = @_ ;
422              
423 0           my ($is_header, $is_comment, $is_bitfield, $is_skip, $range_size, $unpack_format) = (0, 0, 0, 0, -1, '');
424              
425 0           my $digits_or_hex = '(?:(?:0x[0-9a-fA-F]+)|(?:\d+))' ;
426              
427 0 0         if('#' eq $size)
    0          
    0          
    0          
    0          
428             {
429 0           $is_comment++ ;
430 0           $range_size = 0 ;
431 0           $unpack_format = '#' ;
432             }
433             elsif('@' eq $size)
434             {
435 0           $is_header++ ;
436 0           $range_size = 0 ;
437 0           $unpack_format = '#' ;
438             }
439             elsif($size =~ /^\s*(X$digits_or_hex)?\s*(x$digits_or_hex)?\s*b$digits_or_hex\s*$/)
440             {
441 0           $is_bitfield++ ;
442 0           $range_size = 0 ;
443 0           $unpack_format = '#' ;
444             }
445             elsif($size =~ /^\s*(x|X)($digits_or_hex)\s*$/)
446             {
447 0           $is_skip++ ;
448 0           $range_size = $2 ;
449            
450 0 0         $range_size = hex($range_size) if $range_size =~ /^0x/ ;
451 0           $unpack_format = '#' ;
452             }
453             elsif($size =~ /^\s*($digits_or_hex)\s*$/)
454             {
455 0           $range_size = $1 ;
456 0 0         $range_size = hex($range_size) if $range_size =~ /^0x/ ;
457            
458 0           $unpack_format = "x$used_data a$range_size" ;
459             }
460             else
461             {
462 0           my $location = "$self->{FILE}:$self->{LINE}" ;
463              
464 0           $self->{INTERACTION}{DIE}("Error: size '$size' doesn't look valid in range '$range_name' at '$location'.\n")
465             }
466              
467             #~ print "$range_name => $is_header, $is_comment, $is_bitfield, $is_skip, $range_size, $unpack_format\n";
468              
469 0           return ($is_header, $is_comment, $is_bitfield, $is_skip, $range_size, $unpack_format) ;
470             }
471              
472             #-------------------------------------------------------------------------------
473              
474             sub create_ranges
475             {
476              
477             =head2 [P] create_ranges($range_description)
478              
479             Transforms the user supplied ranges into an internal format
480              
481             I -
482              
483             =over 2
484              
485             =item * $range_description - See L
486              
487             =back
488              
489             I - Array ference - ranges in internal format
490              
491             I - Croaks with an error messge if the input data is invalid
492              
493             =cut
494              
495 0     0 0   my ($self, $range_description) = @_ ;
496              
497 0 0         return $self->create_ranges_from_array_ref($range_description) if 'ARRAY' eq ref($range_description) ;
498 0 0         return $self->create_ranges_from_string($range_description) if '' eq ref($range_description) ;
499              
500             }
501              
502             #-------------------------------------------------------------------------------
503              
504             sub create_ranges_from_string
505             {
506              
507             =head2 [P] create_ranges_from_string($range_description)
508              
509             Transforms the user supplied ranges into an internal format
510              
511             I -
512              
513             =over 2
514              
515             =item * $range_description - A string - See L
516              
517             =back
518              
519             I - Array ference - ranges in internal format
520              
521             I - Croaks with an error messge if the input data is invalid
522              
523             =cut
524              
525 0     0 0   my ($self, $range_description) = @_ ;
526              
527             # 'comment,#:name,size,color:name,size:name,size,color'
528              
529 0           my @ranges =
530             map
531             {
532 0           '' eq $_
533             ? []
534 0 0         : [ map {s/^\s+// ; s/\s+$//; $_} split /,/ ] ;
  0            
  0            
535             } split /:/, $range_description ;
536              
537 0           my @flattened ;
538              
539             eval
540 0           {
541 0           @flattened = $self->flatten(\@ranges) ;
542             } ;
543              
544 0 0         if($EVAL_ERROR)
545             {
546 0           my ($error_message, $range_index) = @{ $EVAL_ERROR } ;
  0            
547 0           chomp $error_message ;
548              
549 2     2   27 use Data::TreeDumper ;
  2         3  
  2         98  
550 2     2   7 use List::MoreUtils qw(pairwise) ;
  2         3  
  2         22  
551            
552 0           my @keys = ('name', 'size', 'color (optional)', 'user comment (optional)') ;
553              
554             $self->{INTERACTION}{DIE}->
555             (
556             DumpTree
557 0     0     { pairwise { ( $a, $b) } @keys, @{$ranges[$range_index]} },
  0            
  0            
558             "Range index $range_index: $error_message",
559             QUOTE_VALUES => 1,
560             TYPE_FILTERS => {'HASH' => sub {'HASH', undef, @keys }, }
561 0           ) ;
562             }
563              
564 0           @ranges = () ;
565              
566 0           while(@flattened)
567             {
568 0           push @ranges, [splice(@flattened, 0, $RANGE_DEFINITON_FIELDS)] ;
569             }
570              
571 0           return \@ranges ;
572             }
573              
574              
575             sub create_ranges_from_array_ref
576             {
577              
578             =head2 [P] create_ranges_from_array_ref($range_description)
579              
580             transforms the user supplied ranges into an internal format
581              
582             I -
583              
584             =over 2
585              
586             =item * $range_description - An array reference - See L
587              
588             =back
589              
590             I - I - Array ference - ranges in internal format
591              
592             I - Croaks with an error messge if the input data is invalid
593              
594             =cut
595              
596 0     0 0   my ($self, $range_description) = @_ ;
597              
598 0           my @flattened ;
599              
600             eval
601 0           {
602 0           @flattened = $self->flatten($range_description) ;
603             } ;
604              
605 0 0         if($EVAL_ERROR)
606             {
607 0           my ($error_message, $range_index) = @{ $EVAL_ERROR } ;
  0            
608 0           chomp $error_message ;
609              
610 2     2   1166 use Data::TreeDumper ;
  2         3  
  2         103  
611 2     2   8 use List::MoreUtils qw(pairwise) ;
  2         2  
  2         10  
612            
613 0           my @keys = ('name', 'size', 'color (optional)', 'user comment (optional)') ;
614              
615             $self->{INTERACTION}{DIE}->
616             (
617             DumpTree
618 0     0     { pairwise { ( $a, $b) } @keys, @{$range_description->[$range_index]} },
  0            
  0            
619             "Range index $range_index: $error_message",
620             QUOTE_VALUES => 1,
621             TYPE_FILTERS => {'HASH' => sub {'HASH', undef, @keys }, }
622 0           ) ;
623             }
624              
625 0           my @ranges ;
626              
627 0           while(@flattened)
628             {
629 0           push @ranges, [splice(@flattened, 0, $RANGE_DEFINITON_FIELDS)] ;
630             }
631            
632 0           return \@ranges ;
633             }
634              
635             #-------------------------------------------------------------------------------
636              
637             sub flatten
638             {
639            
640             =head2 [P] flatten($range_description)
641              
642             transforms the user supplied ranges into an internal format
643              
644             I -
645              
646             =over 2
647              
648             =item * $range_description - See L
649              
650             =back
651              
652             I - Nothing
653              
654             I - Croaks with an error messge if the input data is invalid
655              
656             =cut
657              
658 0     0 0   my $self = shift ;
659             #my $location = "$self->{FILE}:$self->{LINE}" ;
660              
661 0           my $index = -1 ;
662              
663 0           map
664             {
665 0           my $description = $_ ;
666 0           $index++ ;
667              
668 0 0         if(ref($description) eq 'ARRAY')
669             {
670 0 0         if(@{$description} == 0)
  0            
671             {
672 0           $self->{INTERACTION}{DIE}->(["Error: no elements in range description.", $index]) ;
673             }
674            
675 0 0   0     if(all {'' eq ref($_) || 'CODE' eq ref($_) } @{$description} )
  0 0          
  0            
676             {
677 0 0         if(@{$description} == 0)
  0 0          
    0          
    0          
    0          
    0          
678 0           {
679 0           $self->{INTERACTION}{DIE}->(["Error: no elements in range description.", $index]) ;
680             }
681             elsif(@{$description} == 1)
682 0           {
683 0 0         if('' eq ref($description->[0]))
684             {
685 0 0         $self->{INTERACTION}{DIE}->
686             ([
687             "Error: too few elements in range description ["
688 0           . join(', ', map {defined $_ ? $_ : 'undef'} @{$description})
  0            
689             . "]." ,
690             $index
691             ]) ;
692             }
693             else
694             {
695             # OK, will be called at gather time
696 0           push @{$description}, undef, undef, undef ;
  0            
697             }
698             }
699             elsif(@{$description} == 2)
700 0           {
701 0           push @{$description}, undef, undef ;
  0            
702             }
703             elsif(@{$description} == 3)
704 0           {
705 0           push @{$description}, undef ;
  0            
706             # make sure we get a default color
707 0 0 0       $description->[2] = undef if defined $description->[2] && $description->[2] eq $EMPTY_STRING ;
708             }
709             elsif(@{$description} == 4)
710 0           {
711             # make sure we get a default color
712 0 0 0       $description->[2] = undef if defined $description->[2] && $description->[2] eq $EMPTY_STRING ;
713             }
714             elsif(@{$description} > $RANGE_DEFINITON_FIELDS)
715             {
716 0 0         $self->{INTERACTION}{DIE}->
717             ([
718             "Error: too many elements in range description ["
719 0           . join(', ', map {defined $_ ? $_ : 'undef'} @{$description})
  0            
720             . "].",
721             $index
722             ]) ;
723             }
724            
725 0           @{$description} ;
  0            
726             }
727             else
728             {
729 0           $self->flatten(@{$description}) ;
  0            
730             }
731             }
732             else
733             {
734 0           $description
735             }
736             } @_
737             }
738              
739             #-------------------------------------------------------------------------------
740              
741             1 ;
742              
743             =head1 BUGS AND LIMITATIONS
744              
745             None so far.
746              
747             =head1 AUTHOR
748              
749             Nadim ibn hamouda el Khemir
750             CPAN ID: NKH
751             mailto: nadim@cpan.org
752              
753             =head1 COPYRIGHT AND LICENSE
754              
755             Copyright Nadim Khemir 2010.
756              
757             This program is free software; you can redistribute it and/or
758             modify it under the terms of either:
759              
760             =over 4
761              
762             =item * the GNU General Public License as published by the Free
763             Software Foundation; either version 1, or (at your option) any
764             later version, or
765              
766             =item * the Artistic License version 2.0.
767              
768             =back
769              
770             =head1 SUPPORT
771              
772             You can find documentation for this module with the perldoc command.
773              
774             perldoc Data::HexDump::Range
775              
776             You can also look for information at:
777              
778             =over 4
779              
780             =item * AnnoCPAN: Annotated CPAN documentation
781              
782             L
783              
784             =item * RT: CPAN's request tracker
785              
786             Please report any bugs or feature requests to L .
787              
788             We will be notified, and then you'll automatically be notified of progress on
789             your bug as we make changes.
790              
791             =item * Search CPAN
792              
793             L
794              
795             =back
796              
797             =head1 SEE ALSO
798              
799             L
800              
801             =cut