File Coverage

lib/Pcore/Core/CLI.pm
Criterion Covered Total %
statement 94 312 30.1
branch 17 146 11.6
condition 5 53 9.4
subroutine 16 31 51.6
pod 1 5 20.0
total 133 547 24.3


line stmt bran cond sub pod time code
1             package Pcore::Core::CLI;
2              
3 5     5   36 use Pcore -class;
  5         13  
  5         37  
4 5     5   48 use Pcore::Util::Scalar qw[is_ref is_plain_arrayref];
  5         12  
  5         49  
5 5     5   2815 use Getopt::Long qw[];
  5         54860  
  5         204  
6 5     5   2414 use Pcore::Core::CLI::Opt;
  5         24  
  5         262  
7 5     5   2671 use Pcore::Core::CLI::Arg;
  5         20  
  5         214  
8 5     5   45 use Config;
  5         15  
  5         12804  
9              
10             has class => ( is => 'ro', isa => Str, required => 1 );
11             has cmd_path => ( is => 'ro', isa => ArrayRef, default => sub { [] } ); # array of used cli commands
12              
13             has spec => ( is => 'lazy', isa => HashRef, init_arg => undef );
14             has cmd => ( is => 'lazy', isa => ArrayRef, init_arg => undef );
15             has opt => ( is => 'lazy', isa => HashRef, init_arg => undef );
16             has arg => ( is => 'lazy', isa => ArrayRef, init_arg => undef );
17              
18             has is_cmd => ( is => 'lazy', isa => Bool, init_arg => undef );
19             has _cmd_index => ( is => 'lazy', isa => HashRef, init_arg => undef );
20              
21 5     5   71 sub _build_spec ($self) {
  5         12  
  5         11  
22 5         26 return $self->_get_class_spec;
23             }
24              
25 5     5   63 sub _build_cmd ($self) {
  5         13  
  5         11  
26 5         15 my $cmd = [];
27              
28 5 50       99 if ( my $cli_cmd = $self->spec->{cmd} ) {
29 0         0 my @classes;
30              
31 0         0 for my $cli_cmd_class ( $cli_cmd->@* ) {
32 0 0       0 if ( substr( $cli_cmd_class, -2, 2 ) eq q[::] ) {
33 0         0 my $ns = $cli_cmd_class;
34              
35 0         0 my $ns_path = $ns =~ s[::][/]smgr;
36              
37 0         0 for (@INC) {
38 0 0       0 next if ref;
39              
40 0         0 my $path = $_ . q[/] . $ns_path;
41              
42 0 0       0 next if !-d $path;
43              
44 0         0 for my $fn ( P->file->read_dir( $path, full_path => 0 )->@* ) {
45 0 0 0     0 if ( $fn =~ /\A(.+)[.]pm\z/sm && -f "$path/$fn" ) {
46 0         0 push @classes, $ns . $1;
47             }
48             }
49             }
50             }
51             else {
52 0         0 push @classes, $cli_cmd_class;
53             }
54             }
55              
56 0         0 my $index;
57              
58 0         0 for my $class (@classes) {
59 0 0       0 next if $index->{$class};
60              
61 0         0 $index->{$class} = 1;
62              
63 0         0 $class = P->class->load($class);
64              
65 0 0 0     0 if ( $class->can('does') && $class->does('Pcore::Core::CLI::Cmd') ) {
66 0         0 push $cmd->@*, $class;
67             }
68             }
69             }
70              
71 5         148 return $cmd;
72             }
73              
74 5     5   62 sub _build_opt ($self) {
  5         11  
  5         10  
75 5         18 my $opt = {};
76              
77 5         35 my $index = {
78             help => undef,
79             h => undef,
80             q[?] => undef,
81             version => undef,
82             scan_deps => undef,
83             };
84              
85 5 50       108 if ( my $cli_opt = $self->spec->{opt} ) {
86 0         0 for my $name ( keys $cli_opt->%* ) {
87 0 0       0 die qq[Option "$name" is duplicated] if exists $index->{$name};
88              
89 0         0 $opt->{$name} = Pcore::Core::CLI::Opt->new( { $cli_opt->{$name}->%*, name => $name } ); ## no critic qw[ValuesAndExpressions::ProhibitCommaSeparatedStatements]
90              
91 0         0 $index->{$name} = 1;
92              
93 0 0       0 if ( $opt->{$name}->short ) {
94 0 0       0 die qq[Short name "@{[$opt->{$name}->short]}" for option "$name" is duplicated] if exists $index->{ $opt->{$name}->short };
  0         0  
95              
96 0         0 $index->{ $opt->{$name}->short } = 1;
97             }
98             }
99             }
100              
101 5         150 return $opt;
102             }
103              
104 5     5   70 sub _build_arg ($self) {
  5         19  
  5         11  
105 5         15 my $args = [];
106              
107 5         14 my $index = {};
108              
109 5         13 my $next_arg = 0; # 0 - any, 1 - min = 0, 2 - no arg
110              
111 5 50       107 if ( my $cli_arg = $self->spec->{arg} ) {
112 0         0 for ( my $i = 0; $i <= $cli_arg->$#*; $i += 2 ) {
113 0 0       0 die q[Can't have other arguments after slurpy argument] if $next_arg == 2;
114              
115 0         0 $cli_arg->[ $i + 1 ]->{name} = $cli_arg->[$i];
116              
117 0         0 my $arg = Pcore::Core::CLI::Arg->new( $cli_arg->[ $i + 1 ] );
118              
119 0 0 0     0 die q[Can't have required argument after not mandatory argument] if $next_arg == 1 && $arg->min != 0;
120              
121 0 0       0 die qq[Argument "@{[$arg->name]}" is duplicated] if exists $index->{ $arg->name };
  0         0  
122              
123 0 0       0 if ( !$arg->max ) { # slurpy arg
    0          
124 0         0 $next_arg = 2;
125             }
126             elsif ( $arg->min == 0 ) {
127 0         0 $next_arg = 1;
128             }
129              
130 0         0 push $args->@*, $arg;
131              
132 0         0 $index->{ $arg->name } = 1;
133             }
134             }
135              
136 5         142 return $args;
137             }
138              
139 5     5   61 sub _build__cmd_index ($self) {
  5         13  
  5         13  
140 5         15 my $index = {};
141              
142 5         103 for my $class ( $self->cmd->@* ) {
143 0         0 for my $cmd ( $self->_get_class_cmd($class)->@* ) {
144 0 0       0 die qq[Command "$cmd" is duplicated] if exists $index->{$cmd};
145              
146 0         0 $index->{$cmd} = $class;
147             }
148             }
149              
150 5         125 return $index;
151             }
152              
153 5     5   63 sub _build_is_cmd ($self) {
  5         12  
  5         10  
154 5 50       100 return $self->_cmd_index->%* ? 1 : 0;
155             }
156              
157 5     5 0 61 sub run ( $self, $argv ) {
  5         15  
  5         14  
  5         13  
158              
159             # redirect, if class is defined
160 5 50       110 if ( $self->spec->{class} ) {
161 0         0 require $self->spec->{class} =~ s[::][/]smgr . '.pm';
162              
163 0         0 return __PACKAGE__->new( { class => $self->spec->{class} } )->run($argv);
164             }
165              
166             # make a copy
167 5 50       75 my @argv = $argv ? $argv->@* : ();
168              
169 5 50       105 if ( $self->is_cmd ) {
170 0         0 return $self->_parse_cmd( \@argv );
171             }
172             else {
173 5         191 return $self->_parse_opt( \@argv );
174             }
175             }
176              
177 0     0   0 sub _parse_cmd ( $self, $argv ) {
  0         0  
  0         0  
  0         0  
178 0         0 my $res = {
179             cmd => undef,
180             opt => {},
181             rest => undef,
182             };
183              
184 0         0 my $parser = Getopt::Long::Parser->new(
185             config => [ #
186             'no_auto_abbrev',
187             'no_getopt_compat',
188             'gnu_compat',
189             'no_require_order',
190             'permute',
191             'bundling',
192             'no_ignore_case',
193             'pass_through',
194             ]
195             );
196              
197             $parser->getoptionsfromarray(
198             $argv,
199             $res->{opt},
200 0         0 'help|h|?',
201             'version',
202             ( $ENV->can_scan_deps ? 'scan-deps' : () ),
203 0     0   0 '<>' => sub ($arg) {
  0         0  
204 0 0 0     0 if ( !$res->{cmd} && substr( $arg, 0, 1 ) ne q[-] ) {
205 0         0 $res->{cmd} = $arg;
206             }
207             else {
208 0         0 push $res->{rest}->@*, $arg;
209             }
210              
211 0         0 return;
212             }
213 0 0       0 );
214              
215 0 0 0     0 push $res->{rest}->@*, $argv->@* if defined $argv && $argv->@*;
216              
217             # process --scan-deps option
218 0 0 0     0 $ENV->scan_deps if $ENV->can_scan_deps && $res->{opt}->{'scan-deps'};
219              
220 0 0       0 if ( $res->{opt}->{version} ) {
    0          
221 0         0 return $self->help_version;
222             }
223             elsif ( !defined $res->{cmd} ) {
224 0 0       0 if ( $res->{opt}->{help} ) {
225 0         0 return $self->help;
226             }
227             else {
228 0         0 return $self->help_usage;
229             }
230             }
231             else {
232 0         0 my $possible_commands = [];
233              
234 0         0 my @index = keys $self->_cmd_index->%*;
235              
236 0         0 for my $cmd_name (@index) {
237 0 0       0 push $possible_commands->@*, $cmd_name if index( $cmd_name, $res->{cmd} ) == 0;
238             }
239              
240 0 0       0 if ( !$possible_commands->@* ) {
    0          
241 0         0 return $self->help_usage( [qq[command "$res->{cmd}" is unknown]] );
242             }
243             elsif ( $possible_commands->@* > 1 ) {
244 0         0 return $self->help_error( qq[command "$res->{cmd}" is ambiguous:$LF ] . join q[ ], $possible_commands->@* );
245             }
246             else {
247 0 0       0 unshift $res->{rest}->@*, '--help' if $res->{opt}->{help};
248              
249 0         0 my $class = $self->_cmd_index->{ $possible_commands->[0] };
250              
251 0         0 push $self->cmd_path->@*, $self->_get_class_cmd($class)->[0];
252              
253 0         0 return __PACKAGE__->new( { class => $class, cmd_path => $self->cmd_path } )->run( $res->{rest} );
254             }
255             }
256             }
257              
258 5     5   14 sub _parse_opt ( $self, $argv ) {
  5         24  
  5         20  
  5         12  
259 5         39 my $res = {
260             error => undef,
261             opt => {},
262             arg => {},
263             rest => undef,
264             };
265              
266             # build cli spec for Getopt::Long
267 5         15 my $cli_spec = [];
268              
269 5         108 for my $opt ( values $self->opt->%* ) {
270 0         0 push $cli_spec->@*, $opt->getopt_spec;
271             }
272              
273 5         113 my $parser = Getopt::Long::Parser->new(
274             config => [ #
275             'auto_abbrev',
276             'no_getopt_compat', # do not allow + to start options
277             'gnu_compat',
278             'no_require_order',
279             'permute',
280             'bundling',
281             'no_ignore_case',
282             'no_pass_through',
283             ]
284             );
285              
286 5         1009 my $parsed_args = [];
287              
288             {
289 5     5   45 no warnings qw[redefine];
  5         12  
  5         14387  
  5         29  
290              
291             local $SIG{__WARN__} = sub {
292 0     0   0 push $res->{error}->@*, join q[], @_;
293              
294 0         0 $res->{error}->[-1] =~ s/\n\z//sm;
295              
296 0         0 return;
297 5         59 };
298              
299             $parser->getoptionsfromarray(
300             $argv,
301             $res->{opt},
302 0         0 $cli_spec->@*,
303             'version',
304             'help|h|?',
305             ( $ENV->can_scan_deps ? 'scan-deps' : () ),
306 0     0   0 '<>' => sub ($arg) {
  0         0  
307 0         0 push $parsed_args->@*, $arg;
308              
309 0         0 return;
310             }
311 5 50       144 );
312              
313 5 50 33     2382 push $res->{rest}->@*, $argv->@* if defined $argv && $argv->@*;
314             }
315              
316             # process --scan-deps option
317 5 50 33     178 $ENV->scan_deps if $ENV->can_scan_deps && $res->{opt}->{'scan-deps'};
318              
319 5 50       105 if ( $res->{opt}->{version} ) {
    50          
    50          
320 0         0 return $self->help_version;
321             }
322             elsif ( $res->{opt}->{help} ) {
323 0         0 return $self->help;
324             }
325             elsif ( $res->{error} ) {
326 0         0 return $self->help_usage( $res->{error} );
327             }
328              
329             # validate options
330 5         112 for my $opt ( values $self->opt->%* ) {
331 0 0       0 if ( my $error_msg = $opt->validate( $res->{opt} ) ) {
332 0         0 return $self->help_usage( [$error_msg] );
333             }
334             }
335              
336             # parse and validate args
337 5         148 for my $arg ( $self->arg->@* ) {
338 0 0       0 if ( my $error_msg = $arg->parse( $parsed_args, $res->{arg} ) ) {
339 0         0 return $self->help_usage( [$error_msg] );
340             }
341             }
342              
343 5 50       69 return $self->help_usage( [qq[unexpected arguments]] ) if $parsed_args->@*;
344              
345             # validate cli
346 5         27 my $class = $self->class;
347              
348 5 50 33     72 if ( $class->can('CLI_VALIDATE') && defined( my $error_msg = $class->CLI_VALIDATE( $res->{opt}, $res->{arg}, $res->{rest} ) ) ) {
349 0         0 return $self->help_error($error_msg);
350             }
351              
352             # store results globally
353 5         23 $ENV->{cli} = $res;
354              
355             # run
356 5 50       49 if ( $class->can('CLI_RUN') ) {
357 0         0 return $class->CLI_RUN( $res->{opt}, $res->{arg}, $res->{rest} );
358             }
359             else {
360 5         68 return $res;
361             }
362             }
363              
364 5     5   12 sub _get_class_spec ( $self, $class = undef ) {
  5         12  
  5         12  
  5         12  
365 5   33     61 $class //= $self->class;
366              
367 5 50 33     124 if ( $class->can('CLI') && ( my $spec = $class->CLI ) ) {
368 0 0       0 if ( !is_ref $spec ) {
    0          
369 0         0 $spec = { class => $spec };
370             }
371             elsif ( is_plain_arrayref $spec ) {
372 0         0 $spec = { cmd => $spec };
373             }
374             else {
375 0 0 0     0 $spec->{cmd} = [ $spec->{cmd} ] if $spec->{cmd} && !is_ref $spec->{cmd};
376              
377 0 0 0     0 $spec->{name} = [ $spec->{name} ] if $spec->{name} && !is_ref $spec->{name};
378             }
379              
380 0         0 return $spec;
381             }
382             else {
383 5         121 return {};
384             }
385             }
386              
387 0     0     sub _get_class_cmd ( $self, $class = undef ) {
  0            
  0            
  0            
388 0 0         my $spec = $class ? $self->_get_class_spec($class) : $self->spec;
389              
390 0 0         if ( $spec->{name} ) {
391 0           return $spec->{name};
392             }
393             else {
394 0   0       $class //= $self->class;
395              
396 0           return [ lc $class =~ s/\A.*:://smr ];
397             }
398             }
399              
400             # HELP
401 0     0     sub _help_class_abstract ( $self, $class = undef ) {
  0            
  0            
  0            
402 0 0         my $spec = $class ? $self->_get_class_spec($class) : $self->spec;
403              
404 0   0       return $spec->{abstract} // q[];
405             }
406              
407 0     0     sub _help_usage_string ($self) {
  0            
  0            
408 0           my $usage = join q[ ], P->path( $ENV->{SCRIPT_NAME} )->filename, $self->cmd_path->@*;
409              
410 0 0         if ( $self->is_cmd ) {
411 0           $usage .= ' [COMMAND] [OPTION]...';
412             }
413             else {
414 0 0         $usage .= ' [OPTION]...' if $self->opt->%*;
415              
416 0 0         if ( $self->arg->@* ) {
417 0           my @args;
418              
419 0           for my $arg ( $self->arg->@* ) {
420 0           push @args, $arg->help_spec;
421             }
422              
423 0           $usage .= q[ ] . join q[ ], @args;
424             }
425             }
426              
427 0           return $usage;
428             }
429              
430 0     0     sub _help_alias ($self) {
  0            
  0            
431 0           my $cmd = $self->_get_class_cmd;
432              
433 0           shift $cmd->@*;
434              
435 0 0         if ( $cmd->@* ) {
436 0           return 'aliases: ' . join q[ ], sort $cmd->@*;
437             }
438             else {
439 0           return q[];
440             }
441             }
442              
443 0     0     sub _help ($self) {
  0            
  0            
444 0   0       my $help = $self->spec->{help} // q[];
445              
446 0 0         if ($help) {
447 0           $help =~ s/^/ /smg;
448              
449 0           $help =~ s/\n+\z//sm;
450             }
451              
452 0           return $help;
453             }
454              
455 0     0     sub _help_usage ($self) {
  0            
  0            
456 0           my $help;
457              
458 0           my $list = {};
459              
460 0 0         if ( $self->is_cmd ) {
461 0           $help = 'list of commands:' . $LF . $LF;
462              
463 0           for my $class ( $self->cmd->@* ) {
464 0           $list->{ $self->_get_class_cmd($class)->[0] } = [ $self->_get_class_cmd($class)->[0], $self->_help_class_abstract($class) ];
465             }
466             }
467             else {
468 0           $help = 'options ([+] - can be repeated, [!] - is required):' . $LF . $LF;
469              
470 0           for my $opt ( values $self->opt->%* ) {
471 0   0       $list->{ $opt->name } = [ $opt->help_spec, $opt->desc // q[] ];
472             }
473             }
474              
475 0 0         return q[] if !$list->%*;
476              
477 0           my $max_key_len = 10;
478              
479 0           for ( values $list->%* ) {
480 0 0         $max_key_len = length $_->[0] if length $_->[0] > $max_key_len;
481              
482             # remove \n from desc
483 0           $_->[1] =~ s/\n+\z//smg;
484             }
485              
486 0           my $desc_indent = $LF . q[ ] . ( q[ ] x $max_key_len );
487              
488 0           $help .= join $LF, map { sprintf( " %-${max_key_len}s ", $list->{$_}->[0] ) . $list->{$_}->[1] =~ s/\n/$desc_indent/smgr } sort keys $list->%*;
  0            
489              
490 0   0       return $help // q[];
491             }
492              
493 0     0     sub _help_footer ($self) {
  0            
  0            
494 0           my @opt = qw[--help -h -? --version];
495              
496 0 0         push @opt, '--scan-deps' if $ENV->can_scan_deps;
497              
498 0           return '(global options: ' . join( q[, ], @opt ) . q[)];
499             }
500              
501 0     0 1   sub help ($self) {
  0            
  0            
502 0           say $self->_help_usage_string, $LF;
503              
504 0 0         if ( my $alias = $self->_help_alias ) {
505 0           say $alias, $LF;
506             }
507              
508 0 0         if ( my $abstract = $self->_help_class_abstract ) {
509 0           say $abstract, $LF;
510             }
511              
512 0 0         if ( my $help = $self->_help ) {
513 0           say $help, $LF;
514             }
515              
516 0 0         if ( my $help_usage = $self->_help_usage ) {
517 0           say $help_usage, $LF;
518             }
519              
520 0           say $self->_help_footer, $LF;
521              
522 0           exit 2;
523             }
524              
525 0     0 0   sub help_usage ( $self, $invalid_options = undef ) {
  0            
  0            
  0            
526 0 0         if ($invalid_options) {
527 0           for ( $invalid_options->@* ) {
528 0           say;
529             }
530              
531 0           print $LF;
532             }
533              
534 0           say $self->_help_usage_string, $LF;
535              
536 0 0         if ( my $abstract = $self->_help_class_abstract ) {
537 0           say $abstract, $LF;
538             }
539              
540 0 0         if ( my $help_usage = $self->_help_usage ) {
541 0           say $help_usage, $LF;
542             }
543              
544 0           say $self->_help_footer, $LF;
545              
546 0           exit 2;
547             }
548              
549 0     0 0   sub help_version ($self) {
  0            
  0            
550 0 0         if ( $ENV->dist ) {
551 0           say $ENV->dist->version_string;
552             }
553             else {
554 0 0         say join q[ ], $ENV->{SCRIPT_NAME}, ( $main::VERSION ? version->new($main::VERSION)->normal : () );
555             }
556              
557 0 0 0       say $ENV->pcore->version_string if !$ENV->dist || $ENV->dist->name ne $ENV->pcore->name;
558              
559 0           say 'Perl ' . $^V->normal . " $Config{archname}";
560              
561 0 0         say join $LF, q[], 'Image path: ' . $ENV{PAR_PROGNAME}, 'Temp dir: ' . $ENV{PAR_TEMP} if $ENV->is_par;
562              
563 0           exit 2;
564             }
565              
566 0     0 0   sub help_error ( $self, $msg ) {
  0            
  0            
  0            
567 0 0         say $msg, $LF if defined $msg;
568              
569 0           exit 2;
570             }
571              
572             1;
573             ## -----SOURCE FILTER LOG BEGIN-----
574             ##
575             ## PerlCritic profile "pcore-script" policy violations:
576             ## +------+----------------------+----------------------------------------------------------------------------------------------------------------+
577             ## | Sev. | Lines | Policy |
578             ## |======+======================+================================================================================================================|
579             ## | 3 | 45 | ControlStructures::ProhibitDeepNests - Code structure is deeply nested |
580             ## |------+----------------------+----------------------------------------------------------------------------------------------------------------|
581             ## | 3 | 343 | ValuesAndExpressions::ProhibitInterpolationOfLiterals - Useless interpolation of literal string |
582             ## |------+----------------------+----------------------------------------------------------------------------------------------------------------|
583             ## | 3 | 508, 536 | NamingConventions::ProhibitAmbiguousNames - Ambiguously named variable "abstract" |
584             ## |------+----------------------+----------------------------------------------------------------------------------------------------------------|
585             ## | 2 | 112 | ControlStructures::ProhibitCStyleForLoops - C-style "for" loop used |
586             ## +------+----------------------+----------------------------------------------------------------------------------------------------------------+
587             ##
588             ## -----SOURCE FILTER LOG END-----
589             __END__
590             =pod
591              
592             =encoding utf8
593              
594             =head1 NAME
595              
596             Pcore::Core::CLI
597              
598             =head1 SYNOPSIS
599              
600             # redirect CLI processing
601             sub CLI ($self) {
602             return 'Other::Class';
603             }
604              
605             # CLI commands hub
606             sub CLI {
607             return ['Cmd1', 'Cmd2', 'Cmd::Modules::' ];
608             }
609              
610             # or
611             sub CLI {
612             return {
613             abstract => 'Abstract description',
614             help => <<'HELP',
615             Full CLI help
616             HELP
617             cmd => ['Cmd1', 'Cmd2', 'Cmd::Modules::' ],
618             };
619             }
620              
621             # CLI command class
622             with qw[Pcore::Core::CLI::Cmd];
623              
624             sub CLI ($self) {
625             return {
626             name => 'command',
627             abstract => 'abstract desc',
628             help => undef,
629             opt => {},
630             arg => {},
631             };
632             }
633              
634             sub CLI_VALIDATE ( $self, $opt, $arg, $rest ) {
635             return;
636             }
637              
638             sub CLI_RUN ( $self, $opt, $arg, $rest ) {
639             return;
640             }
641              
642             =head1 DESCRIPTION
643              
644             CLI class can be either a CLI "commands hub" or "command". Command hub - only keep other CLI commands together, it doesn't do anything else. CLI command must be a consumer of Pcore::Core::CLI::Cmd role.
645              
646             =head1 METHODS
647              
648             =head2 CLI ($self)
649              
650             Return CLI specification as Str, ArrayRef of HashRef. Str - name of class to redirect CLI processor to. ArrayRef - list of CLI commands classes or namespaces. HashRef - full CLI specification, where supported keys are:
651              
652             =over
653              
654             =item * cmd - CLI commands classes names or namespace. Namespace should be specified with '::' at the end, eg.: 'My::CLI::Packages::'. cmd can be Str or ArrayRef[Str];
655              
656             =item * abstract - short description;
657              
658             =item * help - full help, can be multiline string;
659              
660             =item * name - CLI command name, can be a Str or ArrayRef[Str], if command has aliases. If command name is not specified - if will be parsed from the last segment of the class name;
661              
662             =item * opt - HashRef, options specification;
663              
664             =item * arg - ArrayRef, arguments specification;
665              
666             =back
667              
668             =head2 CLI_VALIDATE ( $self, $opt, $arg, $rest )
669              
670             Should validate parsed CLI data and return Str in case of error or undef.
671              
672             =head2 CLI_RUN ( $self, $opt, $arg, $rest )
673              
674             =head1 SEE ALSO
675              
676             =cut