Adding upstream version 2.23.4+deb12u1.upstream/2.23.4+deb12u1upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 83 insertions, 0 deletions

diff --git a/lib/Devscripts/Output.pm b/lib/Devscripts/Output.pm
new file mode 100644
index 0000000..6ef2947
--- /dev/null
+++ b/lib/Devscripts/Output.pm
@@ -0,0 +1,83 @@
+package Devscripts::Output;
+
+use strict;
+use Exporter 'import';
+use File::Basename;
+use constant accept => qr/^y(?:es)?\s*$/i;
+use constant refuse => qr/^n(?:o)?\s*$/i;
+
+our @EXPORT = (
+    qw(ds_debug ds_extra_debug ds_verbose ds_warn ds_error
+      ds_die ds_msg who_called $progname $verbose
+      ds_prompt accept refuse $ds_yes)
+);
+
+# ACCESSORS
+our ($verbose, $die_on_error, $ds_yes) = (0, 1, 0);
+
+our $progname = basename($0);
+
+sub printwarn {
+    my ($msg, $w) = @_;
+    chomp $msg;
+    if ($w) {
+        print STDERR "$msg\n";
+    } else {
+        print "$msg\n";
+    }
+}
+
+sub ds_msg {
+    my $msg = $_[0];
+    printwarn("$progname: $msg", $_[1]);
+}
+
+sub ds_verbose {
+    my $msg = $_[0];
+    if ($verbose > 0) {
+        printwarn("$progname info: $msg", $_[1]);
+    }
+}
+
+sub who_called {
+    return '' unless ($verbose > 1);
+    my @out = caller(1);
+    return " [$out[0]: $out[2]]";
+}
+
+sub ds_warn {
+    my $msg = $_[0];
+    printwarn("$progname warn: $msg" . who_called, 1);
+}
+
+sub ds_debug {
+    my $msg = $_[0];
+    printwarn("$progname debug: $msg", $_[1]) if $verbose > 1;
+}
+
+sub ds_extra_debug {
+    my $msg = $_[0];
+    printwarn("$progname debug: $msg", $_[1]) if $verbose > 2;
+}
+
+*ds_die = \&ds_error;
+
+sub ds_error {
+    my $msg = $_[0];
+    $msg = "$progname error: $msg" . who_called;
+    if ($die_on_error) {
+        print STDERR "$msg\n";
+        exit 1;
+    }
+    printwarn($msg, 1);
+}
+
+sub ds_prompt {
+    return 'yes' if ($ds_yes > 0);
+    print STDERR shift;
+    my $s = <STDIN>;
+    chomp $s;
+    return $s;
+}
+
+1;