X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FUtils.pm;h=fc877d430fd75bfd57343427853ba3a3044f23ea;hp=ff4f53da0d3072617cd575567834a43fb2ca1e2b;hb=199731fb710c6a165793f055f85de60539039dfe;hpb=4477b313f9ef93789650b63e5ce408fe65ca54b2 diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index ff4f53d..fc877d4 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -10,8 +10,9 @@ use Cwd; use Class::Load 'is_class_loaded'; use String::RewritePrefix; use Class::Load (); - use namespace::clean; +use Devel::InnerPackage; +use Moose::Util; =head1 NAME @@ -384,26 +385,46 @@ that 'env' now lists COLUMNS.) As last resort, default value of 80 chars will be used. +Calling C with a true value will cause it to be recalculated; you +can use this to cause it to get recalculated when your terminal is resized like +this + + $SIG{WINCH} = sub { Catalyst::Utils::term_width(1) }; + =cut my $_term_width; sub term_width { + my $force_reset = shift; + + undef $_term_width if $force_reset; + return $_term_width if $_term_width; my $width; eval ' - require Term::Size::Any; - my ($columns, $rows) = Term::Size::Any::chars; - $width = $columns; - 1; + use Term::Size::Any; + ($width) = Term::Size::Any::chars; + 1; ' or do { + if($@ =~m[Can't locate Term/Size/Any.pm]) { + warn "Term::Size::Any is not installed, can't autodetect terminal column width\n"; + } else { + warn "There was an error trying to detect your terminal size: $@\n"; + } + }; + + unless ($width) { + warn 'Trouble trying to detect your terminal size, looking at $ENV{COLUMNS}'."\n"; $width = $ENV{COLUMNS} if exists($ENV{COLUMNS}) && $ENV{COLUMNS} =~ m/^\d+$/; - }; + } - $width = 80 unless ($width && $width >= 80); + do { + warn "Cannot determine desired terminal width, using default of 80 columns\n"; + $width = 80 } unless ($width && $width >= 80); return $_term_width = $width; } @@ -486,6 +507,83 @@ sub apply_registered_middleware { return $new_psgi; } +=head2 inject_component + +Used to add components at runtime: + + into The Catalyst package to inject into (e.g. My::App) + component The component package to inject + traits (Optional) ArrayRef of Ls that the componet should consume. + as An optional moniker to use as the package name for the derived component + +For example: + + Catalyst::Utils::inject_component( into => My::App, component => Other::App::Controller::Apple ) + + The above will create 'My::App::Controller::Other::App::Controller::Apple' + + Catalyst::Utils::inject_component( into => My::App, component => Other::App::Controller::Apple, as => Apple ) + + The above will create 'My::App::Controller::Apple' + + Catalyst::Utils::inject_component( into => $myapp, component => 'MyRootV', as => 'Controller::Root' ); + +Will inject Controller, Model, and View components into your Catalyst application +at setup (run)time. It does this by creating a new package on-the-fly, having that +package extend the given component, and then having Catalyst setup the new component +(via $app->setup_component). + +B This is basically a core version of L. If you were using that +you can now use this safely instead. Going forward changes required to make this work will be +synchronized with the core method. + +B The 'traits' option is unique to the L version of this feature. + +B These injected components really need to be a L and a L +based class. + +=cut + +sub inject_component { + my %given = @_; + my ($into, $component, $as) = @given{qw/into component as/}; + + croak "No Catalyst (package) given" unless $into; + croak "No component (package) given" unless $component; + + Class::Load::load_class($component); + + $as ||= $component; + unless ( $as =~ m/^(?:Controller|Model|View)::/ || $given{skip_mvc_renaming} ) { + my $category; + for (qw/ Controller Model View /) { + if ( $component->isa( "Catalyst::$_" ) ) { + $category = $_; + last; + } + } + croak "Don't know what kind of component \"$component\" is" unless $category; + $as = "${category}::$as"; + } + my $component_package = join '::', $into, $as; + + unless ( Class::Load::is_class_loaded $component_package ) { + eval "package $component_package; use base qw/$component/; 1;" or + croak "Unable to build component package for \"$component_package\": $@"; + Moose::Util::apply_all_roles($component_package, @{$given{traits}}) if $given{traits}; + (my $file = "$component_package.pm") =~ s{::}{/}g; + $INC{$file} ||= 1; + } + + my $_setup_component = sub { + my $into = shift; + my $component_package = shift; + $into->components->{$component_package} = $into->delayed_setup_component( $component_package ); + }; + + $_setup_component->( $into, $component_package ); +} + =head1 PSGI Helpers Utility functions to make it easier to work with PSGI applications under Catalyst @@ -505,7 +603,7 @@ Localize C<$env> under the current controller path prefix: my $env = $c->Catalyst::Utils::env_at_path_prefix; } -Assuming you have a requst like GET /user/name: +Assuming you have a request like GET /user/name: In the example case C<$env> will have PATH_INFO of '/name' instead of '/user/name' and SCRIPT_NAME will now be '/user'. @@ -548,7 +646,7 @@ Assuming you have a request like GET /user/name: In the example case C<$env> will have PATH_INFO of '/' instead of '/user/name' and SCRIPT_NAME will now be '/user/name'. -Alternatively, assuming you have a requst like GET /user/name/foo: +Alternatively, assuming you have a request like GET /user/name/foo: In this example case C<$env> will have PATH_INFO of '/foo' instead of '/user/name/foo' and SCRIPT_NAME will now be '/user/name'. @@ -593,7 +691,7 @@ Localize C<$env> under the current request URI: my $env = $c->Catalyst::Utils::env_at_request_uri } -Assuming you have a requst like GET /user/name/hello: +Assuming you have a request like GET /user/name/hello: In the example case C<$env> will have PATH_INFO of '/' instead of '/user/name' and SCRIPT_NAME will now be '/user/name/hello'.