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

clkao at bestpractical.com clkao at bestpractical.com
Mon Sep 8 07:22:54 EDT 2008


Author: clkao
Date: Mon Sep  8 07:22:54 2008
New Revision: 15838

Added:
   PerlIO-via-symlink/trunk/CHANGES
   PerlIO-via-symlink/trunk/MANIFEST
   PerlIO-via-symlink/trunk/Makefile.PL
   PerlIO-via-symlink/trunk/README
   PerlIO-via-symlink/trunk/SIGNATURE
   PerlIO-via-symlink/trunk/symlink.pm   (contents, props changed)
   PerlIO-via-symlink/trunk/t/
   PerlIO-via-symlink/trunk/t/1use.t
   PerlIO-via-symlink/trunk/t/2basic.t
Modified:
   PerlIO-via-symlink/trunk/   (props changed)

Log:
 r235 at mtl:  clkao | 2004-11-10 21:25:02 +0800
 PerlIO::via::symlink 0.02


Added: PerlIO-via-symlink/trunk/CHANGES
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/CHANGES	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,3 @@
+[Changes for 0.01 - 20 Jul, 2004]
+
+Initial release.

Added: PerlIO-via-symlink/trunk/MANIFEST
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/MANIFEST	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,20 @@
+CHANGES
+inc/ExtUtils/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+Makefile.PL
+MANIFEST
+META.yml			Module meta-data (added by MakeMaker)
+README
+SIGNATURE
+symlink.pm
+t/1use.t
+t/2basic.t

Added: PerlIO-via-symlink/trunk/Makefile.PL
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/Makefile.PL	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+use inc::Module::Install;
+
+name		('PerlIO-via-symlink');
+author		('Chia-liang Kao <clkao at clkao.org>');
+abstract	('PerlIO layer for symlinks');
+license		('perl');
+version_from	('symlink.pm');
+clean_files	('symlink-test'); # from test
+
+include('ExtUtils::AutoInstall');
+auto_install();
+
+WriteAll( sign => 1 );

Added: PerlIO-via-symlink/trunk/README
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/README	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,24 @@
+This is the README file for PerlIO::via::symlink, a module that helps creating
+symlink from IO handle.
+
+* Installation
+
+PerlIO::via::symlink uses the stanard perl module install process:
+
+% perl Makefile.PL
+% make
+# make install
+
+* Latest version
+
+The latest PerlIO::via::symlink could be found on cpan or at:
+http://svn.elixus.org/svnweb/repos/browse/member/clkao/PerlIO-via-symlink/
+
+* 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-symlink/trunk/SIGNATURE
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/SIGNATURE	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,42 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.41.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+    % cpansign -v
+
+It would check each file's integrity, as well as the signature's
+validity.  If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 e36a99ef0b5379978cdd06aa3ca1734875ee3699 CHANGES
+SHA1 1776e7a5f7bb41b83d26d9093d1ddb08d2d7124f MANIFEST
+SHA1 fad52ffa3f2876b47f1be524fabcb9a3ee0eec85 META.yml
+SHA1 3eaf6ff28e9f88959c455a03079faa2a8953e85a Makefile.PL
+SHA1 5ac3a50442cdfa46aaf30d8d9d01079db5c21152 README
+SHA1 127fb0a41f8433b854676941c699693abc3e85d4 inc/ExtUtils/AutoInstall.pm
+SHA1 6801d1d6d53c9a3f8b868a1b70740c1a87f1c893 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
+SHA1 33659c004518e95afb6ffafad41e84f2a6268412 inc/Module/Install/Fetch.pm
+SHA1 b42b4d3a89848325ae29422c72638e1571e7af1b inc/Module/Install/Include.pm
+SHA1 c4ed10cd20914c04f3fff3f8aaf8943372cec114 inc/Module/Install/Makefile.pm
+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 43e4b27eb350b710c5ff892d11d28f210871603a t/1use.t
+SHA1 5f7990e6ba76890024c9f21c26df5c46a6aeb376 t/2basic.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.4 (FreeBSD)
+
+iD8DBQFA/Z0Uk1XldlEkA5YRAmgMAJ4t0i/GQA3k1g9oy81/qyBMBxihOQCeOm6R
+jlCWDI049wqCIzN5dPfakAQ=
+=iQI+
+-----END PGP SIGNATURE-----

Added: PerlIO-via-symlink/trunk/symlink.pm
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/symlink.pm	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,78 @@
+package PerlIO::via::symlink;
+use 5.008;
+use warnings;
+use strict;
+our $VERSION = '0.01';
+
+=head1 NAME
+
+PerlIO::via::symlink - PerlIO layers for create symlinks
+
+=head1 SYNOPSIS
+
+ open $fh, '>:via(symlink)', $fname;
+ print $fh "link foobar";
+ close $fh;
+
+=head1 DESCRIPTION
+
+The PerlIO layer C<symlink> allows you to create a symbolic link by
+writing to the file handle.
+
+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 Symbol qw(gensym);
+
+sub PUSHED {
+    $! = EINVAL, return -1
+	unless $_[1] eq 'w';
+    bless gensym(), $_[0];
+}
+
+sub OPEN { ${*{$_[0]}}{fname} = $_[1] }
+
+sub WRITE {
+    my $buf = $_[1];
+    ${*{$_[0]}}{content} .= $_[1];
+    return length($buf);
+}
+
+sub CLOSE {
+    my ($link, $fname) = @{*{$_[0]}}{qw/content fname/};
+    warn "symlink $link";
+    $link =~ s/^link // or $! = EINVAL, return -1;
+    symlink $link, $fname or return -1;
+    return 0;
+}
+
+=head1 TEST COVERAGE
+
+ ----------------------------------- ------ ------ ------ ------ ------ ------
+ File                                  stmt branch   cond    sub   time  total
+ ----------------------------------- ------ ------ ------ ------ ------ ------
+ blib/lib/PerlIO/via/symlink.pm       100.0  100.0    n/a  100.0  100.0  100.0
+ Total                                100.0  100.0    n/a  100.0  100.0  100.0
+ ----------------------------------- ------ ------ ------ ------ ------ ------
+
+=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-symlink/trunk/t/1use.t
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/t/1use.t	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+use Test;
+BEGIN { plan tests => 1 };
+use PerlIO::via::symlink; ok(1);
+exit;

Added: PerlIO-via-symlink/trunk/t/2basic.t
==============================================================================
--- (empty file)
+++ PerlIO-via-symlink/trunk/t/2basic.t	Mon Sep  8 07:22:54 2008
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+use Test::More tests => 7;
+use PerlIO::via::symlink;
+use strict;
+
+my $fname = 'symlink-test';
+unlink ($fname);
+
+open my $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 $!;
+is (<$fh>, 'link foobar', 'read');
+seek $fh, 0, 0;
+is (<$fh>, 'link foobar', 'read');
+
+unlink ($fname);
+
+eval {
+open my $fh, '>:via(symlink)', $fname or die $!;
+print $fh "foobar";
+close $fh or die $!;
+};
+ok ($@ =~ m'Invalid argument');
+
+open $fh, '<:via(symlink)', $fname;
+ok ($! =~ m'Invalid argument');
+
+eval {
+open my $fh, '>:via(symlink)', $fname or die $!;
+`touch $fname`;
+print $fh "link foobar";
+close $fh or die $!;
+};
+ok ($@ =~ m'File exists');



More information about the Bps-public-commit mailing list