# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' BEGIN { $| = 1; print "1..13\n"; } END { print "not ok 1\n" unless $loaded;} use IO::LockedFile; use diagnostics; $loaded = 1; print "ok 1\n"; use Fcntl; use Cwd; my $file_path = cwd()."/locked1.txt"; ### check opening the file using the Perl mode ### # create an exclussive locked file my $file1 = new IO::LockedFile(">".$file_path); # check that the file is locked exclussively # try to open it to read if (my $pid = fork()) { wait; } else { # in the child process my $file2 = new IO::LockedFile({ block => 0 }, ">".$file_path); print_ok(!$file2, 2, "the file is locked exclussivly, ". "so we could not open it to write"); $file2 = new IO::LockedFile({ block => 0 }, $file_path); print_ok(!$file2, 3, "the file is locked exclussivly, ". "so we could not open it to read"); exit 0; # exit from that process and continue in the "wait" above } # close (and unlock) the file $file1 = undef; # create a shared locked file $file1 = new IO::LockedFile($file_path); # check that the file has a shared locked # try to open it to write if (my $pid = fork()) { wait; } else { # in the child process my $file2 = new IO::LockedFile({ block => 0 }, ">".$file_path); print_ok(!$file2, 4, "the file has a shared lock, ". "so we could not open it to write"); $file2 = new IO::LockedFile({ block => 0 }, $file_path); print_ok($file2, 5, "the file has a shared lock, ". "so we could open it to read"); exit 0; # exit from that process and continue in the "wait" above } # close (and unlock) the file $file1 = undef; ### check opening the file using Numeric mode ### # create an exclussive locked file $file1 = new IO::LockedFile($file_path, O_CREAT | O_TRUNC); # check that the file is locked exclussively # try to open it to read if (my $pid = fork()) { wait; } else { # in the child process my $file2 = new IO::LockedFile({ block => 0 }, $file_path, O_CREAT | O_TRUNC); print_ok(!$file2, 6, "the file is locked exclussivly, ". "so we could not open it to write"); $file2 = new IO::LockedFile({ block => 0 }, $file_path); print_ok(!$file2, 7, "the file is locked exclussivly, ". "so we could not open it to read"); exit 0; # exit from that process and continue in the "wait" above } # close (and unlock) the file $file1 = undef; # create a shared locked file $file1 = new IO::LockedFile($file_path); # check that the file has a shared locked # try to open it to write if (my $pid = fork()) { wait; } else { # in the child process my $file2 = new IO::LockedFile({ block => 0 }, $file_path, O_CREAT | O_TRUNC); print_ok(!$file2, 8, "the file has a shared lock, ". "so we could not open it to write"); $file2 = new IO::LockedFile({ block => 0 }, $file_path); print_ok($file2, 9, "the file has a shared lock, ". "so we could open it to read"); exit 0; # exit from that process and continue in the "wait" above } # close (and unlock) the file $file1 = undef; ### check opening the file using POSIX mode ### # create an exclussive locked file $file1 = new IO::LockedFile($file_path, "w"); # check that the file is locked exclussively # try to open it to read if (my $pid = fork()) { wait; } else { # in the child process my $file2 = new IO::LockedFile({ block => 0 }, $file_path, "w"); print_ok(!$file2, 10, "the file is locked exclussivly, ". "so we could not open it to write"); $file2 = new IO::LockedFile({ block => 0 }, $file_path, "r"); print_ok(!$file2, 11, "the file is locked exclussivly, ". "so we could not open it to read"); exit 0; # exit from that process and continue in the "wait" above } # close (and unlock) the file $file1 = undef; # create a shared locked file $file1 = new IO::LockedFile($file_path, "r"); # check that the file has a shared locked # try to open it to write if (my $pid = fork()) { wait; } else { # in the child process my $file2 = new IO::LockedFile({ block => 0 }, $file_path, "w"); print_ok(!$file2, 12, "the file has a shared lock, ". "so we could not open it to write"); $file2 = new IO::LockedFile({ block => 0 }, $file_path, "r"); print_ok($file2, 13, "the file has a shared lock, ". "so we could open it to read"); exit 0; # exit from that process and continue in the "wait" above } # close (and unlock) the file $file1 = undef; # remove the file unlink($file_path); ############################################# # print_ok ($expression, $number, $comment) ############################################# sub print_ok { my $expression = shift; my $number =shift; my $string = shift || ""; $string = "ok " . $number . " " . $string . "\n"; if (! $expression) { $string = "not " . $string; } print $string; } # print_ok