lib/Catalyst/ScriptRole.pm

   1 package Catalyst::ScriptRole;
   2 use Moose::Role;
   3 use MooseX::Types::Moose qw/Str Bool/;
   4 use Pod::Usage;
   5 use namespace::autoclean;
   6
   7 with 'MooseX::Getopt';
   8
   9 has application_name => (
  10     traits => ['NoGetopt'],
  11     isa => Str,
  12     is => 'ro',
  13     required => 1,
  14 );
  15
  16 has help => (
  17     traits => ['Getopt'],
  18     isa => Bool,
  19     is => 'ro',
  20     documentation => q{Display this help and exit},
  21 );
  22
  23 sub _exit_with_usage {
  24     my $self = shift;
  25     pod2usage();
  26     exit 0;
  27 }
  28
  29 before run => sub {
  30     my $self = shift;
  31     $self->_exit_with_usage if $self->help;
  32 };
  33
  34 sub run {
  35     my $self = shift;
  36     $self->_run_application;
  37 }
  38
  39 sub _application_args {
  40     ()
  41 }
  42
  43 sub _run_application {
  44     my $self = shift;
  45     my $app = $self->application_name;
  46     Class::MOP::load_class($app);
  47     $app->run($self->_application_args);
  48 }
  49
  50 # GROSS HACK, temporary until MX::Getopt gets some proper refactoring and unfucking..
  51 around '_parse_argv' => sub {
  52     my ($orig, $self, @args) = @_;
  53     my %data = eval { $self->$orig(@args) };
  54     $self->_exit_with_usage($@) if $@;
  55     $data{usage} = Catalyst::ScriptRole::Useage->new(code => sub { shift; $self->_exit_with_usage(@_) });
  56     return %data;
  57 };
  58
  59 # This package is going away.
  60 package # Hide from PAUSE
  61     Catalyst::ScriptRole::Useage;
  62 use Moose;
  63 use namespace::autoclean;
  64
  65 has code => ( is => 'ro', required => 1 );
  66
  67 sub die { shift->code->(@_) }
  68
  69 1;
  70
  71 =head1 NAME
  72
  73 Catalyst::ScriptRole - Common functionality for Catalyst scripts.
  74
  75 =head1 SYNOPSIS
  76
  77     package MyApp::Script::Foo;
  78     use Moose;
  79     use namespace::autoclean;
  80
  81     with 'Catalyst::Script::Role';
  82
  83      sub _application_args { ... }
  84
  85 =head1 DESCRIPTION
  86
  87 Role with the common functionality of Catalyst scripts.
  88
  89 =head1 METHODS
  90
  91 =head2 run
  92
  93 The method invoked to run the application.
  94
  95 =head1 ATTRIBUTES
  96
  97 =head2 application_name
  98
  99 The name of the application class, e.g. MyApp
 100
 101 =head1 SEE ALSO
 102
 103 L<Catalyst>
 104
 105 L<MooseX::Getopt>
 106
 107 =head1 AUTHORS
 108
 109 Catalyst Contributors, see Catalyst.pm
 110
 111 =head1 COPYRIGHT
 112
 113 This library is free software, you can redistribute it and/or modify
 114 it under the same terms as Perl itself.
 115
 116 =cut
 117