File Coverage

blib/lib/Metabrik/File/Write.pm
Criterion Covered Total %
statement 9 72 12.5
branch 0 44 0.0
condition 0 14 0.0
subroutine 3 10 30.0
pod 2 7 28.5
total 14 147 9.5


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::write Brik
5             #
6             package Metabrik::File::Write;
7 5     5   39 use strict;
  5         10  
  5         149  
8 5     5   25 use warnings;
  5         8  
  5         156  
9              
10 5     5   44 use base qw(Metabrik);
  5         10  
  5         4644  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             output => [ qw(file) ],
20             append => [ qw(0|1) ],
21             overwrite => [ qw(0|1) ],
22             encoding => [ qw(utf8|ascii) ],
23             fd => [ qw(file_descriptor) ],
24             unbuffered => [ qw(0|1) ],
25             use_locking => [ qw(0|1) ],
26             },
27             attributes_default => {
28             append => 1,
29             overwrite => 0,
30             unbuffered => 0,
31             use_locking => 0,
32             },
33             commands => {
34             open => [ qw(file|OPTIONAL) ],
35             lock => [ ],
36             unlock => [ ],
37             write => [ qw($data|$data_ref|$data_list) ],
38             close => [ ],
39             },
40             require_modules => {
41             Fcntl => [ qw(:flock) ],
42             },
43             };
44             }
45              
46             sub brik_use_properties {
47 0     0 1   my $self = shift;
48              
49             # encoding: see `perldoc Encode::Supported' for other types
50             return {
51 0   0       attributes_default => {
52             encoding => defined($self->global) && $self->global->encoding || 'utf8',
53             },
54             };
55             }
56              
57             sub open {
58 0     0 0   my $self = shift;
59 0           my ($output) = @_;
60              
61 0   0       $output ||= $self->output;
62 0 0         $self->brik_help_run_undef_arg('open', $output) or return;
63              
64 0           my $encoding = $self->encoding;
65 0 0         if ($encoding eq 'ascii') {
66 0           $encoding = '';
67             }
68              
69 0           my $out;
70 0 0 0       if ($self->append) {
    0 0        
    0 0        
71 0           my $r = open($out, ">>$encoding", $output);
72 0 0         if (! defined($r)) {
73 0           return $self->log->error("open: open: append file [$output]: $!");
74             }
75             }
76             elsif (! $self->append && $self->overwrite) {
77 0           my $r = open($out, ">$encoding", $output);
78 0 0         if (! defined($r)) {
79 0           return $self->log->error("open: open: write file [$output]: $!");
80             }
81             }
82             elsif (! $self->append && ! $self->overwrite && -f $output) {
83 0           $self->log->info("open: we will not overwrite an existing file. See:");
84 0           return $self->log->error($self->brik_help_set('overwrite'));
85             }
86              
87 0           my $previous_default = select(STDOUT);
88 0           select($out);
89 0 0         $| = $self->unbuffered ? 1 : 0;
90 0           select($previous_default);
91              
92 0           $self->log->debug("open: fd [$out]");
93              
94 0           return $self->fd($out);
95             }
96              
97             sub close {
98 0     0 0   my $self = shift;
99              
100 0 0         if (defined($self->fd)) {
101 0           close($self->fd);
102 0           $self->fd(undef);
103             }
104              
105 0           return 1;
106             }
107              
108             sub lock {
109 0     0 0   my $self = shift;
110              
111 0 0         my $fd = $self->fd or return 1;
112              
113 0           my $r = flock($fd, Fcntl::LOCK_EX());
114 0 0         if (! defined($r)) {
115 0           return $self->log->error("lock: flock: locking failed: $!");
116             }
117              
118 0           $r = seek($fd, 0, Fcntl::SEEK_END());
119 0 0         if (! defined($r)) {
120 0           return $self->log->error("lock: seek: seeking failed: $!");
121             }
122              
123 0           $self->log->debug("lock: locking fd");
124              
125 0           return 1;
126             }
127              
128             sub unlock {
129 0     0 0   my $self = shift;
130              
131 0 0         my $fd = $self->fd or return 1;
132              
133 0           my $r = flock($fd, Fcntl::LOCK_UN());
134 0 0         if (! defined($r)) {
135 0           return $self->log->error("lock: flock: unlocking failed: $!");
136             }
137              
138 0           $self->log->debug("unlock: unlocking fd");
139              
140 0           return 1;
141             }
142              
143             sub write {
144 0     0 0   my $self = shift;
145 0           my ($data) = @_;
146              
147 0           my $fd = $self->fd;
148 0 0         $self->brik_help_run_undef_arg('open', $fd) or return;
149 0 0         $self->brik_help_run_undef_arg('write', $data) or return;
150              
151 0 0         if ($self->use_locking) {
152 0 0         $self->lock or return;
153             }
154              
155 0           $self->log->debug("write: data[$data]");
156              
157 0 0         if (ref($data) eq 'ARRAY') {
158 0           for my $this (@$data) {
159 0           print $fd $this."\n";
160             }
161             }
162             else {
163 0 0         ref($data) eq 'SCALAR' ? print $fd $$data : print $fd $data;
164             }
165              
166 0 0         if ($self->use_locking) {
167 0 0         $self->unlock or return;
168             }
169              
170 0           return $data;
171             }
172              
173             1;
174              
175             __END__