/usr/share/perl5/PerlIO/via/symlink.pm is in libperlio-via-symlink-perl 0.05-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | package PerlIO::via::symlink;
use 5.008;
use warnings;
use strict;
our $VERSION = '0.05';
=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.
=cut
use Errno qw(EINVAL ENOENT);
use Symbol qw(gensym);
sub PUSHED {
$! = EINVAL, return -1
unless $_[1] eq 'w' || $_[1] eq 'r';
my $self = bless gensym(), $_[0];
*$self->{mode} = $_[1];
return $self;
}
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 ($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, $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;
}
=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@clkao.orgE<gt>
=head1 COPYRIGHT
Copyright 2004-2005 by Chia-liang Kao E<lt>clkao@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;
|