code_perl/Maasha/DumpFunc.pm

   1 package Maasha::DumpFunc;
   2
   3 # Copyright (C) 2003 Martin A. Hansen.
   4
   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.
   9
  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.
  14
  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.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Routines to inspect objects and their inheritance.
  26
  27
  28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  29
  30
  31 use warnings;
  32 use strict;
  33 use Class::Inspector;
  34 use vars qw ( @ISA @EXPORT );
  35 use Exporter;
  36
  37 use Data::Dumper;
  38
  39 @ISA = qw( Exporter );
  40
  41
  42 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  43
  44
  45 sub dump_func
  46 {
  47     # Martin A. Hansen, August 2003.
  48
  49     # given an object, the cognate functions are returned as a list
  50
  51     my ( $obj,   # incomming object
  52        ) = @_;
  53
  54     my ( $ref, $methods );
  55
  56     $ref     = ref $obj;
  57     $methods = Class::Inspector->methods( $ref, 'full', 'public' );
  58
  59 #    @{ $methods } = grep /$ref/, @{ $methods };
  60
  61     return wantarray ? @{ $methods } : $methods;
  62 }
  63
  64
  65 sub dump_test
  66 {
  67     # Martin A. Hansen, August 2003.
  68
  69     # given an object, returns the cognate function run with default values
  70
  71     my ( $obj ,    # incomming object
  72        ) = @_;
  73
  74     # returns a list of test lines to be printed
  75
  76     my ( $methods, $method, $function, @lines );
  77
  78     $methods = dump_func( $obj );
  79
  80     foreach $method ( @{ $methods } )
  81     {
  82         $method   =~ /::(\w+)$/;
  83         $function = $1;
  84         next if not eval { $obj->$function };
  85
  86         # push @lines, "Testing $function from $method --- Returns -> " . $obj->$function;
  87         print "TESTING $function FROM $method: RETURNS->" . $obj->$function . "\n";
  88     }
  89
  90     return wantarray ? @lines : \@lines;
  91 }
  92
  93
  94 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<