[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