Merge 'trunk' into 'dbicadmin_pod'
Peter Rabbitson [Sun, 21 Feb 2010 11:34:39 +0000 (11:34 +0000)]
r8759@Thesaurus (orig r8746):  ribasushi | 2010-02-19 00:30:37 +0100
Fix bogus test
r8760@Thesaurus (orig r8747):  ribasushi | 2010-02-19 00:34:22 +0100
Retire useless abstraction (all rdbms need this anyway)
r8761@Thesaurus (orig r8748):  ribasushi | 2010-02-19 00:35:01 +0100
Fix count of group_by over aliased function
r8765@Thesaurus (orig r8752):  ribasushi | 2010-02-19 10:11:20 +0100
 r8497@Thesaurus (orig r8484):  ribasushi | 2010-01-31 10:06:29 +0100
 Branch to unify mandatory PK handling
 r8498@Thesaurus (orig r8485):  ribasushi | 2010-01-31 10:20:36 +0100
 This is not really used for anything (same code in DBI)
 r8499@Thesaurus (orig r8486):  ribasushi | 2010-01-31 10:25:55 +0100
 Helper primary_columns wrapper to throw if a PK is not defined
 r8500@Thesaurus (orig r8487):  ribasushi | 2010-01-31 11:07:25 +0100
 Stupid errors
 r8501@Thesaurus (orig r8488):  ribasushi | 2010-01-31 12:18:57 +0100
 Saner handling of nonexistent/partial conditions
 r8762@Thesaurus (orig r8749):  ribasushi | 2010-02-19 10:07:40 +0100
 trap unresolvable conditions due to incomplete relationship specification
 r8764@Thesaurus (orig r8751):  ribasushi | 2010-02-19 10:11:09 +0100
 Changes

r8767@Thesaurus (orig r8754):  ribasushi | 2010-02-19 11:14:30 +0100
Fix for RT54697
r8769@Thesaurus (orig r8756):  caelum | 2010-02-19 12:21:53 +0100
bump Test::Pod dep
r8770@Thesaurus (orig r8757):  caelum | 2010-02-19 12:23:07 +0100
bump Test::Pod dep in Optional::Dependencies too
r8773@Thesaurus (orig r8760):  rabbit | 2010-02-19 16:41:24 +0100
Fix stupid sqlt parser regression
r8774@Thesaurus (orig r8761):  rabbit | 2010-02-19 16:42:40 +0100
Port remaining tests to the Opt::Dep reposiory
r8775@Thesaurus (orig r8762):  rabbit | 2010-02-19 16:43:36 +0100
Some test cleanups
r8780@Thesaurus (orig r8767):  rabbit | 2010-02-20 20:59:20 +0100
Test::Deep actually isn't required
r8786@Thesaurus (orig r8773):  rabbit | 2010-02-20 22:21:41 +0100
These are core for perl 5.8
r8787@Thesaurus (orig r8774):  rabbit | 2010-02-21 10:52:40 +0100
Shuffle tests a bit
r8788@Thesaurus (orig r8775):  rabbit | 2010-02-21 12:09:25 +0100
Bogus require
r8789@Thesaurus (orig r8776):  rabbit | 2010-02-21 12:09:48 +0100
Bogus unnecessary dep

.gitignore
Makefile.PL
lib/DBIx/Class/Admin/Descriptive.pm [new file with mode: 0644]
lib/DBIx/Class/Admin/Usage.pm [new file with mode: 0644]
script/dbicadmin
t/03podcoverage.t

index 5aa3840..ea0a947 100644 (file)
@@ -10,5 +10,6 @@ _build/
 blib/
 inc/
 lib/DBIx/Class/Optional/Dependencies.pod
+lib/dbicadmin.pod
 pm_to_blib
 t/var/
index a8c2065..f01351d 100644 (file)
@@ -8,6 +8,11 @@ use 5.008001;
 use FindBin;
 use lib "$FindBin::Bin/lib";
 
+# adjust ENV for $AUTHOR system() calls
+use Config;
+$ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
+
+
 ###
 ### DO NOT ADD OPTIONAL DEPENDENCIES HERE, EVEN AS recommends()
 ### All of them should go to DBIx::Class::Optional::Dependencies
@@ -54,7 +59,7 @@ my $reqs = {
   test_requires => { %$test_requires },
 };
 
