r43651 - in /branches/upstream/libmime-base32-perl: ./ current/ current/Base32.pm current/MANIFEST current/META.yml current/Makefile.PL current/README current/test.pl current/test1.pl
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Sep 4 10:47:05 UTC 2009
Author: dmn
Date: Fri Sep 4 10:46:33 2009
New Revision: 43651
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43651
Log:
[svn-inject] Installing original source of libmime-base32-perl
Added:
branches/upstream/libmime-base32-perl/
branches/upstream/libmime-base32-perl/current/
branches/upstream/libmime-base32-perl/current/Base32.pm
branches/upstream/libmime-base32-perl/current/MANIFEST
branches/upstream/libmime-base32-perl/current/META.yml
branches/upstream/libmime-base32-perl/current/Makefile.PL
branches/upstream/libmime-base32-perl/current/README
branches/upstream/libmime-base32-perl/current/test.pl
branches/upstream/libmime-base32-perl/current/test1.pl
Added: branches/upstream/libmime-base32-perl/current/Base32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/Base32.pm?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/Base32.pm (added)
+++ branches/upstream/libmime-base32-perl/current/Base32.pm Fri Sep 4 10:46:33 2009
@@ -1,0 +1,145 @@
+package MIME::Base32;
+
+require 5.005_62;
+use strict;
+use warnings;
+
+use vars qw( $VERSION );
+
+ $VERSION = '1.01'; # $Id: Base32.pm_rev 1.5 2003/12/11 13:21:18 root Exp root $
+
+
+sub import
+{
+ my( $pkg, $arg )=@_;
+ if( defined($arg) && $arg =~ /rfc|3548/i )
+ {
+ *encode = \&encode_rfc3548;
+ *decode = \&decode_rfc3548;
+ }
+ else
+ {
+ *encode = \&encode_09AV;
+ *decode = \&decode_09AV;
+ }
+}
+
+sub encode_rfc3548{
+
+ # base32:
+ #
+ # modified base64 algorithm with
+ # 32 characters set: A - Z 2 - 7 compliant with: RFC-3548
+ #
+
+
+ $_ = shift @_;
+ my( $buffer, $l, $e );
+
+ $_=unpack('B*', $_);
+ s/(.....)/000$1/g;
+ $l=length;
+ if ($l & 7)
+ {
+ $e = substr($_, $l & ~7);
+ $_ = substr($_, 0, $l & ~7);
+ $_ .= "000$e" . '0' x (5 - length $e);
+ }
+ $_=pack('B*', $_);
+ tr|\0-\37|A-Z2-7|;
+ $_;
+}
+
+sub decode_rfc3548{
+ $_ = shift;
+ my( $l );
+
+ tr|A-Z2-7|\0-\37|;
+ $_=unpack('B*', $_);
+ s/000(.....)/$1/g;
+ $l=length;
+
+ # pouzije pouze platnou delku retezce
+ $_=substr($_, 0, $l & ~7) if $l & 7;
+
+ $_=pack('B*', $_);
+}
+
+sub encode_09AV{
+
+ # base32:
+ #
+ # modified base64 algorithm with
+ # 32 characters set: [0-9A-V] pre 1.00 backward compatibility
+ #
+
+
+ $_ = shift @_;
+ my( $buffer, $l, $e );
+
+ $_=unpack('B*', $_);
+ s/(.....)/000$1/g;
+ $l=length;
+ if ($l & 7)
+ {
+ $e = substr($_, $l & ~7);
+ $_ = substr($_, 0, $l & ~7);
+ $_ .= "000$e" . '0' x (5 - length $e);
+ }
+ $_=pack('B*', $_);
+ tr|\0-\37|0-9A-V|;
+ $_;
+}
+
+sub decode_09AV{
+ $_ = shift;
+ my( $l );
+
+ tr|0-9A-V|\0-\37|;
+ $_=unpack('B*', $_);
+ s/000(.....)/$1/g;
+ $l=length;
+
+ # pouzije pouze platnou delku retezce
+ $_=substr($_, 0, $l & ~7) if $l & 7;
+
+ $_=pack('B*', $_);
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+MIME::Base32 - Base32 encoder / decoder
+
+=head1 SYNOPSIS
+
+ # RFC forces the [A-Z2-7] RFC-3548 compliant encoding
+ # default encoding [0-9A-V] is for backward compatibility with pre v1.0
+ use MIME::Base32 qw( RFC );
+
+ $encoded = MIME::Base32::encode($text_or_binary_data);
+ $decoded = MIME::Base32::decode($encoded);
+
+=head1 DESCRIPTION
+
+Encode data similar way like MIME::Base64 does.
+
+Main purpose is to create encrypted text used as id or key entry typed-or-submitted by user. It is upper/lowercase safe (not sensitive).
+
+=head1 EXPORT
+
+ALLWAYS NOTHING
+
+=head1 AUTHOR
+
+Daniel Peder, sponsored by Infoset s.r.o., Czech Republic
+<Daniel.Peder at InfoSet.COM> http://www.infoset.com
+
+=head1 SEE ALSO
+
+perl(1), MIME::Base64(3pm).
+
+=cut
Added: branches/upstream/libmime-base32-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/MANIFEST?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/MANIFEST (added)
+++ branches/upstream/libmime-base32-perl/current/MANIFEST Fri Sep 4 10:46:33 2009
@@ -1,0 +1,7 @@
+Base32.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+test.pl
+test1.pl
Added: branches/upstream/libmime-base32-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/META.yml?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/META.yml (added)
+++ branches/upstream/libmime-base32-perl/current/META.yml Fri Sep 4 10:46:33 2009
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: MIME-Base32
+version: 1.01
+version_from: Base32.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.16
Added: branches/upstream/libmime-base32-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/Makefile.PL?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/Makefile.PL (added)
+++ branches/upstream/libmime-base32-perl/current/Makefile.PL Fri Sep 4 10:46:33 2009
@@ -1,0 +1,23 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'MIME::Base32',
+ 'VERSION_FROM' => 'Base32.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? (
+ ABSTRACT_FROM => 'Base32.pm',
+ AUTHOR => 'Daniel Peder <DanPeder at CPAN.ORG>',
+ ) : ()),
+);
+sub MY::postamble { q{
+
+docs : README
+
+README: Base32.pm
+ pod2text --loose Base32.pm > README
+
+xdist:
+ [ -f MANIFEST ] && rm -f MANIFEST ; make realclean docs manifest tardist; perl Makefile.PL
+
+}; }
Added: branches/upstream/libmime-base32-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/README?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/README (added)
+++ branches/upstream/libmime-base32-perl/current/README Fri Sep 4 10:46:33 2009
@@ -1,0 +1,33 @@
+NAME
+
+ MIME::Base32 - Base32 encoder / decoder
+
+SYNOPSIS
+
+ # RFC forces the [A-Z2-7] RFC-3548 compliant encoding
+ # default encoding [0-9A-V] is for backward compatibility with pre v1.0
+ use MIME::Base32 qw( RFC );
+
+ $encoded = MIME::Base32::encode($text_or_binary_data);
+ $decoded = MIME::Base32::decode($encoded);
+
+DESCRIPTION
+
+ Encode data similar way like MIME::Base64 does.
+
+ Main purpose is to create encrypted text used as id or key entry
+ typed-or-submitted by user. It is upper/lowercase safe (not sensitive).
+
+EXPORT
+
+ ALLWAYS NOTHING
+
+AUTHOR
+
+ Daniel Peder, sponsored by Infoset s.r.o., Czech Republic
+ <Daniel.Peder at InfoSet.COM> http://www.infoset.com
+
+SEE ALSO
+
+ perl(1), MIME::Base64(3pm).
+
Added: branches/upstream/libmime-base32-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/test.pl?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/test.pl (added)
+++ branches/upstream/libmime-base32-perl/current/test.pl Fri Sep 4 10:46:33 2009
@@ -1,0 +1,63 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..10\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MIME::Base32 qw( RFC-3548 );
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+our $TestLevel = 1;
+our $TestLevels = 10;
+our $TestLabel = 'this case';
+our $TestLabelPrefix = 'TEST:';
+sub TestOK() { printf "ok %s\n", $TestLevel; return 1 }
+sub TestKO() { printf "not ok %s\n", $TestLevel; return 0 } # KO -> k.o. -> knock out
+sub TestSKIP() { printf "ok %s # SKIP\n", $TestLevel; return 1 }
+sub TestIt($) { shift() ? TestOK : TestKO }
+sub TestMSG($) { printf "\t%s%s: '%s'\n", $TestLabelPrefix, $TestLabel, shift() }
+sub TestMSGf(@) { printf "\t%s%s: ".shift()."\n", $TestLabelPrefix, $TestLabel, @_ }
+
+our $GlobalTestString = 'Hallo world, whats new?';
+our $GlobalEncodedString;
+our $GlobalDecodedString;
+
+$TestLevel++;
+$TestLabel = 'Encode (RFC-3548 compliant)';
+TestIt(
+ eval{
+ $GlobalEncodedString = MIME::Base32::encode( $GlobalTestString );
+ TestMSGf "'%s'->'%s'", $GlobalTestString, $GlobalEncodedString;
+ } && !$@
+);
+
+$TestLevel++;
+$TestLabel = 'Decode (RFC-3548 compliant)';
+TestIt(
+ eval{
+ $GlobalDecodedString = MIME::Base32::decode( $GlobalEncodedString );
+ TestMSGf "'%s'->'%s'", $GlobalEncodedString, $GlobalDecodedString;
+ } && !$@
+);
+
+$TestLevel++;
+$TestLabel = 'Reversibility match';
+TestIt(
+ eval{
+ TestMSG ($GlobalTestString eq $GlobalDecodedString?'PASSED':'FAILED');
+ } && !$@
+);
+
+# unUsed levels are OK
+TestSKIP while $TestLevels > $TestLevel++;
Added: branches/upstream/libmime-base32-perl/current/test1.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmime-base32-perl/current/test1.pl?rev=43651&op=file
==============================================================================
--- branches/upstream/libmime-base32-perl/current/test1.pl (added)
+++ branches/upstream/libmime-base32-perl/current/test1.pl Fri Sep 4 10:46:33 2009
@@ -1,0 +1,63 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..10\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MIME::Base32;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+our $TestLevel = 1;
+our $TestLevels = 10;
+our $TestLabel = 'this case';
+our $TestLabelPrefix = 'TEST:';
+sub TestOK() { printf "ok %s\n", $TestLevel; return 1 }
+sub TestKO() { printf "not ok %s\n", $TestLevel; return 0 } # KO -> k.o. -> knock out
+sub TestSKIP() { printf "ok %s # SKIP\n", $TestLevel; return 1 }
+sub TestIt($) { shift() ? TestOK : TestKO }
+sub TestMSG($) { printf "\t%s%s: '%s'\n", $TestLabelPrefix, $TestLabel, shift() }
+sub TestMSGf(@) { printf "\t%s%s: ".shift()."\n", $TestLabelPrefix, $TestLabel, @_ }
+
+our $GlobalTestString = 'Hallo world, whats new?';
+our $GlobalEncodedString;
+our $GlobalDecodedString;
+
+$TestLevel++;
+$TestLabel = 'Encode';
+TestIt(
+ eval{
+ $GlobalEncodedString = MIME::Base32::encode( $GlobalTestString );
+ TestMSGf "'%s'->'%s'", $GlobalTestString, $GlobalEncodedString;
+ } && !$@
+);
+
+$TestLevel++;
+$TestLabel = 'Decode';
+TestIt(
+ eval{
+ $GlobalDecodedString = MIME::Base32::decode( $GlobalEncodedString );
+ TestMSGf "'%s'->'%s'", $GlobalEncodedString, $GlobalDecodedString;
+ } && !$@
+);
+
+$TestLevel++;
+$TestLabel = 'Reversibility match';
+TestIt(
+ eval{
+ TestMSG ($GlobalTestString eq $GlobalDecodedString?'PASSED':'FAILED');
+ } && !$@
+);
+
+# unUsed levels are OK
+TestSKIP while $TestLevels > $TestLevel++;
More information about the Pkg-perl-cvs-commits
mailing list