add extract_usage function to Mojo::Util

mojolicious · Jan 19, 2017 · 193a2c4 · 193a2c4
1 parent 1aa4ecc
commit 193a2c4
Show file tree

Hide file tree

Showing 8 changed files with 83 additions and 45 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 
 7.21  2017-01-19
+  - Added extract_usage function to Mojo::Util.
 
 7.20  2017-01-18
   - Fixed a bug in Mojo::File where the make_path method would die even if no

diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm
@@ -11,6 +11,7 @@ use Getopt::Long 'GetOptionsFromArray';
 use IO::Poll qw(POLLIN POLLPRI);
 use List::Util 'min';
 use MIME::Base64 qw(decode_base64 encode_base64);
+use Pod::Usage 'pod2usage';
 use Symbol 'delete_package';
 use Time::HiRes ();
 
@@ -55,11 +56,11 @@ my %CACHE;
 
 our @EXPORT_OK = (
   qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize),
-  qw(decode deprecated dumper encode getopt hmac_sha1_sum html_unescape),
-  qw(md5_bytes md5_sum monkey_patch punycode_decode punycode_encode quote),
-  qw(secure_compare sha1_bytes sha1_sum split_cookie_header split_header),
-  qw(steady_time tablify term_escape trim unindent unquote url_escape),
-  qw(url_unescape xml_escape xor_encode)
+  qw(decode deprecated dumper encode extract_usage getopt hmac_sha1_sum),
+  qw(html_unescape md5_bytes md5_sum monkey_patch punycode_decode),
+  qw(punycode_encode quote secure_compare sha1_bytes sha1_sum),
+  qw(split_cookie_header split_header steady_time tablify term_escape trim),
+  qw(unindent unquote url_escape url_unescape xml_escape xor_encode)
 );
 
 # DEPRECATED!
@@ -127,6 +128,17 @@ sub dumper {
 
 sub encode { _encoding($_[0])->encode("$_[1]") }
 
+sub extract_usage {
+  my $file = @_ ? "$_[0]" : (caller)[1];
+
+  open my $handle, '>', \my $output;
+  pod2usage -exitval => 'noexit', -input => $file, -output => $handle;
+  $output =~ s/^.*\n|\n$//;
+  $output =~ s/\n$//;
+
+  return unindent($output);
+}
+
 # DEPRECATED!
 sub files {
   deprecated
@@ -570,6 +582,22 @@ Dump a Perl data structure with L<Data::Dumper>.
 
 Encode characters to bytes.
 
+=head2 extract_usage
+
+  my $usage = extract_usage;
+  my $usage = extract_usage '/home/sri/foo.pod';
+
+Extract usage message from the SYNOPSIS section of a file containing POD
+documentation, defaults to using the file this function was called from.
+
+  # "Usage: APPLICATION test [OPTIONS]\n"
+  extract_usage;
+  =head1 SYNOPSIS
+
+    Usage: APPLICATION test [OPTIONS]
+
+  =cut
+
 =head2 getopt
 
   getopt $array,

diff --git a/lib/Mojolicious/Command.pm b/lib/Mojolicious/Command.pm
@@ -6,8 +6,7 @@ use Mojo::File 'path';
 use Mojo::Loader 'data_section';
 use Mojo::Server;
 use Mojo::Template;
-use Mojo::Util qw(deprecated unindent);
-use Pod::Usage 'pod2usage';
+use Mojo::Util 'deprecated';
 
 has app => sub { Mojo::Server->new->build_app('Mojo::HelloWorld') };
 has description => 'No description';
@@ -31,16 +30,7 @@ sub create_dir {
 
 sub create_rel_dir { $_[0]->create_dir($_[0]->rel_file($_[1])) }
 
-sub extract_usage {
-  my $self = shift;
-
-  open my $handle, '>', \my $output;
-  pod2usage -exitval => 'noexit', -input => (caller)[1], -output => $handle;
-  $output =~ s/^.*\n//;
-  $output =~ s/\n$//;
-
-  return unindent $output;
-}
+sub extract_usage { Mojo::Util::extract_usage((caller)[1]) }
 
 sub help { print shift->usage }
 
@@ -104,20 +94,26 @@ Mojolicious::Command - Command base class
   # Short description
   has description => 'My first Mojo command';
 
-  # Short usage message
-  has usage => <<EOF;
-  Usage: APPLICATION mycommand [OPTIONS]
-
-  Options:
-    -s, --something   Does something
-  EOF
+  # Usage message from SYNOPSIS
+  has usage => sub { shift->extract_usage };
 
   sub run {
     my ($self, @args) = @_;
 
     # Magic here! :)
   }
 
+  1;
+
+  =head1 SYNOPSIS
+
+    Usage: APPLICATION mycommand [OPTIONS]
+
+    Options:
+      -s, --something   Does something
+
+  =cut
+
 =head1 DESCRIPTION
 
 L<Mojolicious::Command> is an abstract base class for L<Mojolicious> commands.
@@ -194,7 +190,7 @@ Portably create a directory relative to the current working directory.
   my $usage = $command->extract_usage;
 
 Extract usage message from the SYNOPSIS section of the file this method was
-called from.
+called from with L<Mojo::Util/"extract_usage">.
 
 =head2 help
 

diff --git a/script/hypnotoad b/script/hypnotoad
@@ -1,11 +1,8 @@
 #!perl
-
-use strict;
-use warnings;
+use Mojo::Base -strict;
 
 use Mojo::Server::Hypnotoad;
-use Mojo::Util 'getopt';
-use Mojolicious::Command;
+use Mojo::Util qw(extract_usage getopt);
 
 getopt \@ARGV,
   'f|foreground' => \$ENV{HYPNOTOAD_FOREGROUND},
@@ -14,7 +11,7 @@ getopt \@ARGV,
   't|test'       => \$ENV{HYPNOTOAD_TEST};
 
 my $app = shift || $ENV{HYPNOTOAD_APP};
-die Mojolicious::Command->new->extract_usage if $help || !$app;
+die extract_usage if $help || !$app;
 Mojo::Server::Hypnotoad->new->run($app);
 
 =encoding utf8

diff --git a/script/mojo b/script/mojo
@@ -1,7 +1,5 @@
 #!perl
-
-use strict;
-use warnings;
+use Mojo::Base -strict;
 
 use Mojolicious::Commands;
 

diff --git a/script/morbo b/script/morbo
@@ -1,11 +1,8 @@
 #!perl
-
-use strict;
-use warnings;
+use Mojo::Base -strict;
 
 use Mojo::Server::Morbo;
-use Mojo::Util 'getopt';
-use Mojolicious::Command;
+use Mojo::Util qw(extract_usage getopt);
 
 getopt \@ARGV,
   'h|help'     => \my $help,
@@ -14,7 +11,7 @@ getopt \@ARGV,
   'v|verbose'  => \$ENV{MORBO_VERBOSE},
   'w|watch=s'  => \my @watch;
 
-die Mojolicious::Command->new->extract_usage if $help || !(my $app = shift);
+die extract_usage if $help || !(my $app = shift);
 my $morbo = Mojo::Server::Morbo->new;
 $morbo->daemon->listen(\@listen) if @listen;
 $morbo->watch(\@watch) if @watch;

diff --git a/t/mojo/lib/myapp.pl b/t/mojo/lib/myapp.pl
@@ -3,3 +3,12 @@
 app->config(script => $0);
 
 app->start;
+
+=head1 SYNOPSIS
+
+  USAGE: myapp.pl daemon
+
+   test
+  123
+
+=cut
diff --git a/t/mojo/util.t b/t/mojo/util.t
@@ -5,15 +5,16 @@ use lib "$FindBin::Bin/lib";
 
 use Test::More;
 use Mojo::ByteStream 'b';
+use Mojo::File 'path';
 use Mojo::DeprecationTest;
 
 use Mojo::Util
   qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize),
-  qw(decode dumper encode getopt hmac_sha1_sum html_unescape md5_bytes md5_sum),
-  qw(monkey_patch punycode_decode punycode_encode quote secure_compare),
-  qw(sha1_bytes sha1_sum split_cookie_header split_header steady_time tablify),
-  qw(term_escape trim unindent unquote url_escape url_unescape xml_escape),
-  qw(xor_encode);
+  qw(decode dumper encode extract_usage getopt hmac_sha1_sum html_unescape),
+  qw(md5_bytes md5_sum monkey_patch punycode_decode punycode_encode quote),
+  qw(secure_compare sha1_bytes sha1_sum split_cookie_header split_header),
+  qw(steady_time tablify term_escape trim unindent unquote url_escape),
+  qw(url_unescape xml_escape xor_encode);
 
 # camelize
 is camelize('foo_bar_baz'), 'FooBarBaz', 'right camelized result';
@@ -112,6 +113,17 @@ $tree   = [
 ];
 is_deeply split_cookie_header($header), $tree, 'right result';
 
+# extract_usage
+is extract_usage, "extract_usage test!\n", 'right result';
+is extract_usage(path($FindBin::Bin, 'lib', 'myapp.pl')),
+  "USAGE: myapp.pl daemon\n\n test\n123\n", 'right result';
+
+=head1 SYNOPSIS
+
+  extract_usage test!
+
+=cut
+
 # getopt
 getopt ['--charset', 'UTF-8'], 'c|charset=s' => \my $charset;
 is $charset, 'UTF-8', 'right string';