https://github.com/songmu/p5-plack-middleware-unicodepictogramfallback-typecast

https://github.com/songmu/p5-plack-middleware-unicodepictogramfallback-typecast

Last synced: 2 days ago
JSON representation

• Host: GitHub
• URL: https://github.com/songmu/p5-plack-middleware-unicodepictogramfallback-typecast
• Owner: Songmu
• License: other
• Created: 2013-02-20T18:50:03.000Z (over 11 years ago)
• Default Branch: master
• Last Pushed: 2013-02-21T06:49:22.000Z (over 11 years ago)
• Last Synced: 2024-10-11T21:09:34.265Z (27 days ago)
• Language: Perl
• Size: 148 KB
• Stars: 0
• Watchers: 3
• Forks: 0
• Open Issues: 0
• Metadata Files:
  • Readme: README.pod
  • Changelog: Changes
  • License: LICENSE

Awesome Lists containing this project

README

        
package Plack::Middleware::UnicodePictogramFallback::TypeCast;

use 5.008_001;

use strict;

use warnings;

our $VERSION = '0.01';

use Plack::Util;

use Plack::Middleware::UnicodePictogramFallback::TypeCast::EmoticonMap;

use Encode qw/encode_utf8 decode/;

use Encode::JP::Mobile ':props';

use Encode::JP::Mobile::UnicodeEmoji;

use parent 'Plack::Middleware';

use Plack::Util::Accessor qw(

    template

);

sub prepare_app {

    my $self = shift;

    die 'requires template' unless $self->template;

}

sub call {

    my ($self, $env) = @_;

    my $res = $self->app->($env);

    my $h = Plack::Util::headers($res->[1]);

    return $res if $h->get('Content-Type') !~ m!^text/!;

    $self->response_cb($res, sub {

        my $res = shift;

        return sub {

            my $chunk = shift;

            return unless defined $chunk;

            $self->_filter($chunk);

        };

    });

}

sub _filter {

    my ($self, $html) = @_;

    $html = decode('x-utf8-jp-mobile-unicode-emoji', $html);

    my $emoticon_map = Plack::Middleware::UnicodePictogramFallback::TypeCast::EmoticonMap::MAP;

    $html =~ s{(\p{InMobileJPPictograms})}{

        my $char = $1;

        my $code = sprintf '%X', ord $char;

        if (my $name = $emoticon_map->{$code}) {

            sprintf $self->template, $name, $char;

        } else {

            $char;

        }

    }ge;

    encode_utf8 $html;

}

1;

__END__

=head1 NAME

Plack::Middleware::UnicodePictogramFallback::TypeCast - Unicode pictogram fallback to HTML

=head1 VERSION

This document describes Plack::Middleware::UnicodePictogramFallback::TypeCast version 0.01.

=head1 SYNOPSIS

    use Plack::Middleware::UnicodePictogramFallback::TypeCast;

    use Plack::Builder;

    my $app = sub {

        [200, ['Content-Type' => 'text/html', 'Content-Length' => 16], ["\xE2\x98\x80"]];

    };

    builder {

        enable 'UnicodePictogramFallback::TypeCast',

            template => '';

        $app;

    };

    # returns