-# re-build README and require extra modules for testing if we're in a checkout
+# autogenerate docs and require extra modules for testing if we're in a checkout
 if ($Module::Install::AUTHOR) {
 
   print "Regenerating README\n";
@@ -65,6 +70,9 @@ if ($Module::Install::AUTHOR) {
     unlink 'MANIFEST';
   }
 
+  print "Regenerating dbicadmin.pod\n";
+  system('perl script/dbicadmin --pod > lib/dbicadmin.pod');
+
   print "Regenerating Optional/Dependencies.pod\n";
   require DBIx::Class::Optional::Dependencies;
   DBIx::Class::Optional::Dependencies->_gen_pod;
diff --git a/lib/DBIx/Class/Admin/Descriptive.pm b/lib/DBIx/Class/Admin/Descriptive.pm
new file mode 100644 (file)
index 0000000..45fcb19
--- /dev/null
@@ -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 (file)
index 0000000..d3e16e5
--- /dev/null
@@ -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;
index 2b6a456..975f62a 100755 (executable)
@@ -10,26 +10,42 @@ BEGIN {
   ) unless DBIx::Class::Optional::Dependencies->req_ok_for ('admin_script');
 }
 
-use Getopt::Long::Descriptive;
+use DBIx::Class::Admin::Descriptive;
+#use Getopt::Long::Descriptive;
 use DBIx::Class::Admin;
 
+my $short_description = "utility for administrating DBIx::Class schemata";
+my $synopsis_text =qq{ 
+  deploy a schema to a database
+  %c --schema=MyApp::Schema \
+    --connect='["dbi:SQLite:my.db", "", ""]' \
+    --deploy
+
+  update an existing record
+  %c --schema=MyApp::Schema --class=Employee \
+    --connect='["dbi:SQLite:my.db", "", ""]' \
+    --op=update --set='{ "name": "New_Employee" }'
+}
+;
+
 my ($opts, $usage) = describe_options(
-  "%c: %o",
+    "%c: %o",
   (
     ['Actions'],
     ["action" => hidden => { one_of => [
       ['create|c' => 'Create version diffs needs preversion',],
-      ['upgrade|u' => 'Upgrade the database to the current schema '],
-      ['install|i' => 'Install the schema to the database',],
+      ['upgrade|U' => 'Upgrade the database to the current schema '],
+      ['install|I' => 'Install the schema version tables to an existing database',],
       ['deploy|d' => 'Deploy the schema to the database',],
       ['select|s'   => 'Select data from the schema', ],
       ['insert|i'   => 'Insert data into the schema', ],
       ['update|u'   => 'Update data in the schema', ], 
       ['delete|D'   => 'Delete data from the schema',],
       ['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
-      ['help|h' => 'display this help'],
+      ['help|h' => 'display this help', { implies => { schema_class => 'main' } } ],
+      ['pod' => 'Output this usage as pod', { implies => { schema_class => 'main' } } ],
     ], required=> 1 }],
-    ['Options'],
+    ['Arguments'],
     ['schema-class|schema|C:s' => 'The class of the schema to load', { required => 1 } ],
     ['resultset|resultset_class|class|r:s' => 'The resultset to operate on for data manipulation' ],
     ['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
@@ -41,7 +57,6 @@ my ($opts, $usage) = describe_options(
     ['version|v:i' => 'Supply a version install'],
     ['preversion|p:s' => 'The previous version to diff against',],
     ['set:s' => 'JSON data used to perform data operations' ],
-    ['lib|I:s' => 'Additonal library path to search in'], 
     ['attrs:s' => 'JSON string to be used for the second argument for search'],
     ['where:s' => 'JSON string to be used for the where clause of search'],
     ['force' => 'Be forceful with some operations'],
@@ -52,6 +67,17 @@ my ($opts, $usage) = describe_options(
 
 die "please only use one of --config or --connect-info\n" if ($opts->{config} and $opts->{connect_info});
 
+if($opts->{pod}) {
+    $usage->synopsis($synopsis_text);
+    $usage->short_description($short_description);
+    print $usage->pod();
+    exit 0;
+}
+
+if($opts->{help}) {
+    $usage->die();
+}
+
 # option compatability mangle
 if($opts->{connect}) {
   $opts->{connect_info} = delete $opts->{connect};
@@ -83,6 +109,19 @@ if ($action eq 'select') {
     print $csv->string()."\n";
   }
 }
+__END__
+
+=begin pod_begin
+
+BEGIN MARKER FOR DYNAMIC POD
+
+=end pod_begin
+
+=begin pod_end
+
+END MARKER FOR DYNAMIC POD
+
+=end pod_end
 
 =head1 AUTHOR
 
@@ -93,3 +132,5 @@ See L<DBIx::Class/CONTRIBUTORS>.
 You may distribute this code under the same terms as Perl itself
 
 =cut
+
+# vim: et ft=perl
index d3a5374..3115234 100644 (file)
@@ -86,7 +86,7 @@ my $exceptions = {
         /]
     },
 
-    'DBIx::Class::Admin::Types'                     => { skip => 1 },
+    'DBIx::Class::Admin::*'                         => { skip => 1 },
     'DBIx::Class::ClassResolver::PassThrough'       => { skip => 1 },
     'DBIx::Class::Componentised'                    => { skip => 1 },
     'DBIx::Class::Relationship::*'                  => { skip => 1 },