Example of UTF-8 form processing

See also WikiBooks Perl & UTF-8
#!/usr/bin/perl -w -T
# Example CGI::Application program with UTF-8 form processing
#   by Mark Rajcok
# Much more info at http://en.wikibooks.org/wiki/Perl_Programming/Unicode_UTF-8
use strict;
use CGI::Carp qw(fatalsToBrowser);
# ================================================================================
package CGI::as_utf8;  # add UTF-8 decode capability to CGI.pm
BEGIN {
  use strict;
  use warnings;
  use CGI 3.47;  # earlier versions have a UTF-8 double-decoding bug
  {   no warnings 'redefine';
      my $param_org = \&CGI::param;
      my $might_decode = sub {
          my $p = shift;
          # make sure upload() filehandles are not modified
          return $p if !$p || ( ref $p && fileno($p) );
          utf8::decode($p);  # may fail, but only logs an error
          $p
      };
      *CGI::param = sub {
          # setting a param goes through the original interface
          goto &$param_org if scalar @_ != 2;
          my $q = $_[0];    # assume object calls always
          my $p = $_[1];
          return wantarray
              ? map { $might_decode->($_) } $q->$param_org($p)
              : $might_decode->( $q->$param_org($p) );
      }
  }
}
# ================================================================================
package MyApp;
#use CGI::as_utf8;  uncomment this line if CGI::as_utf8 is in a separate file
use base 'CGI::Application';
use CGI::Application::Plugin::AutoRunmode;
use CGI::Application::Plugin::ValidateRM;
# --------------------------------------------------------------------------------
sub cgiapp_init() {       # overrides
  my $self = shift;
  $self->query->charset('UTF-8');  # cause CGI.pm to send a UTF-8 Content-Type header
}
# --------------------------------------------------------------------------------
sub cgiapp_postrun {  # overrides
  my ($self, $output_ref) = @_;
  $$output_ref .= '<pre>'.$self->dump;
  utf8::encode( $$output_ref ) if utf8::is_utf8($$output_ref) # encode for UTF-8
}
# --------------------------------------------------------------------------------
sub show_form :StartRunmode  {
  my $self = shift;
  my $errs = shift;
  my $template_text = do { local( $/ ); <main::DATA> };  # slurp it all in
  # add a Unicode character
  my $unicode_char = "\x{00f1}";
  utf8::upgrade($unicode_char);  # convert to internal UTF-8 encoding
  $template_text =~ s/value=""/value="$unicode_char"/; # add a unicode character
  my $t = $self->load_tmpl(\$template_text);
  $t->param($errs) if $errs;
  $t->output
}
# --------------------------------------------------------------------------------
sub _dfv_rules {{
  required    => [qw(text)],
  filters     => [qw(trim strip)],
  constraint_methods => { text => qr/^\w+$/ },
  msgs => { prefix  => 'err_' }
}}
# --------------------------------------------------------------------------------
sub update :Runmode {
  my $self = shift;
  my $dfv_results = $self->check_rm('show_form', _dfv_rules) ||
      return $self->check_rm_error_page;
  'Form validation successful. You submitted: <b>' . $self->query->param('text') . '</b>'
}
# ================================================================================
package main;
#use MyApp;  uncomment this line if MyApp is in a separate file
my $webapp = MyApp->new(); # normally:  MyApp->new(TMPL_PATH=>'templates');
$webapp->run();

# normally, put the following into a separate HTML template file
__DATA__
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8" />
<title>UTF-8 Sample App</title>
</head>
<body>
This web form is UTF-8 capable.
<form method="post">
  Enter \w text: <input type="text" name="text" value=""> <tmpl_var err_text>
  <br /><input type="submit">
  <input type="hidden" name="rm" value="update">
</form>
</body>
</html>
BACKLINKS

Example of UTF-8 form processing
