line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################### |
2
|
|
|
|
|
|
|
# Purpose : Default (unrestricted) File I/O policies |
3
|
|
|
|
|
|
|
# Author : John Alden |
4
|
|
|
|
|
|
|
# Created : March 2005 |
5
|
|
|
|
|
|
|
# CVS : $Id: Default.pm,v 1.6 2005/05/18 15:57:28 johna Exp $ |
6
|
|
|
|
|
|
|
############################################################################### |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package File::Policy::Default; |
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
79
|
|
11
|
2
|
|
|
2
|
|
2034
|
use File::Spec::Functions; |
|
2
|
|
|
|
|
10680
|
|
|
2
|
|
|
|
|
239
|
|
12
|
2
|
|
|
2
|
|
15
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
145
|
|
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
8
|
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
529
|
|
15
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
16
|
|
|
|
|
|
|
@EXPORT_OK = qw(get_temp_dir get_log_dir check_safe); |
17
|
|
|
|
|
|
|
%EXPORT_TAGS = ('all' => \@EXPORT_OK); |
18
|
|
|
|
|
|
|
$VERSION = sprintf"%d.%03d", q$Revision: 1.6 $ =~ /: (\d+)\.(\d+)/; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub get_temp_dir { |
21
|
1
|
|
33
|
1
|
1
|
545
|
return $ENV{TEMP} || File::Spec::Functions::tmpdir(); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub get_log_dir { |
25
|
1
|
|
50
|
1
|
1
|
6
|
return $ENV{LOGDIR} || File::Spec::Functions::curdir(); |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub check_safe { |
29
|
35
|
|
|
35
|
1
|
70
|
my ($name, $mode) = @_; |
30
|
35
|
50
|
66
|
|
|
175
|
croak("mode must be r or w") unless($mode eq 'r' || $mode eq 'w'); |
31
|
35
|
|
|
|
|
76
|
return 1; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
1; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 NAME |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
File::Policy::Default - Default policy for file I/O functions |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 SYNOPSIS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use File::Policy; |
43
|
|
|
|
|
|
|
use File::Policy qw/check_safe/; # to import a specific subroutine |
44
|
|
|
|
|
|
|
use File::Policy qw/:all/; # to import all subroutines |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
#Checking I/O policy |
47
|
|
|
|
|
|
|
check_safe($filename, 'r'); |
48
|
|
|
|
|
|
|
check_safe($filename, 'w'); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#Portable directory locations |
51
|
|
|
|
|
|
|
$logdir = get_log_dir(); |
52
|
|
|
|
|
|
|
$tmpdir = get_temp_dir(); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 DESCRIPTION |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
This defines the default (unrestricted) policy for file I/O with modules such as File::Slurp::WithinPolicy. |
57
|
|
|
|
|
|
|
You may replace this default policy with one for your organisation. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 FUNCTIONS |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=over 4 |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=item check_safe |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
check_safe( FILENAME , MODE ); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Checks a filename is safe - dies if not. MODE is r (read) or w (write). |
68
|
|
|
|
|
|
|
Default is no restrictions on file I/O. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item get_temp_dir |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
$temporary_directory = get_temp_dir(); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Returns the path to temporary directory from the TEMP environment variable or File::Spec::Functions::tmpdir(). |
75
|
|
|
|
|
|
|
Note that any return value will have been cleared of a trailing slash. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item get_log_dir |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$log_directory = get_log_dir(); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Returns the path to log directory from the LOGDIR environment variable or the current directory. |
82
|
|
|
|
|
|
|
Note that any return value will have been cleared of a trailing slash. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=back |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 VERSION |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
$Revision: 1.6 $ on $Date: 2005/05/18 15:57:28 $ by $Author: johna $ |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head1 AUTHOR |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
John Alden |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 COPYRIGHT |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
(c) BBC 2005. This program is free software; you can redistribute it and/or modify it under the GNU GPL. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=cut |