1 package Maasha::DumpFunc;
3 # Copyright (C) 2003 Martin A. Hansen.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 # http://www.gnu.org/copyleft/gpl.html
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
25 # Routines to inspect objects and their inheritance.
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
34 use vars qw ( @ISA @EXPORT );
39 @ISA = qw( Exporter );
42 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
47 # Martin A. Hansen, August 2003.
49 # given an object, the cognate functions are returned as a list
51 my ( $obj, # incomming object
54 my ( $ref, $methods );
57 $methods = Class::Inspector->methods( $ref, 'full', 'public' );
59 # @{ $methods } = grep /$ref/, @{ $methods };
61 return wantarray ? @{ $methods } : $methods;
67 # Martin A. Hansen, August 2003.
69 # given an object, returns the cognate function run with default values
71 my ( $obj , # incomming object
74 # returns a list of test lines to be printed
76 my ( $methods, $method, $function, @lines );
78 $methods = dump_func( $obj );
80 foreach $method ( @{ $methods } )
82 $method =~ /::(\w+)$/;
84 next if not eval { $obj->$function };
86 # push @lines, "Testing $function from $method --- Returns -> " . $obj->$function;
87 print "TESTING $function FROM $method: RETURNS->" . $obj->$function . "\n";
90 return wantarray ? @lines : \@lines;
94 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<