v0.5.1 release
[Fedora-Rebuild.git] / lib / Fedora / Rebuild / Package / StateLock.pm
blobb9429699de0217734e43ebb8415125201d91c5b0
1 package Fedora::Rebuild::Package::StateLock;
2 use strict;
3 use warnings;
4 use version 0.77; our $VERSION = version->declare("v0.5.1");
6 use Moose;
7 use Carp;
8 use Proc::SyncExec;
9 use POSIX;
10 use Data::Dumper;
11 use Storable qw(nstore_fd retrieve);
12 use DateTime;
13 use namespace::clean;
16 has package => (
17 is => 'ro',
18 isa => 'Fedora::Rebuild::Package',
19 required => 1
22 has state => (
23 is => 'ro',
24 isa => 'Str',
25 required => 1
28 has lockfile => (
29 is => 'ro',
30 isa => 'Str',
31 lazy_build => 1,
32 init_arg => undef
35 has logfile => (
36 is => 'ro',
37 isa => 'Str',
38 lazy_build => 1,
39 init_arg => undef
42 has logfd => (
43 is => 'ro',
44 isa => 'FileHandle',
45 lazy_build => 1,
46 init_arg => undef
48 sub BUILD {
49 my $self = shift;
51 if (! defined $self->state || $self->state eq '') {
52 croak "Invalid `state' attributed passed to StateLock constructor";
56 sub _build_lockfile {
57 my $self = shift;
58 return $self->package->packagedir . '/.' . $self->state;
61 sub _build_logfile {
62 my $self = shift;
63 return $self->lockfile. '.log';
66 sub _build_logfd {
67 my $self = shift;
68 my $file = IO::Handle->new();
69 open ($file, '>', $self->logfile) or
70 croak "Could not create `" . $self->logfile . "' logfile: $!";
71 return $file;
74 # Print array into log
75 sub lograw {
76 shift->logfd->print(@_);
79 # Print current time and array into log
80 sub log {
81 shift->lograw(DateTime->now, ' ', @_);
84 # Return true if state is finshed, otherwise open log file.
85 sub is_done {
86 my $self = shift;
88 if (-e $self->lockfile) {
89 return 1;
90 } else {
91 $self->logfd;
92 return 0;
96 # Remove lock file (if exists) without any other actions.
97 # Use mark_failed() to close log file too.
98 # Return value is not specified.
99 sub remove_lock {
100 my $self = shift;
101 if (-e $self->lockfile) { unlink $self->lockfile; }
104 # Fsync and close log file. Croaks on error.
105 sub close_log {
106 my $self=shift;
107 $self->logfd->sync && $self->logfd->close or
108 croak "Could not sync and close `" . $self->logile . "' logfile: $!";
111 # Create lock file signalling the state has been finished. is_done() return
112 # true then. Return true if succeeded.
113 sub mark_done {
114 my $self = shift;
115 $self->close_log;
116 my $file = IO::Handle->new();
117 open ($file, '>', $self->lockfile) or
118 croak "Could not open `" . $self->lockfile .
119 "' lockfile for writing: $!";
120 $file->sync && close($file) or
121 croak "Could not sync and close `" . $self->lockfile .
122 "' lockfile: $!";
123 return 1;
126 # Close log file. Remove lock file if exist. is_done() return false then.
127 # Return false.
128 sub mark_failed {
129 my $self = shift;
130 $self->close_log;
131 $self->remove_lock;
132 return 0;
135 # Convert ${^CHILD_ERROR_NATIVE} to string description.
136 # XXX: This is not a method.
137 sub child_error_as_string {
138 my $reason = ${^CHILD_ERROR_NATIVE};
139 if (WIFEXITED($reason)) {
140 $reason = "exit code " . WEXITSTATUS($reason);
141 } elsif (WIFSIGNALED($reason)) {
142 $reason = "signal " . WTERMSIG($reason);
144 return $reason;
147 # Format array of command with argument as quoted string
148 # XXX: This not a method
149 sub format_command {
150 $Data::Dumper::Indent=0;
151 $Data::Dumper::Terse=1;
152 return '(' . join(' ', map {Dumper($_)} @_) . ')';
155 # Run command while appending output to log. Blocks. If workdir is nonempty
156 # string, switch into it befere execution (and opening the log).
157 # Return true if command succeeds.
158 sub do {
159 my ($self, $workdir, @command) = @_;
161 my $redirect = sub {
162 open(STDOUT, '>&', $self->logfd->fileno) and
163 open(STDERR, '>&STDOUT');
164 $self->log("Executing: " . format_command(@command) . "\n");
165 if (defined $workdir && $workdir ne '' && !chdir $workdir) {
166 $self->log("Could not change directory to $workdir: $!\n");
167 return 0;
169 return 1;
171 my $pid = Proc::SyncExec::sync_exec($redirect, @command);
172 if (!defined $pid) {
173 $self->log("Could not execute " . format_command(@command) . ": $!\n");
174 return 0;
176 if ($pid != waitpid($pid, 0) || $?) {
177 $self->log("Command " . format_command(@command) . " failed: " .
178 child_error_as_string . "\n");
179 return 0;
181 $self->log("Command " . format_command(@command) .
182 " returned successfully.\n");
183 return 1;
186 # Run command while appending stderr and stdout to log and stdout to refered
187 # output argument. In case of empty command output fill empty string;
188 # Blocks. If workdir is nonempty string, switch into it befere execution
189 # (and opening the log).
190 # Return true if command succeeds.
191 sub dooutput {
192 my ($self, $workdir, $output, @command) = @_;
194 my ($parent, $child);
195 if (!pipe $child, $parent) {
196 $self->log("Could not get connected pipes for command " .
197 format_command(@command) . ": $!\n");
198 return 0;
201 my $redirect = sub {
202 close $child and
203 open(STDOUT, '>&', fileno $parent) and
204 close $parent and
206 open(STDERR, '>&', $self->logfd->fileno) and
207 $self->log("Executing: " . format_command(@command) . "\n");
208 if (defined $workdir && $workdir ne '' && !chdir $workdir) {
209 $self->log("Could not change directory to $workdir: $!\n");
210 return 0;
212 return 1;
214 my $pid = Proc::SyncExec::sync_exec($redirect, @command);
216 my $errno = $!;
217 close $parent;
218 $! = $errno;
220 if (!defined $pid) {
221 $self->log("Could not execute " . format_command(@command) . ": $!\n");
222 return 0;
225 for ($$output = ''; local $_ = <$child>;) {
226 $$output .= $_;
227 $self->lograw($_);
230 if ($pid != waitpid($pid, 0) || $?) {
231 $self->log("Command " . format_command(@command) . " failed: " .
232 child_error_as_string . "\n");
233 return 0;
236 $self->log("Command " . format_command(@command) .
237 " returned successfully.\n");
238 return 1;
241 # Serialize referenced variable into file identified by name.
242 # The file is recreated.
243 # Return true if command succeeds, otherwise false;
244 sub nstorereference {
245 my ($self, $reference, $filename) = @_;
247 unlink($filename);
248 my $file = IO::Handle->new();
249 if (! open($file, '>', $filename)) {
250 $self->log("Could not open `" . $filename . "' file for writing: $!\n");
251 return 0;
253 if (! eval { nstore_fd($reference, $file); }) {
254 $self->log("Could not store variable into `" . $filename .
255 "' file: $@\n");
256 close($file);
257 return 0;
259 if (!$file->sync or !close($file)) {
260 $self->log("Could not sync and close `" . $filename . "' file: $!\n");
261 return 0;
264 return 1;
267 # Load serialized variable from file identified by name.
268 # Return reference to the variable or undef in case of error.
269 sub retrievereference {
270 my ($self, $filename) = @_;
272 my $reference;
273 if (! eval { $reference = retrieve($filename); } || !$reference) {
274 $self->log("Could not load variable from `" . $filename .
275 "' file: $@\n");
276 return undef;
279 return $reference;