1 |
package SWE::DB::NamedText; |
2 |
use strict; |
3 |
|
4 |
sub new ($) { |
5 |
my $self = bless { |
6 |
root_directory_name => './', |
7 |
leaf_suffix => '.txt', |
8 |
}, shift; |
9 |
return $self; |
10 |
} # new |
11 |
|
12 |
sub _get_file_name ($$$) { |
13 |
my $self = shift; |
14 |
my $name = $_[0]; |
15 |
my $mkdir = $_[1]; |
16 |
|
17 |
my $encoded_name = $name; |
18 |
$encoded_name =~ s/([^0-9A-Za-z_-])/sprintf '@%06X', ord $1/ge; |
19 |
|
20 |
my $dir = $self->{root_directory_name}; |
21 |
my $file_name = $dir . '/' . $encoded_name . $self->{leaf_suffix}; |
22 |
|
23 |
unless ($mkdir) { |
24 |
return $file_name; |
25 |
} |
26 |
|
27 |
unless (-d $dir) { |
28 |
mkdir $dir or die "$0: $dir: $!"; |
29 |
} |
30 |
|
31 |
$self->{version_control}->add_directory ($dir) if $self->{version_control}; |
32 |
|
33 |
return $file_name; |
34 |
} # _get_file_name |
35 |
|
36 |
sub get_data ($$) { |
37 |
my $self = shift; |
38 |
my $file_name = $self->_get_file_name ($_[0]); |
39 |
|
40 |
unless (-f $file_name) { |
41 |
return undef; |
42 |
} |
43 |
|
44 |
open my $file, '<:encoding(utf8)', $file_name or die "$0: $file_name: $!"; |
45 |
local $/ = undef; |
46 |
return \ (<$file>); |
47 |
} # get_data |
48 |
|
49 |
sub set_data ($$$) { |
50 |
my $self = shift; |
51 |
my $file_name = $self->_get_file_name ($_[0], 1); |
52 |
my $textref = $_[1]; |
53 |
|
54 |
open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!"; |
55 |
print $file $$textref; |
56 |
close $file; |
57 |
|
58 |
$self->{version_control}->add_file ($file_name) if $self->{version_control}; |
59 |
} # set_data |
60 |
|
61 |
1; |