view release on metacpan or  search on metacpan

lib/Data/Dumper/EasyOO.pm  view on Meta::CPAN

    $ddo->{_ezdd_noreset} = 1 if $cfg{_ezdd_noreset};

    for my $item (keys %cfg) {
	#print "$item => $cfg{$item}\n";
	my $attr = lc $item;
	my $meth = ucfirst $item;

	if (grep {$attr eq $_} @styleopts) {
	    $ddo->$meth($cfg{$item});
	}
	elsif (grep {$item eq $_} @ddmethods) {
	    $ddo->$meth($cfg{$item});
	}
	elsif (grep {$attr eq $_} @okPrefs) {
	    $ddo->{$attr} = $cfg{$item};
	}
	else { carp "illegal method <$item>" }
    }
    return $ezdd;
}

use vars '$AUTOLOAD';

sub AUTOLOAD {
    my ($ezdd, $arg) = @_;
    (my $meth = $AUTOLOAD) =~ s/.*:://;
    return if $meth eq 'DESTROY';
    my @vals = $ezdd->Set($meth => $arg);
    return $ezdd unless wantarray;
    return $ezdd, @vals;
}

sub pp {
    my ($ezdd, @data) = @_;
    $ezdd->(@data);
}

# Im ambivalent about this BEGIN block.  Its only use is to suppress
# redefined warnings issued when re-do{}'g the file, ie when purposely
# avoiding use or require (see t/redefined.t).  A more normal
# re-importing is already supressed in import(), by the same
# (localized) handler.

local $SIG{__WARN__};
BEGIN {
    $SIG{__WARN__} = sub {
	carp $@, @_ unless $_[0] =~ / redefined/;
    };
    *dump = \&pp;	# causes warning if done outside begin block
}

sub _ez_ddo {
    my ($ezdd) = @_;
    return $ezdd->($magic);
}

my $_privatePrinter;	# visible only to new and closure object it makes

sub new {
    my ($cls, %cfg) = @_;
    my $prefs = $cliPrefs{caller()} || {};

    my $ddo = Data::Dumper->new([]);	# inner obj w bogus data
    Set($ddo, %$prefs, %cfg);		# ctor-params override pkg-config

    #print "EzDD::new() ", Data::Dumper::Dumper [$prefs, \%cfg];

    my $code = sub { # closure on $ddo
	&$_privatePrinter($ddo, @_);
    };
    # copy constructor
    bless $code, ref $cls || $cls;
    
    if (ref $cls) {
	# clone its settings
	my $ddo = $cls->($magic);
	my %styles;
	@styles{@styleopts,@okPrefs} = @$ddo{@styleopts,@okPrefs};
	$code->Set(%styles,%cfg);
    }
    return $code;
}

$_privatePrinter = \&__DONT_TOUCH_THIS;

sub __DONT_TOUCH_THIS {
    my ($ddo, @args) = @_;

    unless ($ddo->{_ezdd_noreset}) {
	$ddo->Reset;	# clear seen
	$ddo->Names([]);	# clear labels
	$ddo->Values([]);	# clear data
    }
    if (@args == 1) {
	# test for AUTOLOADs special access
	return $ddo if defined $args[0] and $args[0] == $magic;
	
	# else Regular usage
	$ddo->{todump} = \@args;
    }
    elsif (@args % 2) {
	# cant be a hash, must be array of data
	$ddo->{todump} = \@args;
    }
    else {
	# possible labelled usage, 
	# check that all 'labels' are scalars
	
	my %rev = reverse @args;
	if (grep {ref $_} values %rev) {
	    # odd elements are refs, must print as array
	    $ddo->{todump} = \@args;
	}
	else {
	    while (@args) {
		push @{$ddo->{names}}, shift @args;
		push @{$ddo->{todump}}, shift @args;
	    }
	}
    }
  PrintIt:
    # return dump-str unless *void* context
    return $ddo->Dump() if defined wantarray;
    
    unless (defined $ddo->{autoprint}) {
	carp "called in void context, without autoprint defined\n";