File: | Dpkg/File.pm |
Coverage: | 90.5% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright © 2011 Raphaël Hertzog <hertzog@debian.org> | ||||||
2 | # Copyright © 2012 Guillem Jover <guillem@debian.org> | ||||||
3 | # | ||||||
4 | # This program is free software; you can redistribute it and/or modify | ||||||
5 | # it under the terms of the GNU General Public License as published by | ||||||
6 | # the Free Software Foundation; either version 2 of the License, or | ||||||
7 | # (at your option) any later version. | ||||||
8 | # | ||||||
9 | # This program is distributed in the hope that it will be useful, | ||||||
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
12 | # GNU General Public License for more details. | ||||||
13 | # | ||||||
14 | # You should have received a copy of the GNU General Public License | ||||||
15 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | ||||||
16 | |||||||
17 | package Dpkg::File; | ||||||
18 | |||||||
19 | 61 61 61 | 367 289 2203 | use strict; | ||||
20 | 61 61 61 | 282 118 5720 | use warnings; | ||||
21 | |||||||
22 | our $VERSION = '0.01'; | ||||||
23 | our @EXPORT = qw( | ||||||
24 | file_slurp | ||||||
25 | file_dump | ||||||
26 | file_touch | ||||||
27 | ); | ||||||
28 | |||||||
29 | 61 61 61 | 340 113 2195 | use Exporter qw(import); | ||||
30 | 61 61 61 | 282 307 3300 | use Scalar::Util qw(openhandle); | ||||
31 | |||||||
32 | 61 61 61 | 2966 147 4276 | use Dpkg::ErrorHandling; | ||||
33 | 61 61 61 | 469 257 26716 | use Dpkg::Gettext; | ||||
34 | |||||||
35 | sub file_slurp { | ||||||
36 | 318 | 0 | 668 | my $file = shift; | |||
37 | 318 | 225 | my $fh; | ||||
38 | 318 | 343 | my $doclose = 0; | ||||
39 | |||||||
40 | 318 | 784 | if (openhandle($file)) { | ||||
41 | 11 | 11 | $fh = $file; | ||||
42 | } else { | ||||||
43 | 307 | 6259 | open $fh, '<', $file or syserr(g_('cannot read %s'), $fh); | ||||
44 | 306 | 519 | $doclose = 1; | ||||
45 | } | ||||||
46 | 317 | 977 | local $/; | ||||
47 | 317 | 3499 | my $data = <$fh>; | ||||
48 | 317 | 1833 | close $fh if $doclose; | ||||
49 | |||||||
50 | 317 | 1225 | return $data; | ||||
51 | } | ||||||
52 | |||||||
53 | sub file_dump { | ||||||
54 | 388 | 0 | 554 | my ($file, $data) = @_; | |||
55 | 388 | 244 | my $fh; | ||||
56 | 388 | 761 | my $doclose = 0; | ||||
57 | |||||||
58 | 388 | 886 | if (openhandle($file)) { | ||||
59 | 139 | 838 | $fh = $file; | ||||
60 | } else { | ||||||
61 | 249 | 8895 | open $fh, '>', $file or syserr(g_('cannot create file %s'), $file); | ||||
62 | 249 | 394 | $doclose = 1; | ||||
63 | } | ||||||
64 | 388 388 | 5574 909 | print { $fh } $data; | ||||
65 | 388 | 596 | if ($doclose) { | ||||
66 | 249 | 11137 | close $fh or syserr(g_('cannot write %s'), $file); | ||||
67 | } | ||||||
68 | |||||||
69 | 388 | 832 | return; | ||||
70 | } | ||||||
71 | |||||||
72 | sub file_touch { | ||||||
73 | 47 | 0 | 32 | my $file = shift; | |||
74 | |||||||
75 | 47 | 842 | open my $fh, '>', $file or syserr(g_('cannot create file %s'), $file); | ||||
76 | 47 | 199 | close $fh or syserr(g_('cannot write %s'), $file); | ||||
77 | } | ||||||
78 | |||||||
79 | 1; |