From: Gordon Irving <goraxe@cpan.org>
Date: Sat, 20 Feb 2010 19:35:00 +0000 (+0000)
Subject: add G:L:D sub classes to generate pod
X-Git-Tag: v0.08120~15^2~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6c29f38143062ac50a77abd32ebe05613b37d11;p=dbsrgits%2FDBIx-Class.git

add G:L:D sub classes to generate pod
---

diff --git a/lib/DBIx/Class/Admin/Descriptive.pm b/lib/DBIx/Class/Admin/Descriptive.pm
new file mode 100644
index 0000000..45fcb19
--- /dev/null
+++ b/lib/DBIx/Class/Admin/Descriptive.pm
@@ -0,0 +1,10 @@
+package     # hide from PAUSE
+    DBIx::Class::Admin::Descriptive;
+
+use DBIx::Class::Admin::Usage;
+
+use base 'Getopt::Long::Descriptive';
+
+sub usage_class { 'DBIx::Class::Admin::Usage'; }
+
+1;
diff --git a/lib/DBIx/Class/Admin/Usage.pm b/lib/DBIx/Class/Admin/Usage.pm
new file mode 100644
index 0000000..d3e16e5
--- /dev/null
+++ b/lib/DBIx/Class/Admin/Usage.pm
@@ -0,0 +1,72 @@
+package     # hide from PAUSE
+    DBIx::Class::Admin::Usage;
+
+
+use base 'Getopt::Long::Descriptive::Usage';
+
+use base 'Class::Accessor::Grouped';
+
+use Class::C3;
+
+__PACKAGE__->mk_group_accessors('simple', 'synopsis', 'short_description');
+
+sub prog_name {
+    Getopt::Long::Descriptive::prog_name();
+}
+
+sub set_simple {
+    my ($self,$field, $value) = @_;
+    my $prog_name = prog_name();
+    $value =~ s/%c/$prog_name/g;
+    $self->next::method($field, $value);
+}
+
+
+=head2 pod
+
+This returns the usage formated as a pod document
+
+=cut
+
+
+sub pod {
+  my ($self) = @_;
+  return join qq{\n}, $self->pod_leader_text, $self->pod_option_text;
+}
+
+sub pod_leader_text {
+  my ($self) = @_;
+
+  return qq{=head1 NAME\n\n}.prog_name()." - ".$self->short_description().qq{\n\n}.
+         qq{=head1 SYNOPSIS\n\n}.$self->leader_text().qq{\n}.$self->synopsis().qq{\n\n};
+
+}
+
+
+sub pod_option_text {
+  my ($self) = @_;
+  my @options = @{ $self->{options} || [] };
+  my $string = q{};
+  return $string unless @options;
+
+  $string .= "=head1 OPTIONS\n\n=over\n\n";
+
+  foreach my $opt (@options) {
+    my $spec = $opt->{spec};
+    my $desc = $opt->{desc};
+    if ($desc eq 'spacer') {
+        $string .= "=back\n\n=head2 $spec\n\n=cut\n\n=over\n\n";
+        next;
+    }
+
+    $spec = Getopt::Long::Descriptive->_strip_assignment($spec);
+    $string .= "=item " . join " or ", map { length > 1 ? "B<--$_>" : "B<-$_>" }
+                             split /\|/, $spec; 
+    $string .= "\n\n$desc\n\n=cut\n\n";
+
+  }
+  $string .= "=back\n\n";
+  return $string;
+}
+
+1;