From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 20 Feb 2013 19:28:04 +0000 (+0000)
Subject: lib::with::preamble initial import
X-Git-Tag: v0.001000~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Flib-with-preamble.git;a=commitdiff_plain;h=dcd0209bbc313fa56060d938adffe28375172948

lib::with::preamble initial import
---

dcd0209bbc313fa56060d938adffe28375172948
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..e5eeda8
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,10 @@
+use strict;
+use warnings FATAL => 'all';
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+  NAME => 'lib-with-preamble',
+  VERSION => 0,
+  PM_FILTER => 'perl my/filter',
+  PREREQ_PM => { 'PerlIO::via::dynamic' => 0.02 },
+);
diff --git a/lib/lib/with/preamble.pm b/lib/lib/with/preamble.pm
new file mode 100644
index 0000000..d71ddf7
--- /dev/null
+++ b/lib/lib/with/preamble.pm
@@ -0,0 +1,34 @@
+package lib::with::preamble;
+
+use strict;
+use warnings FATAL => 'all';
+use File::Spec;
+use PerlIO::via::dynamic;
+
+sub require_with_preamble {
+  my ($arrayref, $filename) = @_;
+  my (undef, $preamble, @libs) = @$arrayref;
+  foreach my $cand (map File::Spec->catfile($_, $filename), @libs) {
+    if (-f $cand) {
+      if (open my $fh, '<', $cand) {
+        return with_preamble($preamble."\n#line 1 $cand\n", $fh);
+      }
+    }
+  }
+}
+
+sub with_preamble {
+  my ($preamble, $fh) = @_;
+  PerlIO::via::dynamic->new(untranslate => sub {
+    $preamble and $_[1] =~ s/\A/$preamble/, undef($preamble);
+  })->via($fh);
+  return $fh;
+}
+
+sub import {
+  my ($class, $preamble, @libs) = @_;
+  return unless defined($preamble) and @libs;
+  unshift @INC, [ \&require_with_preamble, $preamble, @libs ];
+}
+
+1;
diff --git a/lib/lib/with/preamble/example/strict.pm b/lib/lib/with/preamble/example/strict.pm
new file mode 100644
index 0000000..1b7f252
--- /dev/null
+++ b/lib/lib/with/preamble/example/strict.pm
@@ -0,0 +1,5 @@
+package lib::with::preamble::example::strict;
+
+$orz++; # should die
+
+1;
diff --git a/t/example.t b/t/example.t
new file mode 100644
index 0000000..78443ee
--- /dev/null
+++ b/t/example.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More qw(no_plan);
+use lib::with::preamble 'use v5.10;', 't/lib';
+
+ok(eval { require my_given_example; 1 }, 'Loaded module');
+
+sub result_for { eval { my_given_example::example_sub($_[0]) } }
+
+is(result_for(1), 'positive');
+is(result_for(-1), 'negative');
+is(result_for(0), 'zero');
+
+is(my_given_example::my_file(), 't/lib/my_given_example.pm');
+is(my_given_example::my_line(), 12);
diff --git a/t/lib/my_given_example.pm b/t/lib/my_given_example.pm
new file mode 100644
index 0000000..f241838
--- /dev/null
+++ b/t/lib/my_given_example.pm
@@ -0,0 +1,14 @@
+package my_given_example;
+
+sub example_sub {
+  given ($_[0]) {
+    when ($_ > 0) { return 'positive' }
+    when ($_ < 0) { return 'negative' }
+    return 'zero'
+  }
+}
+
+sub my_file { __FILE__ }
+sub my_line { __LINE__ }
+
+1;
diff --git a/t/strict.t b/t/strict.t
new file mode 100644
index 0000000..57954b1
--- /dev/null
+++ b/t/strict.t
@@ -0,0 +1,10 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More qw(no_plan);
+
+ok(
+  !eval { require lib::with::preamble::example::strict; 1 },
+  'strict example dies'
+);
+
+like($@, qr{Global symbol "\$orz" requires explicit package name at \S+lib/with/preamble/example/strict.pm line 3}, 'Error has right name and line');