Toby Inkster avatar Toby Inkster committed 3355956

initial version

Comments (0)

Files changed (16)

+use inc::Module::Package 'RDF:standard';
+

examples/output-names.pl

+use 5.010;
+use PerlIO::via::UnicodeDebug;
+binmode STDOUT, ':via(UnicodeDebug)' or die $!;
+
+local $Unicode::Debug::Names = 1;
+say "Héllň Wörld";

examples/output.pl

+use 5.010;
+use PerlIO::via::UnicodeDebug;
+binmode STDOUT, ':via(UnicodeDebug)' or die $!;
+
+say "Héllň Wörld";

lib/Devel/Unicode.pm

+package Devel::Unicode;
+
+use Unicode::Debug;
+
+BEGIN
+{
+	$Devel::Unicode::AUTHORITY = 'cpan:TOBYINK';
+	$Devel::Unicode::VERSION   = '0.001';
+}
+
+sub DB::DB { 1 }
+
+sub import {
+	my $class = shift;
+	my $args  = join q(,), @_;
+	
+	$Unicode::Debug::Names      = 1 if $args =~ /name/i;
+	$Unicode::Debug::Whitespace = 1 if $args =~ /ws|white/i;
+	
+	binmode STDOUT, ':via(UnicodeDebug)' or die $!;
+}
+
+__PACKAGE__
+__END__
+
+=head1 NAME
+
+Devel::Unicode - sugar for setting STDOUT to use PerlIO::via::UnicodeDebug
+
+=head1 SYNOPSIS
+
+ perl -d:Unicode myscript.pl
+
+ perl -d:Unicode=names myscript.pl
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Unicode-Debug>.
+
+=head1 SEE ALSO
+
+L<PerlIO::via::UnicodeDebug>,
+L<Unicode::Debug>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

lib/PerlIO/via/UnicodeDebug.pm

+package PerlIO::via::UnicodeDebug;
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Unicode::Debug 'unidecode';
+
+BEGIN
+{
+	$PerlIO::via::UnicodeDebug::AUTHORITY = 'cpan:TOBYINK';
+	$PerlIO::via::UnicodeDebug::VERSION   = '0.001';
+}
+
+sub PUSHED
+{
+	bless \*PUSHED, $_[0];
+}
+
+sub FILL
+{
+	my $line = readline( $_[1] );
+	(defined $line) ? unidecode( $line ) : undef;
+}
+
+sub WRITE
+{
+	my $x = $_[1];
+	utf8::decode($x);
+	unidecode($x);
+	( print {$_[2]} $x ) ? length($_[1]) : -1;
+}
+
+__PACKAGE__
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+PerlIO::via::UnicodeDebug - debug Unicode input/output
+
+=head1 SYNOPSIS
+
+ use 5.010;
+ use Unicode::Debug;
+ binmode STDOUT, ':via(UnicodeDebug)' or die $!;
+ 
+ say "HÊllò WÜrld";
+
+=head1 DESCRIPTION
+
+Passes IO through L<Unicode::Debug>.
+
+=begin private
+
+=item PUSHED
+
+=item FILL
+
+=item WRITE
+
+=end private
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Unicode-Debug>.
+
+=head1 SEE ALSO
+
+L<Unicode::Debug>,
+L<Devel::Unicode>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/Unicode/Debug.pm

