[Bps-public-commit] r15839 - in PerlIO-via-symlink/trunk: .

[clkao at bestpractical.com]

Author: clkao
Date: Mon Sep  8 07:23:30 2008
New Revision: 15839

Modified:
   PerlIO-via-symlink/trunk/   (props changed)
   PerlIO-via-symlink/trunk/CHANGES
   PerlIO-via-symlink/trunk/SIGNATURE
   PerlIO-via-symlink/trunk/symlink.pm
   PerlIO-via-symlink/trunk/t/2basic.t

Log:
 r236 at mtl:  clkao | 2004-11-10 21:33:29 +0800
 PerlIO::via::symlink 0.02.
 
 


Modified: PerlIO-via-symlink/trunk/CHANGES
==============================================================================
--- PerlIO-via-symlink/trunk/CHANGES	(original)
+++ PerlIO-via-symlink/trunk/CHANGES	Mon Sep  8 07:23:30 2008
@@ -1,3 +1,7 @@
+[Changes for 0.02 - 9 Aug, 2004]
+
+Support reading symlink.
+
 [Changes for 0.01 - 20 Jul, 2004]
 
 Initial release.

Modified: PerlIO-via-symlink/trunk/SIGNATURE
==============================================================================
--- PerlIO-via-symlink/trunk/SIGNATURE	(original)
+++ PerlIO-via-symlink/trunk/SIGNATURE	Mon Sep  8 07:23:30 2008
@@ -14,13 +14,13 @@
 -----BEGIN PGP SIGNED MESSAGE-----
 Hash: SHA1
 
-SHA1 e36a99ef0b5379978cdd06aa3ca1734875ee3699 CHANGES
+SHA1 d9ceac30a06605c7c57101660c1eec3c8633e817 CHANGES
 SHA1 1776e7a5f7bb41b83d26d9093d1ddb08d2d7124f MANIFEST
-SHA1 fad52ffa3f2876b47f1be524fabcb9a3ee0eec85 META.yml
+SHA1 766be82d4f056b6605b39d7eb7d8a7b4d600b635 META.yml
 SHA1 3eaf6ff28e9f88959c455a03079faa2a8953e85a Makefile.PL
 SHA1 5ac3a50442cdfa46aaf30d8d9d01079db5c21152 README
 SHA1 127fb0a41f8433b854676941c699693abc3e85d4 inc/ExtUtils/AutoInstall.pm
-SHA1 6801d1d6d53c9a3f8b868a1b70740c1a87f1c893 inc/Module/Install.pm
+SHA1 02597776ad22aacd2c8e189594fcbf701390b606 inc/Module/Install.pm
 SHA1 53422ed14b41bbc9af3ac14a26ced3ed21dee0bc inc/Module/Install/AutoInstall.pm
 SHA1 7ca8b8f54287c2b5af8062fc9f349275a07e06f3 inc/Module/Install/Base.pm
 SHA1 b6af22816210f8eaab4c2c616e05a8892b2fcfd0 inc/Module/Install/Can.pm
@@ -30,13 +30,13 @@
 SHA1 ccf9b6267b5c9e7b35ef129f7e974255955c8867 inc/Module/Install/Metadata.pm
 SHA1 1288f4c4e4ba88e19194d7952eacbd6be2a5b916 inc/Module/Install/Win32.pm
 SHA1 1022a7ab797fc0081ea947f102650362ad925d7a inc/Module/Install/WriteAll.pm
-SHA1 017e3a795bd2a73a1271c16d37bf5d7bf452bd2e symlink.pm
+SHA1 860e16c23175dd55be26ffa9fb0531789190baeb symlink.pm
 SHA1 43e4b27eb350b710c5ff892d11d28f210871603a t/1use.t
-SHA1 5f7990e6ba76890024c9f21c26df5c46a6aeb376 t/2basic.t
+SHA1 b230b4d54ce1faba672a0f951757263efb06b55d t/2basic.t
 -----BEGIN PGP SIGNATURE-----
 Version: GnuPG v1.2.4 (FreeBSD)
 
-iD8DBQFA/Z0Uk1XldlEkA5YRAmgMAJ4t0i/GQA3k1g9oy81/qyBMBxihOQCeOm6R
-jlCWDI049wqCIzN5dPfakAQ=
-=iQI+
+iD8DBQFBFtD+k1XldlEkA5YRAklPAKCCfMxWGNKJdi+Sl9K67WQ3wWZBcACfTUnS
+b17Y+TYB88mg3wTDZhH7Xa0=
+=eqoX
 -----END PGP SIGNATURE-----

