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__);