summaryrefslogtreecommitdiffstats
path: root/lib/Devscripts/Output.pm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Devscripts/Output.pm83
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;