MooseX-Runnable-0.03/0000755000175000017500000000000011411550611012543 5ustar jonjonMooseX-Runnable-0.03/README0000644000175000017500000000000011163610335013415 0ustar jonjonMooseX-Runnable-0.03/.gitignore0000644000175000017500000000012311202500610014517 0ustar jonjoncover_db META.yml Makefile blib inc pm_to_blib MANIFEST Makefile.old /MANIFEST.bak MooseX-Runnable-0.03/xt/0000755000175000017500000000000011411550611013176 5ustar jonjonMooseX-Runnable-0.03/xt/pod.t0000644000175000017500000000021411163610335014146 0ustar jonjon#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); MooseX-Runnable-0.03/xt/pod-coverage.t0000644000175000017500000000025411163610335015743 0ustar jonjon#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); MooseX-Runnable-0.03/META.yml0000644000175000017500000000134111411550607014020 0ustar jonjon--- abstract: 'tag a class as a runnable application' author: - 'Jonathan Rockway C<< >>' build_requires: ExtUtils::MakeMaker: 6.42 Test::More: 0 Test::TableDriven: 0 ok: 0 configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module generated_by: 'Module::Install version 0.92' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: MooseX-Runnable no_index: directory: - example - inc - t - xt requires: List::MoreUtils: 0 Moose: 0 MooseX::Getopt: 0 MooseX::Types: 0.10 MooseX::Types::Path::Class: 0 Params::Util: 0 namespace::autoclean: 0 resources: license: http://dev.perl.org/licenses/ version: 0.03 MooseX-Runnable-0.03/Makefile.PL0000644000175000017500000000066411411545424014531 0ustar jonjonuse inc::Module::Install; name 'MooseX-Runnable'; all_from 'lib/MooseX/Runnable.pm'; requires 'Moose'; requires 'MooseX::Getopt'; # not really requires 'MooseX::Types' => '0.10'; requires 'MooseX::Types::Path::Class'; requires 'namespace::autoclean'; requires 'List::MoreUtils'; requires 'Params::Util'; build_requires 'Test::More'; build_requires 'ok'; build_requires 'Test::TableDriven'; install_script 'bin/mx-run'; WriteAll(); MooseX-Runnable-0.03/MANIFEST0000644000175000017500000000220311265024537013703 0ustar jonjon.gitignore bin/mx-run Changes example/LongRunning.pm example/MyApp.pm inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Scripts.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/MooseX/Runnable.pm lib/MooseX/Runnable/Invocation.pm lib/MooseX/Runnable/Invocation/MxRun.pm lib/MooseX/Runnable/Invocation/Plugin/Debug.pm lib/MooseX/Runnable/Invocation/Plugin/PAR.pm lib/MooseX/Runnable/Invocation/Plugin/Profile.pm lib/MooseX/Runnable/Invocation/Plugin/Restart.pm lib/MooseX/Runnable/Invocation/Plugin/Restart/Auto.pm lib/MooseX/Runnable/Invocation/Plugin/Restart/Base.pm lib/MooseX/Runnable/Invocation/Plugin/Role/CmdlineArgs.pm lib/MooseX/Runnable/Invocation/Role/WithParsedArgs.pm lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm lib/MooseX/Runnable/Run.pm lib/MooseX/Runnable/Util/ArgParser.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00-load.t t/arg-parser.t t/basic-mx-getopt.t t/basic.t t/invocation-plugin-initargs.t t/reverse-args.t xt/pod-coverage.t xt/pod.t MooseX-Runnable-0.03/inc/0000755000175000017500000000000011411550611013314 5ustar jonjonMooseX-Runnable-0.03/inc/Module/0000755000175000017500000000000011411550611014541 5ustar jonjonMooseX-Runnable-0.03/inc/Module/Install/0000755000175000017500000000000011411550611016147 5ustar jonjonMooseX-Runnable-0.03/inc/Module/Install/Metadata.pm0000644000175000017500000003626711411550607020250 0ustar jonjon#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords }; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the reall old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub _extract_license { if ( $_[0] =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyrights?|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1, 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } } else { return; } } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( \Qhttp://rt.cpan.org/\E[^>]+| \Qhttp://github.com/\E[\w_]+/[\w_]+/issues| \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; MooseX-Runnable-0.03/inc/Module/Install/WriteAll.pm0000644000175000017500000000222211411550607020233 0ustar jonjon#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92';; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; MooseX-Runnable-0.03/inc/Module/Install/Can.pm0000644000175000017500000000333311411550607017215 0ustar jonjon#line 1 package Module::Install::Can; use strict; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 156 MooseX-Runnable-0.03/inc/Module/Install/Base.pm0000644000175000017500000000176611411550607017376 0ustar jonjon#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '0.92'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 154 MooseX-Runnable-0.03/inc/Module/Install/Win32.pm0000644000175000017500000000340311411550607017414 0ustar jonjon#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; MooseX-Runnable-0.03/inc/Module/Install/Fetch.pm0000644000175000017500000000462711411550607017554 0ustar jonjon#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; MooseX-Runnable-0.03/inc/Module/Install/Scripts.pm0000644000175000017500000000101111411550607020132 0ustar jonjon#line 1 package Module::Install::Scripts; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; MooseX-Runnable-0.03/inc/Module/Install/Makefile.pm0000644000175000017500000001753611411550607020243 0ustar jonjon#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.92'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/; $self->build_requires( 'ExtUtils::MakeMaker' => $v ); $self->configure_requires( 'ExtUtils::MakeMaker' => $v ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $build_prereq->{$file}; #Delete from build prereqs only } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 426 MooseX-Runnable-0.03/inc/Module/Install.pm0000644000175000017500000002501511411550607016515 0ustar jonjon#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.92'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; # Save to the singleton $MAIN = $self; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[0]) <=> _version($_[1]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2010 Adam Kennedy. MooseX-Runnable-0.03/Changes0000644000175000017500000000065711411550540014047 0ustar jonjon0.03 Sat Jun 26 23:19:41 CDT 2010 - modified verification of RunnableClass values to use Params::Util::_CLASS (Karen Etheridge) 0.02 Mon Nov 2 02:30:10 CST 2009 - fix bug where roles of superclasses were not considered when applying invocation schemes. 0.01 Tue Oct 13 02:04:03 CDT 2009 - stable release, no major changes 0.00_01 Wed Apr 29 10:58:09 CDT 2009 - first release MooseX-Runnable-0.03/example/0000755000175000017500000000000011411550611014176 5ustar jonjonMooseX-Runnable-0.03/example/LongRunning.pm0000644000175000017500000000031211202500307016763 0ustar jonjonpackage LongRunning; use Moose; use 5.010; with 'MooseX::Runnable'; # I use this to test the +Restart plugins sub run { say "[$$] App is starting"; while(1){ sleep 86400; } } 1; MooseX-Runnable-0.03/example/MyApp.pm0000644000175000017500000000056411164355461015602 0ustar jonjonpackage MyApp; use Moose; use 5.010; with 'MooseX::Runnable', 'MooseX::Getopt'; has 'name' => ( is => 'ro', isa => 'Str', default => 'world', documentation => 'Your name, defaults to "world"' ); sub run { my ($self, $name) = @_; say 'Hello, '. $self->name. '.'; return 0; } 1; __END__ cd to this dir, and then run "mx-run MyApp --help" MooseX-Runnable-0.03/MANIFEST.SKIP0000644000175000017500000000012311163610335014441 0ustar jonjon.git/ blib pm_to_blib MANIFEST.bak MANIFEST.SKIP~ cover_db Makefile$ Makefile.old$ MooseX-Runnable-0.03/lib/0000755000175000017500000000000011411550611013311 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/0000755000175000017500000000000011411550611014523 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/0000755000175000017500000000000011411550611016271 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Run.pm0000644000175000017500000000305011265024326017377 0ustar jonjonpackage MooseX::Runnable::Run; use strict; use warnings; use MooseX::Runnable::Invocation; sub run_application($;@) { my ($app, @args) = @_; exit MooseX::Runnable::Invocation->new( class => $app, )->run(@args); } sub run_application_with_plugins($$;@){ my ($app, $plugins, @args) = @_; exit MooseX::Runnable::Invocation->new( class => $app, plugins => $plugins, )->run(@args); } sub import { my ($class, $app) = @_; if($app){ run_application $app, @ARGV; } else { my $c = caller; no strict 'refs'; *{ $c. '::run_application' } = \&run_application; *{ $c. '::run_application_with_plugins' } = \&run_application_with_plugins; } } 1; __END__ =head1 NAME MooseX::Runnable::Run - run a MooseX::Runnable class as an application =head1 SYNOPSIS Write an app: package MyApp; use Moose; with 'MooseX::Runnable'; sub run { say 'Hello, world.'; return 0 } # (UNIX exit code) Write a wrapper script, C. With sugar: #!/usr/bin/env perl use MooseX::Runnable::Run 'MyApp'; Or without: #!/usr/bin/env perl use MooseX::Runnable::Run; run_application 'MyApp', @ARGV; Then, run your app: $ ./myapp.pl Hello, world. $ echo $? 0 =head1 DESCRIPTION This is a utility module that runs a L class with L. =head1 SEE ALSO L, a script that will run MooseX::Runnable apps, saving you valuable seconds! L MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation.pm0000644000175000017500000001107611407730040020746 0ustar jonjonpackage MooseX::Runnable::Invocation; use Moose; use MooseX::Types -declare => ['RunnableClass']; use MooseX::Types::Moose qw(Str HashRef ArrayRef); use List::MoreUtils qw(uniq); use Params::Util qw(_CLASS); use namespace::autoclean; require Class::MOP; # we can't load the class until plugins are loaded, # so we have to handle this outside of coerce subtype RunnableClass, as Str, where { _CLASS($_) }; with 'MooseX::Runnable'; # this class technically follows # MX::Runnable's protocol has 'class' => ( is => 'ro', isa => RunnableClass, required => 1, ); has 'plugins' => ( is => 'ro', isa => HashRef[ArrayRef[Str]], default => sub { +{} }, required => 1, auto_deref => 1, ); sub BUILD { my $self = shift; # it would be nice to use MX::Object::Pluggable, but our plugins # are too configurable my $plugin_ns = 'MooseX::Runnable::Invocation::Plugin::'; for my $plugin (keys %{$self->plugins}){ my $orig = $plugin; $plugin = "$plugin_ns$plugin" unless $plugin =~ /^[+]/; $plugin =~ s/^[+]//g; Class::MOP::load_class( $plugin ); my $does_cmdline = $plugin->meta-> does_role('MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'); my $args; if($does_cmdline){ $args = eval { $plugin->_build_initargs_from_cmdline( @{$self->plugins->{$orig}}, ); }; if($@) { confess "Error building initargs for $plugin: $@"; } } elsif(!$does_cmdline && scalar @{$self->plugins->{$orig}} > 0){ confess "You supplied arguments to the $orig plugin, but it". " does not know how to accept them. Perhaps the plugin". " should consume the". " 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'". " role?"; } $plugin->meta->apply( $self, defined $args ? (rebless_params => $args) : (), ); } } sub load_class { my $self = shift; my $class = $self->class; Class::MOP::load_class( $class ); confess 'We can only work with Moose classes with "meta" methods' if !$class->can('meta'); my $meta = $class->meta; confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta" unless $meta->isa('Moose::Meta::Class'); confess 'MooseX::Runnable can only run classes tagged with '. 'the MooseX::Runnable role' unless $meta->does_role('MooseX::Runnable'); return $meta; } sub apply_scheme { my ($self, $class) = @_; my @schemes = grep { defined } map { eval { $self->_convert_role_to_scheme($_) } } map { eval { $_->meta->calculate_all_roles }; } $class->linearized_isa; eval { foreach my $scheme (uniq @schemes) { $scheme->apply($self); } }; } sub _convert_role_to_scheme { my ($self, $role) = @_; my $name = $role->name; return if $name =~ /\|/; $name = "MooseX::Runnable::Invocation::Scheme::$name"; return eval { Class::MOP::load_class($name); warn "$name was loaded OK, but it's not a role!" and return unless $name->meta->isa('Moose::Meta::Role'); return $name->meta; }; } sub validate_class { my ($self, $class) = @_; my @bad_attributes = map { $_->name } grep { $_->is_required && !($_->has_default || $_->has_builder) } $class->get_all_attributes; confess 'By default, MooseX::Runnable calls the constructor with no'. ' args, but that will result in an error for your class. You'. ' need to provide a MooseX::Runnable::Invocation::Plugin or'. ' ::Scheme for this class that will satisfy the requirements.'. "\n". "The class is @{[$class->name]}, and the required attributes are ". join ', ', map { "'$_'" } @bad_attributes if @bad_attributes; return; # return value is meaningless } sub create_instance { my ($self, $class, @args) = @_; return ($class->name->new, @args); } sub start_application { my $self = shift; my $instance = shift; my @args = @_; return $instance->run(@args); } sub run { my $self = shift; my @args = @_; my $class = $self->load_class; $self->apply_scheme($class); $self->validate_class($class); my ($instance, @more_args) = $self->create_instance($class, @args); my $exit_code = $self->start_application($instance, @more_args); return $exit_code; } 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Util/0000755000175000017500000000000011411550611017206 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Util/ArgParser.pm0000644000175000017500000001401311407727643021451 0ustar jonjonpackage MooseX::Runnable::Util::ArgParser; use Moose; use MooseX::Types::Moose qw(HashRef ArrayRef Str Bool); use MooseX::Types::Path::Class qw(Dir); use List::MoreUtils qw(first_index); use FindBin; use namespace::autoclean -also => ['_look_for_dash_something', '_delete_first']; has 'argv' => ( is => 'ro', isa => ArrayRef, required => 1, auto_deref => 1, ); has 'class_name' => ( is => 'ro', isa => Str, lazy_build => 1, ); has 'modules' => ( is => 'ro', isa => ArrayRef[Str], lazy_build => 1, auto_deref => 1, ); has 'include_paths' => ( is => 'ro', isa => ArrayRef[Dir], lazy_build => 1, auto_deref => 1, ); has 'plugins' => ( is => 'ro', isa => HashRef[ArrayRef[Str]], lazy_build => 1, ); has 'app_args' => ( is => 'ro', isa => ArrayRef[Str], lazy_build => 1, auto_deref => 1, ); has 'is_help' => ( is => 'ro', isa => Bool, lazy_build => 1, ); sub _build_class_name { my $self = shift; my @args = $self->argv; my $next_is_it = 0; my $need_dash_dash = 0; ARG: for my $arg (@args) { if($next_is_it){ return $arg; } if($arg eq '--'){ $next_is_it = 1; next ARG; } next ARG if $arg =~ /^-[A-Za-z]/; if($arg =~ /^[+]/){ $need_dash_dash = 1; next ARG; } return $arg unless $need_dash_dash; } if($next_is_it){ confess 'Parse error: expecting ClassName, got EOF'; } if($need_dash_dash){ confess 'Parse error: expecting --, got EOF'; } confess "Parse error: looking for ClassName, but can't find it; perhaps you meant '--help' ?"; } sub _look_for_dash_something($@) { my ($something, @args) = @_; my @result; my $rx = qr/^-$something(.*)$/; ARG: for my $arg (@args) { last ARG if $arg eq '--'; last ARG unless $arg =~ /^-/; if($arg =~ /$rx/){ push @result, $1; } } return @result; } sub _build_modules { my $self = shift; my @args = $self->argv; return [ _look_for_dash_something 'M', @args ]; } sub _build_include_paths { my $self = shift; my @args = $self->argv; return [ map { Path::Class::dir($_) } _look_for_dash_something 'I', @args ]; } sub _build_is_help { my $self = shift; my @args = $self->argv; return (_look_for_dash_something 'h', @args) || (_look_for_dash_something '\\?', @args) || (_look_for_dash_something '-help', @args) ;; } sub _build_plugins { my $self = shift; my @args = $self->argv; $self->class_name; # causes death when plugin syntax is wrong my %plugins; my @accumulator; my $in_plugin = undef; ARG: for my $arg (@args) { if(defined $in_plugin){ if($arg eq '--'){ $plugins{$in_plugin} = [@accumulator]; @accumulator = (); return \%plugins; } elsif($arg =~ /^[+](.+)$/){ $plugins{$in_plugin} = [@accumulator]; @accumulator = (); $in_plugin = $1; next ARG; } else { push @accumulator, $arg; } } else { # once we are $in_plugin, we can never be out again if($arg eq '--'){ return {}; } elsif($arg =~ /^[+](.+)$/){ $in_plugin = $1; next ARG; } } } if($in_plugin){ confess "Parse error: expecting arguments for plugin $in_plugin, but got EOF. ". "Perhaps you forgot '--' ?"; } return {}; } sub _delete_first($\@) { my ($to_delete, $list) = @_; my $idx = first_index { $_ eq $to_delete } @$list; splice @$list, $idx, 1; return; } # this is a dumb way to do it, but i forgot about it until just now, # and don't want to rewrite the whole class ;) ;) sub _build_app_args { my $self = shift; my @args = $self->argv; return [] if $self->is_help; # LIES!!11!, but who cares # functional programmers may wish to avert their eyes _delete_first $_, @args for map { "-M$_" } $self->modules; _delete_first $_, @args for map { "-I$_" } $self->include_paths; my %plugins = %{ $self->plugins }; PLUGIN: for my $p (keys %plugins){ my $vl = scalar @{ $plugins{$p} }; my $idx = first_index { $_ eq "+$p" } @args; next PLUGIN if $idx == -1; # HORRIBLE API! splice @args, $idx, $vl + 1; } if($args[0] eq '--'){ shift @args; } if($args[0] eq $self->class_name){ shift @args; } else { confess 'Parse error: Some residual crud was found before the app name: '. join ', ', @args; } return [@args]; } # XXX: bad sub guess_cmdline { my ($self, %opts) = @_; confess 'Parser is help' if $self->is_help; my @perl_flags = @{$opts{perl_flags} || []}; my @without_plugins = @{$opts{without_plugins} || []}; # invoke mx-run my @cmdline = ( $^X, (map { "-I$_" } @INC), @perl_flags, $FindBin::Bin.'/'.$FindBin::Script, ); push @cmdline, map { "-I$_" } $self->include_paths; push @cmdline, map { "-M$_" } $self->modules; p: for my $plugin (keys %{$self->plugins}){ for my $without (@without_plugins) { next p if $without eq $plugin; } push @cmdline, "+$plugin", @{$self->plugins->{$plugin} || []}; } push @cmdline, '--'; push @cmdline, $self->class_name; push @cmdline, $self->app_args; return @cmdline; } 1; __END__ =head1 NAME MooseX::Runnable::Util::ArgParser - parse @ARGV for mx-run =head1 SYNOPSIS my $parser = MooseX::Runnable::Util::ArgParser->new( argv => \@ARGV, ); $parser->class_name; $parser->modules; $parser->include_paths; $parser->plugins; $parser->is_help; $parser->app_args; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/0000755000175000017500000000000011411550611020402 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/MxRun.pm0000644000175000017500000000024011265023071022007 0ustar jonjonpackage MooseX::Runnable::Invocation::MxRun; use Moose; extends 'MooseX::Runnable::Invocation'; with 'MooseX::Runnable::Invocation::Role::WithParsedArgs'; 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/0000755000175000017500000000000011411550611021640 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Role/0000755000175000017500000000000011411550611022541 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Role/CmdlineArgs.pm0000644000175000017500000000020011265023071025261 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs; use Moose::Role; requires '_build_initargs_from_cmdline'; 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Profile.pm0000644000175000017500000000106011265023071023575 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::Profile; use Moose::Role; before 'load_class' => sub { my ($self) = @_; confess 'The Profile plugin cannot be used when not invoked via mx-urn' unless $self->does('MooseX::Runnable::Invocation::Role::WithParsedArgs'); my @cmdline = $self->parsed_args->guess_cmdline( perl_flags => ['-d:NYTProf'], without_plugins => ['Profile', '+'.__PACKAGE__], ); eval { $self->_debug_message( "Re-execing with ". join ' ' , @cmdline, )}; exec(@cmdline); }; 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Restart/0000755000175000017500000000000011411550611023264 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Restart/Base.pm0000644000175000017500000000561411202500355024500 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::Restart::Base; use Moose::Role; use MooseX::Types::Moose qw(Int); use namespace::autoclean; has 'child_pid' => ( is => 'rw', isa => Int, clearer => 'clear_child_pid', predicate => 'has_child_pid', ); # XXX: blocking is probably a bad idea; refactor this later requires 'run_parent_loop'; my $is_debug = sub { return 1; $_[0]->meta->does_role('MooseX::Runnable::Invocation::Plugin::Debug'); }; sub _restart_parent_setup { my $self = shift; } sub restart { my $self = shift; return unless $self->has_child_pid; eval { $self->_debug_message("Restarting...") }; kill 'HUP', $self->child_pid; } sub kill_child { my $self = shift; return unless $self->has_child_pid; eval { $self->_debug_message("Killing ", $self->child_pid) }; kill 'KILL', $self->child_pid; $self->clear_child_pid; } around 'run' => sub { my ($next, $self, @args) = @_; my $pid = fork(); if($pid){ local $SIG{CHLD} = sub { # handle the case where the child dies unexpectedly waitpid $self->child_pid, 0; $self->clear_child_pid; my ($code, $sig) = ($? >> 8, $? & 127); eval { $self->_debug_message( "Exiting early, child died with status $code (signal $sig).", )}; # relay the error up, so the shell (etc.) can see it kill $sig, $$ if $sig; # no-op? exit $code; }; # parent $self->child_pid( $pid ); $self->_restart_parent_setup; my $code = $self->run_parent_loop; eval { $self->_debug_message("Shutting down.") }; $self->kill_child; return $code; } else { # we go to all this effort so that the child process is always # free of any "infection" by the parent (like the event loop, # used by the parent to receive filesystem events or signals, # which can't be cancelled by the child) my $child_body; $child_body = sub { while(1){ my $pid2 = fork; if($pid2){ # parent? wait for kid to die local $SIG{HUP} = sub { kill 'KILL', $pid2; }; waitpid $pid2, 0; my $code = $? >> 8; if($code == 0){ goto $child_body; } else { eval { $self->_debug_message( "Child exited with non-zero status; aborting.", )}; exit $code; } } else { # child? actually do the work exit $self->$next(@args); } } }; $child_body->(); } }; 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Restart/Auto.pm0000644000175000017500000000427011265023071024537 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::Restart::Auto; use Moose::Role; use MooseX::Types; use MooseX::Types::Moose qw(ArrayRef RegexpRef Any Str); use MooseX::Types::Path::Class qw(Dir); use File::ChangeNotify; use namespace::autoclean; # coerce ArrayRef[Dir], from ArrayRef[Any], via {[ # map { warn $_; Path::Class::dir($_) } @$_, # ]}; coerce RegexpRef, from Str, via { qr/$_/i }; with 'MooseX::Runnable::Invocation::Plugin::Restart::Base', 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'; has 'watch_regexp' => ( is => 'ro', isa => RegexpRef, required => 1, coerce => 1, default => sub { qr/^[^.].+[.]pmc?$/i }, ); has 'watch_directories' => ( is => 'ro', isa => ArrayRef[Dir], required => 1, coerce => 1, default => sub { [Path::Class::dir('.')] }, ); has 'watcher' => ( is => 'ro', isa => 'File::ChangeNotify::Watcher', lazy_build => 1, ); sub _build_initargs_from_cmdline { my ($self, @args) = @_; my $regexp; my @dirs; my $next_type; for my $arg (@args){ # if($arg eq '--inc'){ # push @dirs, @INC; # } if($arg eq '--dir'){ $next_type = 'dir'; } elsif($arg eq '--regexp' || $arg eq '--regex'){ # i call them regexps, other people call them "regexen" :P $next_type = 'regexp'; } elsif($next_type eq 'dir'){ push @dirs, $arg; } elsif($next_type eq 'regexp'){ $regexp = $arg; } else { confess 'Invalid args passed to Restart::Auto'; } } my %result; $result{watch_directories} = [map { Path::Class::dir($_) } @dirs] if @dirs; $result{watch_regexp} = $regexp if $regexp; return \%result; } sub _build_watcher { my $self = shift; my $w = File::ChangeNotify->instantiate_watcher( directories => [map { $_->stringify } @{$self->watch_directories}], filter => $self->watch_regexp, ); return $w; } sub run_parent_loop { my $self = shift; while(1){ my @events = $self->watcher->wait_for_events(); $self->restart; } } 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/PAR.pm0000644000175000017500000000355111176073517022641 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::PAR; use Moose::Role; use Module::ScanDeps (); use App::Packer::PAR (); use MooseX::Runnable::Run; use Data::Dump::Streamer; use File::Temp qw(tempfile); my $mk_scanner = sub { my $class = Moose::Meta::Class->create_anon_class( superclasses => ['Moose::Object'] ); for my $m (qw/set_file set_options calculate_info go scan_deps add_deps _find_in_inc/){ $class->add_method( $m => sub { warn "$m @_" } ); } $class->add_method( get_files => sub { warn 'get_files'; [ keys %INC ] } ); my $name = $class->name; $name =~ s{::}{/}g; $INC{ "$name.pm" } = 1; return $class; }; around run => sub { my ($next, $self, @args) = @_; print "Creating a PAR instead of runing the app.\n"; { # pre-load as much as possible my $class = $self->load_class; $self->apply_scheme($class); eval { # this is probably not possible, but we might as well try $self->validate_class($class); $self->create_instance($class, @args); }; } my $inc = join " ", map { "require '$_';\n" } keys %INC; my %plugins = %{ $self->plugins }; delete $plugins{PAR}; my $plugins = Dump(\%plugins)->Out; my $app = $self->class; my $script = <<"END"; use MooseX::Runnable::Run; use MooseX::Runnable::Invocation; require Params::Validate; # XXX! $inc $plugins exit MooseX::Runnable::Invocation->new( class => '$app', plugins => \$HASH1, )->run(\@ARGV); END print "script: \n$script"; $app =~ s/::/_/g; $app = lc $app; my $opt = { e => $script, o => $app, vvv => 1 }; App::Packer::PAR->new( frontend => 'Module::ScanDeps', backend => 'PAR::Packer', frontopts => $opt, backopts => $opt, args => [], )->go; return 0; }; 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Restart.pm0000644000175000017500000000312511265023071023625 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::Restart; use Moose::Role; use MooseX::Types::Moose qw(Str); use AnyEvent; use namespace::autoclean; with 'MooseX::Runnable::Invocation::Plugin::Restart::Base', 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'; has 'completion_condvar' => ( is => 'ro', isa => 'AnyEvent::CondVar', required => 1, default => sub { AnyEvent->condvar }, ); has 'kill_signal' => ( is => 'ro', isa => Str, required => 1, default => sub { 'INT' }, ); has 'restart_signal' => ( is => 'ro', isa => Str, required => 1, default => sub { 'HUP' }, ); sub _build_initargs_from_cmdline { my ($class, @args) = @_; confess 'Bad args passed to Restart plugin' unless @args % 2 == 0; my %args = @args; my %res; if(my $kill = $args{'--kill-signal'}){ $res{kill_signal} = $kill; } if(my $res = $args{'--restart-signal'}){ $res{restart_signal} = $res; } return \%res; } after '_restart_parent_setup' => sub { my $self = shift; my ($kw, $rw); $kw = AnyEvent->signal( signal => $self->kill_signal, cb => sub { $self->kill_child; undef $kw; $self->completion_condvar->send(0); # parent exit code }); $rw = AnyEvent->signal( signal => $self->restart_signal, cb => sub { $rw = $rw; # closes over $rw and prevents it from being GC'd $self->restart; }); }; sub run_parent_loop { my $self = shift; print {*STDERR} "Control pid is $$\n"; return $self->completion_condvar->wait; } 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Plugin/Debug.pm0000644000175000017500000000271011265024100023220 0ustar jonjonpackage MooseX::Runnable::Invocation::Plugin::Debug; use Moose::Role; with 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'; # this is an example to cargo-cult, rather than a useful feature :) has 'debug_prefix' => ( is => 'ro', isa => 'Str', required => 1, default => sub { "" }, ); sub _build_initargs_from_cmdline { my ($class, @args) = @_; confess 'Bad args passed to Debug plugin' unless @args % 2 == 0; my %args = @args; if(my $p = $args{'--prefix'}){ return { debug_prefix => $p }; } return; } sub _debug_message { my ($self, @msg) = @_; print {*STDERR} $self->debug_prefix, "[$$] ", @msg, "\n"; } for my $method (qw{ load_class apply_scheme validate_class create_instance start_application }){ requires $method; before $method => sub { my ($self, @args) = @_; my $args = join ', ', @args; $self->_debug_message("Calling $method($args)"); }; after $method => sub { my $self = shift; $self->_debug_message("Returning from $method"); }; } 1; __END__ =head1 NAME MooseX::Runnable::Invocation::Plugin::Debug - print debugging information =head1 DESCRIPTION This is an example plugin, showing how you could write your own. It prints a message for each stage of the "run" process. It is also used by other plugins to determine whether or not to print debugging messages. =head1 SEE ALSO L MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Role/0000755000175000017500000000000011411550611021303 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Role/WithParsedArgs.pm0000644000175000017500000000036111265023071024532 0ustar jonjonpackage MooseX::Runnable::Invocation::Role::WithParsedArgs; use Moose::Role; use MooseX::Runnable::Util::ArgParser; has 'parsed_args' => ( is => 'ro', isa => 'MooseX::Runnable::Util::ArgParser', required => 1, ); 1; MooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Scheme/0000755000175000017500000000000011411550611021606 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Scheme/MooseX/0000755000175000017500000000000011411550611023020 5ustar jonjonMooseX-Runnable-0.03/lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm0000644000175000017500000000170511265024233024626 0ustar jonjonpackage MooseX::Runnable::Invocation::Scheme::MooseX::Getopt; use Moose::Role; around validate_class => sub { return; # always valid }; around create_instance => sub { my ($next, $self, $class, @args) = @_; local @ARGV = @args; # ugly! my $instance = $class->name->new_with_options(); my $more_args = $instance->extra_argv; return ($instance, @$more_args); }; # XXX: arounds that don't actually call $orig fuck up plugins. i # think that's OK, mostly, but it's something to keep in mind... 1; __END__ =head1 NAME MooseX::Runnable::Invocation::Scheme::MooseX::Getopt - run MX::Getopt classes =head1 DESCRIPTION This role will be used by C to create an instance of the class to be run with C. Any args not consumed by MX::Getopt will be passed to the class's run method. (See the test C for an example.) =head1 SEE ALSO L L MooseX-Runnable-0.03/lib/MooseX/Runnable.pm0000644000175000017500000000557111411550565016647 0ustar jonjonpackage MooseX::Runnable; use Moose::Role; our $VERSION = '0.03'; requires 'run'; 1; __END__ =head1 NAME MooseX::Runnable - tag a class as a runnable application =head1 SYNOPSIS Create a class, tag it runnable, and provide a C method: package App::HelloWorld; use feature 'say'; use Moose; with 'MooseX::Runnable'; sub run { my ($self,$name) = @_; say "Hello, $name."; return 0; # success } Then you can run this class as an application with the included C script: $ mx-run App::HelloWorld jrockway Hello, jrockway. $ C supports L, and other similar systems (and is extensible, in case you have written such a system). =head1 DESCRIPTION MooseX::Runnable is a framework for making classes runnable applications. This role doesn't do anything other than tell the rest of the framework that your class is a runnable application that has a C method which accepts arguments and returns the process' exit code. This is a convention that the community has been using for a while. This role tells the computer that your class uses this convention, and let's the computer abstract away some of the tedium this entails. =head1 REQUIRED METHODS =head2 run Your class must implement C. It accepts the commandline args (that were not consumed by another parser, if applicable) and returns an integer representing the UNIX exit value. C means success. =head1 THINGS YOU GET =head2 C This is a script that accepts a C class and tries to run it, using C. The syntax is: mx-run Class::Name mx-run -- Class::Name for example: mx-run -Ilib App::HelloWorld --args --go --here or: mx-run -Ilib +Persistent --port 8080 -- App::HelloWorld --args --go --here =head2 C If you don't want to invoke your app with C, you can write a custom version using L. =head1 ARCHITECTURE C is designed to be extensible; users can run plugins from the command-line, and application developers can add roles to their class to control behavior. For example, if you consume L, the command-line will be parsed with C. Any recognized args will be used to instantiate your class, and any extra args will be passed to C. =head1 BUGS Many of the plugins shipped are unstable; they may go away, change, break, etc. If there is no documentation for a plugin, it is probably just a prototype. =head1 REPOSITORY L =head1 AUTHOR Jonathan Rockway C<< >> =head1 COPYRIGHT Copyright (c) 2009 Jonathan Rockway This module is Free Software, you can redistribute it under the same terms as Perl itself. MooseX-Runnable-0.03/t/0000755000175000017500000000000011411550611013006 5ustar jonjonMooseX-Runnable-0.03/t/00-load.t0000644000175000017500000000014511163610335014333 0ustar jonjon#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 1; use ok 'MooseX::Runnable'; MooseX-Runnable-0.03/t/basic-mx-getopt.t0000644000175000017500000000153311407730040016201 0ustar jonjonuse strict; use warnings; use Test::Exception; use Test::More tests => 9; use MooseX::Runnable::Invocation; use ok 'MooseX::Runnable::Invocation::Scheme::MooseX::Getopt'; my $foo; { package Class; use Moose; with 'MooseX::Runnable', 'MooseX::Getopt'; has 'foo' => ( is => 'ro', isa => 'Str', required => 1, ); sub run { my ($self, $code) = @_; $foo = $self->foo; return $code; } } { package Class2; use Moose; extends 'Class'; } foreach my $class (qw(Class Class2)) { my $invocation = MooseX::Runnable::Invocation->new( class => $class, ); ok $invocation, 'class is instantiatable'; my $code; lives_ok { $code = $invocation->run('--foo', '42', 0); } 'run lived'; is $foo, '42', 'got foo from cmdline'; is $code, 0, 'exit status ok'; } MooseX-Runnable-0.03/t/basic.t0000644000175000017500000000205511176072153014266 0ustar jonjonuse strict; use warnings; use Test::Exception; use Test::More tests => 8; use ok 'MooseX::Runnable'; use ok 'MooseX::Runnable::Invocation'; { package Class; use Moose; with 'MooseX::Runnable'; sub run { my ($self, @args) = @_; my $result; $result += $_ for @args; return $result; } } my $invocation = MooseX::Runnable::Invocation->new( class => 'Class', ); ok $invocation; my $code; lives_ok { $code = $invocation->run(1,2,3); } 'run lived'; is $code, 6, 'run worked'; { package MooseX::Runnable::Invocation::Plugin::ExitFixer; use Moose::Role; around run => sub { my ($next, $self, @args) = @_; my $code = $self->$next(@args); if($code){ return 0 } else { confess "Exited with error." } }; } $invocation = MooseX::Runnable::Invocation->new( class => 'Class', plugins => {'+MooseX::Runnable::Invocation::Plugin::ExitFixer' => []}, ); ok $invocation; lives_ok { $code = $invocation->run(1,2,3); } 'run lived'; is $code, 0, 'run worked, and plugin changed the return code'; MooseX-Runnable-0.03/t/invocation-plugin-initargs.t0000644000175000017500000000311211265023072020456 0ustar jonjonuse strict; use warnings; use Test::Exception; use Test::More tests => 7; use MooseX::Runnable::Invocation; my $initargs; { package Class; use Moose; with 'MooseX::Runnable'; sub run { 42 } } { package Plugin; use Moose::Role; with 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'; has 'init' => ( is => 'ro', required => 1 ); sub _build_initargs_from_cmdline { my $class = shift; $initargs = join ',', @_; return { init => 'args' }; } } { package Argless; use Moose::Role; } { package Plugin2; use Moose::Role; with 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'; sub _build_initargs_from_cmdline { return { init => 'fails' }; } } my $i; lives_ok { $i = MooseX::Runnable::Invocation->new( class => 'Class', plugins => { '+Plugin' => [qw/foo bar baz/], }, ); } 'created invocation without dying'; ok $i, 'created invocation ok'; ok $i->run, 'ran ok'; is $initargs, 'foo,bar,baz', 'got initargs'; throws_ok { MooseX::Runnable::Invocation->new( class => 'Class', plugins => { '+Argless' => ['args go here'], }, ); } qr/Perhaps/, 'argless + args = error'; lives_ok { MooseX::Runnable::Invocation->new( class => 'Class', plugins => { '+Argless' => [], }, ); } 'argless + no args = ok'; lives_ok { MooseX::Runnable::Invocation->new( class => 'Class', plugins => { '+Plugin' => [], '+Plugin2' => [], }, ); } 'two plugins with args compose OK'; MooseX-Runnable-0.03/t/arg-parser.t0000644000175000017500000001025611407727643015262 0ustar jonjonuse strict; use warnings; use MooseX::Runnable::Util::ArgParser; use Test::TableDriven ( class_name => { 'Foo' => 'Foo', '-Ilib Foo' => 'Foo' , '-I/foo/bar/lib -Ilib -IFoo module with lots of args' => 'module' , '-- Foo' => 'Foo', '-Ilib -- Foo' => 'Foo', '-Ilib -MFoo::Bar -- Foo::Baz' => 'Foo::Baz', '-MFoo Bar' => 'Bar', '+Plugin1 --args --go --here -- Foo' => 'Foo', '+P --args --arehere +Q --more --args -- Foo' => 'Foo', '-Ilib +P --args --arehere +Q --more --args -Ilib -- Foo' => 'Foo', '+P --args -- Foo -- Bar' => 'Foo', '-Ilib +Debug -- PlanFinder' => 'PlanFinder', '-Ilib -Iexample +Debug --prefix 42 -- MyApp' => 'MyApp', }, modules => { 'Foo' => [], 'Foo -MFoo' => [], '-MFoo' => ['Foo'], '-MFoo Foo' => ['Foo'], '-MFoo Foo' => ['Foo'], '-MFoo -MFoo Foo' => ['Foo', 'Foo'], '-MFoo -MBar -MBaz::Quux -Ilib OH::HAI' => ['Foo','Bar','Baz::Quux'], '+End -MFoo -MBar -- OH::HAI' => [], '-Ilib +End -MFoo -- OH::HAI' => [], '-Ilib -MFoo OH::HAI' => ['Foo'], '-Ilib -MFoo +End -MBar -- OH::HAI' => ['Foo'], '-Ilib +Debug -- PlanFinder' => [], '-Ilib -Iexample +Debug --prefix 42 -- MyApp' => [], }, include_paths => { 'Foo' => [], 'Foo -Ilib' => [], '-Ilib Foo' => ['lib'], '-MFoo Foo' => [], '-MFoo -MBar -MBaz::Quux -Ilib OH::HAI' => ['lib'], '+End -MFoo -MBar -- OH::HAI' => [], '-Ilib +End -MFoo -- OH::HAI' => ['lib'], '-Ilib -MFoo OH::HAI' => ['lib'], '-Ilib -MFoo +End -IBar -- OH::HAI' => ['lib'], '-Ilib -MFoo -I../../../../lib +End -IBar -- OH::HAI' => ['lib', '../../../../lib'], '-Ilib +Debug -- PlanFinder' => ['lib'], '-Ilib -Iexample +Debug --prefix 42 -- MyApp' => ['lib', 'example'], }, plugins => { 'Foo' => {}, '-Ilib Foo' => {}, '-Ilib -MFoo -- Bar' => {}, '+One --arg +Two --arg2 -- End' => { One => ['--arg'], Two => ['--arg2'] }, '+Debug +PAR +Foo::Bar -- Baz' => { Debug => [], PAR => [], 'Foo::Bar' => [] }, '-Ilib +Debug -- PlanFinder' => { Debug => [] }, '++Foo -- Bar' => { '+Foo' => [] }, '-Ilib -Iexample +Debug --prefix 42 -- MyApp' => { Debug => [ '--prefix', '42' ] }, }, is_help => { '--help' => 1, '-h' => 1, '-?' => 1, '--?' => 0, '--h' => 0, '+Foo --help' => 0, 'Foo' => 0, '-Ilib -MFoo --help' => 1, '-- Foo --help' => 0, 'Foo --help' => 0, 'Foo -?' => 0, 'Foo -h' => 0, '-Ilib +Debug -- PlanFinder' => 0, '-Ilib -Iexample +Debug --prefix 42 -- MyApp' => 0, }, app_args => { 'Foo' => [], '-Ilib Foo' => [], '-Ilib -MFoo Bar' => [], 'Foo Bar' => ['Bar'], 'Foo Bar Baz' => ['Bar', 'Baz'], '-- Foo Bar Baz' => ['Bar', 'Baz'], '-Ilib Foo -Ilib' => ['-Ilib'], '-MFoo Foo -MFoo' => ['-MFoo'], '-MFoo -MFoo Foo -MFoo' => ['-MFoo'], '-- Foo --help' => ['--help'], '-Ilib +Debug -- PlanFinder' => [], '-Ilib -Iexample +Debug --prefix 42 -- MyApp' => [], }, ); sub class_name { my ($argv) = @_; my $p = MooseX::Runnable::Util::ArgParser->new( argv => [split / /, $argv] ); return $p->class_name; } sub modules { my ($argv) = @_; my $p = MooseX::Runnable::Util::ArgParser->new( argv => [split / /, $argv] ); return $p->modules; } sub include_paths { my ($argv) = @_; my $p = MooseX::Runnable::Util::ArgParser->new( argv => [split / /, $argv] ); return [ map { $_->stringify } $p->include_paths ]; } sub plugins { my ($argv) = @_; my $p = MooseX::Runnable::Util::ArgParser->new( argv => [split / /, $argv] ); return $p->plugins; } sub is_help { my ($argv) = @_; my $p = MooseX::Runnable::Util::ArgParser->new( argv => [split / /, $argv] ); return $p->is_help ? 1 : 0; } sub app_args { my ($argv) = @_; my $p = MooseX::Runnable::Util::ArgParser->new( argv => [split / /, $argv] ); return $p->app_args; } runtests; MooseX-Runnable-0.03/t/reverse-args.t0000644000175000017500000000122111265023072015577 0ustar jonjonuse strict; use warnings; use Test::More tests => 1; use MooseX::Runnable::Util::ArgParser; my $str = '-MFoo -Ilib -MBar +Plugout +Plugin --with-args -- MyApp --with args'; my $args = MooseX::Runnable::Util::ArgParser->new( argv => [split ' ', $str], ); local $^X = '/path/to/perl'; local $FindBin::Bin = '/path/to'; local $FindBin::Script = 'mx-run'; local @INC = ('foobar'); my @cmdline = $args->guess_cmdline( perl_flags => ['--X--'], without_plugins => ['Plugout'], ); is join(' ', @cmdline), "/path/to/perl -Ifoobar --X-- /path/to/mx-run -Ilib -MFoo -MBar +Plugin --with-args -- MyApp --with args", 'cmdline reverses reasonably'; MooseX-Runnable-0.03/bin/0000755000175000017500000000000011411550611013313 5ustar jonjonMooseX-Runnable-0.03/bin/mx-run0000644000175000017500000000331611265024346014477 0ustar jonjon#!/usr/bin/env perl use strict; use warnings; use MooseX::Runnable::Util::ArgParser; use MooseX::Runnable::Invocation::MxRun; exit run(); sub run { my $args = MooseX::Runnable::Util::ArgParser->new( argv => \@ARGV, ); help() if $args->is_help; # set @INC from -I... unshift @INC, $_->stringify for $args->include_paths; # load -M... modules do { eval "require $_"; die $@ if $@ } for $args->modules; my $app = $args->class_name; local $0 = "mx-run ... $app"; return MooseX::Runnable::Invocation::MxRun->new( class => $app, plugins => $args->plugins, parsed_args => $args, )->run($args->app_args); } sub help { print <<'END'; This is mx-run, a utility for running MooseX::Runnable classes. usage: mx-run -- Class::Name mx-run options: --help -? -h Print this message -I Add to @INC before loading modules -M use immediately +PluginName Load PluginName (see MooseX::Runnable::Invocation) Note that as soon as +PluginName is seen, all following -[IM] options are ignored by mx-run, and are instead processed by PluginName. So put them at the very beginning. In the simplest cases, where you use only -I or -M (no plugins), you may omit the -- before the class name. To get help for Class::Name, run: mx-run Class::Name --help Syntax examples: mx-run -Ilib Class::Name # Local Class::Name mx-run -Ilib -MCarp::Always +Debug -- Class::Name # Debugging END exit 1; } __END__ =head1 NAME mx-run - script to run MooseX::Runnable classes =head1 SEE ALSO L