summaryrefslogtreecommitdiffstats
path: root/Bugzilla/Quantum
diff options
context:
space:
mode:
authorDylan William Hardison <dylan@hardison.net>2018-08-04 18:24:15 +0200
committerDylan William Hardison <dylan@hardison.net>2018-08-04 18:24:15 +0200
commitf44392e8cdbea85ac308b2472f813ee605ebae4b (patch)
tree6e7adaf99a0e5a43eb1bf5a0d673d86b60f34f99 /Bugzilla/Quantum
parent5be3a7fd0061aa0bc3059e09079741873b9b833f (diff)
parent4528b21bc922f8b1e0ba8581d230a492aa43c9cf (diff)
downloadbugzilla-f44392e8cdbea85ac308b2472f813ee605ebae4b.tar.gz
bugzilla-f44392e8cdbea85ac308b2472f813ee605ebae4b.tar.xz
Merge branch 'mojo-poc'
Diffstat (limited to 'Bugzilla/Quantum')
-rw-r--r--Bugzilla/Quantum/CGI.pm97
-rw-r--r--Bugzilla/Quantum/Plugin/BasicAuth.pm40
-rw-r--r--Bugzilla/Quantum/Plugin/BlockIP.pm24
-rw-r--r--Bugzilla/Quantum/Plugin/Glue.pm41
-rw-r--r--Bugzilla/Quantum/SES.pm89
-rw-r--r--Bugzilla/Quantum/Static.pm4
-rw-r--r--Bugzilla/Quantum/Stdout.pm41
7 files changed, 188 insertions, 148 deletions
diff --git a/Bugzilla/Quantum/CGI.pm b/Bugzilla/Quantum/CGI.pm
index 16c733686..0a74f1ee5 100644
--- a/Bugzilla/Quantum/CGI.pm
+++ b/Bugzilla/Quantum/CGI.pm
@@ -9,57 +9,55 @@ package Bugzilla::Quantum::CGI;
use Mojo::Base 'Mojolicious::Controller';
use CGI::Compile;
-use Bugzilla::Constants qw(bz_locations);
-use Bugzilla::Quantum::Stdout;
-use File::Slurper qw(read_text);
-use File::Spec::Functions qw(catfile);
-use Sub::Name;
-use Sub::Quote 2.005000;
use Try::Tiny;
use Taint::Util qw(untaint);
-use Socket qw(AF_INET inet_aton);
use Sys::Hostname;
+use Sub::Quote 2.005000;
+use Sub::Name;
+use Socket qw(AF_INET inet_aton);
+use File::Spec::Functions qw(catfile);
+use File::Slurper qw(read_text);
use English qw(-no_match_vars);
+use Bugzilla::Quantum::Stdout;
+use Bugzilla::Constants qw(bz_locations);
our $C;
my %SEEN;
sub load_all {
- my ($class, $r) = @_;
+ my ( $class, $r ) = @_;
- foreach my $file (glob '*.cgi') {
- my $name = _file_to_method($file);
- $class->load_one($name, $file);
+ foreach my $file ( glob '*.cgi' ) {
+ my $name = _file_to_method($file);
+ $class->load_one( $name, $file );
$r->any("/$file")->to("CGI#$name");
}
}
sub load_one {
- my ($class, $name, $file) = @_;
- my $package = __PACKAGE__ . "::$name",
- my $inner_name = "_$name";
- my $content = read_text( catfile( bz_locations->{cgi_path}, $file ) );
+ my ( $class, $name, $file ) = @_;
+ my $package = __PACKAGE__ . "::$name", my $inner_name = "_$name";
+ my $content = read_text( catfile( bz_locations->{cgi_path}, $file ) );
$content = "package $package; $content";
untaint($content);
my %options = (
- package => $package,
- file => $file,
- line => 1,
+ package => $package,
+ file => $file,
+ line => 1,
no_defer => 1,
);
die "Tried to load $file more than once" if $SEEN{$file}++;
my $inner = quote_sub $inner_name, $content, {}, \%options;
my $wrapper = sub {
my ($c) = @_;
- my $stdin = $c->_STDIN;
- my $stdout = '';
- local $C = $c;
- local %ENV = $c->_ENV($file);
- local *STDIN; ## no critic (local)
+ my $stdin = $c->_STDIN;
+ local $C = $c;
+ local %ENV = $c->_ENV($file);
local $CGI::Compile::USE_REAL_EXIT = 0;
- local $PROGRAM_NAME = $file;
+ local $PROGRAM_NAME = $file;
+ local *STDIN; ## no critic (local)
open STDIN, '<', $stdin->path or die "STDIN @{[$stdin->path]}: $!" if -s $stdin->path;
- tie *STDOUT, 'Bugzilla::Quantum::Stdout', controller => $c; ## no critic (tie)
+ tie *STDOUT, 'Bugzilla::Quantum::Stdout', controller => $c; ## no critic (tie)
try {
Bugzilla->init_page();
$inner->();
@@ -70,66 +68,68 @@ sub load_one {
finally {
untie *STDOUT;
$c->finish;
- Bugzilla->_cleanup; ## no critic (private)
+ Bugzilla->cleanup;
CGI::initialize_globals();
};
};
- no strict 'refs'; ## no critic (strict)
- *{$name} = subname($name, $wrapper);
+ no strict 'refs'; ## no critic (strict)
+ *{$name} = subname( $name, $wrapper );
return 1;
}
+
sub _ENV {
- my ($c, $script_name) = @_;
- my $tx = $c->tx;
- my $req = $tx->req;
- my $headers = $req->headers;
+ my ( $c, $script_name ) = @_;
+ my $tx = $c->tx;
+ my $req = $tx->req;
+ my $headers = $req->headers;
my $content_length = $req->content->is_multipart ? $req->body_size : $headers->content_length;
- my %env_headers = ( HTTP_COOKIE => '', HTTP_REFERER => '' );
+ my %env_headers = ( HTTP_COOKIE => '', HTTP_REFERER => '' );
for my $name ( @{ $headers->names } ) {
my $key = uc "http_$name";
- $key =~ s!\W!_!g;
+ $key =~ s/\W/_/g;
$env_headers{$key} = $headers->header($name);
}
my $remote_user;
- if ( my $userinfo = $c->req->url->to_abs->userinfo ) {
+ if ( my $userinfo = $req->url->to_abs->userinfo ) {
$remote_user = $userinfo =~ /([^:]+)/ ? $1 : '';
}
elsif ( my $authenticate = $headers->authorization ) {
$remote_user = $authenticate =~ /Basic\s+(.*)/ ? b64_decode $1 : '';
$remote_user = $remote_user =~ /([^:]+)/ ? $1 : '';
}
- my $path_info = $c->param('PATH_INFO');
+ my $path_info = $c->stash->{'mojo.captures'}{'PATH_INFO'};
my %captures = %{ $c->stash->{'mojo.captures'} // {} };
- foreach my $key (keys %captures) {
- if ($key eq 'action' || $key eq 'PATH_INFO' || $key =~ /^REWRITE_/) {
+ foreach my $key ( keys %captures ) {
+ if ( $key eq 'controller' || $key eq 'action' || $key eq 'PATH_INFO' || $key =~ /^REWRITE_/ ) {
delete $captures{$key};
}
}
my $cgi_query = Mojo::Parameters->new(%captures);
- $cgi_query->append($req->url->query);
+ $cgi_query->append( $req->url->query );
+ my $prefix = $c->stash->{bmo_prefix} ? '/bmo/' : '/';
return (
%ENV,
CONTENT_LENGTH => $content_length || 0,
CONTENT_TYPE => $headers->content_type || '',
GATEWAY_INTERFACE => 'CGI/1.1',
- HTTPS => $req->is_secure ? 'YES' : 'NO',
+ HTTPS => $req->is_secure ? 'on' : 'off',
%env_headers,
- QUERY_STRING => $cgi_query->to_string,
- PATH_INFO => $path_info ? "/$path_info" : '',
- REMOTE_ADDR => $tx->remote_address,
- REMOTE_HOST => gethostbyaddr( inet_aton( $tx->remote_address || '127.0.0.1' ), AF_INET ) || '',
- REMOTE_PORT => $tx->remote_port,
- REMOTE_USER => $remote_user || '',
+ QUERY_STRING => $cgi_query->to_string,
+ PATH_INFO => $path_info ? "/$path_info" : '',
+ REMOTE_ADDR => $tx->original_remote_address,
+ REMOTE_HOST => $tx->original_remote_address,
+ REMOTE_PORT => $tx->remote_port,
+ REMOTE_USER => $remote_user || '',
REQUEST_METHOD => $req->method,
- SCRIPT_NAME => "/$script_name",
+ SCRIPT_NAME => "$prefix$script_name",
SERVER_NAME => hostname,
SERVER_PORT => $tx->local_port,
- SERVER_PROTOCOL => $req->is_secure ? 'HTTPS' : 'HTTP', # TODO: Version is missing
+ SERVER_PROTOCOL => $req->is_secure ? 'HTTPS' : 'HTTP', # TODO: Version is missing
SERVER_SOFTWARE => __PACKAGE__,
);
}
@@ -157,5 +157,4 @@ sub _file_to_method {
return $name;
}
-
1;
diff --git a/Bugzilla/Quantum/Plugin/BasicAuth.pm b/Bugzilla/Quantum/Plugin/BasicAuth.pm
new file mode 100644
index 000000000..e17273404
--- /dev/null
+++ b/Bugzilla/Quantum/Plugin/BasicAuth.pm
@@ -0,0 +1,40 @@
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+# This Source Code Form is "Incompatible With Secondary Licenses", as
+# defined by the Mozilla Public License, v. 2.0.
+package Bugzilla::Quantum::Plugin::BasicAuth;
+use 5.10.1;
+use Mojo::Base qw(Mojolicious::Plugin);
+
+use Bugzilla::Logging;
+use Carp;
+
+sub register {
+ my ( $self, $app, $conf ) = @_;
+
+ $app->renderer->add_helper(
+ basic_auth => sub {
+ my ( $c, $realm, $auth_user, $auth_pass ) = @_;
+ my $req = $c->req;
+ my ( $user, $password ) = $req->url->to_abs->userinfo =~ /^([^:]+):(.*)/;
+
+ unless ( $realm && $auth_user && $auth_pass ) {
+ croak 'basic_auth() called with missing parameters.';
+ }
+
+ unless ( $user eq $auth_user && $password eq $auth_pass ) {
+ WARN('username and password do not match');
+ $c->res->headers->www_authenticate("Basic realm=\"$realm\"");
+ $c->res->code(401);
+ $c->rendered;
+ return 0;
+ }
+
+ return 1;
+ }
+ );
+}
+
+1; \ No newline at end of file
diff --git a/Bugzilla/Quantum/Plugin/BlockIP.pm b/Bugzilla/Quantum/Plugin/BlockIP.pm
index fbfffad66..058ecbf64 100644
--- a/Bugzilla/Quantum/Plugin/BlockIP.pm
+++ b/Bugzilla/Quantum/Plugin/BlockIP.pm
@@ -4,38 +4,38 @@ use Mojo::Base 'Mojolicious::Plugin';
use Bugzilla::Memcached;
-use constant BLOCK_TIMEOUT => 60*60;
+use constant BLOCK_TIMEOUT => 60 * 60;
-my $MEMCACHED = Bugzilla::Memcached->_new()->{memcached};
+my $MEMCACHED = Bugzilla::Memcached->new()->{memcached};
sub register {
my ( $self, $app, $conf ) = @_;
- $app->hook(before_routes => \&_before_routes);
- $app->helper(block_ip => \&_block_ip);
- $app->helper(unblock_ip => \&_unblock_ip);
+ $app->hook( before_routes => \&_before_routes );
+ $app->helper( block_ip => \&_block_ip );
+ $app->helper( unblock_ip => \&_unblock_ip );
}
sub _block_ip {
- my ($class, $ip) = @_;
- $MEMCACHED->set("block_ip:$ip" => 1, BLOCK_TIMEOUT) if $MEMCACHED;
+ my ( $class, $ip ) = @_;
+ $MEMCACHED->set( "block_ip:$ip" => 1, BLOCK_TIMEOUT ) if $MEMCACHED;
}
sub _unblock_ip {
- my ($class, $ip) = @_;
+ my ( $class, $ip ) = @_;
$MEMCACHED->delete("block_ip:$ip") if $MEMCACHED;
}
sub _before_routes {
- my ( $c ) = @_;
+ my ($c) = @_;
return if $c->stash->{'mojo.static'};
my $ip = $c->tx->remote_address;
- if ($MEMCACHED && $MEMCACHED->get("block_ip:$ip")) {
+ if ( $MEMCACHED && $MEMCACHED->get("block_ip:$ip") ) {
$c->block_ip($ip);
$c->res->code(429);
- $c->res->message("Too Many Requests");
- $c->res->body("Too Many Requests");
+ $c->res->message('Too Many Requests');
+ $c->res->body('Too Many Requests');
$c->finish;
}
}
diff --git a/Bugzilla/Quantum/Plugin/Glue.pm b/Bugzilla/Quantum/Plugin/Glue.pm
index 54a360003..ea21429bd 100644
--- a/Bugzilla/Quantum/Plugin/Glue.pm
+++ b/Bugzilla/Quantum/Plugin/Glue.pm
@@ -11,7 +11,6 @@ use Mojo::Base 'Mojolicious::Plugin';
use Try::Tiny;
use Bugzilla::Constants;
-use Bugzilla::Quantum::Template;
use Bugzilla::Logging;
use Bugzilla::RNG ();
use JSON::MaybeXS qw(decode_json);
@@ -20,10 +19,10 @@ sub register {
my ( $self, $app, $conf ) = @_;
my %D;
- if ($ENV{BUGZILLA_HTTPD_ARGS}) {
- my $args = decode_json($ENV{BUGZILLA_HTTPD_ARGS});
+ if ( $ENV{BUGZILLA_HTTPD_ARGS} ) {
+ my $args = decode_json( $ENV{BUGZILLA_HTTPD_ARGS} );
foreach my $arg (@$args) {
- if ($arg =~ /^-D(\w+)$/) {
+ if ( $arg =~ /^-D(\w+)$/ ) {
$D{$1} = 1;
}
else {
@@ -35,6 +34,7 @@ sub register {
# hypnotoad is weird and doesn't look for MOJO_LISTEN itself.
$app->config(
hypnotoad => {
+ proxy => 1,
listen => [ $ENV{MOJO_LISTEN} ],
},
);
@@ -49,30 +49,32 @@ sub register {
sub {
Bugzilla::RNG::srand();
srand();
- eval { Bugzilla->dbh->ping };
+ try { Bugzilla->dbh->ping };
}
);
$app->hook(
before_dispatch => sub {
my ($c) = @_;
- if ($D{HTTPD_IN_SUBDIR}) {
+ if ( $D{HTTPD_IN_SUBDIR} ) {
my $path = $c->req->url->path;
- $path =~ s{^/bmo}{}s;
- $c->req->url->path($path);
+ if ( $path =~ s{^/bmo}{}s ) {
+ $c->stash->{bmo_prefix} = 1;
+ $c->req->url->path($path);
+ }
}
- Log::Log4perl::MDC->put(request_id => $c->req->request_id);
+ Log::Log4perl::MDC->put( request_id => $c->req->request_id );
}
);
Bugzilla::Extension->load_all();
- if ($app->mode ne 'development') {
+ if ( $app->mode ne 'development' ) {
Bugzilla->preload_features();
- DEBUG("preloading templates");
+ DEBUG('preloading templates');
Bugzilla->preload_templates();
- DEBUG("done preloading templates");
+ DEBUG('done preloading templates');
}
- $app->secrets([Bugzilla->localconfig->{side_wide_secret}]);
+ $app->secrets( [ Bugzilla->localconfig->{side_wide_secret} ] );
$app->renderer->add_handler(
'bugzilla' => sub {
@@ -90,23 +92,16 @@ sub register {
# The controller
$vars->{c} = $c;
my $name = $options->{template};
- unless ($name =~ /\./) {
+ unless ( $name =~ /\./ ) {
$name = sprintf '%s.%s.tmpl', $options->{template}, $options->{format};
}
my $template = Bugzilla->template;
$template->process( $name, $vars, $output )
- or die $template->error;
+ or die $template->error;
}
);
- $app->log(
- MojoX::Log::Log4perl::Tiny->new(
- logger => Log::Log4perl->get_logger(ref $app)
- )
- );
+ $app->log( MojoX::Log::Log4perl::Tiny->new( logger => Log::Log4perl->get_logger( ref $app ) ) );
}
-
-
-
1;
diff --git a/Bugzilla/Quantum/SES.pm b/Bugzilla/Quantum/SES.pm
index e36956b1d..47c591fb5 100644
--- a/Bugzilla/Quantum/SES.pm
+++ b/Bugzilla/Quantum/SES.pm
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+package Bugzilla::Quantum::SES;
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
@@ -7,12 +7,8 @@
# defined by the Mozilla Public License, v. 2.0.
use 5.10.1;
-use strict;
-use warnings;
+use Mojo::Base qw( Mojolicious::Controller );
-use lib qw(.. ../lib ../local/lib/perl5);
-
-use Bugzilla ();
use Bugzilla::Constants qw(ERROR_MODE_DIE);
use Bugzilla::Logging;
use Bugzilla::Mailer qw(MessageToMTA);
@@ -22,51 +18,44 @@ use JSON::MaybeXS qw(decode_json);
use LWP::UserAgent ();
use Try::Tiny qw(catch try);
-Bugzilla->error_mode(ERROR_MODE_DIE);
-try {
- main();
-}
-catch {
- FATAL("Fatal error: $_");
- respond( 500 => 'Internal Server Error' );
-};
-
sub main {
- my $message = decode_json_wrapper( Bugzilla->cgi->param('POSTDATA') ) // return;
- my $message_type = $ENV{HTTP_X_AMZ_SNS_MESSAGE_TYPE} // '(missing)';
+ my ($self) = @_;
+ Bugzilla->error_mode(ERROR_MODE_DIE);
+ my $message = $self->_decode_json_wrapper( $self->req->body ) // return;
+ my $message_type = $self->req->headers->header('X-Amz-SNS-Message-Type') // '(missing)';
if ( $message_type eq 'SubscriptionConfirmation' ) {
- confirm_subscription($message);
+ $self->_confirm_subscription($message);
}
elsif ( $message_type eq 'Notification' ) {
- my $notification = decode_json_wrapper( $message->{Message} ) // return;
+ my $notification = $self->_decode_json_wrapper( $message->{Message} ) // return;
unless (
# https://docs.aws.amazon.com/ses/latest/DeveloperGuide/event-publishing-retrieving-sns-contents.html
- handle_notification( $notification, 'eventType' )
+ $self->_handle_notification( $notification, 'eventType' )
# https://docs.aws.amazon.com/ses/latest/DeveloperGuide/notification-contents.html
- || handle_notification( $notification, 'notificationType' )
+ || $self->_handle_notification( $notification, 'notificationType' )
)
{
WARN('Failed to find notification type');
- respond( 400 => 'Bad Request' );
+ $self->_respond( 400 => 'Bad Request' );
}
}
else {
WARN("Unsupported message-type: $message_type");
- respond( 200 => 'OK' );
+ $self->_respond( 200 => 'OK' );
}
}
-sub confirm_subscription {
- my ($message) = @_;
+sub _confirm_subscription {
+ my ($self, $message) = @_;
my $subscribe_url = $message->{SubscribeURL};
if ( !$subscribe_url ) {
WARN('Bad SubscriptionConfirmation request: missing SubscribeURL');
- respond( 400 => 'Bad Request' );
+ $self->_respond( 400 => 'Bad Request' );
return;
}
@@ -74,15 +63,15 @@ sub confirm_subscription {
my $res = $ua->get( $message->{SubscribeURL} );
if ( !$res->is_success ) {
WARN( 'Bad response from SubscribeURL: ' . $res->status_line );
- respond( 400 => 'Bad Request' );
+ $self->_respond( 400 => 'Bad Request' );
return;
}
- respond( 200 => 'OK' );
+ $self->_respond( 200 => 'OK' );
}
-sub handle_notification {
- my ( $notification, $type_field ) = @_;
+sub _handle_notification {
+ my ( $self, $notification, $type_field ) = @_;
if ( !exists $notification->{$type_field} ) {
return 0;
@@ -90,20 +79,20 @@ sub handle_notification {
my $type = $notification->{$type_field};
if ( $type eq 'Bounce' ) {
- process_bounce($notification);
+ $self->_process_bounce($notification);
}
elsif ( $type eq 'Complaint' ) {
- process_complaint($notification);
+ $self->_process_complaint($notification);
}
else {
WARN("Unsupported notification-type: $type");
- respond( 200 => 'OK' );
+ $self->_respond( 200 => 'OK' );
}
return 1;
}
-sub process_bounce {
- my ($notification) = @_;
+sub _process_bounce {
+ my ($self, $notification) = @_;
# disable each account that is bouncing
foreach my $recipient ( @{ $notification->{bounce}->{bouncedRecipients} } ) {
@@ -140,10 +129,11 @@ sub process_bounce {
}
}
- respond( 200 => 'OK' );
+ $self->_respond( 200 => 'OK' );
}
-sub process_complaint {
+sub _process_complaint {
+ my ($self) = @_;
# email notification to bugzilla admin
my ($notification) = @_;
@@ -170,31 +160,28 @@ sub process_complaint {
MessageToMTA($message);
}
- respond( 200 => 'OK' );
+ $self->_respond( 200 => 'OK' );
}
-sub respond {
- my ( $code, $message ) = @_;
- print Bugzilla->cgi->header( -status => "$code $message" );
-
- # apache will generate non-200 response pages for us
- say html_quote($message) if $code == 200;
+sub _respond {
+ my ( $self, $code, $message ) = @_;
+ $self->render(text => "$message\n", status => $code);
}
-sub decode_json_wrapper {
- my ($json) = @_;
+sub _decode_json_wrapper {
+ my ($self, $json) = @_;
my $result;
if ( !defined $json ) {
- WARN( 'Missing JSON from ' . remote_ip() );
- respond( 400 => 'Bad Request' );
+ WARN( 'Missing JSON from ' . $self->tx->remote_address );
+ $self->_respond( 400 => 'Bad Request' );
return undef;
}
my $ok = try {
$result = decode_json($json);
}
catch {
- WARN( 'Malformed JSON from ' . remote_ip() );
- respond( 400 => 'Bad Request' );
+ WARN( 'Malformed JSON from ' . $self->tx->remote_address );
+ $self->_respond( 400 => 'Bad Request' );
return undef;
};
return $ok ? $result : undef;
@@ -212,3 +199,5 @@ sub ua {
}
return $ua;
}
+
+1; \ No newline at end of file
diff --git a/Bugzilla/Quantum/Static.pm b/Bugzilla/Quantum/Static.pm
index 2bb54990e..d687873ab 100644
--- a/Bugzilla/Quantum/Static.pm
+++ b/Bugzilla/Quantum/Static.pm
@@ -16,9 +16,9 @@ my $LEGACY_RE = qr{
}xs;
sub file {
- my ($self, $rel) = @_;
+ my ( $self, $rel ) = @_;
- if (my ($legacy_rel) = $rel =~ $LEGACY_RE) {
+ if ( my ($legacy_rel) = $rel =~ $LEGACY_RE ) {
local $self->{paths} = [ bz_locations->{cgi_path} ];
return $self->SUPER::file($legacy_rel);
}
diff --git a/Bugzilla/Quantum/Stdout.pm b/Bugzilla/Quantum/Stdout.pm
index ee470a56a..be7b546ea 100644
--- a/Bugzilla/Quantum/Stdout.pm
+++ b/Bugzilla/Quantum/Stdout.pm
@@ -9,34 +9,51 @@ package Bugzilla::Quantum::Stdout;
use 5.10.1;
use Moo;
+use Bugzilla::Logging;
+use Encode;
+
has 'controller' => (
is => 'ro',
required => 1,
);
-sub TIEHANDLE { ## no critic (unpack)
+has '_encoding' => (
+ is => 'rw',
+ default => '',
+);
+
+sub TIEHANDLE { ## no critic (unpack)
my $class = shift;
return $class->new(@_);
}
-sub PRINTF { ## no critic (unpack)
+sub PRINTF { ## no critic (unpack)
my $self = shift;
- $self->PRINT(sprintf @_);
+ $self->PRINT( sprintf @_ );
}
-sub PRINT { ## no critic (unpack)
- my $self = shift;
-
- foreach my $chunk (@_) {
- my $str = "$chunk";
- utf8::encode($str);
- $self->controller->write($str);
+sub PRINT { ## no critic (unpack)
+ my $self = shift;
+ my $c = $self->controller;
+ my $bytes = join '', @_;
+ return unless $bytes;
+ if ( $self->_encoding ) {
+ $bytes = encode( $self->_encoding, $bytes );
}
+ $c->write($bytes.$\);
}
sub BINMODE {
- # no-op
+ my ( $self, $mode ) = @_;
+ if ($mode) {
+ if ( $mode eq ':bytes' or $mode eq ':raw' ) {
+ $self->_encoding('');
+ }
+ elsif ( $mode eq ':utf8' ) {
+ $self->_encoding('utf8');
+ }
+ }
}
-1; \ No newline at end of file
+1;