lib/Catalyst/Engine.pm

   1 package Catalyst::Engine;
   2
   3 use Moose;
   4 with 'MooseX::Emulate::Class::Accessor::Fast';
   5
   6 use CGI::Simple::Cookie;
   7 use Data::Dump qw/dump/;
   8 use Errno 'EWOULDBLOCK';
   9 use HTML::Entities;
  10 use HTTP::Body;
  11 use HTTP::Headers;
  12 use URI::QueryParam;
  13 use Plack::Loader;
  14 use Catalyst::EngineLoader;
  15 use Encode ();
  16 use utf8;
  17
  18 use namespace::clean -except => 'meta';
  19
  20 # Amount of data to read from input on each pass
  21 our $CHUNKSIZE = 64 * 1024;
  22
  23 # XXX - this is only here for compat, do not use!
  24 has env => ( is => 'rw', writer => '_set_env' );
  25 my $WARN_ABOUT_ENV = 0;
  26 around env => sub {
  27   my ($orig, $self, @args) = @_;
  28   if(@args) {
  29     warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI"
  30       unless $WARN_ABOUT_ENV++;
  31     return $self->_set_env(@args);
  32   }
  33   return $self->$orig;
  34 };
  35
  36 # XXX - Only here for Engine::PSGI compat
  37 sub prepare_connection {
  38     my ($self, $ctx) = @_;
  39     $ctx->request->prepare_connection;
  40 }
  41
  42 =head1 NAME
  43
  44 Catalyst::Engine - The Catalyst Engine
  45
  46 =head1 SYNOPSIS
  47
  48 See L<Catalyst>.
  49
  50 =head1 DESCRIPTION
  51
  52 =head1 METHODS
  53
  54
  55 =head2 $self->finalize_body($c)
  56
  57 Finalize body.  Prints the response output as blocking stream if it looks like
  58 a filehandle, otherwise write it out all in one go.  If there is no body in
  59 the response, we assume you are handling it 'manually', such as for nonblocking
  60 style or asynchronous streaming responses.
  61
  62 By default we do not close the writer object in case we are in an event loop
  63 and there is deferred activity.  However if you have some sloppy code that is
  64 closing over an unweakened context ($c) this could lead to the writer NEVER
  65 being closed.  In versions of Catalyst 5.90030 and older, we used to forcibly
  66 close the writer in this method, but we no longer do that since it prevented us
  67 from introducing proper asynchronous support in Catalyst core.  If you have old
  68 code that is leaking context but was otherwise working and you don't want to fix
  69 your memory leaks (is really the best idea) you can force enable the old
  70 behavior (and lose asynchronous support) by setting the global configuration key
  71 C<aggressively_close_writer_on_finalize_body> to true.  See L<Catalyst::Upgrading>
  72 for more if you have this issue.
  73
  74 =cut
  75
  76 sub finalize_body {
  77     my ( $self, $c ) = @_;
  78     my $body = $c->response->body;
  79     no warnings 'uninitialized';
  80     if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) {
  81         my $got;
  82         do {
  83             $got = read $body, my ($buffer), $CHUNKSIZE;
  84             $got = 0 unless $self->write( $c, $buffer );
  85         } while $got > 0;
  86
  87         close $body;
  88     }
  89     else {
  90         $self->write( $c, $body );
  91     }
  92
  93     if($c->config->{aggressively_close_writer_on_finalize_body}) {
  94       my $res = $c->response;
  95       $res->_writer->close;
  96       $res->_clear_writer;
  97     }
  98
  99     return;
 100 }
 101
 102 =head2 $self->finalize_cookies($c)
 103
 104 Create CGI::Simple::Cookie objects from $c->res->cookies, and set them as
 105 response headers.
 106
 107 =cut
 108
 109 sub finalize_cookies {
 110     my ( $self, $c ) = @_;
 111
 112     my @cookies;
 113     my $response = $c->response;
 114
 115     foreach my $name (keys %{ $response->cookies }) {
 116
 117         my $val = $response->cookies->{$name};
 118
 119         my $cookie = (
 120             blessed($val)
 121             ? $val
 122             : CGI::Simple::Cookie->new(
 123                 -name    => $name,
 124                 -value   => $val->{value},
 125                 -expires => $val->{expires},
 126                 -domain  => $val->{domain},
 127                 -path    => $val->{path},
 128                 -secure  => $val->{secure} || 0,
 129                 -httponly => $val->{httponly} || 0,
 130             )
 131         );
 132         if (!defined $cookie) {
 133             $c->log->warn("undef passed in '$name' cookie value - not setting cookie")
 134                 if $c->debug;
 135             next;
 136         }
 137
 138         push @cookies, $cookie->as_string;
 139     }
 140
 141     for my $cookie (@cookies) {
 142         $response->headers->push_header( 'Set-Cookie' => $cookie );
 143     }
 144 }
 145
 146 =head2 $self->finalize_error($c)
 147
 148 Output an appropriate error message. Called if there's an error in $c
 149 after the dispatch has finished. Will output debug messages if Catalyst
 150 is in debug mode, or a `please come back later` message otherwise.
 151
 152 =cut
 153
 154 sub _dump_error_page_element {
 155     my ($self, $i, $element) = @_;
 156     my ($name, $val)  = @{ $element };
 157
 158     # This is fugly, but the metaclass is _HUGE_ and demands waaay too much
 159     # scrolling. Suggestions for more pleasant ways to do this welcome.
 160     local $val->{'__MOP__'} = "Stringified: "
 161         . $val->{'__MOP__'} if ref $val eq 'HASH' && exists $val->{'__MOP__'};
 162
 163     my $text = encode_entities( dump( $val ));
 164     sprintf <<"EOF", $name, $text;
 165 <h2><a href="#" onclick="toggleDump('dump_$i'); return false">%s</a></h2>
 166 <div id="dump_$i">
 167     <pre wrap="">%s</pre>
 168 </div>
 169 EOF
 170 }
 171
 172 sub finalize_error {
 173     my ( $self, $c ) = @_;
 174
 175     $c->res->content_type('text/html; charset=utf-8');
 176     my $name = ref($c)->config->{name} || join(' ', split('::', ref $c));
 177
 178     # Prevent Catalyst::Plugin::Unicode::Encoding from running.
 179     # This is a little nasty, but it's the best way to be clean whether or
 180     # not the user has an encoding plugin.
 181
 182     if ($c->can('encoding')) {
 183       $c->{encoding} = '';
 184     }
 185
 186     my ( $title, $error, $infos );
 187     if ( $c->debug ) {
 188
 189         # For pretty dumps
 190         $error = join '', map {
 191                 '<p><code class="error">'
 192               . encode_entities($_)
 193               . '</code></p>'
 194         } @{ $c->error };
 195         $error ||= 'No output';
 196         $error = qq{<pre wrap="">$error</pre>};
 197         $title = $name = "$name on Catalyst $Catalyst::VERSION";
 198         $name  = "<h1>$name</h1>";
 199
 200         # Don't show context in the dump
 201         $c->res->_clear_context;
 202
 203         # Don't show body parser in the dump
 204         $c->req->_clear_body;
 205
 206         my @infos;
 207         my $i = 0;
 208         for my $dump ( $c->dump_these ) {
 209             push @infos, $self->_dump_error_page_element($i, $dump);
 210             $i++;
 211         }
 212         $infos = join "\n", @infos;
 213     }
 214     else {
 215         $title = $name;
 216         $error = '';
 217         $infos = <<"";
 218 <pre>
 219 (en) Please come back later
 220 (fr) SVP veuillez revenir plus tard
 221 (de) Bitte versuchen sie es spaeter nocheinmal
 222 (at) Konnten's bitt'schoen spaeter nochmal reinschauen
 223 (no) Vennligst prov igjen senere
 224 (dk) Venligst prov igen senere
 225 (pl) Prosze sprobowac pozniej
 226 (pt) Por favor volte mais tarde
 227 (ru) Попробуйте еще раз позже
 228 (ua) Спробуйте ще раз пізніше
 229 </pre>
 230
 231         $name = '';
 232     }
 233     $c->res->body( <<"" );
 234 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 235     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 236 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
 237 <head>
 238     <meta http-equiv="Content-Language" content="en" />
 239     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 240     <title>$title</title>
 241     <script type="text/javascript">
 242         <!--
 243         function toggleDump (dumpElement) {
 244             var e = document.getElementById( dumpElement );
 245             if (e.style.display == "none") {
 246                 e.style.display = "";
 247             }
 248             else {
 249                 e.style.display = "none";
 250             }
 251         }
 252         -->
 253     </script>
 254     <style type="text/css">
 255         body {
 256             font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
 257                          Tahoma, Arial, helvetica, sans-serif;
 258             color: #333;
 259             background-color: #eee;
 260             margin: 0px;
 261             padding: 0px;
 262         }
 263         :link, :link:hover, :visited, :visited:hover {
 264             color: #000;
 265         }
 266         div.box {
 267             position: relative;
 268             background-color: #ccc;
 269             border: 1px solid #aaa;
 270             padding: 4px;
 271             margin: 10px;
 272         }
 273         div.error {
 274             background-color: #cce;
 275             border: 1px solid #755;
 276             padding: 8px;
 277             margin: 4px;
 278             margin-bottom: 10px;
 279         }
 280         div.infos {
 281             background-color: #eee;
 282             border: 1px solid #575;
 283             padding: 8px;
 284             margin: 4px;
 285             margin-bottom: 10px;
 286         }
 287         div.name {
 288             background-color: #cce;
 289             border: 1px solid #557;
 290             padding: 8px;
 291             margin: 4px;
 292         }
 293         code.error {
 294             display: block;
 295             margin: 1em 0;
 296             overflow: auto;
 297         }
 298         div.name h1, div.error p {
 299             margin: 0;
 300         }
 301         h2 {
 302             margin-top: 0;
 303             margin-bottom: 10px;
 304             font-size: medium;
 305             font-weight: bold;
 306             text-decoration: underline;
 307         }
 308         h1 {
 309             font-size: medium;
 310             font-weight: normal;
 311         }
 312         /* from http://users.tkk.fi/~tkarvine/linux/doc/pre-wrap/pre-wrap-css3-mozilla-opera-ie.html */
 313         /* Browser specific (not valid) styles to make preformatted text wrap */
 314         pre {
 315             white-space: pre-wrap;       /* css-3 */
 316             white-space: -moz-pre-wrap;  /* Mozilla, since 1999 */
 317             white-space: -pre-wrap;      /* Opera 4-6 */
 318             white-space: -o-pre-wrap;    /* Opera 7 */
 319             word-wrap: break-word;       /* Internet Explorer 5.5+ */
 320         }
 321     </style>
 322 </head>
 323 <body>
 324     <div class="box">
 325         <div class="error">$error</div>
 326         <div class="infos">$infos</div>
 327         <div class="name">$name</div>
 328     </div>
 329 </body>
 330 </html>
 331
 332     # Trick IE. Old versions of IE would display their own error page instead
 333     # of ours if we'd give it less than 512 bytes.
 334     $c->res->{body} .= ( ' ' x 512 );
 335
 336     $c->res->{body} = Encode::encode("UTF-8", $c->res->{body});
 337
 338     # Return 500
 339     $c->res->status(500);
 340 }
 341
 342 =head2 $self->finalize_headers($c)
 343
 344 Allows engines to write headers to response
 345
 346 =cut
 347
 348 sub finalize_headers {
 349     my ($self, $ctx) = @_;
 350
 351     $ctx->finalize_headers unless $ctx->response->finalized_headers;
 352     return;
 353 }
 354
 355 =head2 $self->finalize_uploads($c)
 356
 357 Clean up after uploads, deleting temp files.
 358
 359 =cut
 360
 361 sub finalize_uploads {
 362     my ( $self, $c ) = @_;
 363
 364     # N.B. This code is theoretically entirely unneeded due to ->cleanup(1)
 365     #      on the HTTP::Body object.
 366     my $request = $c->request;
 367     foreach my $key (keys %{ $request->uploads }) {
 368         my $upload = $request->uploads->{$key};
 369         unlink grep { -e $_ } map { $_->tempname }
 370           (ref $upload eq 'ARRAY' ? @{$upload} : ($upload));
 371     }
 372
 373 }
 374
 375 =head2 $self->prepare_body($c)
 376
 377 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
 378
 379 =cut
 380
 381 sub prepare_body {
 382     my ( $self, $c ) = @_;
 383
 384     $c->request->prepare_body;
 385 }
 386
 387 =head2 $self->prepare_body_chunk($c)
 388
 389 Add a chunk to the request body.
 390
 391 =cut
 392
 393 # XXX - Can this be deleted?
 394 sub prepare_body_chunk {
 395     my ( $self, $c, $chunk ) = @_;
 396
 397     $c->request->prepare_body_chunk($chunk);
 398 }
 399
 400 =head2 $self->prepare_body_parameters($c)
 401
 402 Sets up parameters from body.
 403
 404 =cut
 405
 406 sub prepare_body_parameters {
 407     my ( $self, $c ) = @_;
 408
 409     $c->request->prepare_body_parameters;
 410 }
 411
 412 =head2 $self->prepare_parameters($c)
 413
 414 Sets up parameters from query and post parameters.
 415 If parameters have already been set up will clear
 416 existing parameters and set up again.
 417
 418 =cut
 419
 420 sub prepare_parameters {
 421     my ( $self, $c ) = @_;
 422
 423     $c->request->_clear_parameters;
 424     return $c->request->parameters;
 425 }
 426
 427 =head2 $self->prepare_path($c)
 428
 429 abstract method, implemented by engines.
 430
 431 =cut
 432
 433 sub prepare_path {
 434     my ($self, $ctx) = @_;
 435
 436     my $env = $ctx->request->env;
 437
 438     my $scheme    = $ctx->request->secure ? 'https' : 'http';
 439     my $host      = $env->{HTTP_HOST} || $env->{SERVER_NAME};
 440     my $port      = $env->{SERVER_PORT} || 80;
 441     my $base_path = $env->{SCRIPT_NAME} || "/";
 442
 443     # set the request URI
 444     my $path;
 445     if (!$ctx->config->{use_request_uri_for_path}) {
 446         my $path_info = $env->{PATH_INFO};
 447         if ( exists $env->{REDIRECT_URL} ) {
 448             $base_path = $env->{REDIRECT_URL};
 449             $base_path =~ s/\Q$path_info\E$//;
 450         }
 451         $path = $base_path . $path_info;
 452         $path =~ s{^/+}{};
 453         $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
 454         $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
 455     }
 456     else {
 457         my $req_uri = $env->{REQUEST_URI};
 458         $req_uri =~ s/\?.*$//;
 459         $path = $req_uri;
 460         $path =~ s{^/+}{};
 461     }
 462
 463     # Using URI directly is way too slow, so we construct the URLs manually
 464     my $uri_class = "URI::$scheme";
 465
 466     # HTTP_HOST will include the port even if it's 80/443
 467     $host =~ s/:(?:80|443)$//;
 468
 469     if ($port !~ /^(?:80|443)$/ && $host !~ /:/) {
 470         $host .= ":$port";
 471     }
 472
 473     my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : '';
 474     my $uri   = $scheme . '://' . $host . '/' . $path . $query;
 475
 476     $ctx->request->uri( (bless \$uri, $uri_class)->canonical );
 477
 478     # set the base URI
 479     # base must end in a slash
 480     $base_path .= '/' unless $base_path =~ m{/$};
 481
 482     my $base_uri = $scheme . '://' . $host . $base_path;
 483
 484     $ctx->request->base( bless \$base_uri, $uri_class );
 485
 486     return;
 487 }
 488
 489 =head2 $self->prepare_request($c)
 490
 491 =head2 $self->prepare_query_parameters($c)
 492
 493 process the query string and extract query parameters.
 494
 495 =cut
 496
 497 sub prepare_query_parameters {
 498     my ($self, $c) = @_;
 499
 500     my $env = $c->request->env;
 501     my $query_string = exists $env->{QUERY_STRING}
 502         ? $env->{QUERY_STRING}
 503         : '';
 504
 505     # Check for keywords (no = signs)
 506     # (yes, index() is faster than a regex :))
 507     if ( index( $query_string, '=' ) < 0 ) {
 508         $c->request->query_keywords( $self->unescape_uri($query_string) );
 509         return;
 510     }
 511
 512     my %query;
 513
 514     # replace semi-colons
 515     $query_string =~ s/;/&/g;
 516
 517     my @params = grep { length $_ } split /&/, $query_string;
 518
 519     for my $item ( @params ) {
 520
 521         my ($param, $value)
 522             = map { $self->unescape_uri($_) }
 523               split( /=/, $item, 2 );
 524
 525         $param = $self->unescape_uri($item) unless defined $param;
 526
 527         if ( exists $query{$param} ) {
 528             if ( ref $query{$param} ) {
 529                 push @{ $query{$param} }, $value;
 530             }
 531             else {
 532                 $query{$param} = [ $query{$param}, $value ];
 533             }
 534         }
 535         else {
 536             $query{$param} = $value;
 537         }
 538     }
 539     $c->request->query_parameters( \%query );
 540 }
 541
 542 =head2 $self->prepare_read($c)
 543
 544 Prepare to read by initializing the Content-Length from headers.
 545
 546 =cut
 547
 548 sub prepare_read {
 549     my ( $self, $c ) = @_;
 550
 551     # Initialize the amount of data we think we need to read
 552     $c->request->_read_length;
 553 }
 554
 555 =head2 $self->prepare_request(@arguments)
 556
 557 Populate the context object from the request object.
 558
 559 =cut
 560
 561 sub prepare_request {
 562     my ($self, $ctx, %args) = @_;
 563     $ctx->log->psgienv($args{env}) if $ctx->log->can('psgienv');
 564     $ctx->request->_set_env($args{env});
 565     $self->_set_env($args{env}); # Nasty back compat!
 566     $ctx->response->_set_response_cb($args{response_cb});
 567 }
 568
 569 =head2 $self->prepare_uploads($c)
 570
 571 =cut
 572
 573 sub prepare_uploads {
 574     my ( $self, $c ) = @_;
 575
 576     my $request = $c->request;
 577     return unless $request->_body;
 578
 579     my $uploads = $request->_body->upload;
 580     my $parameters = $request->parameters;
 581     foreach my $name (keys %$uploads) {
 582         my $files = $uploads->{$name};
 583         my @uploads;
 584         for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) {
 585             my $headers = HTTP::Headers->new( %{ $upload->{headers} } );
 586             my $u = Catalyst::Request::Upload->new
 587               (
 588                size => $upload->{size},
 589                type => scalar $headers->content_type,
 590                headers => $headers,
 591                tempname => $upload->{tempname},
 592                filename => $upload->{filename},
 593               );
 594             push @uploads, $u;
 595         }
 596         $request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
 597
 598         # support access to the filename as a normal param
 599         my @filenames = map { $_->{filename} } @uploads;
 600         # append, if there's already params with this name
 601         if (exists $parameters->{$name}) {
 602             if (ref $parameters->{$name} eq 'ARRAY') {
 603                 push @{ $parameters->{$name} }, @filenames;
 604             }
 605             else {
 606                 $parameters->{$name} = [ $parameters->{$name}, @filenames ];
 607             }
 608         }
 609         else {
 610             $parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0];
 611         }
 612     }
 613 }
 614
 615 =head2 $self->write($c, $buffer)
 616
 617 Writes the buffer to the client.
 618
 619 =cut
 620
 621 sub write {
 622     my ( $self, $c, $buffer ) = @_;
 623
 624     $c->response->write($buffer);
 625 }
 626
 627 =head2 $self->read($c, [$maxlength])
 628
 629 Reads from the input stream by calling C<< $self->read_chunk >>.
 630
 631 Maintains the read_length and read_position counters as data is read.
 632
 633 =cut
 634
 635 sub read {
 636     my ( $self, $c, $maxlength ) = @_;
 637
 638     $c->request->read($maxlength);
 639 }
 640
 641 =head2 $self->read_chunk($c, \$buffer, $length)
 642
 643 Each engine implements read_chunk as its preferred way of reading a chunk
 644 of data. Returns the number of bytes read. A return of 0 indicates that
 645 there is no more data to be read.
 646
 647 =cut
 648
 649 sub read_chunk {
 650     my ($self, $ctx) = (shift, shift);
 651     return $ctx->request->read_chunk(@_);
 652 }
 653
 654 =head2 $self->run($app, $server)
 655
 656 Start the engine. Builds a PSGI application and calls the
 657 run method on the server passed in, which then causes the
 658 engine to loop, handling requests..
 659
 660 =cut
 661
 662 sub run {
 663     my ($self, $app, $psgi, @args) = @_;
 664     # @args left here rather than just a $options, $server for back compat with the
 665     # old style scripts which send a few args, then a hashref
 666
 667     # They should never actually be used in the normal case as the Plack engine is
 668     # passed in got all the 'standard' args via the loader in the script already.
 669
 670     # FIXME - we should stash the options in an attribute so that custom args
 671     # like Gitalist's --git_dir are possible to get from the app without stupid tricks.
 672     my $server = pop @args if (scalar @args && blessed $args[-1]);
 673     my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH');
 674     # Back compat hack for applications with old (non Catalyst::Script) scripts to work in FCGI.
 675     if (scalar @args && !ref($args[0])) {
 676         if (my $listen = shift @args) {
 677             $options->{listen} ||= [$listen];
 678         }
 679     }
 680     if (! $server ) {
 681         $server = Catalyst::EngineLoader->new(application_name => ref($self))->auto(%$options);
 682         # We're not being called from a script, so auto detect what backend to
 683         # run on.  This should never happen, as mod_perl never calls ->run,
 684         # instead the $app->handle method is called per request.
 685         $app->log->warn("Not supplied a Plack engine, falling back to engine auto-loader (are your scripts ancient?)")
 686     }
 687     $app->run_options($options);
 688     $server->run($psgi, $options);
 689 }
 690
 691 =head2 build_psgi_app ($app, @args)
 692
 693 Builds and returns a PSGI application closure. (Raw, not wrapped in middleware)
 694
 695 =cut
 696
 697 sub build_psgi_app {
 698     my ($self, $app, @args) = @_;
 699
 700     return sub {
 701         my ($env) = @_;
 702
 703         return sub {
 704             my ($respond) = @_;
 705             confess("Did not get a response callback for writer, cannot continiue") unless $respond;
 706             $app->handle_request(env => $env, response_cb => $respond);
 707         };
 708     };
 709 }
 710
 711 =head2 $self->unescape_uri($uri)
 712
 713 Unescapes a given URI using the most efficient method available.  Engines such
 714 as Apache may implement this using Apache's C-based modules, for example.
 715
 716 =cut
 717
 718 sub unescape_uri {
 719     my ( $self, $str ) = @_;
 720
 721     $str =~ s/(?:%([0-9A-Fa-f]{2})|\+)/defined $1 ? chr(hex($1)) : ' '/eg;
 722
 723     return $str;
 724 }
 725
 726 =head2 $self->finalize_output
 727
 728 <obsolete>, see finalize_body
 729
 730 =head2 $self->env
 731
 732 Hash containing environment variables including many special variables inserted
 733 by WWW server - like SERVER_*, REMOTE_*, HTTP_* ...
 734
 735 Before accessing environment variables consider whether the same information is
 736 not directly available via Catalyst objects $c->request, $c->engine ...
 737
 738 BEWARE: If you really need to access some environment variable from your Catalyst
 739 application you should use $c->engine->env->{VARNAME} instead of $ENV{VARNAME},
 740 as in some environments the %ENV hash does not contain what you would expect.
 741
 742 =head1 AUTHORS
 743
 744 Catalyst Contributors, see Catalyst.pm
 745
 746 =head1 COPYRIGHT
 747
 748 This library is free software. You can redistribute it and/or modify it under
 749 the same terms as Perl itself.
 750
 751 =cut
 752
 753 __PACKAGE__->meta->make_immutable;
 754
 755 1;