X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=4714ed6bfcbb5676ab1b6dc13bfcbad06bae4148;hp=0165a44dabcd672f2d3167981be3b531128ab915;hb=4904ee278992db70da965b94627728085b88de54;hpb=c8083f4e984e61ea783d324f9064282ae38a4607 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 0165a44..4714ed6 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -14,6 +14,7 @@ use Catalyst::Request::Upload; use Catalyst::Response; use Catalyst::Utils; use Catalyst::Controller; +use Data::OptList; use Devel::InnerPackage (); use File::stat; use Module::Pluggable::Object (); @@ -30,6 +31,7 @@ use List::MoreUtils qw/uniq/; use attributes; use utf8; use Carp qw/croak carp shortmess/; +use Try::Tiny; BEGIN { require 5.008004; } @@ -68,18 +70,17 @@ our $GO = Catalyst::Exception::Go->new; __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class engine_class context_class request_class response_class stats_class - setup_finished/; + setup_finished psgi_app/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); -__PACKAGE__->engine_class('Catalyst::Engine::CGI'); +__PACKAGE__->engine_class('Catalyst::Engine'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80018'; -$VERSION = eval $VERSION; +our $VERSION = '5.80024'; sub import { my ( $class, @arguments ) = @_; @@ -281,14 +282,15 @@ Specifies a comma-delimited list of log levels. =head2 -Stats -Enables statistics collection and reporting. You can also force this setting -from the system environment with CATALYST_STATS or _STATS. The -environment settings override the application, with _STATS having the -highest priority. +Enables statistics collection and reporting. -e.g. + use Catalyst qw/-Stats=1/; - use Catalyst qw/-Stats=1/ +You can also force this setting from the system environment with CATALYST_STATS +or _STATS. The environment settings override the application, with +_STATS having the highest priority. + +Stats are also enabled if L<< debugging |/"-Debug" >> is enabled. =head1 METHODS @@ -638,7 +640,13 @@ If you want to search for controllers, pass in a regexp as the argument. sub controller { my ( $c, $name, @args ) = @_; + my $appclass = ref($c) || $c; if( $name ) { + unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps + my $comps = $c->components; + my $check = $appclass."::Controller::".$name; + return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + } my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; return $c->_filter_component( $result[ 0 ], @args ); @@ -672,6 +680,11 @@ sub model { my ( $c, $name, @args ) = @_; my $appclass = ref($c) || $c; if( $name ) { + unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps + my $comps = $c->components; + my $check = $appclass."::Model::".$name; + return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + } my @result = $c->_comp_search_prefixes( $name, qw/Model M/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; return $c->_filter_component( $result[ 0 ], @args ); @@ -726,6 +739,11 @@ sub view { my $appclass = ref($c) || $c; if( $name ) { + unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps + my $comps = $c->components; + my $check = $appclass."::View::".$name; + return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + } my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; return $c->_filter_component( $result[ 0 ], @args ); @@ -1182,23 +1200,20 @@ EOF return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE. } - =head2 $app->setup_finalize -A hook to attach modifiers to. -Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup. -Also better than C< setup_finished(); >, as that is a getter method. +A hook to attach modifiers to. This method does not do anything except set the +C accessor. - sub setup_finalize { +Applying method modifiers to the C method doesn't work, because of quirky thingsdone for plugin setup. - my $app = shift; - - ## do stuff, i.e., determine a primary key column for sessions stored in a DB - - $app->next::method(@_); +Example: + after setup_finalize => sub { + my $app = shift; - } + ## do stuff here.. + }; =cut @@ -1259,11 +1274,29 @@ sub uri_for { $path .= '/'; } + undef($path) if (defined $path && $path eq ''); + + my $params = + ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); + + carp "uri_for called with undef argument" if grep { ! defined $_ } @args; + foreach my $arg (@args) { + utf8::encode($arg) if utf8::is_utf8($arg); + $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + } + if ( blessed($path) ) { # action object - my $captures = [ map { s|/|%2F|; $_; } + s|/|%2F|g for @args; + my $captures = [ map { s|/|%2F|g; $_; } ( scalar @args && ref $args[0] eq 'ARRAY' ? @{ shift(@args) } : ()) ]; + + foreach my $capture (@$captures) { + utf8::encode($capture) if utf8::is_utf8($capture); + $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + } + my $action = $path; $path = $c->dispatcher->uri_for_action($action, $captures); if (not defined $path) { @@ -1274,15 +1307,6 @@ sub uri_for { $path = '/' if $path eq ''; } - undef($path) if (defined $path && $path eq ''); - - my $params = - ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); - - carp "uri_for called with undef argument" if grep { ! defined $_ } @args; - s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; - s|/|%2F| for @args; - unshift(@args, $path); unless (defined $path && $path =~ s!^/!!) { # in-place strip @@ -1488,7 +1512,7 @@ sub welcome_message { models, and views; they can save you a lot of work.

- 
script/${prefix}_create.pl -help
+ 
script/${prefix}_create.pl --help

Also, be sure to check out the vast and growing collection of plugins for Catalyst on CPAN; you are likely to find what you need there. @@ -1731,6 +1755,8 @@ sub finalize { $c->finalize_body; } + $c->log_response; + if ($c->use_stats) { my $elapsed = sprintf '%f', $c->stats->elapsed; my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; @@ -1863,7 +1889,7 @@ namespaces. sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) } -=head2 $c->handle_request( $class, @arguments ) +=head2 $app->handle_request( @arguments ) Called to handle each HTTP request. @@ -1874,7 +1900,7 @@ sub handle_request { # Always expect worst case! my $status = -1; - eval { + try { if ($class->debug) { my $secs = time - $START || 1; my $av = sprintf '%.3f', $COUNT / $secs; @@ -1885,12 +1911,11 @@ sub handle_request { my $c = $class->prepare(@arguments); $c->dispatch; $status = $c->finalize; - }; - - if ( my $error = $@ ) { - chomp $error; - $class->log->error(qq/Caught exception in engine "$error"/); } + catch { + chomp(my $error = $_); + $class->log->error(qq/Caught exception in engine "$error"/); + }; $COUNT++; @@ -1923,40 +1948,49 @@ sub prepare { #surely this is not the most efficient way to do things... $c->stats($class->stats_class->new)->enable($c->use_stats); - if ( $c->debug ) { + if ( $c->debug || $c->config->{enable_catalyst_header} ) { $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } - #XXX reuse coderef from can - # Allow engine to direct the prepare flow (for POE) - if ( $c->engine->can('prepare') ) { - $c->engine->prepare( $c, @arguments ); - } - else { - $c->prepare_request(@arguments); - $c->prepare_connection; - $c->prepare_query_parameters; - $c->prepare_headers; - $c->prepare_cookies; - $c->prepare_path; - - # Prepare the body for reading, either by prepare_body - # or the user, if they are using $c->read - $c->prepare_read; - - # Parse the body unless the user wants it on-demand - unless ( ref($c)->config->{parse_on_demand} ) { - $c->prepare_body; + try { + # Allow engine to direct the prepare flow (for POE) + if ( my $prepare = $c->engine->can('prepare') ) { + $c->engine->$prepare( $c, @arguments ); + } + else { + $c->prepare_request(@arguments); + $c->prepare_connection; + $c->prepare_query_parameters; + $c->prepare_headers; + $c->prepare_cookies; + $c->prepare_path; + + # Prepare the body for reading, either by prepare_body + # or the user, if they are using $c->read + $c->prepare_read; + + # Parse the body unless the user wants it on-demand + unless ( ref($c)->config->{parse_on_demand} ) { + $c->prepare_body; + } } } + # VERY ugly and probably shouldn't rely on ->finalize actually working + catch { + # failed prepare is always due to an invalid request, right? + $c->response->status(400); + $c->response->content_type('text/plain'); + $c->response->body('Bad Request'); + $c->finalize; + die $_; + }; my $method = $c->req->method || ''; my $path = $c->req->path; $path = '/' unless length $path; my $address = $c->req->address || ''; - $c->log->debug(qq/"$method" request for "$path" from "$address"/) - if $c->debug; + $c->log_request; $c->prepare_action; @@ -1986,17 +2020,6 @@ sub prepare_body { $c->engine->prepare_body( $c, @_ ); $c->prepare_parameters; $c->prepare_uploads; - - if ( $c->debug && keys %{ $c->req->body_parameters } ) { - my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] ); - for my $key ( sort keys %{ $c->req->body_parameters } ) { - my $param = $c->req->body_parameters->{$key}; - my $value = defined($param) ? $param : ''; - $t->row( $key, - ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); - } - $c->log->debug( "Body Parameters are:\n" . $t->draw ); - } } =head2 $c->prepare_body_chunk( $chunk ) @@ -2080,55 +2103,156 @@ sub prepare_query_parameters { my $c = shift; $c->engine->prepare_query_parameters( $c, @_ ); +} - if ( $c->debug && keys %{ $c->request->query_parameters } ) { - my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] ); - for my $key ( sort keys %{ $c->req->query_parameters } ) { - my $param = $c->req->query_parameters->{$key}; - my $value = defined($param) ? $param : ''; - $t->row( $key, - ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); - } - $c->log->debug( "Query Parameters are:\n" . $t->draw ); +=head2 $c->log_request + +Writes information about the request to the debug logs. This includes: + +=over 4 + +=item * Request method, path, and remote IP address + +=item * Query keywords (see L) + +=item * Request parameters + +=item * File uploads + +=back + +=cut + +sub log_request { + my $c = shift; + + return unless $c->debug; + + my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these; + my $request = $dump->[1]; + + my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address ); + $method ||= ''; + $path = '/' unless length $path; + $address ||= ''; + $c->log->debug(qq/"$method" request for "$path" from "$address"/); + + $c->log_request_headers($request->headers); + + if ( my $keywords = $request->query_keywords ) { + $c->log->debug("Query keywords are: $keywords"); } + + $c->log_request_parameters( query => $request->query_parameters, body => $request->body_parameters ); + + $c->log_request_uploads($request); } -=head2 $c->prepare_read +=head2 $c->log_response -Prepares the input for reading. +Writes information about the response to the debug logs by calling +C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>. =cut -sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) } +sub log_response { + my $c = shift; -=head2 $c->prepare_request + return unless $c->debug; -Prepares the engine request. + my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these; + my $response = $dump->[1]; + + $c->log_response_status_line($response); + $c->log_response_headers($response->headers); +} + +=head2 $c->log_response_status_line($response) + +Writes one line of information about the response to the debug logs. This includes: + +=over 4 + +=item * Response status code + +=item * Content-Type header (if present) + +=item * Content-Length header (if present) + +=back =cut -sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) } +sub log_response_status_line { + my ($c, $response) = @_; -=head2 $c->prepare_uploads + $c->log->debug( + sprintf( + 'Response Code: %s; Content-Type: %s; Content-Length: %s', + $response->status || 'unknown', + $response->headers->header('Content-Type') || 'unknown', + $response->headers->header('Content-Length') || 'unknown' + ) + ); +} -Prepares uploads. +=head2 $c->log_response_headers($headers); + +Hook method which can be wrapped by plugins to log the responseheaders. +No-op in the default implementation. =cut -sub prepare_uploads { - my $c = shift; +sub log_response_headers {} - $c->engine->prepare_uploads( $c, @_ ); +=head2 $c->log_request_parameters( query => {}, body => {} ) + +Logs request parameters to debug logs + +=cut + +sub log_request_parameters { + my $c = shift; + my %all_params = @_; - if ( $c->debug && keys %{ $c->request->uploads } ) { + return unless $c->debug; + + my $column_width = Catalyst::Utils::term_width() - 44; + foreach my $type (qw(query body)) { + my $params = $all_params{$type}; + next if ! keys %$params; + my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); + for my $key ( sort keys %$params ) { + my $param = $params->{$key}; + my $value = defined($param) ? $param : ''; + $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); + } + $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw ); + } +} + +=head2 $c->log_request_uploads + +Logs file uploads included in the request to the debug logs. +The parameter name, filename, file type, and file size are all included in +the debug logs. + +=cut + +sub log_request_uploads { + my $c = shift; + my $request = shift; + return unless $c->debug; + my $uploads = $request->uploads; + if ( keys %$uploads ) { my $t = Text::SimpleTable->new( [ 12, 'Parameter' ], [ 26, 'Filename' ], [ 18, 'Type' ], [ 9, 'Size' ] ); - for my $key ( sort keys %{ $c->request->uploads } ) { - my $upload = $c->request->uploads->{$key}; + for my $key ( sort keys %$uploads ) { + my $upload = $uploads->{$key}; for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) { $t->row( $key, $u->filename, $u->type, $u->size ); } @@ -2137,6 +2261,68 @@ sub prepare_uploads { } } +=head2 $c->log_request_headers($headers); + +Hook method which can be wrapped by plugins to log the request headers. +No-op in the default implementation. + +=cut + +sub log_request_headers {} + +=head2 $c->log_headers($type => $headers) + +Logs L (either request or response) to the debug logs. + +=cut + +sub log_headers { + my $c = shift; + my $type = shift; + my $headers = shift; # an HTTP::Headers instance + + return unless $c->debug; + + my $column_width = Catalyst::Utils::term_width() - 28; + my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] ); + $headers->scan( + sub { + my ( $name, $value ) = @_; + $t->row( $name, $value ); + } + ); + $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw ); +} + + +=head2 $c->prepare_read + +Prepares the input for reading. + +=cut + +sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) } + +=head2 $c->prepare_request + +Prepares the engine request. + +=cut + +sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) } + +=head2 $c->prepare_uploads + +Prepares uploads. + +=cut + +sub prepare_uploads { + my $c = shift; + + $c->engine->prepare_uploads( $c, @_ ); +} + =head2 $c->prepare_write Prepares the output for writing. @@ -2230,17 +2416,15 @@ sub setup_components { # we know M::P::O found a file on disk so this is safe Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); - - # Needs to be done as soon as the component is loaded, as loading a sub-component - # (next time round the loop) can cause us to get the wrong metaclass.. - $class->_controller_init_base_classes($component); } for my $component (@comps) { - $class->components->{ $component } = $class->setup_component($component); - for my $component ($class->expand_component_module( $component, $config )) { + my $instance = $class->components->{ $component } = $class->setup_component($component); + my @expanded_components = $instance->can('expand_modules') + ? $instance->expand_modules( $component, $config ) + : $class->expand_component_module( $component, $config ); + for my $component (@expanded_components) { next if $comps{$component}; - $class->_controller_init_base_classes($component); # Also cover inner packages $class->components->{ $component } = $class->setup_component($component); } } @@ -2293,19 +2477,6 @@ sub expand_component_module { =cut -# FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes -# nearest to Catalyst::Controller first, no matter what order stuff happens -# to be loaded. There are TODO tests in Moose for this, see -# f2391d17574eff81d911b97be15ea51080500003 -sub _controller_init_base_classes { - my ($app_class, $component) = @_; - return unless $component->isa('Catalyst::Controller'); - foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) { - Moose::Meta::Class->initialize( $class ) - unless find_meta($class); - } -} - sub setup_component { my( $class, $component ) = @_; @@ -2376,76 +2547,15 @@ Sets up engine. =cut sub setup_engine { - my ( $class, $engine ) = @_; - - if ($engine) { - $engine = 'Catalyst::Engine::' . $engine; - } - - if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) { - $engine = 'Catalyst::Engine::' . $env; - } - - if ( $ENV{MOD_PERL} ) { - my $meta = Class::MOP::get_metaclass_by_name($class); - - # create the apache method - $meta->add_method('apache' => sub { shift->engine->apache }); - - my ( $software, $version ) = - $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; - - $version =~ s/_//g; - $version =~ s/(\.[^.]+)\./$1/g; - - if ( $software eq 'mod_perl' ) { - - if ( !$engine ) { - - if ( $version >= 1.99922 ) { - $engine = 'Catalyst::Engine::Apache2::MP20'; - } - - elsif ( $version >= 1.9901 ) { - $engine = 'Catalyst::Engine::Apache2::MP19'; - } - - elsif ( $version >= 1.24 ) { - $engine = 'Catalyst::Engine::Apache::MP13'; - } - - else { - Catalyst::Exception->throw( message => - qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); - } - - } - - # install the correct mod_perl handler - if ( $version >= 1.9901 ) { - *handler = sub : method { - shift->handle_request(@_); - }; - } - else { - *handler = sub ($$) { shift->handle_request(@_) }; - } - - } - - elsif ( $software eq 'Zeus-Perl' ) { - $engine = 'Catalyst::Engine::Zeus'; - } - - else { - Catalyst::Exception->throw( - message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ ); - } - } + my ($class, $engine) = @_; unless ($engine) { $engine = $class->engine_class; } + $engine = 'Catalyst::Engine::' . $engine + unless $engine =~ /^Catalyst::Engine/; + + $engine = 'Catalyst::Engine' if $engine eq 'Catalyst::Engine::HTTP'; Class::MOP::load_class($engine); @@ -2481,8 +2591,8 @@ sub setup_engine { ); } - # engine instance $class->engine( $engine->new ); + $class->psgi_app( $class->engine->build_psgi_app($class) ); } =head2 $c->setup_home @@ -2606,13 +2716,8 @@ the plugin name does not begin with C. if $plugin->isa( 'Catalyst::Component' ); $proto->_plugins->{$plugin} = 1; unless ($instant) { - no strict 'refs'; - if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) { - my @superclasses = ($plugin, $meta->superclasses ); - $meta->superclasses(@superclasses); - } else { - unshift @{"$class\::ISA"}, $plugin; - } + my $meta = Class::MOP::get_metaclass_by_name($class); + $meta->superclasses($plugin, $meta->superclasses); } return $class; } @@ -2621,22 +2726,29 @@ the plugin name does not begin with C. my ( $class, $plugins ) = @_; $class->_plugins( {} ) unless $class->_plugins; - $plugins ||= []; + $plugins = Data::OptList::mkopt($plugins || []); - my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins); + my @plugins = map { + [ Catalyst::Utils::resolve_namespace( + $class . '::Plugin', + 'Catalyst::Plugin', $_->[0] + ), + $_->[1], + ] + } @{ $plugins }; for my $plugin ( reverse @plugins ) { - Class::MOP::load_class($plugin); - my $meta = find_meta($plugin); + Class::MOP::load_class($plugin->[0], $plugin->[1]); + my $meta = find_meta($plugin->[0]); next if $meta && $meta->isa('Moose::Meta::Role'); - $class->_register_plugin($plugin); + $class->_register_plugin($plugin->[0]); } my @roles = - map { $_->name } - grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') } - map { find_meta($_) } + map { $_->[0]->name, $_->[1] } + grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') } + map { [find_meta($_->[0]), $_->[1]] } @plugins; Moose::Util::apply_all_roles( @@ -2650,15 +2762,24 @@ the plugin name does not begin with C. Returns an arrayref of the internal execution stack (actions that are currently executing). +=head2 $c->stats + +Returns the current timing statistics object. By default Catalyst uses +L, but can be set otherwise with +L<< stats_class|/"$c->stats_class" >>. + +Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still +available. By enabling it with C< $c->stats->enabled(1) >, it can be used to +profile explicitly, although MyApp.pm still won't profile nor output anything +by itself. + =head2 $c->stats_class -Returns or sets the stats (timing statistics) class. +Returns or sets the stats (timing statistics) class. L is used by default. =head2 $c->use_stats -Returns 1 when stats collection is enabled. Stats collection is enabled -when the -Stats options is set, debug is on or when the _STATS -environment variable is set. +Returns 1 when L<< stats collection|/"-Stats" >> is enabled. Note that this is a static method, not an accessor and should be overridden by declaring C in your MyApp.pm, not by calling C<< $c->use_stats(1) >>. @@ -2756,6 +2877,12 @@ to be shown in hit debug tables in the test server. =item * +C - Controlls if the C or C environment +variable should be used for determining the request path. See L +for more information. + +=item * + C - See L. =back @@ -2985,8 +3112,12 @@ random: Roland Lammel Robert Sedlacek C<< >> +SpiceMan: Marcel Montes + sky: Arthur Bergman +szbalint: Balint Szilakszi + t0m: Tomas Doran Ulf Edvinsson @@ -2997,6 +3128,8 @@ Will Hawes C willert: Sebastian Willert +wreis: Wallace Reis + Yuval Kogman, C =head1 LICENSE