[Bps-public-commit] r15830 - in PerlIO-via-dynamic/trunk: .
clkao at bestpractical.com
clkao at bestpractical.com
Mon Sep 8 07:18:28 EDT 2008
Author: clkao
Date: Mon Sep 8 07:18:28 2008
New Revision: 15830
Added:
PerlIO-via-dynamic/trunk/CHANGES
PerlIO-via-dynamic/trunk/MANIFEST
PerlIO-via-dynamic/trunk/META.yml
PerlIO-via-dynamic/trunk/Makefile.PL
PerlIO-via-dynamic/trunk/README
PerlIO-via-dynamic/trunk/dynamic.pm (contents, props changed)
PerlIO-via-dynamic/trunk/t/
PerlIO-via-dynamic/trunk/t/1use.t
PerlIO-via-dynamic/trunk/t/2basic.t
PerlIO-via-dynamic/trunk/t/3gc.t
Modified:
PerlIO-via-dynamic/trunk/ (props changed)
Log:
r159 at mtl: clkao | 2004-09-06 17:57:33 +0800
PerlIO::via::dynamic 0.02
Added: PerlIO-via-dynamic/trunk/CHANGES
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/CHANGES Mon Sep 8 07:18:28 2008
@@ -0,0 +1,7 @@
+[Changes for 0.01 - 17 Feb, 2004]
+
+Support cleanup for dynamic namespaces..
+
+[Changes for 0.01 - 5 Feb, 2004]
+
+Initial release.
Added: PerlIO-via-dynamic/trunk/MANIFEST
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/MANIFEST Mon Sep 8 07:18:28 2008
@@ -0,0 +1,9 @@
+MANIFEST
+CHANGES
+README
+Makefile.PL
+dynamic.pm
+t/1use.t
+t/2basic.t
+t/3gc.t
+META.yml Module meta-data (added by MakeMaker)
Added: PerlIO-via-dynamic/trunk/META.yml
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/META.yml Mon Sep 8 07:18:28 2008
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: PerlIO-via-dynamic
+version: 0.02
+version_from: dynamic.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.21
Added: PerlIO-via-dynamic/trunk/Makefile.PL
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/Makefile.PL Mon Sep 8 07:18:28 2008
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ AUTHOR => 'Chia-liang Kao (clkao at clkao.org)',
+ ABSTRACT => 'Dynamic PerlIO layers',
+ NAME => 'PerlIO::via::dynamic',
+ VERSION_FROM => 'dynamic.pm',
+ DISTNAME => 'PerlIO-via-dynamic',
+
+ dist => {
+ COMPRESS => 'gzip -9',
+ SUFFIX => '.gz',
+ },
+);
+
Added: PerlIO-via-dynamic/trunk/README
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/README Mon Sep 8 07:18:28 2008
@@ -0,0 +1,24 @@
+This is the README file for PerlIO::via::dynamic, a module that helps creating
+dynamic PerlIO layers.
+
+* Installation
+
+PerlIO::via::dynamic uses the stanard perl module install process:
+
+% perl Makefile.PL
+% make
+# make install
+
+* Latest version
+
+The latest PerlIO::via::dynamic could be found on cpan or at:
+http://svn.elixus.org/svnweb/repos/browse/member/clkao/PerlIO-via-dynamic/
+
+* Copyright
+
+Copyright 2004 by Chia-liang Kao clkao at clkao.org.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See <http://www.perl.com/perl/misc/Artistic.html>.
Added: PerlIO-via-dynamic/trunk/dynamic.pm
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/dynamic.pm Mon Sep 8 07:18:28 2008
@@ -0,0 +1,145 @@
+package PerlIO::via::dynamic;
+use strict;
+our $VERSION = '0.02';
+
+=head1 NAME
+
+PerlIO::via::dynamic - dynamic PerlIO layers
+
+=head1 SYNOPSIS
+
+ open $fh, $fname;
+ $p = PerlIO::via::dynamic->new
+ (translate =>
+ sub { $_[1] =~ s/\$Filename[:\w\s\-\.\/\\]*\$/\$Filename: $fname\$/e},
+ untranslate =>
+ sub { $_[1] =~ s/\$Filename[:\w\s\-\.\/\\]*\$/\$Filename\$/});
+ $p->via ($fh);
+ binmode $fh, $p->via; # deprecated
+
+=head1 DESCRIPTION
+
+PerlIO::via::dynamic is used for creating dynamic PerlIO layers. It is
+useful when the behavior or the layer depends on variables. You should
+not use this module as via layer directly (ie :via(dynamic)).
+
+Use the constructor to create new layers, with two arguments:
+translate and untranslate. Then use C<$p-E<gt>via ($fh)> to wrap the
+handle.
+
+Note that PerlIO::via::dynamic uses the scalar fields to reference to
+the object representing the dynamic namespace. If you
+
+=cut
+
+use Symbol qw(delete_package gensym);
+use Scalar::Util qw(weaken);
+
+sub PUSHED {
+ die "this should not be via directly"
+ if $_[0] eq __PACKAGE__;
+ my $p = bless gensym(), $_[0];
+
+ no strict 'refs';
+ # make sure the blessed glob is destroyed
+ # earlier than the object representing the namespace.
+ ${*$p} = ${"$_[0]::EGO"};
+
+ return $p;
+}
+
+sub translate {
+}
+
+sub untranslate {
+}
+
+sub FILL {
+ my $line = readline( $_[1] );
+ $_[0]->untranslate ($line) if defined $line;
+ $line;
+}
+
+sub WRITE {
+ my $buf = $_[1];
+ $_[0]->translate($buf);
+ (print {$_[2]} $buf) ? length($buf) : -1;
+}
+
+sub SEEK {
+ seek ($_[3], $_[1], $_[2]);
+}
+
+sub new {
+ my ($class, %arg) = @_;
+ my $self = {};
+ my $package = 'PerlIO::via::dynamic'.substr("$self", 7, -1);
+ eval qq|
+package $package;
+our \@ISA = qw($class);
+
+1;
+| or die $@;
+
+ no strict 'refs';
+ for (keys %arg) {
+ *{"$package\::$_"} = $arg{$_};
+ }
+
+ bless $self, $package;
+ ${"$package\::EGO"} = $self;
+ weaken ${"$package\::EGO"};
+ return $self;
+}
+
+sub via {
+ my ($self, $fh) = @_;
+ my $via = ':via('.ref ($_[0]).')';
+ unless ($fh) {
+ # 0.01 compatibility
+ $self->{nogc} = 1;
+ return $via;
+ }
+ binmode ($fh, $via) or die $!;
+ if (defined ${*$fh}) {
+ warn "handle $fh cannot hold references, namespace won't be cleaned";
+ }
+ else {
+ ${*$fh} = $self;
+ }
+}
+
+sub DESTROY {
+ my ($self) = @_;
+ return unless UNIVERSAL::isa ($self, 'HASH');
+ return if $self->{nogc};
+
+ no strict 'refs';
+ my $ref = ref($self);
+ my ($leaf) = ($ref =~ /([^:]+)$/);
+ $leaf .= '::';
+
+ for my $sym (keys %{$ref.'::'}) {
+ undef ${$ref.'::'}{$sym}
+ if $sym;
+ }
+
+ delete $PerlIO::via::{$leaf};
+}
+
+=head1 AUTHORS
+
+Chia-liang Kao E<lt>clkao at clkao.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Chia-liang Kao E<lt>clkao at clkao.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
Added: PerlIO-via-dynamic/trunk/t/1use.t
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/t/1use.t Mon Sep 8 07:18:28 2008
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+use Test;
+BEGIN { plan tests => 1 };
+use PerlIO::via::dynamic; ok(1);
+exit;
Added: PerlIO-via-dynamic/trunk/t/2basic.t
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/t/2basic.t Mon Sep 8 07:18:28 2008
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+use Test;
+use strict;
+use PerlIO::via::dynamic;
+BEGIN { plan tests => 1 };
+
+# $Filename$
+
+my $fname = $0;
+
+my $p = PerlIO::via::dynamic->new
+ (untranslate =>
+ sub { $_[1] =~ s/\$Filename[:\w\s\-\.\/\\]*\$/"\$Filename: $fname\$"/e},
+ translate =>
+ sub { $_[1] =~ s/\$Filename[:\w\s\-\.\/\\]*\$/\$Filename\$/});
+
+open my $fh, '<'.$p->via, $fname;
+
+local $/;
+
+my $text = <$fh>;
+
+ok (1) if $text =~ m/^# \$Filename: $0\$/m;
+
+exit;
Added: PerlIO-via-dynamic/trunk/t/3gc.t
==============================================================================
--- (empty file)
+++ PerlIO-via-dynamic/trunk/t/3gc.t Mon Sep 8 07:18:28 2008
@@ -0,0 +1,39 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 3;
+use PerlIO::via::dynamic;
+
+# $Filename$
+
+our $unused_destroyed;
+my $fname = $0;
+
+sub run_test {
+ my $o = bless {}, 'Unused';
+
+ my $p = PerlIO::via::dynamic->new
+ (untranslate =>
+ sub { $o->{fnord}++;
+ $_[1] =~ s/\$Filename[:\w\s\-\.\/\\]*\$/"\$Filename: $fname\$"/e},
+ translate =>
+ sub { $_[1] =~ s/\$Filename[:\w\s\-\.\/\\]*\$/\$Filename\$/});
+
+ open my $fh, '<', $fname;
+ $p->via ($fh);
+
+ local $/;
+ my $text = <$fh>;
+ ok (1) if $text =~ m/^# \$Filename: $0\$/m;
+}
+
+run_test ();
+
+ok ($unused_destroyed);
+
+run_test ();
+
+package Unused;
+
+sub DESTROY {
+ $main::unused_destroyed = 1;
+}
More information about the Bps-public-commit
mailing list