line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package # hide from PAUSE |
2
|
|
|
|
|
|
|
DBIx::Class::Admin::Usage; |
3
|
|
|
|
|
|
|
|
4
|
2
|
|
|
2
|
|
7794
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
87
|
|
5
|
2
|
|
|
2
|
|
14
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
57
|
|
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
9
|
use base 'Getopt::Long::Descriptive::Usage'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
1137
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use base 'Class::Accessor::Grouped'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors('simple', 'synopsis', 'short_description'); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub prog_name { |
14
|
|
|
|
|
|
|
Getopt::Long::Descriptive::prog_name(); |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub set_simple { |
18
|
|
|
|
|
|
|
my ($self,$field, $value) = @_; |
19
|
|
|
|
|
|
|
my $prog_name = prog_name(); |
20
|
|
|
|
|
|
|
$value =~ s/%c/$prog_name/g; |
21
|
|
|
|
|
|
|
$self->next::method($field, $value); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# This returns the usage formatted as a pod document |
27
|
|
|
|
|
|
|
sub pod { |
28
|
|
|
|
|
|
|
my ($self) = @_; |
29
|
|
|
|
|
|
|
return join qq{\n}, $self->pod_leader_text, $self->pod_option_text, $self->pod_authorlic_text; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub pod_leader_text { |
33
|
|
|
|
|
|
|
my ($self) = @_; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
return qq{=head1 NAME\n\n}.prog_name()." - ".$self->short_description().qq{\n\n}. |
36
|
|
|
|
|
|
|
qq{=head1 SYNOPSIS\n\n}.$self->leader_text().qq{\n}.$self->synopsis().qq{\n\n}; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub pod_authorlic_text { |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
return join ("\n\n", |
43
|
|
|
|
|
|
|
'=head1 AUTHORS', |
44
|
|
|
|
|
|
|
'See L', |
45
|
|
|
|
|
|
|
'=head1 LICENSE', |
46
|
|
|
|
|
|
|
'You may distribute this code under the same terms as Perl itself', |
47
|
|
|
|
|
|
|
'=cut', |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub pod_option_text { |
53
|
|
|
|
|
|
|
my ($self) = @_; |
54
|
|
|
|
|
|
|
my @options = @{ $self->{options} || [] }; |
55
|
|
|
|
|
|
|
my $string = q{}; |
56
|
|
|
|
|
|
|
return $string unless @options; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$string .= "=head1 OPTIONS\n\n=over\n\n"; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
foreach my $opt (@options) { |
61
|
|
|
|
|
|
|
my $spec = $opt->{spec}; |
62
|
|
|
|
|
|
|
my $desc = $opt->{desc}; |
63
|
|
|
|
|
|
|
next if ($desc eq 'hidden'); |
64
|
|
|
|
|
|
|
if ($desc eq 'spacer') { |
65
|
|
|
|
|
|
|
$string .= "=back\n\n=head2 $spec\n\n=cut\n\n=over\n\n"; |
66
|
|
|
|
|
|
|
next; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
$spec = Getopt::Long::Descriptive->_strip_assignment($spec); |
70
|
|
|
|
|
|
|
$string .= "=item " . join " or ", map { length > 1 ? "B<--$_>" : "B<-$_>" } |
71
|
|
|
|
|
|
|
split /\|/, $spec; |
72
|
|
|
|
|
|
|
$string .= "\n\n$desc\n\n=cut\n\n"; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
$string .= "=back\n\n"; |
76
|
|
|
|
|
|
|
return $string; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
1; |