+package Unicode::Debug;
+
+use 5.010;
+use strict;
+use warnings;
+use charnames ':full';
+use utf8;
+
+BEGIN
+{
+	$Unicode::Debug::AUTHORITY = 'cpan:TOBYINK';
+	$Unicode::Debug::VERSION   = '0.001';
+}
+
+use base 'Exporter';
+our @EXPORT    = qw(unidebug);
+our @EXPORT_OK = (@EXPORT, qw(unidecode));
+our %EXPORT_TAGS = (
+	default  => \@EXPORT,
+	standard => \@EXPORT,
+	all      => \@EXPORT_OK,
+	nothing  => [],
+	);
+
+our $Whitespace = 0;
+our $Names      = 0;
+
+sub unidecode
+{
+	unless (defined wantarray)
+	{
+		s/(\r\n|[^\x20-\x7F])/_char($1)/eg for @_;
+	}
+	
+	my @str = map {
+		(my $str = $_) =~ s/(\r\n|\\|[^\x20-\x7F])/_char($1)/eg;
+		$str;
+	} (wantarray ? @_ : $_[0]);
+	
+	wantarray ? @str : $str[0];
+}
+
+sub _char
+{
+	goto \&_ws if $_[0] ~~ ["\r\n", "\r", "\n", "\t"];
+	
+	my $chr = shift;
+	my $ord = ord $chr;
+	
+	return "\\\\" if $chr eq "\\"; 
+
+	if ($Names and my $name = charnames::viacode($ord))
+	{
+		return sprintf('\N{%s}', $name);
+	}
+
+	return sprintf('\x{%04x}', $ord);
+}
+
+sub _ws
+{
+	return $_[0] unless $Whitespace;
+	
+	given ($_[0])
+	{
+		when ("\r\n")  { return "\\r\\n\n" }
+		when ("\n")    { return "\\n\n" }
+		when ("\r")    { return "\\r\n" }
+		when ("\t")    { return "\\t" }
+	}
+}
+
+*unidebug = \&unidecode;
+
+require PerlIO::via::UnicodeDebug;
+
+__PACKAGE__
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Unicode::Debug - debug Unicode strings
+
+=head1 SYNOPSIS
+
+ use 5.010;
+ use Unicode::Debug;
+ 
+ say unidebug("HÊllò WÜrld");
+
+=head1 DESCRIPTION
+
+Makes non-ASCII/non-printable characters in a string blindingly obvious.
+
+=head2 Functions
+
+=head3 unidebug
+
+This function replaces "unusual" characters in strings with a Perl escape
+sequence that will have the same effect. The example in the SYNOPSIS
+outputs this:
+
+ H\x{00e9}ll\x{00f2} W\x{00f6}rld
+
+Which characters are considered unusual? Everything outside the range
+\x20 to \x7F. (The \t, \r and \n characters are handled separately.)
+
+To ensure that unidebug is reversible, backslashes in the input are
+doubled in the output.
+
+Called in void context, it modifies the strings passed to it in-place.
+For example, the following will output the same as the previous example.
+
+  my @strings = ("HÊllò", "WÜrld");
+  unidebug(@strings);
+  say(join " ", @strings);
+  
+Called in list context, it returns modified versions of the strings
+passed to it. Another example:
+
+  my @strings = unidebug("HÊllò", "WÜrld");
+  say(join " ", @strings);
+
+Called in scalar context, it acts the same as in list context, but
+only returns the first modified string.
+
+=head3 unidecode
+
+An alias for C<unidebug>, to use as a drop-in replacement for
+L<Text::Unidecode>.
+
+=head2 Package Variables
+
+OK, so global variables are perhaps not the best way to configure
+things, but we have C<local> so quit complaining.
+
+=head3 C<< $Unicode::Debug::Whitespace >>
+
+If set to true, debugs "\r", "\n" and "\t" as well. They are substituted
+as follows:
+
+ "\r\n"    => "\\r\\n\n"
+ "\r"      => "\\r\n"
+ "\n"      => "\\n\n"
+ "\t"      => "\\t"
+
+When false, these whitespace characters are passed through unchanged.
+False by default.
+
+=head3 C<< $Unicode::Debug::Names >>
+
+If set to true, will use L<charnames> to show character names for
+substituted characters. "WĂśrld" becomes:
+
+ W\N{LATIN SMALL LETTER O WITH DIAERESIS}rld
+
+False by default.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Unicode-Debug>.
+
+=head1 SEE ALSO
+
+L<PerlIO::via::UnicodeDebug>,
+L<Devel::Unicode>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+# This file acts as the project's changelog.
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dcs:     <http://ontologi.es/doap-changeset#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix dist:    <http://purl.org/NET/cpan-uri/dist/Unicode-Debug/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+dist:project :release dist:v_0-001 .
+dist:v_0-001
+	a               :Version ;
+	dc:issued       "2012-04-26"^^xsd:date ;
+	:revision       "0.001"^^xsd:string ;
+	:file-release   <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/Unicode-Debug-0.001.tar.gz> ;
+	rdfs:label      "Initial release" .
+
+# This file contains general metadata about the project.
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix foaf:    <http://xmlns.com/foaf/0.1/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+<http://purl.org/NET/cpan-uri/dist/Unicode-Debug/project>
+	a               :Project ;
+	:programming-language "Perl" ;
+	:name           "Unicode-Debug" ;
+	:shortdesc      "debug unicode strings" ;
+	:homepage       <https://metacpan.org/release/Unicode-Debug> ;
+	:download-page  <https://metacpan.org/release/Unicode-Debug> ;
+	:bug-database   <http://rt.cpan.org/Dist/Display.html?Queue=Unicode-Debug> ;
+	:created        "2012-04-26"^^xsd:date ;
+	:license        <http://dev.perl.org/licenses/> ;
+	:developer      [ a foaf:Person ; foaf:name "Toby Inkster" ; foaf:mbox <mailto:tobyink@cpan.org> ] .
+
+<http://dev.perl.org/licenses/>
+	dc:title        "the same terms as the perl 5 programming language system itself" .
+

meta/makefile.ttl

+# This file provides instructions for packaging.
+
+@prefix : <http://purl.org/NET/cpan-uri/terms#> .
+
+<http://purl.org/NET/cpan-uri/dist/Unicode-Debug/project>
+	:perl_version_from _:main ;
+	:version_from _:main ;
+	:readme_from _:main ;
+	:test_requires "Test::More 0.61"  .
+
+_:main <http://www.semanticdesktop.org/ontologies/2007/03/22/nfo#fileName> "lib/Unicode/Debug.pm" .
+
+use Test::More tests => 3;
+BEGIN { use_ok('Unicode::Debug') };
+
+isa_ok 'Unicode::Debug' => 'Exporter';
+can_ok 'Unicode::Debug' => qw(unidebug unidecode);
+use utf8;
+use Test::More tests => 3;
+use Unicode::Debug;
+
+is(
+	unidebug('HÊllò'),
+	'H\\x{00e9}ll\\x{00f2}',
+	);
+
+$Unicode::Debug::Names = 1;
+is(
+	unidebug('HÊllò'),
+	'H\N{LATIN SMALL LETTER E WITH ACUTE}ll\N{LATIN SMALL LETTER O WITH GRAVE}',
+	);
+
+$Unicode::Debug::Whitespace = 1;
+is(
+	unidebug("\tHello\r\n"),
+	"\\tHello\\r\\n\n",
+	);
+use utf8;
+use Test::More tests => 1;
+use Unicode::Debug;
+
+open my $fh, '>:via(UnicodeDebug)', \(my $file);
+print $fh 'HÊllò';
+
+is(
+	$file,
+	'H\\x{00e9}ll\\x{00f2}',
+	);
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use Test::More;
+use Test::Pod::Coverage;
+
+my @modules = qw(Unicode::Debug);
+pod_coverage_ok($_, "$_ is covered")
+	foreach @modules;
+done_testing(scalar @modules);
+

xt/03meta_uptodate.t

+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok('Unicode-Debug', 'Unicode::Debug');
+
+use Test::EOL;
+all_perl_files_ok();
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.