App-Muter

 view release on metacpan or  search on metacpan

lib/App/Muter.pm  view on Meta::CPAN

        for @modules;
    return;
}

package App::Muter::Backend::Chunked;
$App::Muter::Backend::Chunked::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new($args, %opts);
    $self->{chunk}       = '';
    $self->{enchunksize} = $opts{enchunksize} || $opts{chunksize};
    $self->{dechunksize} = $opts{dechunksize} || $opts{chunksize};
    return $self;
}

sub encode {
    my ($self, $data) = @_;
    return $self->_with_chunk($data, $self->{enchunksize}, 'encode_chunk');
}

lib/App/Muter.pm  view on Meta::CPAN

    }
    return $self->$code($chunk);
}

package App::Muter::Backend::ChunkedDecode;
$App::Muter::Backend::ChunkedDecode::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new($args, %opts);
    $self->{chunk}  = '';
    $self->{regexp} = $opts{regexp};
    return $self;
}

sub encode {
    my ($self, $data) = @_;
    return $self->encode_chunk($data);
}

lib/App/Muter.pm  view on Meta::CPAN


package App::Muter::Backend::Base64;
$App::Muter::Backend::Base64::VERSION = '0.003000';
use MIME::Base64 ();

our @ISA = qw/App::Muter::Backend::Chunked/;

sub new {
    my ($class, $args, %opts) = @_;
    my $nl = (grep { $_ eq 'mime' } @$args) ? "\n" : '';
    my $self = $class->SUPER::new(
        $args, %opts,
        enchunksize => $nl ? 57 : 3,
        dechunksize => 4
    );
    $self->{nl} = $nl;
    if (grep { $_ eq 'yui' } @$args) {
        $self->{exfrm} = sub { (my $x = shift) =~ tr{+/=}{._-}; return $x };
        $self->{dxfrm} = sub { (my $x = shift) =~ tr{._-}{+/=}; return $x };
    }
    else {

lib/App/Muter.pm  view on Meta::CPAN


sub _filter {
    my ($self, $data) = @_;
    $data =~ tr{A-Za-z0-9+/=}{}cd;
    return $data;
}

sub decode {
    my ($self, $data) = @_;
    $data = $self->{dxfrm}->($data);
    return $self->SUPER::decode($self->_filter($data));
}

sub decode_chunk {
    my (undef, $data) = @_;
    return MIME::Base64::decode($data);
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::URL64;

lib/App/Muter.pm  view on Meta::CPAN

}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Hex;
$App::Muter::Backend::Hex::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::Chunked/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new(
        $args, %opts,
        enchunksize => 1,
        dechunksize => 2
    );
    $self->{upper} = 1 if defined $args->[0] && $args->[0] eq 'upper';
    return $self;
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            upper => 'Use uppercase letters',
            lower => 'Use lowercase letters',
        }
    };
}

sub encode_chunk {

lib/App/Muter.pm  view on Meta::CPAN

}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Base16;
$App::Muter::Backend::Base16::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::Hex/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new(['upper'], %opts);
    return $self;
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    delete $meta->{args};
    return $meta;
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Base32;
$App::Muter::Backend::Base32::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::Chunked/;

sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args, enchunksize => 5, dechunksize => 8);
    $self->{ftr} =
        sub { my $val = shift; $val =~ tr/\x00-\x1f/A-Z2-7/; return $val };
    $self->{rtr} =
        sub { my $val = shift; $val =~ tr/A-Z2-7/\x00-\x1f/; return $val };
    $self->{func} = 'base32';
    $self->{manual} =
        grep { $_ eq 'manual' } @args ||
        !eval { require MIME::Base32; MIME::Base32->VERSION(1.0) };
    return $self->_initialize;
}

lib/App/Muter.pm  view on Meta::CPAN

            ($chunk[6] << 5) | $chunk[7],
        );
        my $chunk = pack('C*', map { $_ & 0xff } @converted);
        $result .= substr($chunk, 0, (@data ? 5 : $truncate));
    }
    return $result;
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            'manual' => 'Disable use of MIME::Base32',
        }
    };
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Base32Hex;
$App::Muter::Backend::Base32Hex::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::Base32/;

sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    $self->{ftr} =
        sub { my $val = shift; $val =~ tr/\x00-\x1f/0-9A-V/; return $val };
    $self->{rtr} =
        sub { my $val = shift; $val =~ tr/0-9A-V/\x00-\x1f/; return $val };
    $self->{func} = 'base32hex';
    return $self->_initialize;
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::URI;
$App::Muter::Backend::URI::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::ChunkedDecode/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new($args, %opts, regexp => qr/^(.*)(%.?)$/s);
    my $lower = grep { $_ eq 'lower' } @$args;
    $self->{chunk}  = '';
    $self->{format} = '%%%02' . ($lower ? 'x' : 'X');
    $self->{form}   = grep { $_ eq 'form' } @$args;
    return $self;
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            'upper' => 'Use uppercase letters',
            'lower' => 'Use lowercase letters',
        }
    };
}

sub encode_chunk {

lib/App/Muter.pm  view on Meta::CPAN

}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Form;
$App::Muter::Backend::Form::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::URI/;

sub encode_chunk {
    my ($self, $data) = @_;
    $data = $self->SUPER::encode_chunk($data);
    $data =~ s/%20/+/g;
    return $data;
}

sub decode_chunk {
    my ($self, $data) = @_;
    $data =~ tr/+/ /;
    return $self->SUPER::decode_chunk($data);
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::XML;
$App::Muter::Backend::XML::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::ChunkedDecode/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new($args, %opts, regexp => qr/^(.*)(&[^;]*)$/);
    no warnings 'qw';    ## no critic (ProhibitNoWarnings)
    my $maps = {
        default => [qw/quot amp apos lt gt/],
        html    => [qw/quot amp #x27 lt gt/],
        hex     => [qw/#x22 #x26 #x27 #x3c #x3e/],
    };
    my $type = $args->[0] // 'default';
    $type = 'default' unless exists $maps->{$type};
    @{$self->{fmap}}{qw/" & ' < >/} = map { "&$_;" } @{$maps->{$type}};
    @{$self->{rmap}}{@{$maps->{default}}} = qw/" & ' < >/;
    return $self;
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            default => 'Use XML entity names',
            html    => 'Use HTML-friendly entity names for XML entities',
            hex     => 'Use hexadecimal entity names for XML entities',
        }
    };
}

lib/App/Muter.pm  view on Meta::CPAN


App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::QuotedPrintable;
$App::Muter::Backend::QuotedPrintable::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::ChunkedDecode/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self =
        $class->SUPER::new($args, %opts, regexp => qr/\A(.*)(=[^\n]?)\z/);
    $self->{curlen} = 0;
    $self->{smtp} = 1 if grep { $_ eq 'smtp' } @$args;
    return $self;
}

sub encode {
    my ($self, $data) = @_;
    $data = $self->{chunk} . $data;
    $self->{chunk} = '';
    if (length($data) < 7) {

lib/App/Muter.pm  view on Meta::CPAN


sub decode_chunk {
    my ($self, $data) = @_;
    $data =~ s/=\n//g;
    $data =~ s/=([0-9A-F]{2})/chr(hex($1))/ge;
    return $data;
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            smtp => 'Encode "." and "From " at beginning of line',
        }
    };
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Vis;
$App::Muter::Backend::Vis::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::ChunkedDecode/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new($args, %opts,
        regexp => qr/\A(.*?[^^\\-])?(\\.{0,3})\z/);
    $self->_setup_maps(map { $_ => 1 } @$args);
    $self->{chunk} = '';
    return $self;
}

