App-Rad-1.05/0000755000175000017500000000000012154231310011331 5ustar garugaruApp-Rad-1.05/MANIFEST0000644000175000017500000000174412154231310012470 0ustar garugaruChanges MANIFEST Makefile.PL README lib/App/Rad.pm lib/App/Rad/Plugin.pod lib/App/Rad/Config.pm lib/App/Rad/Help.pm lib/App/Rad/Include.pm lib/App/Rad/Exclude.pm t/pod.t t/00-load.t t/01-standard.t t/02-defaultprogram.t t/02.5-default_with_args.t t/03-default_override.t t/03.5-default_and_invalid.t t/04-help_override.t t/05-commands.t t/05-commands-set.t t/05.5-commands_with_args.t t/06-pre_post_tear.t t/07-argv_and_opt.t t/08-getopt_long.t t/09-stash.t t/10-controller_methods.t t/11-config.t t/12-register_commands.t t/12-register_commands-alt.t t/13-register_commands2.t t/14-register_commands3.t t/15-register_commands4.t t/16-register_commands5.t t/17-register_commands6.t t/18-help_by_attribute.t t/19-plugins.t t/20-plugins2.t t/lib/MyStubPlugin.pm t/lib/App/Rad/Plugin/MyStubPlugin.pm t/etc/config1.txt t/etc/config2.txt META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) App-Rad-1.05/META.json0000664000175000017500000000212012154231310012747 0ustar garugaru{ "abstract" : "Rapid (and easy!) creation of command line applications", "author" : [ "Breno G. de Oliveira " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6501, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "App-Rad", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Attribute::Handlers" : "0", "B::Deparse" : "0", "Carp" : "0", "File::Temp" : "0", "FindBin" : "0", "Getopt::Long" : "2.36", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "1.05" } App-Rad-1.05/README0000644000175000017500000000160311100431213012203 0ustar garugaruApp-Rad This is the general README file for installing the App-Rad module. Please refer to the main POD for usage documentation. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc App::Rad You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Rad AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/App-Rad CPAN Ratings http://cpanratings.perl.org/d/App-Rad Search CPAN http://search.cpan.org/dist/App-Rad COPYRIGHT AND LICENCE Copyright (C) 2008 Breno G. de Oliveira This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. App-Rad-1.05/t/0000755000175000017500000000000012154231310011574 5ustar garugaruApp-Rad-1.05/t/03.5-default_and_invalid.t0000644000175000017500000000250211106677027016336 0ustar garugaruuse Test::More tests => 5; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 5 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad; App::Rad->run(); sub default { my $c = shift; if ( $c->cmd ) { return 'oops'; } else { return 'keys: ' . (keys %{ $c->options }); } } sub invalid { my $c = shift; return 'sorry, but "' . $c->cmd . '" does not exist.'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "keys: 0\n", 'no command (should fall to default)'); $ret = `$^X $filename --test`; is($ret, "keys: 1\n", 'no command, with parameters (should fall to default)'); $ret = `$^X $filename test`; is($ret, "sorry, but \"test\" does not exist.\n", 'invalid command (should fall to invalid)'); $ret = `$^X $filename test --something`; is($ret, "sorry, but \"test\" does not exist.\n", 'invalid command, with parameters (should fall to invalid)'); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: help\tshow syntax and available commands EOHELP $ret = ''; $ret = `$^X $filename help`; is($ret, $helptext); } App-Rad-1.05/t/19-plugins.t0000644000175000017500000000105711170553203013701 0ustar garugaruuse FindBin; use lib $FindBin::RealBin . '/lib'; use Test::More tests => 4; use App::Rad qw(+MyStubPlugin); # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); can_ok($c, 'my_method'); $c->stash->{baz} = 'foo'; my $ret = $c->my_method(qw(some bar)); is($ret, 'foobar', 'plugin method calling'); eval { $c->_my_own(); }; ok($@, '_my_own() should be an internal plugin method'); my @plugins = $c->plugins; my @plugins_expected = qw(MyStubPlugin); is_deeply(\@plugins, \@plugins_expected, 'loaded plugins should match'); App-Rad-1.05/t/08-getopt_long.t0000644000175000017500000000340311174232030014530 0ustar garugaruuse Test::More tests => 17; SKIP: { eval "use Getopt::Long 2.36"; skip "Getopt::Long 2.36 or higher not installed", 17, if $@; use App::Rad; @ARGV = qw(herculoids --igoo=ape -t 4 --zok=3.14 --glup -abc); # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); $c->_get_input(); $c->getopt( 'igoo|i=s', 'tundro|t=i', 'zok|z=f', 'glup', 'glip', 'a', 'b', 'c', ); is($c->cmd, 'herculoids', 'command name should be set'); is(scalar @ARGV, 6, '@ARGV should have 6 elements'); is(scalar @{$c->argv}, 0, '$c->argv should have been consumed'); is(keys %{$c->options}, 7, '$c->options should have 7 elements'); is_deeply(\@ARGV, ['--igoo=ape', '-t', '4', '--zok=3.14', '--glup', '-abc' ], '@ARGV should have just the passed arguments, not the command name' ); is($c->options->{'igoo'}, 'ape', '--igoo should be set'); ok(defined $c->options->{'tundro'}, '--tundro should be defined'); ok(!defined $c->options->{'t'}, '-t should have become --tundro'); is($c->options->{'tundro'}, 4, '--tundro should be set'); ok(defined $c->options->{'zok'}, '--zok should be defined'); is($c->options->{'zok'}, 3.14, '--zok should be set'); ok(!defined $c->options->{'z'}, '-z should not be set'); ok(defined $c->options->{'glup'}, '--glup should be defined'); ok(!defined $c->options->{'glip'}, '--glip should not be defined'); ok(defined $c->options->{'a'}, '-a should be defined'); ok(defined $c->options->{'a'}, '-a should be defined'); ok(defined $c->options->{'a'}, '-a should be defined'); } App-Rad-1.05/t/12-register_commands-alt.t0000644000175000017500000000171211177710544016504 0ustar garugaruuse Test::More tests => 7; use App::Rad; # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); $c->register_commands({ -ignore_prefix => '_', -ignore_suffix => 'cmd', -ignore_regexp => '\d', }); sub foo { return 'hello'; } sub _foo { return 'internal _foo!!!'; } sub foocmd { return 'internal foocmd!!!'; } sub foo1bar { return 'internal foo1bar!!!'; } sub bar { return 'hi'; } sub default { return 'This is default. Over and out.'; } ok(!$c->is_command('default'), '"default" must not be set as a command'); ok($c->is_command('bar'), 'bar should be a valid command'); ok($c->is_command('foo'), 'foo should be a valid command'); ok($c->is_command('help'), 'help should be a valid command'); ok(!$c->is_command('_foo'), '_foo should *not* be a valid command'); ok(!$c->is_command('foocmd'), 'foocmd should *not* be a valid command'); ok(!$c->is_command('foo1bar'), 'foo1bar should *not* be a valid command'); App-Rad-1.05/t/14-register_commands3.t0000644000175000017500000000270511106677242016015 0ustar garugaruuse Test::More tests => 7; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 7 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands( qw/foo bar/ ); } sub foo { return 'hello'; } sub _foo { return 'internal _foo!!!'; } sub foocmd { return 'internal foocmd!!!'; } sub foo1bar { return 'internal foo1bar!!!'; } sub bar { return 'hi'; } sub default { return 'This is default. Over and out.'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "This is default. Over and out.\n"); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: bar \t foo \t help\tshow syntax and available commands EOHELP $ret = `$^X $filename help`; is($ret, $helptext); $ret = `$^X $filename foo _foo foocmd foo1bar bar`; is($ret, "hello\n"); $ret = `$^X $filename _foo foocmd foo1bar bar foo `; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foocmd foo1bar bar foo _foo`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foo1bar bar foo _foo foocmd`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename bar foo _foo foocmd foo1bar`; is($ret, "hi\n"); } App-Rad-1.05/t/12-register_commands.t0000644000175000017500000000303711106677214015726 0ustar garugaruuse Test::More tests => 7; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 7 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands({ -ignore_prefix => '_', -ignore_suffix => 'cmd', -ignore_regexp => '\d', }); } sub foo { return 'hello'; } sub _foo { return 'internal _foo!!!'; } sub foocmd { return 'internal foocmd!!!'; } sub foo1bar { return 'internal foo1bar!!!'; } sub bar { return 'hi'; } sub default { return 'This is default. Over and out.'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "This is default. Over and out.\n"); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: bar \t foo \t help\tshow syntax and available commands EOHELP $ret = `$^X $filename help`; is($ret, $helptext); $ret = `$^X $filename foo _foo foocmd foo1bar bar`; is($ret, "hello\n"); $ret = `$^X $filename _foo foocmd foo1bar bar foo `; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foocmd foo1bar bar foo _foo`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foo1bar bar foo _foo foocmd`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename bar foo _foo foocmd foo1bar`; is($ret, "hi\n"); } App-Rad-1.05/t/20-plugins2.t0000644000175000017500000000110411170553234013750 0ustar garugaruuse FindBin; use lib $FindBin::RealBin . '/lib'; use Test::More tests => 4; use App::Rad qw(MyStubPlugin); # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); can_ok($c, 'my_other_method'); $c->stash->{baz} = 'foo'; my $ret = $c->my_other_method(qw(some bar)); is($ret, 'foobar', 'plugin method calling'); eval { $c->_my_very_own(); }; ok($@, '_my_very_own() should be an internal plugin method'); my @plugins = $c->plugins; my @plugins_expected = qw(MyStubPlugin); is_deeply(\@plugins, \@plugins_expected, 'loaded plugins should match'); App-Rad-1.05/t/00-load.t0000644000175000017500000000034311167763773013147 0ustar garugaru#!perl -T use Test::More tests => 4; BEGIN { use_ok( 'App::Rad' ); use_ok( 'App::Rad::Help' ); use_ok( 'App::Rad::Include' ); use_ok( 'App::Rad::Exclude' ); } diag( "Testing App::Rad $App::Rad::VERSION, Perl $], $^X" ); App-Rad-1.05/t/05.5-commands_with_args.t0000644000175000017500000000177511174073003016234 0ustar garugaruuse Test::More tests => 3; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 3 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad qw(include exclude); App::Rad->run(); sub test1 { my $c = shift; if ($c->argv->[0]) { return 'got ' . $c->argv->[0]; } else { return 'my test #1'; } } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: exclude\tcompletely erase command from your program help \tshow syntax and available commands include\tinclude one-liner as a command test1 \t EOHELP is($ret, $helptext); $ret = ''; $ret = `$^X $filename test1`; is($ret, "my test #1\n"); $ret = ''; $ret = `$^X $filename test1 tested`; is($ret, "got tested\n"); } App-Rad-1.05/t/05-commands.t0000644000175000017500000000160111106677060014016 0ustar garugaruuse Test::More tests => 3; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 3 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad; App::Rad->run(); sub test1 { my $c = shift; if ($c->argv->[0]) { return 'got ' . $c->argv->[0]; } else { return 'my test #1'; } } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: help \tshow syntax and available commands test1\t EOHELP is($ret, $helptext); $ret = ''; $ret = `$^X $filename test1`; is($ret, "my test #1\n"); $ret = ''; $ret = `$^X $filename test1 tested`; is($ret, "got tested\n"); } App-Rad-1.05/t/17-register_commands6.t0000644000175000017500000000334211106677307016023 0ustar garugaruuse Test::More tests => 8; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 8 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands( { -ignore_prefix => '_' }, 'foo', { -ignore_suffix => 'bar' }, 'bar', { baz => 'help your baz' }, ); } sub foo { return 'hello'; } sub _foo { return 'internal _foo!!!'; } sub foocmd { return 'yo'; } sub foo1bar { return 'internal foo1bar!!!'; } sub baz { return 'waza'; } sub bar { return 'hi'; } sub default { return 'This is default. Over and out.'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "This is default. Over and out.\n"); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: bar \t baz \thelp your baz foo \t foocmd\t help \tshow syntax and available commands EOHELP $ret = `$^X $filename help`; is($ret, $helptext); $ret = `$^X $filename foo _foo foocmd foo1bar bar`; is($ret, "hello\n"); $ret = `$^X $filename _foo foocmd foo1bar bar foo `; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foocmd foo1bar bar foo _foo`; is($ret, "yo\n"); $ret = `$^X $filename foo1bar bar foo _foo foocmd`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename bar foo _foo foocmd foo1bar`; is($ret, "hi\n"); $ret = `$^X $filename baz`; is($ret, "waza\n"); } App-Rad-1.05/t/10-controller_methods.t0000644000175000017500000000472211123242313016112 0ustar garugaruuse Test::More tests => 24; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 24 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad; App::Rad->run(); sub command { my $c = shift; my $ret = 'Called: ' . $c->cmd . ' (' . $c->command . ")\n"; $c->execute('list_commands'); $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n"; $c->register($c->create_command_name(), sub { return "test" }); $c->register_command('alias', \&anothercommand, 'this is an alias'); $c->unregister_command('yetanothercommand'); $c->unregister('andanotherone'); $c->execute('list_commands'); $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n"; $c->execute('alias'); $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n"; $c->execute('cmd1'); $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n"; if ( $c->is_command('yetanothercommand') ) { $ret .= "error unregistering 'yetanothercommand'"; } return $ret; } sub anothercommand { return "this is an alias, over" }; sub andanotherone { } sub yetanothercommand { } sub list_commands { my $c = shift; my $ret .= 'Available: ' . $c->commands . "\n"; foreach ( sort $c->commands ) { $ret .= "$_:"; $ret .= $c->is_command($_) ? 'ok' : 'not a command'; $ret .= "\n"; } return $ret; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename command`; my @ret = split m{$/}, $ret; is(scalar (@ret), 23); is($ret[0], 'Available: 6'); is($ret[1], 'andanotherone:ok'); is($ret[2], 'anothercommand:ok'); is($ret[3], 'command:ok'); is($ret[4], 'help:ok'); is($ret[5], 'list_commands:ok'); is($ret[6], 'yetanothercommand:ok'); is($ret[7], ''); is($ret[8], 'Available: 6'); is($ret[9], 'alias:ok'); is($ret[10], 'anothercommand:ok'); is($ret[11], 'cmd1:ok'); is($ret[12], 'command:ok'); is($ret[13], 'help:ok'); is($ret[14], 'list_commands:ok'); is($ret[15], ''); is($ret[16], 'this is an alias, over'); is($ret[17], 'test'); is($ret[18], 'Called: command (command)'); is($ret[19], 'Called: list_commands (list_commands)'); is($ret[20], 'Called: list_commands (list_commands)'); is($ret[21], 'Called: alias (alias)'); is($ret[22], 'Called: cmd1 (cmd1)'); } App-Rad-1.05/t/02.5-default_with_args.t0000644000175000017500000000137211106676776016072 0ustar garugaruuse Test::More tests => 2; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 2 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad qw(include exclude); App::Rad->run(); EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: exclude\tcompletely erase command from your program help \tshow syntax and available commands include\tinclude one-liner as a command EOHELP is($ret, $helptext); $ret = ''; $ret = `$^X $filename help`; is($ret, $helptext); } App-Rad-1.05/t/07-argv_and_opt.t0000644000175000017500000000273211177703732014674 0ustar garugaruuse Test::More tests => 18; use App::Rad; @ARGV = qw(commandname bla -x -abc --def --test1=2 --test2=test ble -vvv -x); # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); $c->_get_input(); is(scalar @ARGV, 9, '@ARGV should have 6 elements'); is(scalar @{$c->argv}, 2, '$c->argv should have 2 arguments'); is(keys %{$c->options}, 8, '$c->options should have 6 elements'); is($c->cmd, 'commandname', 'command name should be set'); is_deeply(\@ARGV, ['bla', '-x', '-abc', '--def', '--test1=2', '--test2=test', 'ble', '-vvv', '-x'], '@ARGV should have just the passed arguments, not the command name' ); is_deeply($c->argv, ['bla', 'ble'], '$c->argv arguments should be consistent'); is($c->options->{'a'}, 1, "'-a' should be set"); is($c->options->{'b'}, 1, "'-b' should be set"); is($c->options->{'c'}, 1, "'-c' should be set"); ok(!defined $c->options->{'abc'}, "'--abc' should *not* be set"); ok(!defined $c->options->{'d'} , "'-d' should *not* be set"); ok(!defined $c->options->{'e'} , "'-e' should *not* be set"); ok(!defined $c->options->{'f'} , "'-f' should *not* be set"); ok(defined $c->options->{'def'}, "'--def' should be set"); is($c->options->{'test1'}, 2, "'--test1' should be set to '2'"); is($c->options->{'test2'}, 'test', "'--test2' should be set to 'test'"); is($c->options->{'v'}, 3, "single arguments can be incremented when put together"); is($c->options->{'x'}, 2, "single arguments can be incremented when invoked separately"); App-Rad-1.05/t/05-commands-set.t0000644000175000017500000000060611177713007014613 0ustar garugaruuse Test::More tests => 3; use App::Rad; # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); is($c->cmd, undef, 'no command should be set upon startup'); $c->cmd = 'somecommand'; is($c->cmd, 'somecommand', 'developer should be able to set $c->cmd'); $c->command = 'anothercommand'; is($c->cmd, 'anothercommand', 'developer should be able to set $c->cmd'); App-Rad-1.05/t/06-pre_post_tear.t0000644000175000017500000000232611106677113015070 0ustar garugaruuse Test::More tests => 3; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 3 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad; App::Rad->run(); sub test1 { my $c = shift; if ($c->argv->[0]) { return 'got ' . $c->argv->[0]; } else { return 'my test #1'; } } sub pre_process { my $c = shift; if ($c->argv->[0] eq 'tested') { $c->argv->[0] .= ' again'; } } sub teardown { print 'tearing down...'; } sub post_process { my $c = shift; print $c->output() . ' [NARF!]' . $/; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: help \tshow syntax and available commands test1\t [NARF!] EOHELP $helptext .= 'tearing down...'; is($ret, $helptext); $ret = ''; $ret = `$^X $filename test1`; is($ret, "my test #1 [NARF!]\ntearing down..."); $ret = ''; $ret = `$^X $filename test1 tested`; is($ret, "got tested again [NARF!]\ntearing down..."); } App-Rad-1.05/t/16-register_commands5.t0000644000175000017500000000316611106677273016027 0ustar garugaruuse Test::More tests => 7; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 7 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands({ -ignore_prefix => '_', -ignore_suffix => 'bar', foo => 'help your foo', bar => 'help your bar', }); } sub foo { return 'hello'; } sub _foo { return 'internal _foo!!!'; } sub foocmd { return 'yo'; } sub foo1bar { return 'internal foo1bar!!!'; } sub bar { return 'hi'; } sub default { return 'This is default. Over and out.'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "This is default. Over and out.\n"); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: bar \thelp your bar foo \thelp your foo foocmd\t help \tshow syntax and available commands EOHELP $ret = `$^X $filename help`; is($ret, $helptext); $ret = `$^X $filename foo _foo foocmd foo1bar bar`; is($ret, "hello\n"); $ret = `$^X $filename _foo foocmd foo1bar bar foo `; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foocmd foo1bar bar foo _foo`; is($ret, "yo\n"); $ret = `$^X $filename foo1bar bar foo _foo foocmd`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename bar foo _foo foocmd foo1bar`; is($ret, "hi\n"); } App-Rad-1.05/t/13-register_commands2.t0000644000175000017500000000253111106677230016005 0ustar garugaruuse Test::More tests => 5; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 5 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands({ ignore_prefix => 'this is a command', ignore_regexp => 'this is another command', ignore_suffix => 'this too, since none of us start with a dash', }); } sub ignore_prefix { return 1; } sub ignore_suffix { return 2; } sub ignore_regexp { return 3; } sub internal { return "I should *not* be available"; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: help \tshow syntax and available commands ignore_prefix\tthis is a command ignore_regexp\tthis is another command ignore_suffix\tthis too, since none of us start with a dash EOHELP is($ret, $helptext); $ret = `$^X $filename internal`; is($ret, $helptext); $ret = `$^X $filename ignore_prefix`; is($ret, "1\n"); $ret = `$^X $filename ignore_suffix`; is($ret, "2\n"); $ret = `$^X $filename ignore_regexp`; is($ret, "3\n"); } App-Rad-1.05/t/04-help_override.t0000644000175000017500000000131111106644312015033 0ustar garugaruuse Test::More tests => 2; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 2 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<"EOT"; use App::Rad; App::Rad->run(); sub default { return 'this is an override of the default command'; } sub help { return 'this is an override of the help command'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "this is an override of the default command\n"); $ret = ''; $ret = `$^X $filename help`; is($ret, "this is an override of the help command\n"); } App-Rad-1.05/t/03-default_override.t0000644000175000017500000000152211106677015015540 0ustar garugaruuse Test::More tests => 3; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 3 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad; App::Rad->run(); sub default { return 'this is an override of the default command'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "this is an override of the default command\n"); $ret = `$^X $filename unknown`; is($ret, "this is an override of the default command\n"); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: help\tshow syntax and available commands EOHELP $ret = ''; $ret = `$^X $filename help`; is($ret, $helptext); } App-Rad-1.05/t/01-standard.t0000644000175000017500000000117411123262232014004 0ustar garugaruuse Test::More tests => 14; use App::Rad; # tests the existance of the API my $m = 'App::Rad'; can_ok($m, 'commands'); can_ok($m, 'create_command_name'); can_ok($m, 'run'); #tests the existance of the control functions can_ok($m, 'setup'); can_ok($m, 'pre_process'); can_ok($m, 'post_process'); can_ok($m, 'default'); can_ok($m, 'teardown'); # tests the existance of basic commands use App::Rad::Exclude; $m = 'App::Rad::Exclude'; can_ok($m, 'load'); can_ok($m, 'exclude'); use App::Rad::Include; $m = 'App::Rad::Include'; can_ok($m, 'load'); can_ok($m, 'include'); $m = 'App::Rad::Help'; can_ok($m, 'load'); can_ok($m, 'help'); App-Rad-1.05/t/pod.t0000644000175000017500000000035011101462042012540 0ustar garugaru#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); App-Rad-1.05/t/18-help_by_attribute.t0000644000175000017500000000172211170266515015732 0ustar garugaruuse Test::More tests => 1; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 1 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); #TODO: add precedence confirmation with $c->register_commands() #and $c->register() my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub foo :Help(help for foo) { return 'foo'; } sub bar :Help(help for bar) { return 'bar'; } sub baz :Help(yet another help) { return 'baz'; } sub singleword :Help(single) { return 'single word inside help' } EOT print $fh $contents; close $fh; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: bar \thelp for bar baz \tyet another help foo \thelp for foo help \tshow syntax and available commands singleword\tsingle EOHELP $ret = `$^X $filename`; is($ret, $helptext); } App-Rad-1.05/t/lib/0000755000175000017500000000000012154231310012342 5ustar garugaruApp-Rad-1.05/t/lib/MyStubPlugin.pm0000644000175000017500000000020111170537734015313 0ustar garugarupackage MyStubPlugin; sub my_method { my ($c, @args) = (@_); return $c->stash->{baz} . $args[1]; } sub _my_own {} 42; App-Rad-1.05/t/lib/App/0000755000175000017500000000000012154231310013062 5ustar garugaruApp-Rad-1.05/t/lib/App/Rad/0000755000175000017500000000000012154231310013570 5ustar garugaruApp-Rad-1.05/t/lib/App/Rad/Plugin/0000755000175000017500000000000012154231310015026 5ustar garugaruApp-Rad-1.05/t/lib/App/Rad/Plugin/MyStubPlugin.pm0000644000175000017500000000023611170546046020003 0ustar garugarupackage App::Rad::Plugin::MyStubPlugin; sub my_other_method { my ($c, @args) = (@_); return $c->stash->{baz} . $args[1]; } sub _my_very_own {} 42; App-Rad-1.05/t/11-config.t0000644000175000017500000000203711177706537013475 0ustar garugaruuse FindBin; my $path = $FindBin::RealBin . '/etc'; use Test::More tests => 10; use App::Rad; # kids, don't try this at home... my $c = {}; bless $c, 'App::Rad'; $c->_init(); $c->load_config("$path/config1.txt"); $c->load_config("$path/config1.txt", "$path/config2.txt" ); $c->config->{'oito'} = 'eight'; is(keys( %{$c->config} ), 9, 'load_config() should have loaded 9 unique elements'); is($c->config->{'um' }, 'one' , 'config value mismatch'); is($c->config->{'dois' }, 'two' , 'config value mismatch'); is($c->config->{'tres' }, 'three', 'config value mismatch'); is($c->config->{'quatro'}, 'four' , 'config value mismatch'); is($c->config->{'cinco' }, 'sinc' , 'config value mismatch'); is($c->config->{'seis' }, 'six' , 'config value mismatch'); ok(exists $c->config->{'sete'}, 'unary values must exist'); is($c->config->{'oito' }, 'eight', 'should be able to define values in running code'); is($c->config->{'text' }, 'the quick brown fox jumps over the lazy dog', 'strings should be set correctly'); App-Rad-1.05/t/02-defaultprogram.t0000644000175000017500000000117711106676762015246 0ustar garugaruuse Test::More tests => 2; SKIP: { eval "use File::Temp qw{ tempfile tempdir }"; skip "File::Temp not installed", 2 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<"EOT"; use App::Rad; App::Rad->run(); EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: help\tshow syntax and available commands EOHELP is($ret, $helptext); $ret = ''; $ret = `$^X $filename help`; is($ret, $helptext); } App-Rad-1.05/t/09-stash.t0000644000175000017500000000227111101465405013340 0ustar garugaruuse Test::More tests => 4; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 4 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents = <<'EOT'; use App::Rad; App::Rad->run(); sub command { my $c = shift; $c->stash->{num} = 1; $c->stash->{string} = 'foo'; $c->stash->{arrayref} = [ qw(one two three) ]; $c->stash->{hashref} = { key => 'value' }; } sub post_process { my $c = shift; foreach ( sort keys %{$c->stash} ) { print $_ . ':'; if (ref $c->stash->{$_} eq 'ARRAY') { print @{ $c->stash->{$_} }; } elsif (ref $c->stash->{$_} eq 'HASH') { print each %{ $c->stash->{$_} }; } else { print $c->stash->{$_}; } print ' '; } } EOT print $fh $contents; close $fh; my $ret = `$^X $filename command`; my @ret = split / /, $ret; # options testing (sorted alfabetically) is($ret[0], 'arrayref:onetwothree'); is($ret[1], 'hashref:keyvalue'); is($ret[2], 'num:1'); is($ret[3], 'string:foo'); } App-Rad-1.05/t/15-register_commands4.t0000644000175000017500000000302211106677257016016 0ustar garugaruuse Test::More tests => 7; SKIP: { eval "use File::Temp qw{ tempfile tempdir } "; skip "File::Temp not installed", 7 if $@; my ($fh, $filename) = tempfile(UNLINK => 1); diag("using temporary program file '$filename' to test functionality"); my $contents= <<'EOT'; use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands( qw/foo bar/, { -ignore_prefix => '_', -ignore_suffix => 'bar' } ); } sub foo { return 'hello'; } sub _foo { return 'internal _foo!!!'; } sub foocmd { return 'yo'; } sub foo1bar { return 'internal foo1bar!!!'; } sub bar { return 'hi'; } sub default { return 'This is default. Over and out.'; } EOT print $fh $contents; close $fh; my $ret = `$^X $filename`; is($ret, "This is default. Over and out.\n"); my $helptext = <<"EOHELP"; Usage: $filename command [arguments] Available Commands: bar \t foo \t foocmd\t help \tshow syntax and available commands EOHELP $ret = `$^X $filename help`; is($ret, $helptext); $ret = `$^X $filename foo _foo foocmd foo1bar bar`; is($ret, "hello\n"); $ret = `$^X $filename _foo foocmd foo1bar bar foo `; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename foocmd foo1bar bar foo _foo`; is($ret, "yo\n"); $ret = `$^X $filename foo1bar bar foo _foo foocmd`; is($ret, "This is default. Over and out.\n"); $ret = `$^X $filename bar foo _foo foocmd foo1bar`; is($ret, "hi\n"); } App-Rad-1.05/t/etc/0000755000175000017500000000000012154231310012347 5ustar garugaruApp-Rad-1.05/t/etc/config1.txt0000644000175000017500000000031711177706504014457 0ustar garugaruum one dois two tres:three quatro : four # coment=yes! cinco=five # inline comments too! seis = six text: the quick brown fox jumps over the lazy dog App-Rad-1.05/t/etc/config2.txt0000644000175000017500000000007211172715006014446 0ustar garugaru cinco=sinc seis = six sete App-Rad-1.05/META.yml0000664000175000017500000000115412154231310012605 0ustar garugaru--- abstract: 'Rapid (and easy!) creation of command line applications' author: - 'Breno G. de Oliveira ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6501, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: App-Rad no_index: directory: - t - inc requires: Attribute::Handlers: 0 B::Deparse: 0 Carp: 0 File::Temp: 0 FindBin: 0 Getopt::Long: 2.36 Test::More: 0 version: 1.05 App-Rad-1.05/Changes0000644000175000017500000000631112154231135012632 0ustar garugaruRevision history for App-Rad 1.05 2013-06-06 *** YAPC::NA mainenance release *** - As a lot of App::Rad users are aware, the framework has gone through a lot of rethinking in order to be more easily maintainable and expandable, which requires a big rewrite, some back-incompat decisions and a lot of time which I have failed to give in the past few years. Because of this, we have been under a long code freeze which I hope to end in the future. Until then new releases will be made only for bugfixes, like this one. - bugfix: --someoption=0 now sets options->{someoption} to 0 instead of 1 (ironcamel++) - changelog updated to follow the CPAN Changes spec more closely. 1.04 2009-05-04 ***MINOR API CHANGE*** => default is now to register only subs that do *not* start with an underscore - Fixed documentation (bug reported by FCO) - Single (no value) options are now stored in $c->options with '1' value, so you don't have to explicitly use 'defined' to test them. - Increment single options' value if argument is passed more than one time (so -v -v will make $c->options->{v} == 2) - Now configuration files can have whole strings as options - Now $c->cmd is an lvalue and can be changed w/o fiddling with internals - Added CONTRIBUTORS section in POD - Updated test suite 1.03 2009-04-24 - App::Rad::Config.pm was not in the MANIFEST 1.02 2009-04-24 - Fixed bug where $c->getopt would not set $c->argv correctly and change @ARGV instead (reported by FCO) - load_config() factored out, now in App::Rad::Config; - Updated (+fixed) documentation. 1.01 2009-04-13 - Fixed bug where single words inside :Help attribute (received as arrayref) were not dereferenced correctly. - Added $c->plugins() method, with an ordered list of loaded plugins - Added some plugin tests. - Updated documentation. 1.00 2009-04-10 - Added plugins support! - Getopt::Long requirement is specific to getopt() method. - Updated documentation. 0.09 2008-12-22 - Fixed dependencies check and documentation typo. 0.08 2008-12-21 - Added Help() attribute. Put help, include and exclude into separated modules. Updated documentation. More tests. 0.07 2008-11-12 - SMALL API CHANGE: $c->register_commands()'s parameters ignore_prefix, ignore_suffix and ignore_regexp now *must* start with a dash. - $c->register_commands() helper method now can be used to include context documentation on available commands (RT #40578). - Updated documentation. More tests. 0.06 2008-11-03 - Fixed POD. Added license to Meta.yml. Added load_config and config methods. 0.05 2008-10-28 - Separated default() into default() and invalid(). Updated documentation. More tests. 0.04 2008-10-26 - Fixed some testing issues. Added Stash, and improved TODO list. 0.03 2008-10-22 - Added getopt integration. First public release, on an unsuspecting world. 0.02 2008-10-05 - Added controller object and documentation. 0.01 2008-09-20 - First version, for internal use only. App-Rad-1.05/Makefile.PL0000644000175000017500000000151511170540531013312 0ustar garugaruuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'App::Rad', AUTHOR => 'Breno G. de Oliveira ', VERSION_FROM => 'lib/App/Rad.pm', ABSTRACT_FROM => 'lib/App/Rad.pm', LICENSE => 'perl', PL_FILES => {}, # Our dependencies are all core modules, so you shouldn't have # to install anything besides Perl 5.8! PREREQ_PM => { 'Test::More' => 0, 'Getopt::Long' => 2.36, 'Carp' => 0, 'File::Temp' => 0, 'FindBin' => 0, 'Attribute::Handlers' => 0, 'B::Deparse' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'App-Rad-*' }, ); App-Rad-1.05/lib/0000755000175000017500000000000012154231310012077 5ustar garugaruApp-Rad-1.05/lib/App/0000755000175000017500000000000012154231310012617 5ustar garugaruApp-Rad-1.05/lib/App/Rad.pm0000644000175000017500000013410412154231257013700 0ustar garugarupackage App::Rad; use 5.006; use App::Rad::Help; use Carp (); use warnings; use strict; our $VERSION = '1.05'; { #========================# # INTERNAL FUNCTIONS # #========================# my @OPTIONS = (); sub _init { my $c = shift; # instantiate references for the first time $c->{'_ARGV' } = []; $c->{'_options'} = {}; $c->{'_stash' } = {}; $c->{'_config' } = {}; $c->{'_plugins'} = []; # this internal variable holds # references to all special # pre-defined control functions $c->{'_functions'} = { 'setup' => \&setup, 'pre_process' => \&pre_process, 'post_process' => \&post_process, 'default' => \&default, 'invalid' => \&invalid, 'teardown' => \&teardown, }; #load extensions App::Rad::Help->load($c); foreach (@OPTIONS) { if ($_ eq 'include') { eval 'use App::Rad::Include; App::Rad::Include->load($c)'; Carp::croak 'error loading "include" extension.' if ($@); } elsif ($_ eq 'exclude') { eval 'use App::Rad::Exclude; App::Rad::Exclude->load($c)'; Carp::croak 'error loading "exclude" extension.' if ($@); } elsif ($_ eq 'debug') { $c->{'debug'} = 1; } else { $c->load_plugin($_); } } # tiny cheat to avoid doing a lot of processing # when not in debug mode. If needed, I'll create # an actual is_debugging() method or something if ($c->{'debug'}) { $c->debug('initializing: default commands are: ' . join ( ', ', $c->commands() ) ); } } sub import { my $class = shift; @OPTIONS = @_; } sub load_plugin { my $c = shift; my $plugin = shift; my $class = ref $c; my $plugin_fullname = ''; if ($plugin =~ s{^\+}{} ) { $plugin_fullname = $plugin; } else { $plugin_fullname = "App::Rad::Plugin::$plugin"; } eval "use $plugin_fullname ()"; Carp::croak "error loading plugin '$plugin_fullname': $@\n" if $@; my %methods = _get_subs_from($plugin_fullname); Carp::croak "No methods found for plugin '$plugin_fullname'\n" unless keys %methods > 0; no strict 'refs'; foreach my $method (keys %methods) { # don't add plugin's internal methods next if substr ($method, 0, 1) eq '_'; *{"$class\::$method"} = $methods{$method}; $c->debug("-- method '$method' added [$plugin_fullname]"); # fill $c->plugins() push @{ $c->{'_plugins'} }, $plugin; } } # this function browses a file's # symbol table (usually 'main') and maps # each function to a hash # # FIXME: if I create a sub here (Rad.pm) and # there is a global variable with that same name # inside the user's program (e.g.: sub ARGV {}), # the name will appear here as a command. It really # shouldn't... sub _get_subs_from { my $package = shift || 'main'; $package .= '::'; my %subs = (); no strict 'refs'; while (my ($key, $value) = ( each %{*{$package}} )) { local (*SYMBOL) = $value; if ( defined $value && defined *SYMBOL{CODE} ) { $subs{$key} = $value; } } return %subs; } # overrides our pre-defined control # functions with any available # user-defined ones sub _register_functions { my $c = shift; my %subs = _get_subs_from('main'); # replaces only if the function is # in 'default', 'pre_process' or 'post_process' foreach ( keys %{$c->{'_functions'}} ) { if ( defined $subs{$_} ) { $c->debug("overriding $_ with user-defined function."); $c->{'_functions'}->{$_} = $subs{$_}; } } } # retrieves command line arguments # to be executed by the main program sub _get_input { my $c = shift; my $cmd = (defined ($ARGV[0]) and substr($ARGV[0], 0, 1) ne '-') ? shift @ARGV : '' ; @{$c->argv} = @ARGV; $c->{'cmd'} = $cmd; $c->debug('received command: ' . $c->{'cmd'}); $c->debug('received parameters: ' . join (' ', @{$c->argv} )); $c->_tinygetopt(); } # stores arguments passed to a # command via --param[=value] or -p sub _tinygetopt { my $c = shift; my @argv = (); foreach ( @{$c->argv} ) { # single option (could be grouped) if ( m/^\-([^\-\=]+)$/o) { my @args = split //, $1; foreach (@args) { if ($c->options->{$_}) { $c->options->{$_}++; } else { $c->options->{$_} = 1; } } } # long option: --name or --name=value elsif (m/^\-\-([^\-\=]+)(?:\=(.+))?$/o) { $c->options->{$1} = defined $2 ? $2 : 1 ; } else { push @argv, $_; } } @{$c->argv} = @argv; } #========================# # PUBLIC METHODS # #========================# sub load_config { require App::Rad::Config; App::Rad::Config::load_config(@_); } #TODO: this code probably could use some optimization sub register_commands { my $c = shift; my %help_for_sub = (); my %rules = (); # process parameters foreach my $item (@_) { if ( ref ($item) ) { Carp::croak '"register_commands" may receive only HASH references' unless ref ($item) eq 'HASH'; foreach my $params (keys %{$item}) { if ($params eq '-ignore_prefix' or $params eq '-ignore_suffix' or $params eq '-ignore_regexp' ) { $rules{$params} = $item->{$params}; } else { $help_for_sub{$params} = $item->{$params}; } } } else { $help_for_sub{$item} = undef; # no help text } } my %subs = _get_subs_from('main'); foreach (keys %help_for_sub) { # we only add the sub to the commands # list if it's *not* a control function if ( not defined $c->{'_functions'}->{$_} ) { # user want to register a valid (existant) sub if ( exists $subs{$_} ) { $c->debug("registering $_ as a command."); $c->{'_commands'}->{$_}->{'code'} = $subs{$_}; App::Rad::Help->register_help($c, $_, $help_for_sub{$_}); } else { Carp::croak "'$_' does not appear to be a valid sub. Registering seems impossible.\n"; } } } # no parameters, or params+rules: try to register everything if ((!%help_for_sub) or %rules) { foreach my $subname (keys %subs) { # we only add the sub to the commands # list if it's *not* a control function if ( not defined $c->{'_functions'}->{$subname} ) { if ( $rules{'-ignore_prefix'} ) { next if ( substr ($subname, 0, length($rules{'-ignore_prefix'})) eq $rules{'-ignore_prefix'} ); } if ( $rules{'-ignore_suffix'} ) { next if ( substr ($subname, length($subname) - length($rules{'-ignore_suffix'}), length($rules{'-ignore_suffix'}) ) eq $rules{'-ignore_suffix'} ); } if ( $rules{'-ignore_regexp'} ) { my $re = $rules{'-ignore_regexp'}; next if $subname =~ m/$re/o; } # avoid duplicate registration if ( !exists $help_for_sub{$subname} ) { $c->{'_commands'}->{$subname}->{'code'} = $subs{$subname}; App::Rad::Help->register_help($c, $subname, undef); } } } } } sub register_command { return register(@_) } sub register { my ($c, $command_name, $coderef, $helptext) = @_; $c->debug("got: " . ref $coderef); return undef unless ( (ref $coderef) eq 'CODE' ); $c->debug("registering $command_name as a command."); $c->{'_commands'}->{$command_name}->{'code'} = $coderef; App::Rad::Help->register_help($c, $command_name, $helptext); return $command_name; } sub unregister_command { return unregister(@_) } sub unregister { my ($c, $command_name) = @_; if ( $c->{'_commands'}->{$command_name} ) { delete $c->{'_commands'}->{$command_name}; } else { return undef; } } sub create_command_name { my $id = 0; foreach (commands()) { if ( m/^cmd(\d+)$/ ) { $id = $1 if ($1 > $id); } } return 'cmd' . ($id + 1); } sub commands { return ( keys %{$_[0]->{'_commands'}} ); } sub is_command { my ($c, $cmd) = @_; return (defined $c->{'_commands'}->{$cmd} ? 1 : 0 ); } sub command :lvalue { cmd(@_) } sub cmd :lvalue { $_[0]->{'cmd'}; } sub run { my $class = shift; my $c = {}; bless $c, $class; $c->_init(); # first we update the control functions # with any overriden value $c->_register_functions(); # then we run the setup to register # some commands $c->{'_functions'}->{'setup'}->($c); # now we get the actual input from # the command line (someone using the app!) $c->_get_input(); # run the specified command $c->execute(); # that's it. Tear down everything and go home :) $c->{'_functions'}->{'teardown'}->($c); return 0; } # run operations # in a shell-like environment #sub shell { # my $class = shift; # App::Rad::Shell::shell($class); #} sub execute { my ($c, $cmd) = @_; # given command has precedence if ($cmd) { $c->{'cmd'} = $cmd; } else { $cmd = $c->{'cmd'}; # now $cmd always has the called cmd } $c->debug('calling pre_process function...'); $c->{'_functions'}->{'pre_process'}->($c); $c->debug("executing '$cmd'..."); # valid command, run it if ($c->is_command($c->{'cmd'}) ) { $c->{'output'} = $c->{'_commands'}->{$cmd}->{'code'}->($c); } # no command, run default() elsif ( $cmd eq '' ) { $c->debug('no command detected. Falling to default'); $c->{'output'} = $c->{'_functions'}->{'default'}->($c); } # invalid command, run invalid() else { $c->debug("'$cmd' is not a valid command. Falling to invalid."); $c->{'output'} = $c->{'_functions'}->{'invalid'}->($c); } # 3: post-process the result # from the command $c->debug('calling post_process function...'); $c->{'_functions'}->{'post_process'}->($c); $c->debug('reseting output'); $c->{'output'} = undef; } sub argv { return $_[0]->{'_ARGV'} } sub options { return $_[0]->{'_options'} } sub stash { return $_[0]->{'_stash'} } sub config { return $_[0]->{'_config'} } # $c->plugins is sort of "read-only" externally sub plugins { my @plugins = @{$_[0]->{'_plugins'}}; return @plugins; } sub getopt { require Getopt::Long; Carp::croak "Getopt::Long needs to be version 2.36 or above" unless $Getopt::Long::VERSION >= 2.36; my ($c, @options) = @_; # reset values from tinygetopt $c->{'_options'} = {}; my $parser = new Getopt::Long::Parser; $parser->configure( qw(bundling) ); my @tARGV = @ARGV; # we gotta stick to our API my $ret = $parser->getoptions($c->{'_options'}, @options); @{$c->argv} = @ARGV; @ARGV = @tARGV; return $ret; } sub debug { if (shift->{'debug'}) { print "[debug] @_\n"; } } # gets/sets the output (returned value) # of a command, to be post processed sub output { my ($c, @msg) = @_; if (@msg) { $c->{'output'} = join(' ', @msg); } else { return $c->{'output'}; } } #=========================# # CONTROL FUNCTIONS # #=========================# sub setup { $_[0]->register_commands( {-ignore_prefix => '_'} ) } sub teardown {} sub pre_process {} sub post_process { my $c = shift; if ($c->output()) { print $c->output() . $/; } } sub default { my $c = shift; return $c->{'_commands'}->{'help'}->{'code'}->($c); } sub invalid { my $c = shift; return $c->{'_functions'}->{'default'}->($c); } } 42; # ...and thus ends thy module ;) __END__ =head1 NAME App::Rad - Rapid (and easy!) creation of command line applications =head1 VERSION Version 1.04 =head1 SYNOPSIS This is your smallest working application (let's call it I) use App::Rad; App::Rad->run(); That's it, your program already works and you can use it directly via the command line (try it!) [user@host]$ ./myapp.pl Usage: myapp.pl command [arguments] Available Commands: help show syntax and available commands Next, start creating your own functions (e.g.) inside I: sub hello { return "Hello, World!"; } And now your simple command line program I has a 'hello' command! [user@host]$ ./myapp.pl Usage: myapp.pl command [arguments] Available Commands: hello help show syntax and available commands [user@host]$ ./myapp.pl hello Hello, World! You could easily add a customized help message for your command through the 'Help()' attribute: sub hello :Help(give a nice compliment) { return "Hello, World!"; } And then, as expected: [user@host]$ ./myapp.pl Usage: myapp.pl command [arguments] Available Commands: hello give a nice compliment help show syntax and available commands App::Rad also lets you expand your applications, providing a lot of flexibility for every command, with embedded help, argument and options parsing, configuration file, default behavior, and much more: use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands( { foo => 'expand your foo!', bar => 'have a drink! arguments: --drink=DRINK', }); } sub foo { my $c = shift; $c->load_config('myapp.conf'); return 'foo expanded to ' . baz() * $c->config->{'myfoo'}; } # note that 'baz' was not registered as a command, # so it can't be called from the outside. sub baz { rand(10) } sub bar { my $c = shift; if ( $c->options->{'drink'} ) { return 'you asked for a ' . $c->options->{'drink'}; } else { return 'you need to ask for a drink'; } } You can try on the command line: [user@host]$ ./myapp.pl Usage: myapp.pl command [arguments] Available Commands: bar have a drink! arguments: --drink=DRINK foo expand your foo! help show syntax and available commands [user@host]$ ./myapp.pl bar --drink=martini you asked for a martini =head1 WARNING This module is very young, likely to change in strange ways and to have some bugs (please report if you find any!). I will try to keep the API stable, but even that is subject to change (let me know if you find anything annoying or have a wishlist). You have been warned! =head1 DESCRIPTION App::Rad aims to be a simple yet powerful framework for developing your command-line applications. It can easily transform your Perl I into reusable subroutines than can be called directly by the user of your program. It also tries to provide a handy interface for your common command-line tasks. B =head2 Extending App::Rad - Plugins! App::Rad plugins can be loaded by naming them as arguments to the C<< use App::Rad >> statement. Just ommit the C<< App::Rad::Plugin >> prefix from the plugin name. For example: use App::Rad qw(My::Module); will load the C<< App::Rad::Plugin::My::Module >> plugin for you! Developers are B encouraged to publish their App::Rad plugins under the C<< App::Rad::Plugin >> namespace. But, if your plugin start with a name other than that, you can fully qualify the name by using an unary plus sign: use App::Rad qw( My::Module +Fully::Qualified::Plugin::Name ); Note that plugins are loaded in the order in which they appear. B. And check out L<< App::Rad::Plugin >> if you want to create your own plugins. =head1 INSTANTIATION These are the main execution calls for the application. In your App::Rad programs, the B<*ONLY*> thing your script needs to actually (and actively) call is one of the instantiation (or dispatcher) methods. Leave all the rest to your subs. Currently, the only available dispatcher is run(): =head2 run() You'll be able to access all of your program's commands directly through the command line, as shown in the synopsis. =head1 BUILT-IN COMMANDS This module comes with the following default commands. You are free to override them as you see fit. =head2 help Shows help information for your program. This built-in function displays the program name and all available commands (including the ones you added yourself) if a user types the 'help' command, or no command at all, or any command that does not exist (as they'd fall into the 'default' control function which (by default) calls 'help'). You can also display specific embedded help for your commands, either explicitly registering them with C<< $c->register() >> or C<< $c->register_commands() >> inside C<< $c->setup() >> (see respective sections below) or with the Help() attribute: use App::Rad; App::Rad->run(); sub mycmd :Help(display a nice welcome message) { return "Welcome!"; } the associated help text would go like this: [user@host]$ ./myapp.pl Usage: myapp.pl command [arguments] Available Commands: help show syntax and available commands mycmd display a nice welcome message =head1 OTHER BUILT IN COMMANDS (OPT-IN) The 'include' and 'exclude' commands below let the user include and exclude commands to your program and, as this might be dangerous when the user is not yourself, you have to opt-in on them: use App::Rad qw(include); # add the 'include' command use App::Rad qw(exclude); # add the 'exclude' command though you'll probably want to set them both: use App::Rad qw(include exclude); =head2 include I<[command_name]> I<-perl_params> I<'your subroutine code'> Includes the given subroutine into your program on-the-fly, just as you would writing it directly into your program. Let's say you have your simple I<'myapp.pl'> program that uses App::Rad sitting on your system quietly. One day, perhaps during your sysadmin's tasks, you create a really amazing one-liner to solve a really hairy problem, and want to keep it for posterity (reusability is always a good thing!). For instance, to change a CSV file in place, adding a column on position #2 containing the line number, you might do something like this (this is merely illustrative, it's not actually the best way to do it): $ perl -i -paF, -le 'splice @F,1,0,$.; $_=join ",",@F' somesheet.csv And you just found out that you might use this other times. What do you do? App::Rad to the rescue! In the one-liner above, just switch I<'perl'> to I<'myapp.pl include SUBNAME'> and remove the trailing parameters (I): $ myapp.pl include addcsvcol -i -paF, -le 'splice @F,1,0,$.; $_=join ",",@F' That's it! Now myapp.pl has the 'addcsvcol' command (granted, not the best name) and you can call it directly whenever you want: $ myapp.pl addcsvcol somesheet.csv App::Rad not only transforms and adjusts your one-liner so it can be used inside your program, but also automatically formats it with Perl::Tidy (if you have it). This is what the one-liner above would look like inside your program: sub addcsvcol { my $c = shift; local ($^I) = ""; local ($/) = "\n"; local ($\) = "\n"; LINE: while ( defined( $_ = ) ) { chomp $_; our (@F) = split( /,/, $_, 0 ); splice @F, 1, 0, $.; $_ = join( ',', @F ); } continue { die "-p destination: $!\n" unless print $_; } } With so many arguments (-i, -p, -a -F,, -l -e), this is about as bad as it gets. And still one might find this way easier to document and mantain than a crude one-liner stored in your ~/.bash_history or similar. B If you don't supply a name for your command, App::Rad will make one up for you (cmd1, cmd2, ...). But don't do that, as you'll have a hard time figuring out what that specific command does. B =head2 exclude I Removes the requested function from your program. Note that this will delete the actual code from your program, so be *extra* careful. It is strongly recommended that you do not use this command and either remove the subroutine yourself or add the function to your excluded list inside I. Note that built-in commands such as 'help' cannot be removed via I. They have to be added to your excluded list inside I. =head1 ROLLING YOUR OWN COMMANDS Creating a new command is as easy as writing any sub inside your program. Some names ("setup", "default", "invalid", "pre_process", "post_process" and "teardown") are reserved for special purposes (see the I section of this document). App::Rad provides a nice interface for reading command line input and writing formatted output: =head2 The Controller Every command (sub) you create receives the controller object "C<< $c >>" (sometimes referred as "C<< $self >>" in other projects) as an argument. The controller is the main interface to App::Rad and has several methods to easen your command manipulation and execution tasks. =head2 Reading arguments When someone types in a command, she may pass some arguments to it. Those arguments can be accessed in four different ways, depending on what you want. This way it's up to you to control which and how many arguments (if at all) you want to receive and/or use. They are: =head3 @ARGV Perl's @ARGV array has all the arguments passed to your command, without the command name (use C<< $c->cmd >> for this) and without any processing (even if you explicitly use C<< $c->getopt >>, which will change $c->argv instead, see below). Since the command itself won't be in the @ARGV parameters, you can use it in each command as if they were stand-alone programs. =head3 $c->options App::Rad lets you automatically retrieve any POSIX syntax command line options (I) passed to your command via the $c->options method. This method returns a hash reference with keys as given parameters and values as... well... values. The 'options' method automatically supports two simple argument structures: Extended (long) option. Translates C<< --parameter or --parameter=value >> into C<< $c->options->{parameter} >>. If no value is supplied, it will be set to 1. Single-letter option. Translates C<< -p >> into C<< $c->options->{p} >>. Single-letter options can be nested together, so C<-abc> will be parsed into C<< $c->options->{a} >>, C<< $c->options->{b} >> and C<< $c->options{c} >>, while C<--abc> will be parsed into C<< $c->options->{abc} >>. We could, for instance, create a dice-rolling command like this: sub roll { my $c = shift; my $value = 0; for ( 1..$c->options->{'times'} ) { $value += ( int(rand ($c->options->{'faces'}) + 1)); } return $value; } And now you can call your 'roll' command like: [user@host]$ ./myapp.pl roll --faces=6 --times=2 Note that App::Rad does not control which arguments can or cannot be passed: they are all parsed into C<< $c->options >> and it's up to you to use whichever you want. For a more advanced use and control, see the C<< $c->getopt >> method below. Also note that single-letter options will be set to 1. However, if a user types them more than once, the value will be incremented accordingly. For example, if a user calls your program like so: [user@host]$ ./myapp.pl some_command -vvv or [user@host]$ ./myapp.pl some_command -v -v -v then, in both cases, C<< $c->options->{v} >> will be set to 3. This will let you easily keep track of how many times any given option was chosen, and still let you just check for definedness if you don't care about that. =head3 $c->argv The array reference C<< $c->argv >> contains every argument passed to your command that have B been parsed into C<< $c->options >>. This is usually a list of every provided argument that didn't start with a dash (-), unless you've called C<< $c->getopt >> and used something like 'param=s' (again, see below). =head3 $c->getopt (Advanced Getopt usage) App::Rad is also smoothly integrated with Getopt::Long, so you can have even more flexibility and power while parsing your command's arguments, such as aliases and types. Call the C<< $c->getopt() >> method anytime inside your commands (or just once in your "pre_process" function to always have the same interface) passing a simple array with your options, and refer back to $c->options to see them. For instance: sub roll { my $c = shift; $c->getopt( 'faces|f=i', 'times|t=i' ) or $c->execute('usage') and return undef; # and now you have $c->options->{'faces'} # and $c->options->{'times'} just like above. } This becomes very handy for complex or feature-rich commands. Please refer to the Getopt::Long module for more usage examples. B<< So, in order to manipulate and use any arguments, remember: >> =over 6 =item * The given command name does not appear in the argument list; =item * All given arguments are in C<< @ARGV >> =item * Automatically processed arguments are in C<< $c->options >> =item * Non-processed arguments (the ones C<< $c->options >> didn't catch) are in $c->argv =item * You can use C<< $c->getopt >> to have C<< Getopt::Long >> parse your arguments (it will B change C<< @ARGV >>) =back =head2 Sharing Data: C<< $c->stash >> The "stash" is a universal hash for storing data among your Commands: $c->stash->{foo} = 'bar'; $c->stash->{herculoids} = [ qw(igoo tundro zok gloop gleep) ]; $c->stash->{application} = { name => 'My Application' }; You can use it for more granularity and control over your program. For instance, you can email the output of a command if (and only if) something happened: sub command { my $c = shift; my $ret = do_something(); if ( $ret =~ /critical error/ ) { $c->stash->{mail} = 1; } return $ret; } sub post_process { my $c = shift; if ( $c->stash->{mail} ) { # send email alert... } else { print $c->output . "\n"; } } =head2 Returning output Once you're through, return whatever you want to give as output for your command: my $ret = "Here's the list: "; $ret .= join ', ', 1..5; return $ret; # this prints "Here's the list: 1, 2, 3, 4, 5" App::Rad lets you post-process the returned value of every command, so refrain from printing to STDOUT directly whenever possible as it will give much more power to your programs. See the I control function further below in this document. =head1 HELPER METHODS App::Rad's controller comes with several methods to help you manage your application easily. B. =head2 $c->execute( I ) Runs the given command. If no command is given, runs the one stored in C<< $c->cmd >>. If the command does not exist, the 'default' command is ran instead. Each I call also invokes pre_process and post_process, so you can easily manipulate income and outcome of every command. =head2 $c->cmd Returns a string containing the name of the command (that is, the first argument of your program), that will be called right after pre_process. =head3 $c->command Alias for C<< $c->cmd >>. This longer form is discouraged and may be removed in future versions, as one may confuse it with the C<< $c->commands() >> method, explained below. You have been warned. =head2 $c->commands() Returns a list of available commands (I) inside your program =head2 $c->is_command ( I ) Returns 1 (true) if the given I is available, 0 (false) otherwise. =head2 $c->create_command_name() Returns a valid name for a command (i.e. a name slot that's not been used by your program). This goes in the form of 'cmd1', 'cmd2', etc., so don't use unless you absolutely have to. App::Rad, for instance, uses this whenever you try to I (see below) a new command but do not supply a name for it. =head2 $c->load_config( I<< FILE (FILE2, FILE3, ...) >> ) This method lets you easily load into your program one or more configuration files written like this: # comments and blank lines are discarded key1 value1 key2:value2 key3=value3 key5 # stand-alone attribute (and inline-comment) =head2 $c->config Returns a hash reference with any loaded config values (see C<< $c->load_config() >> above). =head2 $c->register ( I, I [, I ]) Registers a coderef as a callable command. Note that you don't have to call this in order to register a sub inside your program as a command, run() will already do this for you - and if you don't want some subroutines to be issued as commands you can always use C<< $c->register_commands() >> (note the plural) inside setup(). This is just an interface to dinamically include commands in your programs. The function returns the command name in case of success, undef otherwise. It is also very useful for creating aliases for your commands: sub setup { my $c = shift; $c->register_commands(); $c->register('myalias', \&command); } sub command { return "Hi!" } and, on the command line: [user@host]$ ./myapp.pl command Hi! [user@host]@ ./myapp.pl myalias Hi! The last parameter is optional and lets you add inline help to your command: $c->register('cmd_name', \&cmd_func, 'display secret of life'); =head3 $c->register_command ( I, I [, I ] ) Longer alias for C<< $c->register() >>. It's use is disencouraged as one may confuse it with C (note the plural) below. Plus you type more :) As such, this method may be removed in future versions. You have been warned! =head2 $c->register_commands() This method, usually called during setup(), tells App::Rad to register subroutines as valid commands. If called without any parameters, it will register B subroutines in your main program as valid commands (note that the default behavior of App::Rad is to ignore subroutines starting with an underscore '_'). You can easily change this behavior using some of the options below: =head3 Adding single commands $c->register_commands( qw/foo bar baz/ ); The code above will register B the subs C, C and C as commands. Other subroutines will B be valid commands, so they can be used as internal subs for your program. You can change this behavior with the bundled options - see 'Adding several commands' and 'Putting it all together' below. =head3 Adding single commands (with inline help) $c->register_commands( { dos2unix => 'convert text files from DOS to Unix format', unix2dos => 'convert text files from Unix to DOS format', } ); You can pass a hash reference containing commands as keys and a small help string as their values. The code above will register B the subs C and C, and the default help for your program will become something like this: [user@host]$ ./myapp.pl Usage: myapp.pl command [arguments] Available Commands: dos2unix convert text files from DOS to Unix format help show syntax and available commands unix2dos convert text files from Unix to DOS format =head3 Adding several commands You can pass a hash reference as an argument, letting you choose which subroutines to add as commands. The following keys may be used (note the dash preceding each key): =over 4 =item * C<< -ignore_prefix >>: subroutine names starting with the given string won't be added as commands =item * C<< -ignore_suffix >>: subroutine names ending with the given string won't be added as commands =item * C<< -ignore_regexp >>: subroutine names matching the given regular expression (as a string) won't be added as commands =back For example: use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands( { -ignore_prefix => '_' } ); } sub foo {} # will become a command sub bar {} # will become a command sub _baz {} # will *NOT* become a command This way you can easily segregate between commands and helper functions, making your code even more reusable without jeopardizing the command line interface (As of version 1.04, ignoring commands with underscore '_' prefixes is also the default App::Rad behavior). =head3 Putting it all together You can combine some of the options above to have even more flexibility: $c->register_commands( 'foo', { -ignore_suffix => 'foo' }, { bar => 'all your command line are belong to us' }, ); The code above will register as commands all subs with names B ending in 'foo', but it B register the 'foo' sub as well. It will also give the 'bar' command the help string. This behavior is handy for registering several commands and having a few exceptions, or to add your commands and only have inline help for a few of them (as you see fit). You don't have to worry about the order of your elements passed, App::Rad will figure them out for you in a DWIM fashion. # this does the same as the code above $c->register_commands( { bar => 'all your command line are belong to us' }, 'foo', { -ignore_suffix => 'foo' }, ); You can even bundle the hash reference to include your C<< cmd => help >> and special keys: # this behaves the same way as the code above: $c->register_commands( 'foo', { -ignore_suffix => 'foo', bar => 'all your command line are belong to us', } ); =head2 $c->unregister_command ( I ) Longer alias for C<< $c->unregister() >>. The use of the shorter form is encouraged, and this alias may be removed in future versions. You have been warned. =head3 $c->unregister ( I ) Unregisters a given command name so it's not available anymore. Note that the subroutine will still be there to be called from inside your program - it just won't be accessible via command line anymore. =head2 $c->debug( I ) Will print the given message on screen only if the debug flag is enabled: use App::Rad qw( debug ); Note that, if debug is enabled, App::Rad itself will print several debug messages stating its current flow, so you can easily find out where everything is happening. =head2 $c->plugins() Returns a list of all loaded plugins, in the order in which they were loaded. =head2 $c->load_plugin( I ) This method will dinamically load the given plugin. The plugin needs to be under the C<< App::Rad::Plugin >> namespace, and the name should be relative to this path (i.e. $c->load_plugin('MyPlugin') will try to load 'App::Rad::Plugin::MyPlugin'). If you want to load a plugin by its fully qualified name, you need to prepend a plus sign to the name ('+Fully::Qualified::Plugin::Name'). B and you really should refrain from using it. Instead, plugins should be loaded as parameters to the C<< use App::Rad >> statement, as explained above. =head1 CONTROL FUNCTIONS (to possibly override) App::Rad implements some control functions which are expected to be overridden by implementing them in your program. They are as follows: =head2 setup() This function is responsible for setting up what your program can and cannot do, plus everything you need to set before actually running any command (connecting to a database or host, check and validate things, download a document, whatever). Note that, if you override setup(), you B<< *must* >> call C<< $c->register_commands() >> or at least C<< $c->register() >> so your subs are classified as valid commands (check $c->register_commands() above for more information). Another interesting thing you can do with setup is to manipulate the command list. For instance, you may want to be able to use the C and C commands, but not let them available for all users. So instead of writing: use App::Rad qw(include exclude); App::Rad->run(); you can write something like this: use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands(); # EUID is 'root' if ( $> == 0 ) { $c->register('include', \&App::Rad::include); $c->register('exclude', \&App::Rad::exclude); } } to get something like this: [user@host]$ myapp.pl help Usage: myapp.pl command [arguments] Available Commands: help [user@host]$ sudo myapp.pl help Usage: myapp.pl command [arguments] Available Commands: exclude help include =head2 default() If no command is given to your application, it will fall in here. Please note that invalid (non-existant) command will fall here too, but you can change this behavior with the invalid() function below (although usually you don't want to). Default's default (grin) is just an alias for the help command. sub default { my $c = shift; # will fall here if the given # command isn't valid. } You are free (and encouraged) to change the default behavior to whatever you want. This is rather useful for when your program will only do one thing, and as such it receives only parameters instead of command names. In those cases, use the "C<< default() >>" sub as your main program's sub and parse the parameters with C<< $c->argv >> and C<< $c->getopt >> as you would in any other command. =head2 invalid() This is a special function to provide even more flexibility while creating your command line applications. This is called when the user requests a command that does not exist. The built-in C<< invalid() >> will simply redirect itself to C<< default() >> (see above), so usually you just have to worry about this when you want to differentiate between "no command given" (with or without getopt-like arguments) and "invalid command given" (with or without getopt-like arguments). =head2 teardown() If implemented, this function is called automatically after your application runs. It can be used to clean up after your operations, removing temporary files, disconnecting a database connection established in the setup function, logging, sending data over a network, or even storing state information via Storable or whatever. =head2 pre_process() If implemented, this function is called automatically right before the actual wanted command is called. This way you have an optional pre-run hook, which permits functionality to be added, such as preventing some commands to be run from a specific uid (e.g. I): sub pre_process { my $c = shift; if ( $c->cmd eq 'some_command' and $> != 0 ) { $c->cmd = 'default'; # or some standard error message } } =head2 post_process() If implemented, this function is called automatically right after the requested function returned. It receives the Controller object right after a given command has been executed (and hopefully with some output returned), so you can manipulate it at will. In fact, the default "post_process" function is as goes: sub post_process { my $c = shift; if ( $c->output() ) { print $c->output() . "\n"; } } You can override this function to include a default header/footer for your programs (either a label or perhaps a "Content-type: " string), parse the output in any ways you see fit (CPAN is your friend, as usual), etc. =head1 IMPORTANT NOTE ON PRINTING INSIDE YOUR COMMANDS B. Using I (or I, in 5.10) to send output to STDOUT is exclusively the domain of the post_process() function. Breaking this rule is a common source of errors. If you want your functions to be interactive (for instance) and print everything themselves, you should disable post-processing in setup(), or create an empty post_process function or make your functions return I (so I will only add a blank line to the output). =head1 DIAGNOSTICS If you see a '1' printed on the screen after a command is issued, it's probably because that command is returning a "true" value instead of an output string. If you don't want to return the command output for post processing(you'll loose some nice features, though) you can return undef or make post_process() empty. =head1 CONFIGURATION AND ENVIRONMENT App::Rad requires no configuration files or environment variables. =head1 DEPENDENCIES App::Rad depends only on 5.8 core modules (Carp for errors, Getopt::Long for "$c->getopt", Attribute::Handlers for "help" and O/B::Deparse for the "include" command). If you have Perl::Tidy installed, the "include" command will tidy up your code before inclusion. The test suite depends on Test::More, FindBin and File::Temp, also core modules. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc App::Rad Although this Module comes without any warraties whatsoever (see DISCLAIMER below), I try really hard to provide some quality assurance for the users. This means I not only try to close all reported bugs in the minimum amount of time but I also try to find some on my own. This version of App::Rad comes with 183 tests and I keep my eye constantly on CPAN Testers L to ensure it passes all of them, in all platforms. You can send me your own App::Rad tests if you feel I'm missing something and I'll hapilly add them to the distribution. Since I take user's feedback very seriously, I really hope you send me any wishlist/TODO you'd like App::Rad to have (please try to send them via RT so other people can give their own suggestions). You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head2 IRC #app-rad on irc.perl.org =head1 TODO This is a small list of features I plan to add in the near future (in no particular order). Feel free to contribute with your wishlist and comentaries! =over 4 =item * Shell-like environment =item * Loadable commands (in an external container file) =item * Modularized commands (similar to App::Cmd::Commands ?) =item * app-starter =item * command inclusion by prefix, suffix and regexp (feature request by fco) =item * command inclusion and exclusion also by attributes =item * some extra integration, maybe IPC::Cmd and IO::Prompt =back =head1 AUTHOR Breno G. de Oliveira, C<< >> =head1 CONTRIBUTORS (in alphabetical order) Ben Hengst Fernando Correa Flavio Glock Thanks to everyone for contributing! Please let me know if I've skipped your name by accident. =head1 ACKNOWLEDGEMENTS This module was inspired by Kenichi Ishigaki's presentation I<"Web is not the only one that requires frameworks"> during YAPC::Asia::2008 and the modules it exposed (mainly App::Cmd and App::CLI). Also, many thanks to CGI::App(now Titanium)'s Mark Stosberg and all the Catalyst developers, as some of App::Rad's functionality was taken from those (web) frameworks. =head1 LICENSE AND COPYRIGHT Copyright 2008 Breno G. de Oliveira C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. App-Rad-1.05/lib/App/Rad/0000755000175000017500000000000012154231310013325 5ustar garugaruApp-Rad-1.05/lib/App/Rad/Plugin.pod0000644000175000017500000000711511170541672015307 0ustar garugaru=head1 NAME App::Rad::Plugin - Extend the App::Rad framework! =head1 SYNOPSIS This document is intended to help developers write their own App::Rad plugins. For specific usage on any given plugin, please refer to it's actual documentation. =head1 WARNING! Since the plugin API is very new, there might be some changes in the future. Please drop me an email or RT wishlist if you feel something can be done to make plugin creation even better. Thanks! =head1 PLUGIN CREATION BASICS Creating App::Rad plugins is very easy. package App::Rad::Plugin::MyPlugin; and create your subs as if they were methods of the App::Rad's C<< $c >> variable. sub newmethod { my $c = shift; # ... } If a user invokes your plugin, she can use your new methods at any point in their program: use App::Rad qw(MyPlugin); App::Rad->run(); sub default { my $c = shift; $c->newmethod(); # this works! } you can also extend App::Rad's functionality by overriding methods, such as C<< getopt >> or C<< config >>. =head1 CREATING INTERNAL (HELPER) SUBS App::Rad will only import methods not starting with an underscore: package App::Rad::Plugin::YetAnother; sub something { my $c = shift; _internal( $c->stash->{somevalue} ); } sub _internal { my $value = shift; #... } So you can safely create several internal subs for your plugin. use App::Rad qw(YetAnother); sub default { my $c = shift; $c->something() # this works! $c->_internal() # this won't... } =head1 RESERVED SUB NAMES Currently there are no reserved names for your plugin subs. However, they might be added in the future to be called on some predefined times in the App::Rad command workflow. Let me know if you feel this would improve your plugin's usability. Thanks! =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc App::Rad::Plugin =head1 AUTHOR Breno G. de Oliveira, C<< >> =head1 ACKNOWLEDGEMENTS Lots of thanks to Fernando Correa (FCO) for his help with this module. =head1 LICENSE AND COPYRIGHT Copyright 2009 Breno G. de Oliveira C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. App-Rad-1.05/lib/App/Rad/Config.pm0000644000175000017500000000144211177706747015122 0ustar garugarupackage App::Rad::Config; sub load_config { my ($c, @files) = (@_); foreach my $filename (@files) { $c->debug("loading configuration from $filename"); open my $CONFIG, '<', $filename or Carp::croak "error opening $filename: $!\n"; while (<$CONFIG>) { chomp; s/#.*//; s/^\s+//; s/\s+$//; next unless length; if ( m/^([^\=\:\s]+) # key (?: # (value is optional) (?:\s*[\=\:]\s*|\s+) # separator ('=', ':' or whitespace) (.+) # value )? /x ) { $c->config->{$1} = $2; } } close $CONFIG; } } 42; App-Rad-1.05/lib/App/Rad/Include.pm0000644000175000017500000001730711123343476015272 0ustar garugarupackage App::Rad::Include; use Carp qw/carp croak/; use strict; use warnings; our $VERSION = '0.01'; sub load { my ($self, $c) = @_; $c->register('include', \&include, 'include one-liner as a command'); } # translates one-liner into # a complete, readable code sub _get_oneliner_code { return _sanitize( _deparse($_[0]) ); } #TODO: option to do it saving a backup file # (behavior probably set via 'setup') # inserts the string received # (hopefully code) inside the # user's program file as a 'sub' sub _insert_code_in_file { my ($command_name, $code_text) = @_; my $sub =<<"EOSUB"; sub $command_name { $code_text } EOSUB # tidy up the code, if Perl::Tidy is available eval "use Perl::Tidy ()"; if (! $@) { my $new_code = ''; Perl::Tidy::perltidy( argv => '', source => \$sub, destination => \$new_code ); $sub = $new_code; } #TODO: flock # eval { # use 'Fcntl qw(:flock)'; # } # if ($@) { # carp 'Could not load file locking module'; # } #TODO: I really should be using PPI #if the user has it installed... #or at least a decent parser open my $fh, '+<', $0 or croak "error updating file $0: $!\n"; # flock($fh, LOCK_EX) or carp "could not lock file $0: $!\n"; my @file = <$fh>; _insert_code_into_array(\@file, $sub); # TODO: only change the file if # it's eval'd without errors seek ($fh, 0, 0) or croak "error seeking file $0: $!\n"; print $fh @file or croak "error writing to file $0: $!\n"; truncate($fh, tell($fh)) or croak "error truncating file $0: $!\n"; close $fh; } sub _insert_code_into_array { my ($file_array_ref, $sub) = @_; my $changed = 0; $sub = "\n\n" . $sub . "\n\n"; my $line_id = 0; while ( $file_array_ref->[$line_id] ) { # this is a very rudimentary parser. It assumes a simple # vanilla application as shown in the main example, and # tries to include the given subroutine just after the # App::Rad->run(); call. next unless $file_array_ref->[$line_id] =~ /App::Rad->run/; # now we add the sub (hopefully in the right place) splice (@{$file_array_ref}, $line_id + 1, 0, $sub); $changed = 1; last; } continue { $line_id++; } if ( not $changed ) { croak "error finding 'App::Rad->run' call. $0 does not seem a valid App::Rad application.\n"; } } # deparses one-liner into a working subroutine code sub _deparse { my $arg_ref = shift; # create array of perl command-line # parameters passed to this one-liner my @perl_args = (); while ( $arg_ref->[0] =~ m/^-/o ) { push @perl_args, (shift @{$arg_ref}); } #TODO: I don't know if "O" and # "B::Deparse" can actually run the same way as # a module as it does via -MO=Deparse. # and while I can't figure out how to use B::Deparse # to do exactly what it does via 'compile', I should # at least catch the stderr buffer from qx via # IPC::Cmd's run(), but that's another TODO my $deparse = join ' ', @perl_args; my $code = $arg_ref->[0]; my $body = qx{perl -MO=Deparse $deparse '$code'}; return $body; } # tries to adjust a subroutine into # App::Rad's API for commands sub _sanitize { my $code = shift; # turns BEGIN variables into local() ones $code =~ s{(?:local\s*\(?\s*)?(\$\^I|\$/|\$\\)} {local ($1)}g; # and then we just strip any BEGIN blocks $code =~ s{BEGIN\s*\{\s*(.+)\s*\}\s*$} {$1}mg; my $codeprefix =<<'EOCODE'; my $c = shift; EOCODE $code = $codeprefix . $code; return $code; } # includes a one-liner as a command. # TODO: don't let the user include # a control function!!!! sub include { my $c = shift; my @args = @ARGV; if( @args < 3 ) { return "Sintax: $0 include [name] -perl_params 'code'.\n"; } # figure out the name of # the command to insert. # Either the user chose it already # or we choose it for the user my $command_name = ''; if ( $args[0] !~ m/^-/o ) { $command_name = shift @args; # don't let the user add a command # that already exists if ( $c->is_command($command_name) ) { return "Command '$command_name' already exists. Please remove it first with '$0 exclude $command_name"; } } else { $command_name = $c->create_command_name(); } $c->debug("including command '$command_name'..."); my $code_text = _get_oneliner_code(\@args); _insert_code_in_file($command_name, $code_text); # turns code string into coderef so we # can register it (just in case the user # needs to run it right away) my $code_ref = sub { eval $code_text}; $c->register($command_name, $code_ref); return; } 42; __END__ =head1 NAME App::Rad::Include - 'include' command extension for App::Rad =head1 VERSION Version 0.01 =head1 SYNOPSIS 'include' is an opt-in command for you App::Rad programs (myapp.pl): use App::Rad qw(include); # add the 'include' command App::Rad->run(); and now you can turn your one-liners (e.g:) [user@host]$ perl -i -pe 's/\r//' file.txt into nice scalable commands, simply replacing 'perl' for 'yourapp include ' [user@host]$ myapp.pl include dos2unix -i -pe 's/\r//' and there you go, a brand new 'dos2unix' command: [user@host]$ myapp.pl dos2unix file.txt =head1 DESCRIPTION This is an internal module for App::Rad and should not be used separately. Please refer to L<< App::Rad >> for further documentation. =head1 INTERNAL METHODS =head2 load Loads the module into App::Rad =head2 include Translates perl one-liner into self-contained command (subroutine) and adds it to your App::Rad program. =head1 DEPENDENCIES =over 4 =item * O, which is core in Perl 5.8. =item * B::Deparse, also core in 5.8. =item * Perl::Tidy (optional) =back =head1 AUTHOR Breno G. de Oliveira, C<< >> =head1 ACKNOWLEDGEMENTS The one-liner conversion and beautification was *much* easened because of the nice C<< O >> , C<< B::Deparse >> and C<< Perl::Tidy >> modules. So many thanks to Malcolm Beattie, Nicholas Clark, Stephen McCamant, Steve Hancock, and everyone that helped those projects. =head1 LICENSE AND COPYRIGHT Copyright 2008 Breno G. de Oliveira C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. App-Rad-1.05/lib/App/Rad/Exclude.pm0000644000175000017500000001234611123343537015274 0ustar garugarupackage App::Rad::Exclude; use Carp qw/carp croak/; use strict; use warnings; our $VERSION = '0.01'; sub load { my ($self, $c) = @_; $c->register('exclude', \&exclude, 'completely erase command from your program'); } # removes given sub from the # main program sub _remove_code_from_file { my $sub = shift; #TODO: I really should be using PPI #if the user has it installed... open my $fh, '+<', $0 or croak "error updating file $0: $!\n"; # flock($fh, LOCK_EX) or carp "could not lock file $0: $!\n"; my @file = <$fh>; my $ret = _remove_code_from_array(\@file, $sub); # TODO: only change the file if it's eval'd without errors seek ($fh, 0, 0) or croak "error seeking file $0: $!\n"; print $fh @file or croak "error writing to file $0: $!\n"; truncate($fh, tell($fh)) or croak "error truncating file $0: $!\n"; close $fh; return $ret; } sub _remove_code_from_array { my $file_array_ref = shift; my $sub = shift; my $index = 0; my $open_braces = 0; my $close_braces = 0; my $sub_start = 0; while ( $file_array_ref->[$index] ) { if ($file_array_ref->[$index] =~ m/\s*sub\s+$sub(\s+|\s*\{)/) { $sub_start = $index; } if ($sub_start) { # in order to see where the sub ends, we'll # try to count the number of '{' against # the number of '}' available #TODO:I should use an actual LR parser or #something. This would be greatly enhanced #and much less error-prone, specially for #nested symbols in the same line. $open_braces++ while $file_array_ref->[$index] =~ m/\{/g; $close_braces++ while $file_array_ref->[$index] =~ m/\}/g; if ( $open_braces > 0 ) { if ( $close_braces > $open_braces ) { croak "Error removing $sub: could not parse $0 correctly."; } elsif ( $open_braces == $close_braces ) { # remove lines from array splice (@{$file_array_ref}, $sub_start, ($index + 1 - $sub_start)); last; } } } } continue { $index++; } if ($sub_start == 0) { return "Error finding '$sub' command. Built-in?"; } else { return "Command '$sub' successfuly removed."; } } sub exclude { my $c = shift; if ( $c->argv->[0] ) { if ( $c->is_command( $c->argv->[0] ) ) { return _remove_code_from_file($c->argv->[0]); } else { return $c->argv->[0] . ' is not an available command'; } } else { return "Sintax: $0 exclude command_name" } } 42; __END__ =head1 NAME App::Rad::Exclude - 'exclude' command extension for App::Rad =head1 VERSION Version 0.01 =head1 SYNOPSIS 'exclude' is an opt-in command for you App::Rad programs (myapp.pl): use App::Rad qw(exclude); # add the 'exclude' command App::Rad->run(); sub mycmd { print "hello, world\n"; } and now you can permanently remove a command from your application [user@host]$ myapp.pl exclude mycmd Note that this B<*will*> edit the program's source code and try to remove the command (subroutine) automatically, so use it with extreme caution. =head1 DESCRIPTION This is an internal module for App::Rad and should not be used separately. Please refer to L<< App::Rad >> for further documentation. =head1 INTERNAL METHODS =head2 load Loads the module into App::Rad =head2 exclude Removes given command (subroutine) from your App::Rad program. =head1 DEPENDENCIES =over 4 =item * Carp, which is core in Perl 5.8. =back =head1 AUTHOR Breno G. de Oliveira, C<< >> =head1 LICENSE AND COPYRIGHT Copyright 2008 Breno G. de Oliveira C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. App-Rad-1.05/lib/App/Rad/Help.pm0000644000175000017500000001177511170267350014600 0ustar garugarupackage App::Rad::Help; use Attribute::Handlers; use strict; use warnings; our $VERSION = '0.03'; sub load { my ($self, $c) = @_; $c->register('help', \&help, 'show syntax and available commands'); } # shows specific help commands # TODO: context specific help, # such as "myapp.pl help command" sub help { my $c = shift; return usage() . "\n\n" . helpstr($c); } sub usage { return "Usage: $0 command [arguments]"; } sub helpstr { my $c = shift; my $string = "Available Commands:\n"; # get length of largest command name my $len = 0; foreach ( sort $c->commands() ) { $len = length($_) if (length($_) > $len); } # format help string foreach ( sort $c->commands() ) { $string .= sprintf " %-*s\t%s\n", $len, $_, defined ($c->{'_commands'}->{$_}->{'help'}) ? $c->{'_commands'}->{$_}->{'help'} : '' ; ; } return $string; } { my %help_attr = (); sub UNIVERSAL::Help :ATTR(CODE) { my ($package, $symbol, $ref, $attr, $data, $phase, $filename, $linenum) = @_; if ($package eq 'main') { # If data is a single word, it is received as an array ref. Don't ask. $data = join(' ', @$data) if ref($data) eq 'ARRAY'; $help_attr{ *{$symbol}{NAME} } = $data; } } sub register_help { my ($self, $c, $cmd, $helptext) = @_; if ((not defined $helptext) && (defined $help_attr{$cmd})) { $helptext = $help_attr{$cmd}; } # we do $helptext // undef as it would issue a warning otherwise $c->{'_commands'}->{$cmd}->{'help'} = defined $helptext ? $helptext : undef ; } } 42; __END__ =head1 NAME App::Rad::Help - 'help' command extension for App::Rad =head1 VERSION Version 0.02 =head1 SYNOPSIS you can add inline help for your App::Rad commands via C<< $c->register() >> or C<< $c->register_commands() >>: use App::Rad; App::Rad->run(); sub setup { my $c = shift; $c->register_commands( { foo => 'expand your foo!', bar => 'have a drink! arguments: --drink=DRINK', }); $c->register('baz', \&baz, 'do your thing'); } you can also do it with the attribute 'Help' in your subs sub my_command :Help(this is my command) { ... } sub another_cmd :Help(yet another command) { ... } =head1 DESCRIPTION This is an internal module for App::Rad and should not be used separately (unless, perhaps, you want to use one of its methods to customize your own 'help' command). Please refer to L<< App::Rad >> for further documentation. =head1 INTERNAL METHODS =head2 load Loads the module into App::Rad =head2 help Show help text =head2 register_help Associates help text with command =head2 usage Prints usage string. Default is "Usage: $0 command [arguments]", where $0 is your program's name. =head2 helpstr Prints a help string with all available commands and their help description. =head1 DEPENDENCIES =over 4 =item * Attribute::Handlers, which is core as of Perl 5.8. =back =head1 AUTHOR Breno G. de Oliveira, C<< >> =head1 ACKNOWLEDGEMENTS The attribute handling was *much* easened because of the nice C<< Attribute::Handlers >> module. So many thanks to Damian Conway, Rafael Garcia-Suarez and Steffen Mueller. =head1 LICENSE AND COPYRIGHT Copyright 2008 Breno G. de Oliveira C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.