changes so that we skip encoding under programmatic situations
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Utils.pm
index 56c2a80..1bccecb 100644 (file)
@@ -9,7 +9,7 @@ use Carp qw/croak/;
 use Cwd;
 use Class::Load 'is_class_loaded';
 use String::RewritePrefix;
-
+use Class::Load ();
 use namespace::clean;
 
 =head1 NAME
@@ -222,7 +222,7 @@ sub home {
             ( my $path = $inc_entry) =~ s/\.pm$//;
             my $home = dir($path)->absolute->cleanup;
 
-            # return if if it's a valid directory
+            # return if it's a valid directory
             return $home->stringify if -d $home;
         }
     }
@@ -383,26 +383,43 @@ that 'env' now lists COLUMNS.)
 
 As last resort, default value of 80 chars will be used.
 
+Calling C<term_width> 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";
+          }
+        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;
 }
 
@@ -432,6 +449,190 @@ sub resolve_namespace {
     }, @classes);
 }
 
+=head2 build_middleware (@args)
+
+Internal application that converts a single middleware definition (see
+L<Catalyst/psgi_middleware>) into an actual instance of middleware.
+
+=cut
+
+sub build_middleware {
+    my ($class, $namespace, @init_args) = @_;
+
+    if(
+      $namespace =~s/^\+// ||
+      $namespace =~/^Plack::Middleware/ ||
+      $namespace =~/^$class/
+    ) {  ## the string is a full namespace
+        return Class::Load::try_load_class($namespace) ?
+          $namespace->new(@init_args) :
+            die "Can't load class $namespace";
+    } else { ## the string is a partial namespace
+      if(Class::Load::try_load_class($class .'::Middleware::'. $namespace)) { ## Load Middleware from Project namespace
+          my $ns = $class .'::Middleware::'. $namespace;
+          return $ns->new(@init_args);
+        } elsif(Class::Load::try_load_class("Plack::Middleware::$namespace")) { ## Act like Plack::Builder
+          return "Plack::Middleware::$namespace"->new(@init_args);
+        } else {
+          die "Can't load middleware via '$namespace'.  It's not ".$class."::Middleware::".$namespace." or Plack::Middleware::$namespace";
+        }
+    }
+
+    return; ## be sure we can count on a proper return when valid
+}
+
+=head2 apply_registered_middleware ($psgi)
+
+Given a $psgi reference, wrap all the L<Catalyst/registered_middlewares>
+around it and return the wrapped version.
+
+This exists to deal with the fact Catalyst registered middleware can be
+either an object with a wrap method or a coderef.
+
+=cut
+
+sub apply_registered_middleware {
+    my ($class, $psgi) = @_;
+    my $new_psgi = $psgi;
+    foreach my $middleware ($class->registered_middlewares) {
+        $new_psgi = Scalar::Util::blessed $middleware ?
+          $middleware->wrap($new_psgi) :
+            $middleware->($new_psgi);
+    }
+    return $new_psgi;
+}
+
+
+
+=head1 PSGI Helpers
+
+Utility functions to make it easier to work with PSGI applications under Catalyst
+
+=head2 env_at_path_prefix
+
+Localize C<$env> under the current controller path prefix:
+
+    package MyApp::Controller::User;
+
+    use Catalyst::Utils;
+
+    use base 'Catalyst::Controller';
+
+    sub name :Local {
+      my ($self, $c) = @_;
+      my $env = $c->Catalyst::Utils::env_at_path_prefix;
+    }
+
+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'.
+
+=cut
+
+sub env_at_path_prefix {
+  my $ctx = shift;
+  my $path_prefix = $ctx->controller->path_prefix;
+  my $env = $ctx->request->env;
+  my $path_info = $env->{PATH_INFO};
+  my $script_name = ($env->{SCRIPT_NAME} || '');
+
+  $path_info =~ s/(^\/\Q$path_prefix\E)//;
+  $script_name = "$script_name$1";
+
+  return +{
+    %$env,
+    PATH_INFO => $path_info,
+    SCRIPT_NAME => $script_name };
+}
+
+=head2 env_at_action
+
+Localize C<$env> under the current action namespace.
+
+    package MyApp::Controller::User;
+
+    use Catalyst::Utils;
+
+    use base 'Catalyst::Controller';
+
+    sub name :Local {
+      my ($self, $c) = @_;
+      my $env = $c->Catalyst::Utils::env_at_action;
+    }
+
+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 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'.
+
+This is probably a common case where you want to mount a PSGI application
+under an action but let the Args fall through to the PSGI app.
+
+=cut
+
+sub env_at_action {
+  my $ctx = shift;
+  my $argpath = join '/', @{$ctx->request->arguments};
+  my $path = '/' . $ctx->request->path;
+
+  $path =~ s/\/?\Q$argpath\E\/?$//;
+
+  my $env = $ctx->request->env;
+  my $path_info = $env->{PATH_INFO};
+  my $script_name = ($env->{SCRIPT_NAME} || '');
+
+  $path_info =~ s/(^\Q$path\E)//;
+  $script_name = "$script_name$1";
+
+  return +{
+    %$env,
+    PATH_INFO => $path_info,
+    SCRIPT_NAME => $script_name };
+}
+
+=head2 env_at_request_uri
+
+Localize C<$env> under the current request URI:
+
+    package MyApp::Controller::User;
+
+    use Catalyst::Utils;
+
+    use base 'Catalyst::Controller';
+
+    sub name :Local Args(1) {
+      my ($self, $c, $id) = @_;
+      my $env = $c->Catalyst::Utils::env_at_request_uri
+    }
+
+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'.
+
+=cut
+
+sub env_at_request_uri {
+  my $ctx = shift;
+  my $path = '/' . $ctx->request->path;
+  my $env = $ctx->request->env;
+  my $path_info = $env->{PATH_INFO};
+  my $script_name = ($env->{SCRIPT_NAME} || '');
+
+  $path_info =~ s/(^\Q$path\E)//;
+  $script_name = "$script_name$1";
+
+  return +{
+    %$env,
+    PATH_INFO => $path_info,
+    SCRIPT_NAME => $script_name };
+}
 
 =head1 AUTHORS