1#!perl -w 2 3# Before `make install' is performed this script should be runnable with 4# `make test'. After `make install' it should work as `perl Linux-xattr.t' 5 6########################## 7 8# change 'tests => 2' to 'tests => last_test_to_print'; 9 10use strict; 11use Test::More; 12 13BEGIN { 14 my $tlib = $0; 15 $tlib =~ s|/[^/]*$|/lib|; 16 push(@INC, $tlib); 17} 18use t::Support; 19 20if (t::Support::should_skip()) { 21 plan skip_all => 'Tests unsupported on this OS/filesystem'; 22} else { 23 plan tests => 6; 24} 25 26use File::Temp qw(tempfile); 27use File::Path; 28use File::ExtAttr qw(setfattr getfattr delfattr); 29use IO::File; 30 31my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); 32my ($fh, $filename) = tempfile( DIR => $TESTDIR ); 33 34close $fh or die "can't close $filename $!"; 35 36# Create a directory. 37my $dirname = "$filename.dir"; 38eval { mkpath($dirname); }; 39if ($@) { 40 warn "Couldn't create $dirname: $@"; 41} 42 43#todo: try wierd characters in here? 44# try unicode? 45my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; 46my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; 47 48########################## 49# Filename-based tests # 50########################## 51 52foreach ( $filename, $dirname ) { 53 print "# using $_\n"; 54 55 #create and replace it -- should fail 56 undef $@; 57 eval { setfattr($_, "$key", $val, { create => 1, replace => 1 }); }; 58 isnt ($@, undef); 59 60 #check that it's not been created 61 is (getfattr($_, "$key"), undef); 62} 63 64########################## 65# IO::Handle-based tests # 66########################## 67 68$fh = new IO::File("<$filename") or die "Unable to open $filename"; 69 70print "# using file descriptor ".$fh->fileno()."\n"; 71 72my $key2 = $key.'2'; 73 74#create and replace it -- should fail 75undef $@; 76eval { setfattr($fh, $key2, $val, { create => 1, replace => 1 }); }; 77isnt ($@, undef); 78 79#check that it's not been created 80is (getfattr($fh, $key2), undef); 81 82END { 83 unlink $filename if $filename; 84 rmdir $dirname if $dirname; 85}; 86