makes search_related on extended rels without the optimized version work. involves...
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Admin / Usage.pm
1 package     # hide from PAUSE
2     DBIx::Class::Admin::Usage;
3
4
5 use base 'Getopt::Long::Descriptive::Usage';
6
7 use base 'Class::Accessor::Grouped';
8
9 use Class::C3;
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 formated 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<DBIx::Class/CONTRIBUTORS>',
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;