Modified: PerlIO-via-symlink/trunk/symlink.pm
==============================================================================
--- PerlIO-via-symlink/trunk/symlink.pm	(original)
+++ PerlIO-via-symlink/trunk/symlink.pm	Mon Sep  8 07:23:30 2008
@@ -2,7 +2,7 @@
 use 5.008;
 use warnings;
 use strict;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 NAME
 
@@ -22,30 +22,50 @@
 You need to write C"link $name" to the file handle. If the format does
 not match, C<close> will fail with EINVAL.
 
-Currently only writing is supported.
-
 =cut
 
-use Errno qw(EINVAL);
+use Errno qw(EINVAL ENOENT);
 use Symbol qw(gensym);
 
 sub PUSHED {
     $! = EINVAL, return -1
-	unless $_[1] eq 'w';
-    bless gensym(), $_[0];
+	unless $_[1] eq 'w' || $_[1] eq 'r';
+    my $self = bless gensym(), $_[0];
+    *$self->{mode} = $_[1];
+    return $self;
 }
 
-sub OPEN { ${*{$_[0]}}{fname} = $_[1] }
+sub OPEN {
+    my ($self, $fname) = @_;
+    *$self->{fname} = $fname;
+    return 1 if *$self->{mode} eq 'w';
+    lstat ($fname) or return -1;
+    $! = EINVAL, return -1 unless -l $fname;
+    *$self->{content} = 'link '.readlink ($fname);
+    return 1;
+}
 
 sub WRITE {
-    my $buf = $_[1];
-    ${*{$_[0]}}{content} .= $_[1];
+    my ($self, $buf) = @_;
+    *$self->{content} .= $buf;
     return length($buf);
 }
 
+sub FILL {
+    my ($self) = @_;
+    return if *$self->{filled};
+    ++*$self->{filled};
+    return *$self->{content};
+}
+
+sub SEEK {
+    my ($self) = @_;
+    delete *$self->{filled};
+}
+
 sub CLOSE {
-    my ($link, $fname) = @{*{$_[0]}}{qw/content fname/};
-    warn "symlink $link";
+    my ($link, $fname, $mode) = @{*{$_[0]}}{qw/content fname mode/};
+    return 0 if $mode eq 'r';
     $link =~ s/^link // or $! = EINVAL, return -1;
     symlink $link, $fname or return -1;
     return 0;

Modified: PerlIO-via-symlink/trunk/t/2basic.t
==============================================================================
--- PerlIO-via-symlink/trunk/t/2basic.t	(original)
+++ PerlIO-via-symlink/trunk/t/2basic.t	Mon Sep  8 07:23:30 2008
@@ -1,18 +1,20 @@
 #!/usr/bin/perl
-use Test::More tests => 7;
+use Test::More tests => 9;
 use PerlIO::via::symlink;
 use strict;
 
 my $fname = 'symlink-test';
 unlink ($fname);
+open my $fh, '+>:via(symlink)', $fname;
+ok ($! =~ m'Invalid argument');
 
-open my $fh, '>:via(symlink)', $fname or die $!;
+open $fh, '>:via(symlink)', $fname or die $!;
 print $fh "link foobar";
 close $fh;
 ok (-l $fname);
 is (readlink $fname, 'foobar');
 
-open my $fh, '<:via(symlink)', $fname or die $!;
+open $fh, '<:via(symlink)', $fname or die $!;
 is (<$fh>, 'link foobar', 'read');
 seek $fh, 0, 0;
 is (<$fh>, 'link foobar', 'read');
@@ -27,7 +29,7 @@
 ok ($@ =~ m'Invalid argument');
 
 open $fh, '<:via(symlink)', $fname;
-ok ($! =~ m'Invalid argument');
+ok ($! =~ m'Bad file descriptor');
 
 eval {
 open my $fh, '>:via(symlink)', $fname or die $!;
@@ -36,3 +38,6 @@
 close $fh or die $!;
 };
 ok ($@ =~ m'File exists');
+
+open $fh, '<:via(symlink)', $fname;
+ok ($! =~ m'Bad file descriptor');