view release on metacpan or  search on metacpan

examples/fatpacked.plackup  view on Meta::CPAN

  
  =item finalize
  
    $res->finalize;
  
  Returns the status code, headers, and body of this response as a PSGI
  response array reference.
  
  =item to_app
  
    $app = $res->to_app;
  
  A helper shortcut for C<< sub { $res->finalize } >>.
  
  
  =back
  
  =head1 AUTHOR
  
  Tokuhiro Matsuno
  
  Tatsuhiko Miyagawa
  
  =head1 SEE ALSO
  
  L<Plack::Request>
  
  =cut
PLACK_RESPONSE

$fatpacked{"Plack/Runner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PLACK_RUNNER';
  package Plack::Runner;
  use strict;
  use warnings;
  use Carp ();
  use Plack::Util;
  use Try::Tiny;
  
  sub new {
      my $class = shift;
      bless {
          env      => $ENV{PLACK_ENV},
          loader   => 'Plack::Loader',
          includes => [],
          modules  => [],
          default_middleware => 1,
          @_,
      }, $class;
  }
  
  # delay the build process for reloader
  sub build(&;$) {
      my $block = shift;
      my $app   = shift || sub { };
      return sub { $block->($app->()) };
  }
  
  sub parse_options {
      my $self = shift;
  
      local @ARGV = @_;
  
      # From 'prove': Allow cuddling the paths with -I, -M and -e
      @ARGV = map { /^(-[IMe])(.+)/ ? ($1,$2) : $_ } @ARGV;
  
      my($host, $port, $socket, @listen);
  
      require Getopt::Long;
      my $parser = Getopt::Long::Parser->new(
          config => [ "no_auto_abbrev", "no_ignore_case", "pass_through" ],
      );
  
      $parser->getoptions(
          "a|app=s"      => \$self->{app},
          "o|host=s"     => \$host,
          "p|port=i"     => \$port,
          "s|server=s"   => \$self->{server},
          "S|socket=s"   => \$socket,
          'l|listen=s@'  => \@listen,
          'D|daemonize'  => \$self->{daemonize},
          "E|env=s"      => \$self->{env},
          "e=s"          => \$self->{eval},
          'I=s@'         => $self->{includes},
          'M=s@'         => $self->{modules},
          'r|reload'     => sub { $self->{loader} = "Restarter" },
          'R|Reload=s'   => sub { $self->{loader} = "Restarter"; $self->loader->watch(split ",", $_[1]) },
          'L|loader=s'   => \$self->{loader},
          "access-log=s" => \$self->{access_log},
          "path=s"       => \$self->{path},
          "h|help"       => \$self->{help},
          "v|version"    => \$self->{version},
          "default-middleware!" => \$self->{default_middleware},
      );
  
      my(@options, @argv);
      while (defined(my $arg = shift @ARGV)) {
          if ($arg =~ s/^--?//) {
              my @v = split '=', $arg, 2;
              $v[0] =~ tr/-/_/;
              if (@v == 2) {
                  push @options, @v;
              } elsif ($v[0] =~ s/^(disable|enable)_//) {
                  push @options, $v[0], $1 eq 'enable';
              } else {
                  push @options, $v[0], shift @ARGV;
              }
          } else {
              push @argv, $arg;
          }
      }
  
      push @options, $self->mangle_host_port_socket($host, $port, $socket, @listen);
      push @options, daemonize => 1 if $self->{daemonize};
  
      $self->{options} = \@options;
      $self->{argv}    = \@argv;
  }
  
  sub set_options {
      my $self = shift;
      push @{$self->{options}}, @_;

examples/fatpacked.plackup  view on Meta::CPAN

          # anything else, including GLOBS without IO (even if they are blessed)
          # and non GLOB objects that look like filehandle objects cannot have a
          # valid file descriptor in fileno($fh) context so may break.
          return FALSE;
      }
  }
  
  sub set_io_path {
      my($fh, $path) = @_;
      bless $fh, 'Plack::Util::IOWithPath';
      $fh->path($path);
  }
  
  sub content_length {
      my $body = shift;
  
      return unless defined $body;
  
      if (ref $body eq 'ARRAY') {
          my $cl = 0;
          for my $chunk (@$body) {
              $cl += length $chunk;
          }
          return $cl;
      } elsif ( is_real_fh($body) ) {
          return (-s $body) - tell($body);
      }
  
      return;
  }
  
  sub foreach {
      my($body, $cb) = @_;
  
      if (ref $body eq 'ARRAY') {
          for my $line (@$body) {
              $cb->($line) if length $line;
          }
      } else {
          local $/ = \65536 unless ref $/;
          while (defined(my $line = $body->getline)) {
              $cb->($line) if length $line;
          }
          $body->close;
      }
  }
  
  sub class_to_file {
      my $class = shift;
      $class =~ s!::!/!g;
      $class . ".pm";
  }
  
  sub _load_sandbox {
      my $_file = shift;
  
      my $_package = $_file;
      $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
  
      local $0 = $_file; # so FindBin etc. works
      local @ARGV = ();  # Some frameworks might try to parse @ARGV
  
      return eval sprintf <<'END_EVAL', $_package;
  package Plack::Sandbox::%s;
  {
      my $app = do $_file;
      if ( !$app && ( my $error = $@ || $! )) { die $error; }
      $app;
  }
  END_EVAL
  }
  
  sub load_psgi {
      my $stuff = shift;
  
      local $ENV{PLACK_ENV} = $ENV{PLACK_ENV} || 'development';
  
      my $file = $stuff =~ /^[a-zA-Z0-9\_\:]+$/ ? class_to_file($stuff) : File::Spec->rel2abs($stuff);
      my $app = _load_sandbox($file);
      die "Error while loading $file: $@" if $@;
  
      return $app;
  }
  
  sub run_app($$) {
      my($app, $env) = @_;
  
      return eval { $app->($env) } || do {
          my $body = "Internal Server Error";
          $env->{'psgi.errors'}->print($@);
          [ 500, [ 'Content-Type' => 'text/plain', 'Content-Length' => length($body) ], [ $body ] ];
      };
  }
  
  sub headers {
      my $headers = shift;
      inline_object(
          iter   => sub { header_iter($headers, @_) },
          get    => sub { header_get($headers, @_) },
          set    => sub { header_set($headers, @_) },
          push   => sub { header_push($headers, @_) },
          exists => sub { header_exists($headers, @_) },
          remove => sub { header_remove($headers, @_) },
          headers => sub { $headers },
      );
  }
  
  sub header_iter {
      my($headers, $code) = @_;
  
      my @headers = @$headers; # copy
      while (my($key, $val) = splice @headers, 0, 2) {
          $code->($key, $val);
      }
  }
  
  sub header_get {
      my($headers, $key) = (shift, lc shift);
  
      return () if not @$headers;