[Bio] / FigKernelPackages / FileLocking.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/FileLocking.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : overbeek 1.1
2 :     package FileLocking;
3 :    
4 :     #
5 :     # Package that uses fcntl to implement flock. Use this on systems that use
6 :     # GPFS to properly implement file locking between machines.
7 :     #
8 :     # Allows for a global override of flock.
9 :     #
10 :    
11 :     use Data::Dumper;
12 :     use strict;
13 :     use Carp;
14 :     use Fcntl qw/:DEFAULT :seek :flock/;
15 :     use Symbol 'qualify_to_ref';
16 :    
17 :     use vars qw(@ISA @EXPORT_OK @EXPORT);
18 :    
19 :     require Exporter;
20 :     @ISA = 'Exporter';
21 :    
22 : olson 1.2 @EXPORT_OK = qw(flock lock_file unlock_file lock_file_shared);
23 :     @EXPORT = qw(lock_file unlock_file lock_file_shared);
24 : overbeek 1.1
25 :     use FIG_Config;
26 :    
27 :     sub import {
28 :     my $pkg = shift;
29 :     return unless @_;
30 :    
31 :     my $sym = shift;
32 :     my $where = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
33 :     # print "IMPORT $pkg @_ to $where\n";
34 :     $pkg->export($where, $sym, @_);
35 :     }
36 :    
37 :     sub lock_file(*)
38 :     {
39 :     my($fh) = @_;
40 :    
41 :     $fh = qualify_to_ref($fh, caller());
42 :    
43 :     return FileLocking::flock($fh, LOCK_EX);
44 :     }
45 :    
46 : olson 1.2 sub lock_file_shared(*)
47 :     {
48 :     my($fh) = @_;
49 :    
50 :     $fh = qualify_to_ref($fh, caller());
51 :    
52 :     return FileLocking::flock($fh, LOCK_SH);
53 :     }
54 :    
55 : overbeek 1.1 sub unlock_file(*)
56 :     {
57 :     my($fh) = @_;
58 :    
59 :     $fh = qualify_to_ref($fh, caller());
60 :    
61 :     return FileLocking::flock($fh, LOCK_UN);
62 :     }
63 :    
64 :    
65 :     sub flock(*$)
66 :     {
67 :     my($fh, $op) = @_;
68 :    
69 :     $fh = qualify_to_ref($fh, caller());
70 :    
71 :     if ($FIG_Config::fcntl_locking)
72 :     {
73 :     return fcntl_flock($fh, $op);
74 :     }
75 :     else
76 :     {
77 :     return CORE::flock($fh, $op);
78 :     }
79 :     }
80 :    
81 :     sub fcntl_flock(*$)
82 :     {
83 :     my($fh, $op) = @_;
84 :    
85 :     $fh = qualify_to_ref($fh, caller());
86 :     # print "flock: fh='$fh' op='$op' fno=" . fileno($fh) . "\n";
87 :    
88 :     if ($op == LOCK_EX)
89 :     {
90 :     my $arg = pack("ssll", F_WRLCK, SEEK_SET, 0, 0);
91 :     my $rc = fcntl($fh, F_SETLKW, $arg);
92 :     # print "flock: LOCK_EX returns $rc\n";
93 :     return $rc;
94 :     }
95 :     elsif ($op == LOCK_SH)
96 :     {
97 :     my $arg = pack("ssll", F_RDLCK, SEEK_SET, 0, 0);
98 :     my $rc = fcntl($fh, F_SETLKW, $arg);
99 :     # print "flock: LOCK_SH returns $rc\n";
100 :     return $rc;
101 :     }
102 :     elsif ($op == LOCK_UN)
103 :     {
104 :     my $arg = pack("ssll", F_UNLCK, SEEK_SET, 0, 0);
105 :     my $rc = fcntl($fh, F_SETLKW, $arg);
106 :     # print "flock: LOCK_UN returns $rc\n";
107 :     return $rc;
108 :     }
109 :     else
110 :     {
111 :     confess "flock: invalid operation $op";
112 :     }
113 :     }
114 :    
115 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3