r27028 - in /branches/upstream/liblchown-perl: ./ current/ current/t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Wed Nov 19 15:51:32 UTC 2008
Author: gregoa
Date: Wed Nov 19 15:51:27 2008
New Revision: 27028
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27028
Log:
[svn-inject] Installing original source of liblchown-perl
Added:
branches/upstream/liblchown-perl/
branches/upstream/liblchown-perl/current/
branches/upstream/liblchown-perl/current/Changes
branches/upstream/liblchown-perl/current/Lchown.pm
branches/upstream/liblchown-perl/current/Lchown.xs
branches/upstream/liblchown-perl/current/MANIFEST
branches/upstream/liblchown-perl/current/META.yml
branches/upstream/liblchown-perl/current/Makefile.PL
branches/upstream/liblchown-perl/current/README
branches/upstream/liblchown-perl/current/t/
branches/upstream/liblchown-perl/current/t/allplatforms.t
branches/upstream/liblchown-perl/current/t/noimport.t
branches/upstream/liblchown-perl/current/t/notsup.t
branches/upstream/liblchown-perl/current/t/pod-coverage.t
branches/upstream/liblchown-perl/current/t/pod.t
branches/upstream/liblchown-perl/current/t/sup.t
Added: branches/upstream/liblchown-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/Changes?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/Changes (added)
+++ branches/upstream/liblchown-perl/current/Changes Wed Nov 19 15:51:27 2008
@@ -1,0 +1,28 @@
+Revision history for Perl extension Lchown.
+
+0.01 Sep 26 2003
+ - original version; created by h2xs 1.19
+
+0.02 Sep 28 2003
+ - got it working and added tests
+
+0.03 Sep 28 2003
+ - tidied docs and Makefile.PL
+
+0.04 Sep 30 2003
+ - added a README
+
+0.05 Sep 30 2003
+ - really added a README this time
+
+0.06 Oct 01 2003
+ - replaced ENOTSUP with the more appropriate ENOSYS
+
+0.07 Jan 02 2004
+ - fixed test failure on platforms without symlinks
+
+1.00 Nov 13 2004
+ - now works on perls back to 5.00404
+ minor code tidy
+ added pod tests
+
Added: branches/upstream/liblchown-perl/current/Lchown.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/Lchown.pm?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/Lchown.pm (added)
+++ branches/upstream/liblchown-perl/current/Lchown.pm Wed Nov 19 15:51:27 2008
@@ -1,0 +1,104 @@
+package Lchown;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+require Exporter;
+require DynaLoader;
+
+ at ISA = qw(Exporter DynaLoader);
+ at EXPORT = qw(lchown);
+ at EXPORT_OK = qw(lchown LCHOWN_AVAILABLE);
+
+$VERSION = '1.00';
+
+bootstrap Lchown $VERSION;
+
+sub LCHOWN_AVAILABLE () {
+ defined lchown(0,0) ? 1 : 0;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Lchown - use the lchown(2) system call from Perl
+
+=head1 SYNOPSIS
+
+ use Lchown;
+
+ lchown $uid, $gid, 'foo' or die "lchown: $!";
+
+ my $count = lchown $uid, $gid, @filenames;
+
+ # or
+
+ use Lchown qw(lchown LCHOWN_AVAILABLE);
+
+ warn "this system lacks the lchown system call\n" unless LCHOWN_AVAILABLE;
+
+ ...
+
+ # or
+
+ use Lchown ();
+
+ warn "this won't work\n" unless Lchown::LCHOWN_AVAILABLE;
+ Lchown::lchown $uid, $gid, 'foo' or die "lchown: $!";
+
+=head1 DESCRIPTION
+
+Provides a perl interface to the C<lchown()> system call, on platforms that
+support it.
+
+=head1 DEFAULT EXPORTS
+
+The following symbols are exported be default:
+
+=over
+
+=item lchown (LIST)
+
+Like the C<chown> builtin, but using the C<lchown()> system call so that
+symlinks will not be followed. Returns the number of files successfully
+changed.
+
+On systems without the C<lchown()> system call, C<lchown> always returns
+C<undef> and sets C<errno> to C<ENOSYS> (Function not implemented).
+
+=back
+
+=head1 ADDITIONAL EXPORTS
+
+The following symbols are available for export but are not exported by
+default:
+
+=over
+
+=item LCHOWN_AVAILABLE ()
+
+Returns true on platforms with the C<lchown()> system call, and false on
+platforms without.
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc/chown>, L<lchown(2)>
+
+=head1 AUTHOR
+
+Nick Cleaton E<lt>nick at cleaton.netE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2003-2004 by Nick Cleaton
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
Added: branches/upstream/liblchown-perl/current/Lchown.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/Lchown.xs?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/Lchown.xs (added)
+++ branches/upstream/liblchown-perl/current/Lchown.xs Wed Nov 19 15:51:27 2008
@@ -1,0 +1,30 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+
+MODULE = Lchown PACKAGE = Lchown
+
+PROTOTYPES: ENABLE
+
+SV *
+lchown(owner, group, ...)
+ unsigned owner
+ unsigned group
+ PROTOTYPE: @
+ PREINIT:
+ int i;
+ int ok;
+ STRLEN len;
+ CODE:
+#ifdef HAS_LCHOWN
+ ok = 0;
+ for ( i=2 ; i<items ; i++ )
+ if ( lchown((char *)SvPV(ST(i),len), owner, group) == 0 )
+ ok++;
+ ST(0) = sv_2mortal(newSViv(ok));
+#else
+ errno = ENOSYS;
+ ST(0) = &sv_undef;
+#endif
+
Added: branches/upstream/liblchown-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/MANIFEST?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/MANIFEST (added)
+++ branches/upstream/liblchown-perl/current/MANIFEST Wed Nov 19 15:51:27 2008
@@ -1,0 +1,13 @@
+Changes
+Lchown.pm
+Lchown.xs
+MANIFEST
+Makefile.PL
+README
+META.yml
+t/allplatforms.t
+t/noimport.t
+t/notsup.t
+t/sup.t
+t/pod.t
+t/pod-coverage.t
Added: branches/upstream/liblchown-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/META.yml?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/META.yml (added)
+++ branches/upstream/liblchown-perl/current/META.yml Wed Nov 19 15:51:27 2008
@@ -1,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Lchown
+version: 1.00
+version_from: Lchown.pm
+installdirs: site
+requires:
+ Test::More: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/liblchown-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/Makefile.PL?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/Makefile.PL (added)
+++ branches/upstream/liblchown-perl/current/Makefile.PL Wed Nov 19 15:51:27 2008
@@ -1,0 +1,8 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Lchown',
+ 'VERSION_FROM' => 'Lchown.pm',
+ 'PREREQ_PM' => { 'Test::More' => 0 },
+);
+
Added: branches/upstream/liblchown-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/README?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/README (added)
+++ branches/upstream/liblchown-perl/current/README Wed Nov 19 15:51:27 2008
@@ -1,0 +1,32 @@
+Lchown - perl interface to the lchown(2) system call
+
+The Lchown module provides a perl interface to the lchown(2) UNIX system
+call, on systems that support lchown. The lchown(2) call is used to
+change the ownership and group of symbolic links.
+
+DEPENDENCIES
+
+ The test suite requires the Test::More module, available from CPAN.
+
+ The oldest perl version that I've tested against is 5.00404.
+
+INSTALLATION
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+This module should build and pass tests on systems without the lchown
+system call. Any lchown call will fail at runtime on such systems.
+
+Since the lchown system call often requires root privileges to make any
+change, most of the tests will be skipped unless "make test" is run as
+root.
+
+Copyright (C) 2003-2004 by Nick Cleaton
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself, either Perl version 5.8.0 or, at
+your option, any later version of Perl 5 you may have available.
+
Added: branches/upstream/liblchown-perl/current/t/allplatforms.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/t/allplatforms.t?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/t/allplatforms.t (added)
+++ branches/upstream/liblchown-perl/current/t/allplatforms.t Wed Nov 19 15:51:27 2008
@@ -1,0 +1,6 @@
+use Test::More (tests => 2);
+
+BEGIN { use_ok('Lchown') }
+
+ok( !lchown(9,9,"nosuchfile"), "failed on nonexistent file" );
+
Added: branches/upstream/liblchown-perl/current/t/noimport.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/t/noimport.t?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/t/noimport.t (added)
+++ branches/upstream/liblchown-perl/current/t/noimport.t Wed Nov 19 15:51:27 2008
@@ -1,0 +1,18 @@
+use Test::More (tests => 3);
+
+use Lchown ();
+
+SKIP: {
+ skip "this system lacks lchown", 3 unless Lchown::LCHOWN_AVAILABLE;
+ skip "not running as root", 3 if $>;
+
+ symlink 'bar', 'foo' or die "symlink: $!";
+ my $result = Lchown::lchown 123, 456, 'foo';
+ is( $result, 1, "Lchown::Lchown prototype works" );
+ ($uid,$gid) = (lstat 'foo')[4,5];
+ is( $uid, 123, "Lchown::lchown foo set uid 123" );
+ is( $gid, 456, "Lchown::lchown foo set gid 456" );
+
+ unlink 'foo' or die "unlink: $!";
+}
+
Added: branches/upstream/liblchown-perl/current/t/notsup.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/t/notsup.t?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/t/notsup.t (added)
+++ branches/upstream/liblchown-perl/current/t/notsup.t Wed Nov 19 15:51:27 2008
@@ -1,0 +1,22 @@
+use Test::More (tests => 6);
+
+use Lchown qw(lchown LCHOWN_AVAILABLE);
+
+SKIP: {
+ skip "this system has lchown", 6 if LCHOWN_AVAILABLE;
+
+ my $uid = $>;
+ my $gid = $) =~ /^(\d+)/;
+
+ ok( ! defined lchown($uid, $gid), "null lchown call failed" );
+ like( $!, '/function not implemented/i', "null lchown gave ENOSYS" );
+
+ symlink 'bar', 'foo' or skip "can't make a symlink", 2;
+ ok( ! defined lchown($uid, $gid, 'foo'), "valid lchown call failed" );
+ like( $!, '/function not implemented/i', "valid lchown gave ENOSYS" );
+ unlink 'foo';
+
+ ok( ! defined lchown($uid, $gid, 'nosuchfile'), "missing file lchown call failed" );
+ like( $!, '/function not implemented/i', "file valid lchown gave ENOSYS" );
+}
+
Added: branches/upstream/liblchown-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/t/pod-coverage.t?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/liblchown-perl/current/t/pod-coverage.t Wed Nov 19 15:51:27 2008
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: branches/upstream/liblchown-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/t/pod.t?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/t/pod.t (added)
+++ branches/upstream/liblchown-perl/current/t/pod.t Wed Nov 19 15:51:27 2008
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/liblchown-perl/current/t/sup.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblchown-perl/current/t/sup.t?rev=27028&op=file
==============================================================================
--- branches/upstream/liblchown-perl/current/t/sup.t (added)
+++ branches/upstream/liblchown-perl/current/t/sup.t Wed Nov 19 15:51:27 2008
@@ -1,0 +1,58 @@
+use Test::More (tests => 17);
+
+use Lchown qw(lchown LCHOWN_AVAILABLE);
+
+
+SKIP: {
+ skip "this system lacks lchown", 17 unless LCHOWN_AVAILABLE;
+
+ is( lchown(0,0), 0, "null lchown gave 0" );
+ my $result = lchown 0, 0;
+ is( $result, 0, "null lchown without parens" );
+
+ is( lchown(0,0,'nosuchfile','nosuchfile.bak'), 0,
+ "lchown returns 0 with 2 missing files");
+
+ skip "not running as root", 14 if $>;
+
+ symlink 'bar', 'foo' or die "symlink: $!";
+
+ is( lchown(123,456,'foo'), 1, "lchown foo success" );
+ my ($uid,$gid) = (lstat 'foo')[4,5];
+ is( $uid, 123, "lchown foo set uid 123" );
+ is( $gid, 456, "lchown foo set gid 456" );
+
+ unlink 'foo' or die "unlink: $!";
+
+ symlink 'bar', 'foo' or die "symlink: $!";
+ symlink 'bar', 'baz' or die "symlink: $!";
+ is( lchown(123,456,'foo','baz'), 2, "foo,baz success" );
+ ($uid,$gid) = (lstat 'foo')[4,5];
+ is( $uid, 123, "foo,baz set foo uid 123" );
+ is( $gid, 456, "foo,baz set foo gid 456" );
+ ($uid,$gid) = (lstat 'baz')[4,5];
+ is( $uid, 123, "foo,baz set baz uid 123" );
+ is( $gid, 456, "foo,baz set baz gid 456" );
+
+ unlink 'foo' or die "unlink: $!";
+ unlink 'baz' or die "unlink: $!";
+
+ symlink 'bar', 'foo' or die "symlink: $!";
+
+ is( lchown(123,456,'foo','nosuch'), 1, "foo,nosuch success for foo" );
+ ($uid,$gid) = (lstat 'foo')[4,5];
+ is( $uid, 123, "foo,nosuch set foo uid 123" );
+ is( $gid, 456, "foo,nosuch set foo gid 456" );
+
+ unlink 'foo' or die "unlink: $!";
+
+ symlink 'bar', 'foo' or die "symlink: $!";
+
+ is( lchown(123,456,'nosuch','foo'), 1, "nosuch,foo success for foo" );
+ ($uid,$gid) = (lstat 'foo')[4,5];
+ is( $uid, 123, "nosuch,foo set foo uid 123" );
+ is( $gid, 456, "nosuch,foo set foo gid 456" );
+
+ unlink 'foo' or die "unlink: $!";
+}
+
More information about the Pkg-perl-cvs-commits
mailing list