GNOME.org
 

[gimp-perl] Multi-level verbose.

commit 55505378cddc32360b5f9e6017495406ae065365
Author: Ed J <edj src gnome org>
Date:   Thu May 15 19:34:29 2014 +0100

    Multi-level verbose.

 Gimp.pm     |   32 ++++++++++++++++++--------------
 Gimp/Fu.pm  |   14 +++++++-------
 Gimp/Lib.pm |    4 ++--
 Gimp/Pod.pm |    6 +++---
 Net/Net.pm  |   10 +++++-----
 5 files changed, 35 insertions(+), 31 deletions(-)
---
diff --git a/Gimp.pm b/Gimp.pm
index 8c7bc00..5e40d57 100644
--- a/Gimp.pm
+++ b/Gimp.pm
@@ -38,7 +38,7 @@ my $net_init;
 
 sub import($;@) {
    my $pkg = shift;
-   warn "$$-$pkg->import(@_)" if $Gimp::verbose;
+   warn "$$-$pkg->import(@_)" if $Gimp::verbose >= 2;
    my $up = caller;
    my @export;
 
@@ -52,7 +52,7 @@ sub import($;@) {
    # do this here as not guaranteed access to GIMP before
    require Gimp::Constant;
    if (not defined &{$Gimp::Constant::EXPORT[-1]}) {
-     warn "$$-Loading constants" if $Gimp::verbose;
+     warn "$$-Loading constants" if $Gimp::verbose >= 2;
      # now get constants from GIMP
      import Gimp::Constant;
    }
@@ -145,7 +145,7 @@ if (@ARGV) {
 Usage: $basename [gimp-args...] [interface-args...] [script-args...]
        gimp-arguments are
            -h | -help | --help | -?   print some help
-           -v | --verbose             be more verbose in what you do
+           -v | --verbose             verbose flag (ok more than once)
            --host|--tcp HOST[:PORT]   connect to HOST (optionally using PORT)
                                       (for more info, see Gimp::Net(3))
 EOF
@@ -172,7 +172,7 @@ sub cbchain {
 }
 
 sub callback {
-  warn "$$-Gimp::callback(@_)" if $Gimp::verbose;
+  warn "$$-Gimp::callback(@_)" if $Gimp::verbose >= 2;
   my $type = shift;
   my @cb;
   if ($type eq "-run") {
@@ -184,7 +184,7 @@ sub callback {
     for (@cb) {
       @retvals = &$_;
     }
-    warn "$$-Gimp::callback returning(@retvals)" if $Gimp::verbose;
+    warn "$$-Gimp::callback returning(@retvals)" if $Gimp::verbose >= 2;
     @retvals;
   } elsif ($type eq "-net") {
     @cb = cbchain(qw(run net));
@@ -194,7 +194,7 @@ sub callback {
     for (@cb) {
       @retvals = &$_;
     }
-    warn "$$-Gimp::callback returning(@retvals)" if $Gimp::verbose;
+    warn "$$-Gimp::callback returning(@retvals)" if $Gimp::verbose >= 2;
     @retvals;
   } elsif ($type eq "-query") {
     @cb = cbchain(qw(query));
@@ -208,7 +208,7 @@ sub callback {
 
 sub register_callback($$) {
    push @{$callback{$_[0]}}, $_[1];
-   warn "$$-register_callback(@_)" if $Gimp::verbose;
+   warn "$$-register_callback(@_)" if $Gimp::verbose >= 2;
 }
 
 sub on_query(&) { register_callback "query", $_[0] }
@@ -234,7 +234,7 @@ warn "$$-Using interface '$interface_type'" if $Gimp::verbose;
 
 eval "require $interface_pkg" or croak $@;
 $interface_pkg->import;
-warn "$$-Finished loading '$interface_pkg'" if $Gimp::verbose;
+warn "$$-Finished loading '$interface_pkg'" if $Gimp::verbose >= 2;
 
 # create some common aliases
 for(qw(gimp_procedural_db_proc_exists gimp_call_procedure set_trace initialized)) {
@@ -264,7 +264,7 @@ sub exception_strip {
 }
 sub AUTOLOAD {
   my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
-  warn "$$-AUTOLOAD $AUTOLOAD(@_)" if $Gimp::verbose;
+  warn "$$-AUTOLOAD $AUTOLOAD(@_)" if $Gimp::verbose >= 2;
   for(@{"$class\::PREFIXES"}) {
     my $sub = $_.$name;
     if (exists $ignore_function{$sub}) {
@@ -288,7 +288,7 @@ sub AUTOLOAD {
       goto &$AUTOLOAD;
     } elsif (gimp_procedural_db_proc_exists($sub)) {
       *{$AUTOLOAD} = sub {
-       warn "$$-gimp_call_procedure{0}(@_)" if $Gimp::verbose;
+       warn "$$-gimp_call_procedure{0}(@_)" if $Gimp::verbose >= 2;
        shift unless ref $_[0];
        unshift @_, $sub;
        warn "$$-gimp_call_procedure{1}(@_)" if $Gimp::verbose;
@@ -1054,14 +1054,18 @@ How to debug your scripts:
 
 =item $Gimp::verbose
 
-If set to true, will make Gimp-Perl say what it's doing on STDOUT. It will
-also stop L<Gimp::Net>'s normal behaviour of the server-side closing
-STDIN, STDOUT and STDERR. If you want it to be set during loading C<Gimp.pm>,
-make sure to do so in a prior C<BEGIN> block:
+If set to true, will make Gimp-Perl say what it's doing on STDERR.
+If you want it to be set during loading C<Gimp.pm>, make sure to do so
+in a prior C<BEGIN> block:
 
  BEGIN { $Gimp::verbose = 1; }
  use Gimp;
 
+Currently two levels of verbosity are supported:
+
+  1: some info - generally things done only once
+  2: all the info
+
 =item Gimp::set_trace (tracemask)
 
 You can switch on tracing to see which parameters are used to call PDB
diff --git a/Gimp/Fu.pm b/Gimp/Fu.pm
index 5779ec7..6feda6a 100644
--- a/Gimp/Fu.pm
+++ b/Gimp/Fu.pm
@@ -110,7 +110,7 @@ FILTER {
    return unless /$podreg_re/;
    my $myline = make_arg_line(insert_params(fixup_args(('') x 9, 1)));
    s/$podreg_re/$1\n$myline/;
-   warn __PACKAGE__."::FILTER: found: '$1'" if $Gimp::verbose;
+   warn __PACKAGE__."::FILTER: found: '$1'" if $Gimp::verbose >= 2;
 };
 
 @EXPORT_OK = qw($run_mode save_image);
@@ -266,7 +266,7 @@ Gimp::on_net {
 };
 
 sub datatype(@) {
-   warn __PACKAGE__."::datatype(@_)" if $Gimp::verbose;
+   warn __PACKAGE__."::datatype(@_)" if $Gimp::verbose >= 2;
    for(@_) {
       return Gimp::PDB_STRING unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; # perlfaq4
       return Gimp::PDB_FLOAT  unless /^[+-]?\d+$/; # again
@@ -371,7 +371,7 @@ sub register($$$$$$$$$;@) {
            die __"menupath _must_ start with <Image>, <Load>, <Save>, <Toolbox>/Xtns/, or <None>!";
          }
       }
-      warn "perlsub: rm=$run_mode" if $Gimp::verbose;
+      warn "perlsub: rm=$run_mode" if $Gimp::verbose >= 2;
       if ($run_mode == Gimp::RUN_INTERACTIVE
           || $run_mode == Gimp::RUN_WITH_LAST_VALS) {
          my $fudata = $Gimp::Data{"$function/_fu_data"};
@@ -380,7 +380,7 @@ sub register($$$$$$$$$;@) {
            my $script_savetime = stat("$RealBin/$RealScript")->mtime;
            undef $fudata if $script_savetime > $data_savetime;
         }
-        if ($Gimp::verbose) {
+        if ($Gimp::verbose >= 2) {
            require Data::Dumper;
            warn "$$-retrieved fudata: ", Data::Dumper::Dumper($fudata);
         }
@@ -405,14 +405,14 @@ sub register($$$$$$$$$;@) {
          die __"run_mode must be INTERACTIVE, NONINTERACTIVE or RUN_WITH_LAST_VALS\n";
       }
 
-      if ($Gimp::verbose) {
+      if ($Gimp::verbose >= 2) {
         require Data::Dumper;
         warn "$$-storing fudata: ", Data::Dumper::Dumper(\ _);
       }
       $Gimp::Data{"$function/_fu_data"}=[time, @_];
 
       warn "$$-Gimp::Fu-generated sub: $function(",join(",",(@pre,@_)),")\n"
-        if $Gimp::verbose;
+        if $Gimp::verbose >= 2;
 
       my @retvals = $code->(@pre,@_);
       Gimp->displays_flush;
@@ -424,7 +424,7 @@ sub register($$$$$$$$$;@) {
 
 sub save_image($$) {
    my($img,$path)= _;
-   print "saving image $path\n" if $Gimp::verbose;
+   warn "saving image $path\n" if $Gimp::verbose;
    my $flatten=0;
    my $interlace=0;
    my $quality=0.75;
diff --git a/Gimp/Lib.pm b/Gimp/Lib.pm
index 9359691..7a1403a 100644
--- a/Gimp/Lib.pm
+++ b/Gimp/Lib.pm
@@ -17,7 +17,7 @@ use subs qw(
 );
 
 sub gimp_init {
-   Gimp::croak Gimp::_("gimp_init not implemented for the Lib interface");
+   Gimp::croak Gimp::__("gimp_init not implemented for the Lib interface");
 }
 
 sub gimp_end {
@@ -80,7 +80,7 @@ sub gimp_drawable_bounds {
    (@b[0,1],$b[2]-$b[0],$b[3]-$b[1]);
 }
 
-warn "$$-Finished loading ".__PACKAGE__ if $Gimp::verbose;
+warn "$$-Finished loading ".__PACKAGE__ if $Gimp::verbose >= 2;
 
 1;
 __END__
diff --git a/Gimp/Pod.pm b/Gimp/Pod.pm
index a6d8448..fc45510 100644
--- a/Gimp/Pod.pm
+++ b/Gimp/Pod.pm
@@ -40,7 +40,7 @@ sub sections { $_[0]->_cache =~ /^\S.*$/mg; }
 
 sub section {
    my $self = shift;
-   warn __PACKAGE__."::section(@_)" if $Gimp::verbose;
+   warn __PACKAGE__."::section(@_)" if $Gimp::verbose >= 2;
    return unless defined(my $doc = $self->_cache);
    ($doc) = $doc =~ /^$_[0]\n(.*?)(?:^[A-Z]|\Z)/sm;
    if ($doc) {
@@ -50,7 +50,7 @@ sub section {
       $doc =~ s/^    //mg;
       chomp $doc;
    }
-   warn __PACKAGE__."::section returning '$doc'" if $Gimp::verbose;
+   warn __PACKAGE__."::section returning '$doc'" if $Gimp::verbose >= 2;
    $doc;
 }
 
@@ -95,7 +95,7 @@ sub make_arg_line {
    return '' unless @{$p[8]};
    die "$0: parameter had empty string\n" if grep { !length $_->[1] } @{$p[8]};
    my $myline = 'my ('.join(',', map { '$'.$_->[1] } @{$p[8]}).') = @_;';
-   warn __PACKAGE__."::make_arg_line: $myline" if $Gimp::verbose;
+   warn __PACKAGE__."::make_arg_line: $myline" if $Gimp::verbose >= 2;
    $myline;
 }
 
diff --git a/Net/Net.pm b/Net/Net.pm
index 64f901b..12af4fd 100644
--- a/Net/Net.pm
+++ b/Net/Net.pm
@@ -161,7 +161,7 @@ sub start_server {
 
 sub try_connect {
    local $_=$_[0];
-   warn "$$-".__PACKAGE__."::try_connect(@_)" if $Gimp::verbose;
+   warn "$$-".__PACKAGE__."::try_connect(@_)" if $Gimp::verbose >= 2;
    my $fh;
    $auth = s/^(.*)\@// ? $1 : "";      # get authorization
    if ($_ eq "") {
@@ -212,11 +212,11 @@ sub gimp_init {
             unless $auth;
          my @r = command "AUTH", $auth;
          die __"authorization failed: $r[1]\n" unless $r[0];
-         print __"authorization ok, but: $r[1]\n" if $Gimp::verbose and $r[1];
+         print __"authorization ok, but: $r[1]\n" if $Gimp::verbose >= 2 and $r[1];
       }
    }
    $initialized = 1;
-   warn "$$-Finished gimp_init(@_)" if $Gimp::verbose;
+   warn "$$-Finished gimp_init(@_)" if $Gimp::verbose >= 2;
 }
 
 sub gimp_end {
@@ -290,7 +290,7 @@ sub handle_request($) {
       read($fh,$req,4) == 4 or die "4\n";
       read($fh,$data,$length-4) == $length-4 or die "5\n";
    };
-   warn "$$-handle_request got '$@'" if $@ and $Gimp::verbose;
+   warn "$$-handle_request got '$@'" if $@ and $Gimp::verbose >= 2;
    return 0 if $@;
    my @args = net2args(($req eq "TRCE" or $req eq "EXEC"), $data);
    if(!$auth or $authorized[fileno($fh)]) {
@@ -359,7 +359,7 @@ sub on_accept {
 }
 
 sub on_input {
-  warn "$$-on_input(@_)" if $Gimp::verbose;
+  warn "$$-on_input(@_)" if $Gimp::verbose >= 2;
   my ($fd, $condition, $fh) = @_;
   if (handle_request($fh)) {
     return ++$stats{$fd}[0]; # non-false!
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]