File Coverage

blib/lib/DBIx/Class/Admin/Usage.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


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;