# ex:ts=8 sw=4:
-# $OpenBSD: State.pm,v 1.70 2021/03/02 10:59:20 espie Exp $
+# $OpenBSD: State.pm,v 1.71 2022/02/12 09:46:19 espie Exp $
#
# Copyright (c) 2007-2014 Marc Espie <espie@openbsd.org>
#
# common routines to everything state.
# in particular, provides "singleton-like" access to UI.
package OpenBSD::State;
-use Carp;
use OpenBSD::Subst;
use OpenBSD::Error;
-require Exporter;
-our @ISA = qw(Exporter);
+use parent qw(OpenBSD::BaseState Exporter);
our @EXPORT = ();
sub locator
return $s <= 0 || getpgrp() == $s;
});
-sub sync_display
-{
-}
-
OpenBSD::Auto::cache(installpath,
sub {
my $self = shift;
exit($code);
}
-my $forbidden = qr{[^[:print:]\s]};
-
-sub safe
-{
- my ($self, $string) = @_;
- $string =~ s/$forbidden/?/g;
- return $string;
-}
-
-sub f
-{
- my $self = shift;
- if (@_ == 0) {
- return undef;
- }
- my ($fmt, @l) = @_;
-
- # is there anything to format, actually ?
- if ($fmt =~ m/\#\d/) {
- # encode any unknown chars as ?
- for (@l) {
- s/$forbidden/?/g if defined;
- }
- # make it so that #0 is #
- unshift(@l, '#');
- $fmt =~ s,\#(\d+),($l[$1] // "<Undefined #$1>"),ge;
- }
- return $fmt;
-}
-
-sub _fatal
-{
- my $self = shift;
- # implementation note: to print "fatal errors" elsewhere,
- # the way is to eval { croak @_}; and decide what to do with $@.
- delete $SIG{__DIE__};
- $self->sync_display;
- croak @_, "\n";
-}
-
-sub fatal
-{
- my $self = shift;
- $self->_fatal($self->f(@_));
-}
-
-sub _fhprint
-{
- my $self = shift;
- my $fh = shift;
- $self->sync_display;
- print $fh @_;
-}
-sub _print
-{
- my $self = shift;
- $self->_fhprint(\*STDOUT, @_) if $self->can_output;
-}
-
-sub _errprint
-{
- my $self = shift;
- $self->_fhprint(\*STDERR, @_);
-}
-
-sub fhprint
-{
- my $self = shift;
- my $fh = shift;
- $self->_fhprint($fh, $self->f(@_));
-}
-
-sub fhsay
-{
- my $self = shift;
- my $fh = shift;
- if (@_ == 0) {
- $self->_fhprint($fh, "\n");
- } else {
- $self->_fhprint($fh, $self->f(@_), "\n");
- }
-}
-
-sub print
-{
- my $self = shift;
- $self->fhprint(\*STDOUT, @_) if $self->can_output;
-}
-
-sub say
-{
- my $self = shift;
- $self->fhsay(\*STDOUT, @_) if $self->can_output;
-}
-
-sub errprint
-{
- my $self = shift;
- $self->fhprint(\*STDERR, @_);
-}
-
-sub errsay
-{
- my $self = shift;
- $self->fhsay(\*STDERR, @_);
-}
-
sub do_options
{
my ($state, $sub) = @_;
}
});
-my @signal_name = ();
-sub fillup_names
-{
- {
- # XXX force autoload
- package verylocal;
-
- require POSIX;
- POSIX->import(qw(signal_h));
- }
-
- for my $sym (keys %POSIX::) {
- next unless $sym =~ /^SIG([A-Z].*)/;
- my $value = eval "&POSIX::$sym()";
- # skip over POSIX stuff we don't have like SIGRT or SIGPOLL
- next unless defined $value;
- $signal_name[$value] = $1;
- }
- # extra BSD signals
- $signal_name[5] = 'TRAP';
- $signal_name[7] = 'IOT';
- $signal_name[10] = 'BUS';
- $signal_name[12] = 'SYS';
- $signal_name[16] = 'URG';
- $signal_name[23] = 'IO';
- $signal_name[24] = 'XCPU';
- $signal_name[25] = 'XFSZ';
- $signal_name[26] = 'VTALRM';
- $signal_name[27] = 'PROF';
- $signal_name[28] = 'WINCH';
- $signal_name[29] = 'INFO';
-}
-
-sub find_signal
-{
- my $number = shift;
-
- if (@signal_name == 0) {
- fillup_names();
- }
-
- return $signal_name[$number] || $number;
-}
-
-sub child_error
-{
- my ($self, $error) = @_;
- $error //= $?;
-
- my $extra = "";
-
- if ($error & 128) {
- $extra = $self->f(" (core dumped)");
- }
- if ($error & 127) {
- return $self->f("killed by signal #1#2",
- find_signal($error & 127), $extra);
- } else {
- return $self->f("exit(#1)#2", ($error >> 8), $extra);
- }
-}
-
-sub _system
-{
- my $self = shift;
- $self->sync_display;
- my ($todo, $todo2);
- if (ref $_[0] eq 'CODE') {
- $todo = shift;
- } else {
- $todo = sub {};
- }
- if (ref $_[0] eq 'CODE') {
- $todo2 = shift;
- } else {
- $todo2 = sub {};
- }
- my $r = fork;
- if (!defined $r) {
- return 1;
- } elsif ($r == 0) {
- $DB::inhibit_exit = 0;
- &$todo;
- exec {$_[0]} @_ or
- exit 1;
- } else {
- &$todo2;
- waitpid($r, 0);
- return $?;
- }
-}
-
-sub system
-{
- my $self = shift;
- my $r = $self->_system(@_);
- if ($r != 0) {
- if (ref $_[0] eq 'CODE') {
- shift;
- }
- if (ref $_[0] eq 'CODE') {
- shift;
- }
- $self->errsay("system(#1) failed: #2",
- join(", ", @_), $self->child_error);
- }
- return $r;
-}
-
-sub verbose_system
-{
- my $self = shift;
- my @p = @_;
- if (ref $p[0]) {
- shift @p;
- }
- if (ref $p[0]) {
- shift @p;
- }
-
- $self->print("Running #1", join(' ', @p));
- my $r = $self->_system(@_);
- if ($r != 0) {
- $self->say("... failed: #1", $self->child_error);
- } else {
- $self->say;
- }
-}
-
-sub copy_file
-{
- my $self = shift;
- require File::Copy;
-
- my $r = File::Copy::copy(@_);
- if (!$r) {
- $self->say("copy(#1) failed: #2", join(',', @_), $!);
- }
- return $r;
-}
-
-sub unlink
-{
- my $self = shift;
- my $verbose = shift;
- my $r = unlink @_;
- if ($r != @_) {
- $self->say("rm #1 failed: removed only #2 targets, #3",
- join(' ', @_), $r, $!);
- } elsif ($verbose) {
- $self->say("rm #1", join(' ', @_));
- }
- return $r;
-}
-
-sub copy
-{
- my $self = shift;
- require File::Copy;
-
- my $r = File::Copy::copy(@_);
- if (!$r) {
- $self->say("copy(#1) failed: #2", join(',', @_), $!);
- }
- return $r;
-}
-
1;
-$OpenBSD: State.pod,v 1.2 2021/01/30 10:37:22 espie Exp $
+$OpenBSD: State.pod,v 1.3 2022/02/12 09:46:19 espie Exp $
=head1 NAME
Some methods can be used and overridden safely.
+See also C<OpenBSD::BaseState> which contains most of the stateless utility
+code like C<say> and friends.
+
=over 4
=item $class->new($cmdname, @params)
callback for C<SIGCONT>, to be overridden by subclasses if some specific
treatment (such as terminal redraw/reset) is needed.
+=item $state->sync_display
+
+hook to be overriden. Called by all the print functions prior to displaying
+anything. To be used to write things out cleanly (e.g., wipe out a
+progressmeter line prior to writing an error message, for instance)
+
+=item $state->system([child setup], [parent setup], @args)
+
+calls C<exec> without an extra shell, with optional code to be run on the
+child, and optional code to be run on the father, then wait for the child
+and write possible errors
+
+=item $state->verbose_system([child setup], [parent setup], @args)
+
+like system, except it always shows what it's running
+
+=item $state->copy_file(@names)
+
+verbose interface to C<File::Copy> with error reporting.
+
+=item $state->unlink(@names)
+
+verbose interface to C<unlink> with error reporting.
+
=back
=head1 BUGS
projects / openbsd / commitdiff