File Coverage

File:Dpkg/File.pm
Coverage:90.5%

linestmtbrancondsubpodtimecode
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=encoding utf8
18
19 - 29
=head1 NAME

Dpkg::File - file handling

=head1 DESCRIPTION

This module provides file handling support functions.

B<Note>: This is a private module, its API can change at any time.

=cut
30
31package Dpkg::File 0.01;
32
33
270
270
270
270
987
313
5418
use strict;
34
270
270
270
270
1621
395
18975
use warnings;
35
36our @EXPORT = qw(
37    file_slurp
38    file_dump
39    file_touch
40);
41
42
270
270
270
270
766
700
5932
use Exporter qw(import);
43
270
270
270
270
820
213
9385
use Scalar::Util qw(openhandle);
44
45
270
270
270
270
10563
427
11907
use Dpkg::ErrorHandling;
46
270
270
270
270
720
258
55337
use Dpkg::Gettext;
47
48sub file_slurp {
49
1650
1650
0
2241
    my $file = shift;
50
1650
1909
    my $fh;
51
1650
2397
    my $doclose = 0;
52
53
1650
100
5493
    if (openhandle($file)) {
54
33
31
        $fh = $file;
55    } else {
56
1617
100
43410
        open $fh, '<', $file or syserr(g_('cannot read %s'), $fh);
57
1614
3161
        $doclose = 1;
58    }
59
1647
6505
    local $/;
60
1647
18995
    my $data = <$fh>;
61
1647
100
10439
    close $fh if $doclose;
62
63
1647
8795
    return $data;
64}
65
66sub file_dump {
67
1860
1860
0
4751
    my ($file, $data) = @_;
68
1860
12021
    my $fh;
69
1860
9878
    my $doclose = 0;
70
71
1860
100
4977
    if (openhandle($file)) {
72
3
10
        $fh = $file;
73    } else {
74
1857
50
118811
        open $fh, '>', $file or syserr(g_('cannot create file %s'), $file);
75
1857
3565
        $doclose = 1;
76    }
77
1860
1860
2009
10264
    print { $fh } $data;
78
1860
100
6858
    if ($doclose) {
79
1857
50
42468
        close $fh or syserr(g_('cannot write %s'), $file);
80    }
81
82
1860
9295
    return;
83}
84
85sub file_touch {
86
1599
1599
0
14023
    my $file = shift;
87
88
1599
50
56618
    open my $fh, '>', $file or syserr(g_('cannot create file %s'), $file);
89
1599
50
12906
    close $fh or syserr(g_('cannot write %s'), $file);
90}
91
92 - 98
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
99
1001;