Commits

Toby Inkster committed 315eaa0

initial checkin

Comments (0)

Files changed (14)

+use inc::Module::Package 'RDF:tobyink 0.009';
+

lib/PerlX/QuoteOperator/Inescapable.pm

+package PerlX::QuoteOperator::Inescapable;
+
+use 5.010001;
+use strict;
+use warnings;
+no warnings qw( void once uninitialized );
+no thanks;
+
+BEGIN {
+	$PerlX::QuoteOperator::Inescapable::AUTHORITY = 'cpan:TOBYINK';
+	$PerlX::QuoteOperator::Inescapable::VERSION   = '0.001';
+}
+
+use Carp qw/croak/;
+use Devel::Declare;
+use Data::OptList;
+use Sub::Install qw/install_sub/;
+
+use parent qw/Devel::Declare::Context::Simple/;
+
+sub import
+{
+	my $caller = caller;
+	my $self   = shift;
+	
+	@_ = 'Q' unless @_;
+	my $optlist = Data::OptList::mkopt(\@_);
+	
+	for my $opt ( @$optlist )
+	{
+		my ($declarator, $callback) = @$opt;
+		$callback //= sub ($) { +shift };
+		$callback = delete $callback->{'-with'} if ref $callback eq 'HASH';
+		
+		$self = $self->new unless ref $self;
+		Devel::Declare->setup_for(
+			$caller,
+			{ $declarator => { const => sub { $self->_parser(@_) } } }
+		);
+		
+		install_sub {
+			into    => $caller,
+			as      => $declarator,
+			code    => $callback,
+		};
+	}	
+}
+
+sub unimport
+{
+	$^H{(__PACKAGE__)} = undef;
+}
+
+sub _parser
+{
+	my $self = shift;
+	$self->init(@_);
+	
+	$self->skip_declarator;
+	$self->skipspace;
+	
+	my $linestr = $self->get_linestr;
+	
+	my $remaining = substr($linestr, $self->offset);
+	my $starter   = substr($remaining, 0, 1);
+	my $ender     = $self->_ender($starter);
+	
+	my $ending    = index($remaining, $ender, 1);
+	croak "Unterminated inescapable quoted string found: '$remaining'" if $ending < 0;
+	
+	substr($remaining, 0, $ending+1) = sprintf("('%s')", $self->_quote(substr $remaining, 1, $ending-1));
+	substr($linestr, $self->offset)  = $remaining;
+	
+	$self->set_linestr($linestr);
+}
+
+sub _ender
+{
+	my ($self, $str) = @_;
+	return {
+		'('    => ')',
+		'{'    => '}',
+		'['    => ']',
+		'<'    => '>',
+	}->{$str} // $str;
+}
+
+sub _quote
+{
+	my ($self, $str) = @_;
+	$str =~ s{([\\\'])}{\\$1}g;
+	return $str;
+}
+
+__FILE__
+__END__
+
+=head1 NAME
+
+PerlX::QuoteOperator::Inescapable - a quote-like operator with no string escapes
+
+=head1 SYNOPSIS
+
+	use PerlX::QuoteOperator::Inescapable;
+	
+	my $var1 = q(Hello World);   # standard Perl quote-like operator
+	my $var2 = Q(Hello World);   # this works the same
+	
+	my $var3 = q(Hello\\World);  # string includes a backslash
+	my $var4 = Q(Hello\\World);  # string includes two backslashes!
+
+=head1 DESCRIPTION
+
+PerlX::QuoteOperator::Inescapable introduces a quote-like operator like
+C<< q(...) >> but that supports B<< no string escapes >>! All characters
+quoted are treated literally.
+
+Like other quote-like operators, standard left/right bracket pairs are
+supported; but unlike other quote-like operators, you cannot nest balanced
+pairs of brackets:
+
+	Q(Hello (Earth) World);   # no!
+
+The current implementation is limited to single-line literals. The
+quote-like operator, starting delimiter and ending delimiter must all
+appear on the same line of source code.
+
+By default, a single quote-like operator is defined, C<< Q >>. You
+can define alternative ones:
+
+	use Path::Class;
+	use PerlX::QuoteOperator::Inescapable
+		Q => (),   # default Q operator
+		F => sub ($) { Path::Class::File->new(@_) },
+		D => sub ($) { Path::Class::Dir->new(@_) },
+	;
+	
+	my $fonts = D(\\Server1\Marketing\Fonts);
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=PerlX-QuoteOperator-Inescapable>.
+
+=head1 SEE ALSO
+
+L<PerlX::QuoteOperator>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 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.
+

meta/changes.pret

+# This file acts as the project's changelog.
+
+`PerlX-QuoteOperator-Inescapable 0.001 cpan:TOBYINK`
+	issued  2013-02-01;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`PerlX-QuoteOperator-Inescapable`
+	:programming-language "Perl" ;
+	:shortdesc            "a quote-like operator with no string escapes";
+	:homepage             <https://metacpan.org/release/PerlX-QuoteOperator-Inescapable>;
+	:download-page        <https://metacpan.org/release/PerlX-QuoteOperator-Inescapable>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=PerlX-QuoteOperator-Inescapable>;
+	:created              2013-02-01;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`PerlX-QuoteOperator-Inescapable`
+	perl_version_from m`PerlX::QuoteOperator::Inescapable`;
+	version_from      m`PerlX::QuoteOperator::Inescapable`;
+	readme_from       m`PerlX::QuoteOperator::Inescapable`;
+	test_requires     p`Test::More 0.61` ;
+	.
+
+# This file contains data about the project developers.
+
+@prefix : <http://xmlns.com/foaf/0.1/>.
+
+cpan:TOBYINK
+	:name  "Toby Inkster";
+	:mbox  <mailto:tobyink@cpan.org>.
+
+use Test::More tests => 1;
+BEGIN { use_ok('PerlX::QuoteOperator::Inescapable') };
+
+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 XT::Util;
+use Test::More;
+use Test::Pod::Coverage;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pod_coverage_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pod_coverage_ok();
+}
+

xt/03meta_uptodate.config

+{"package":"PerlX-QuoteOperator-Inescapable"}
+

xt/03meta_uptodate.t

+use XT::Util;
+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok(__CONFIG__->{package}, __CONFIG__->{version_from});
+
+use Test::EOL;
+all_perl_files_ok();
+use Test::Tabs;
+all_perl_files_ok();
+use XT::Util;
+use Test::More;
+use Test::HasVersion;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pm_version_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pm_version_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.