sub _setup_maps {
    my ($self, %flags) = @_;
    $self->{flags} = \%flags;
    my $standard = {_id_map(0x21 .. 0x7e), 0x5c => "\\\\"};

lib/App/Muter.pm  view on Meta::CPAN

sub encode {
    my ($self, $data) = @_;
    $data = $self->{chunk} . $data;
    if (length $data && substr($data, -1) eq "\0") {
        $data = substr($data, 0, -1);
        $self->{chunk} = "\0";
    }
    else {
        $self->{chunk} = '';
    }
    return $self->SUPER::encode($data);
}

sub encode_chunk {
    my ($self, $data) = @_;
    my $result = join('', map { $self->{map}[$_] } unpack('C*', $data));
    if ($self->{flags}{cstyle}) {
        # Do this twice to fix multiple consecutive NUL bytes.
        $result =~ s/\\000($|[^0-7])/\\0$1/g for 1 .. 2;
    }
    return $result;

lib/App/Muter.pm  view on Meta::CPAN

sub decode_chunk {
    my ($self, $data) = @_;
    return join('',
        map { $self->_decode($_) }
            split /(\\(?:M[-^].|\^.|[0-7]{3}|\\|[0abtnvfrs]))/,
        $data);
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            sp     => 'Encode space',
            space  => 'Encode space',
            tab    => 'Encode tab',
            nl     => 'Encode newline',
            white  => 'Encode space, tab, and newline',
            cstyle => 'Encode using C-like escape sequences',
            octal  => 'Encode using octal escape sequences',

lib/App/Muter.pm  view on Meta::CPAN

}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Ascii85;
$App::Muter::Backend::Ascii85::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::Chunked/;

sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args, enchunksize => 4, dechunksize => 5);
    $self->{start} = '';
    return $self;
}

sub encode {
    my ($self, $data) = @_;
    return '' unless length $data;
    my $prefix = defined $self->{start} ? '<~' : '';
    $self->{start} = undef;
    return $prefix . $self->SUPER::encode($data);
}

sub encode_final {
    my ($self, $data) = @_;
    return $self->SUPER::encode_final($data) .
        (defined $self->{start} ? '' : '~>');
}

sub _encode_seq {
    my ($x, $flag) = @_;
    return (89) if !$x && !$flag;
    my @res;
    for (0 .. 4) {
        push @res, $x % 85;
        $x = int($x / 85);

lib/App/Muter.pm  view on Meta::CPAN

use Digest::MD5;
use Digest::SHA;

our @ISA = qw/App::Muter::Backend/;

my $hashes = {};

sub new {
    my ($class, $args, @args) = @_;
    my ($hash) = @$args;
    my $self = $class->SUPER::new($args, @args);
    $self->{hash} = $hashes->{$hash}->();
    return $self;
}

sub encode {
    my ($self, $data) = @_;
    $self->{hash}->add($data);
    return '';
}

sub encode_final {
    my ($self, $data) = @_;
    $self->{hash}->add($data);
    return $self->{hash}->digest;
}

sub metadata {
    my ($self, $data) = @_;
    my $meta = $self->SUPER::metadata;
    $meta->{args} = {map { $_ => "Use the $_ hash algorithm" } keys %$hashes};
    return $meta;
}

sub register_hash {
    my ($name, $code) = @_;
    return $hashes->{$name} unless $code;
    return $hashes->{$name} = $code;
}

lib/App/Muter/Backend/Uuencode.pm  view on Meta::CPAN

package App::Muter::Backend::Uuencode;
# ABSTRACT: a uuencode transform for App::Muter
$App::Muter::Backend::Uuencode::VERSION = '0.003000';
use strict;
use warnings;

our @ISA = qw/App::Muter::Backend::Chunked/;

sub new {
    my ($class, $args, %opts) = @_;
    my $self = $class->SUPER::new(
        $args, %opts,
        enchunksize => 45,
        dechunksize => 62,
    );
    return $self;
}

sub encode_chunk {    ## no critic(RequireArgUnpacking)
    my ($self, $data) = @_;
    return pack('u', $data);
}

sub encode_final {
    my ($self, $data) = @_;
    return $self->SUPER::encode_final($data) . "`\n";
}

sub decode_chunk {
    my ($self, $data) = @_;
    return '' unless length $data;
    return unpack('u', $data);
}

App::Muter::Registry->instance->register(__PACKAGE__);



( run in 0.278 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )