Hack pour se donner la possibilite de charger ZincDebug sans modifier le code,

de la maniere suivante : perl -MZincDebug script.pl

1 files changed, 60 insertions, 3 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index e7c3909..8eb5ef3 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -1,6 +1,7 @@
 #        ZincDebug Perl Module :
 #
-#        For debugging/analysing a Zinc application
+#        For debugging/analysing a Zinc application. Only one instance
+#        of zinc can be managed.
 #
 #        Author : Daniel Etienne <etienne@cena.fr>
 #
@@ -9,7 +10,7 @@
 package ZincDebug;
 
 use strict 'vars';
-use vars qw(@ISA @EXPORT $WARNING);
+use vars qw(@ISA @EXPORT @EXPORT_OK $WARNING);
 use Carp;
 use English;
 require Exporter;
@@ -24,6 +25,7 @@ use Tk::ItemStyle;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(finditems snapshot tree);
+@EXPORT_OK = qw(finditems snapshot tree);
 
 my ($help_tl0, $help_tl, $result_tl, $result_fm, $search_tl,
     $searchtree_tl, $showitemflag);
@@ -49,6 +51,50 @@ my $helptree_tl;
 my $wwidth;
 my $wheight;
 
+
+# Hack to capture $zinc symbols.
+# Usefull to load ZincDebug by running your perl script in this way :
+#   perl -MZincdebug yourscript.pl
+# or
+#   perl -MZincDebug=tree,finditems yourscript.pl
+#
+# Needs that zinc instance appears in the symbols table of main package,
+# i.e. zinc instance is defined in you script as global (not lexical)
+# variable
+#
+sub import {
+    my ($module, @args) = @_;
+    # export_to_level really export symbols
+    ZincDebug->export_to_level(1, @_);
+    my %args;
+    my $noargs = 1 unless @args > 0;
+    for (@args) {
+        $args{$_} = 1;
+    }
+    Tk::after(3000, sub {
+        my $found = 0;
+	# return if $zinc is alrealdy defined, by invocation of ZincDebug
+	# functions tree(), finditems()... in main
+	return if $zinc;
+        for my $name (keys %{'main::'}) {
+            if (ref(${$main::{$name}}) eq 'Tk::Zinc') {
+                &tree(${$main::{$name}}) if $args{tree} or $noargs;
+                &finditems(${$main::{$name}}) if $args{finditems} or $noargs;
+                &snapshot(${$main::{$name}}) if $args{snapshot} or $noargs;
+                $found++;
+                # return  when first instance of Zinc is found
+                return;
+            }
+        }
+        if ($found == 0) {
+            print "in ZincDebug module, no zinc instance has been detected at ".
+                  "runtime.\n";
+        }
+    });
+    
+} # end import
+
+
 sub tree {
 
     &setwidget(shift);
@@ -1456,12 +1502,17 @@ ZincDebug - a perl module for analysing a Zinc application.
 
 =head1 SYNOPSIS
 
+ perl -MZincDebug zincapplication.pl
+
+   or
+    
  use ZincDebug;
  my $zinc = MainWindow->new()->Zinc()->pack;
  finditems($zinc);
  tree($zinc);
  snapshot($zinc);
 
+
 =head1 DESCRIPTION
 
 ZincDebug provides an interface to help developers to debug or analyse Zinc applications.
@@ -1474,7 +1525,9 @@ With B<snapshot> function, you are able to snapshot the application window, in o
     
 Press B<Escape> key in the main window of the application to have some help about available input sequences.
 
-    
+If you load ZincDebug using the -M perl option, no code modification is needed but the functions described above are invoked with default configuration.
+
+
 =head1 FUNCTIONS 
 
 
@@ -1553,6 +1606,10 @@ Defines the basename used for the file containing the snaphshot. The filename wi
 
 =back
     
+=head1 LIMITATIONS
+
+ZincDebug is currently able to manage only one zinc instance.
+
 =head1 AUTEURS
 
 Daniel Etienne <etienne@cena.fr>