#!perl

package Data::Dumper::EasyOO;
use Data::Dumper();
use Carp 'carp';

use 5.005_03;
use vars qw($VERSION);
$VERSION = '0.04_03';

=head1 NAME

Data::Dumper::EasyOO - wraps DD for easy use of various printing styles

=head1 ABSTRACT

EzDD's main goals are to make it easy to label data that you
print/dump, and to make it easy to one or more dumper objects, and one
or more print styles with each one.

Its designed to give you maximum control with a minimum of keystrokes.
At use-time, you can specify default print style(s), and can also
create 1 or more EzDD printer objects to use those styles.  Each
printer object's style can be adjusted thereafter.

EzDD has similar goals as its step-sibling, Data::Dumper::Simple, but
differs in that it does not use source filtering, and it exposes
essentially all of DD's functionality, but with an easier interface.


=head1 SYNOPSIS

 my $ezdd;	# declare a default object (optional)

 use Data::Dumper::EasyOO
    (
     alias	=> EzDD,	# a temporary top-level-name alias
     
     # set some print-style defaults
     indent	=> 1,		# change DD's default from 2
     sortkeys	=> 1,		# a personal favorite

     # autoconstruct a printer obj (calls EzDD->new) with the defaults
     init	=> \$ezdd,	# var must be undef b4 use

     # set some more default print-styles
     terse	=> 1,	 	# change DD's default of 0
     autoprint	=> $fh,		# prints to $fh when you $ezdd->(\%something);

     # autoconstruct a 2nd printer object, using current print-styles
     init	=> \our $ez2,	# var must be undef b4 use
     );

 $ezdd->(p1 => $person);	# print as '$p1 => ...'

 my $foo = EzDD->new(%style)	# create a printer, via alias, w new style
    ->(there => $place);	# and print with it too.

 $ez2-> (p2 => $person);	# dump w $ez2, use its style

 $foo->(here => $where);	# dump w $foo style (use 2 w/o interference)

 $foo->Set(%morestyle);		# change style at runtime
 $foo->($_) foreach @things;	# print many things

=cut

    ;
##############
# this (private) reference is passed to the closure to recover
# the underlying Data::Dumper object
my $magic = [];
my %cliPrefs;	# stores style preferences for each client package

# DD print-style options/methods/package-vars/attributes.
# Theyre delegated to the inner DD object, and 'importable' too.

my @styleopts;	# used to validate methods in Set()

# 5.00503 shipped with DD v2.101
@styleopts = qw( indent purity pad varname useqq terse freezer
		    toaster deepcopy quotekeys bless );

push @styleopts, qw( maxdepth )
    if $Data::Dumper::VERSION ge '2.102';	# with 5.6.1

push @styleopts, qw( pair useperl sortkeys deparse )
    if $Data::Dumper::VERSION ge '2.121';	# with 5.6.2

# DD methods; also delegated
my @ddmethods = qw ( Seen Values Names Reset );

# EzDD-specific importable style preferences
my @okPrefs = qw( autoprint init );

##############
sub import {
    # save EzDD client's preferences for use in new()
    my ($pkg, @args) = @_;
    my ($prop, $val, %args);

    # handle aliases, multiples allowed (feeping creaturism)

    foreach my $idx (grep {$args[$_] eq 'alias'} reverse 0..$#args) {
	($idx, $alias) = splice(@args, $idx, 2);
	no strict 'refs';
	#*{$alias.'::'} = *{$pkg.'::'};
	*{$alias.'::new'} = *{$pkg.'::new'};
    }

    while ($prop = shift(@args)) {
	$val = shift(@args);

	if (not grep { $_ eq $prop} @styleopts, @okPrefs) {
	    carp "unknown print-style: $prop";
	    next;
	}
	elsif ($prop ne 'init') {
	    $args{$prop} = $val;
	}
	else {
	    carp "init arg must be a ref to a (scalar) variable"
		unless ref($val) =~ /SCALAR/;

	    carp "wont construct a new EzDD object into non-undef variable"
		if defined $$val;

	    $$val = Data::Dumper::EasyOO->new(%args);
	}
    }
    $cliPrefs{caller()} = {%args};	# save the allowed ones
    #print "EzDD client cache: ", Data::Dumper::Dumper \%cliPrefs;
}

sub Set {
    # sets internal state of private data dumper object
    my ($ezdd, %cfg) = @_;
    my $ddo = $ezdd;
    $ddo = $ezdd->($magic) if ref $ezdd eq __PACKAGE__;

    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>" }
    }
    $ezdd;
}

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;
}

#my $_privateFunc;

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

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

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

    my $code = sub { # closure on $ddo
	my @args = @_;

	unless ($ddo->{_ezdd_noreset}) {
	    $ddo->Reset;	# clear seen
	    $ddo->Names([]);	# clear labels
	}
	if (@args == 1) {
	    # test for AUTOLOADs special access
	    return $ddo if defined $args[0] and $args[0] eq $magic;

	    # else Regular usage
	    $ddo->{todump} = \@args;
	    goto PrintIt;
	}
	# else
	if (@args % 2) {
	    # cant be a hash, must be array of data
	    $ddo->{todump} = \@args;
	    goto PrintIt;
	}
	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;
		goto PrintIt;
	    }
	    my (@labels,@vals);
	    while (@args) {
		push @labels, shift @args;
		push @vals,   shift @args;
	    }
	    $ddo->{names}  = \@labels;
	    $ddo->{todump} = \@vals;
	    goto PrintIt;
	}
      PrintIt:
	# return dump-str unless void context
	return $ddo->Dump() if defined wantarray;

	my $auto = (defined $ddo->{autoprint}) ? $ddo->{autoprint} : '';

	unless ($auto) {
	    carp "called in void context, without autoprint set";
	    return;
	}
	# autoprint to STDOUT, STDERR, or HANDLE (IO or GLOB)

	if ($auto == 1) {
	    print STDOUT $ddo->Dump();
	}
	elsif ($auto == 2) {
	    print STDERR $ddo->Dump();
	}
	elsif (ref $auto and (ref $auto eq 'GLOB' or $auto->can("print"))) {
	    print $auto $ddo->Dump();
	}
	else { 
	    carp "illegal autoprint value: $ddo->{autoprint}";
	}
	return;
    };

    # 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;
}

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

*dump = \&pp;

1;

__END__

=head1 DESCRIPTION

=head2 Automatic Labelling of your data

This module 'knows' you prefer B<< labelled => $data >>, and assumes
that you've called it that way, except when you havent.  Any arglist
that looks like a list of pairs is treated as as such, by 2 rules:

  1. arglist length is even
  2. no candidate-labels are refs to other structures

so this B<labels> your data:

  $ezdd->(person => $person, place => $place);

but this doesn't:

  $ezdd->($person, $place);

If you find that EzDD sometimes misinterprets your array data, just
[wrap] your data and label it.

DD::Simple does more magic labelling than EzDD, but EzDD avoids source
filtering, and gives you an unsuprising way to get what you want
without fuss.


=head2 Dumping is default operation

EzDD recognizes that the only reason you'd use it is to dump your
data, so it gives you a shorthand to do so.

  print $ezdd->dump($foo);	# long way
  print $ezdd->pp($foo);	# still a long way
  print $ezdd->($foo);		# identical shorthand

It helps to think of an EzDD object as analogous to a printer;
sometimes you want to change the paper-tray, or the landscape/portrait
orientation, but mostly you just want to print.


=head2 Dumping without calling 'print'

To save more keystrokes, you can set autoprint => 1, either at
use-time (see synopsis), or subequently.  Printing is then done for
you when you call the object.

    $ezdd->Set(autoprint=>1);	# unless already done
    $ezdd->($foo);		# even shorter

But this happens only when you want it to, not when you assign the
results to something else.

    $b4 = $ezdd->($foo);	# save rendering in var
    $foo->bar();		# alter printed obj

    # now dump before and after
    print "before: $b4, after: ", $ezdd->($foo);


=head2 setting print styles (on existing objects)

You can set an object's print-style by imitating the way you'd do it
with object oriented DD.  All of DDs style-changing methods are
emulated this way, not just the 2 illustrated here.

    $ezdd->Indent(2);
    $ezdd->Terse(1);

You can chain them too:

    $ezdd->Indent(2)->Terse(1);


=head2 setting print styles using B<Set()>

The emulation above is really dispatched to Set(); those 2 examples
above can be restated:

    $ezdd->Set(indent => 2)->Set(terse => 1);

or more compactly:

    $ezdd->Set(indent => 2, terse => 1);

Multiple objects' print-styles can be altered independently of each
other:

    $ez2->Set(%addstyle2);
    $ez3->Set(%addstyle3);


=head2 Creating new printer-objects

Create a new printer, using default style:

    $ez3 = Data::Dumper::EasyOO->new();

Create a new printer, with some style overrides that are passed to
Set():

    $ez4 = Data::Dumper::EasyOO->new(%addstyle);

Clone an existing printer:

    $ez5 = $ez4->new();

Clone an existing printer, with style overrides:

    $ez5 = $ez4->new(%addstyle2);


=head2 Dumping to other filehandles

    # obvious way
    print $fh $ezdd->($bar);

    # auto-print way
    $ezdd->Set(autoprint => 1);	# to stdout
    $ezdd->($bar);

You can set autoprint style to any open filehandle, for example
\*STDOUT, \*STDERR, or $fh.  For convenience, 1, 2 are shorthand for
STDOUT, STDERR.  autoprint => 0 turns it off.

TODO: autoprint => 3 prints to fileno(3) if it's been opened, or warns
and prints to stdout if it hasnt.


=head2 Namespace aliasing

Data::Dumper::EasyOO is cumbersome to type more than once in a
program, and is unnecessary too.  Just provide an alias at use-time,
and then use that alias thereafter.

   use Data::Dumper::EasyOO ( alias => 'EzDD' );
   $ez6 = EzDD->new();

=head2 use-time object initialization

If calling C<< $ez1 = EzDD->new >> is too much work, you can
initialize it by passing it at use time.

    use Data::Dumper::EasyOO ( %style, init => \our $ez );

By default, $ez is initialized with DD's defaults, these can be
overridden by %style.

If you want to store the handle in C<< my $ez >>, then declare the
myvar prior to the use statement, otherwize the object assigned to it
at BEGIN time is trashed at program INIT time.

    my $ez;
    use Data::Dumper::EasyOO ( init => \$ez );

=head2 use-time multi-object initialization (TODO)

You can even create multiple objects at use-time.  EzDD treats the
arguments as an order-dependent list, and initializes any specified
objects with the settings seen thus far.

In the synopsis example, $ezdd and $ez2 are both initialized, but $ez2
gets a few more style-tweaks.  To better clarify, consider this
example:

  use Data::Dumper::EasyOO 
    (
     alias => EzDD,
     # %DDdefstyle,	# since we use a DD object, we get its default style
     %styleA,
     init => \$ez1,	# gets DDdef and styleA
     %styleB,
     init => \$ez2,	# gets DDdef, styleA and B
     %styleC,
     init => \$ez3,	# gets DDdef, styleA, B and C
     %styleD,
     );

This is equivalent:

  use Data::Dumper::EasyOO (alias => 'EzDD');
  BEGIN {
    $ez1 = EzDD->new(%DDdefstyle, %styleA);
    $ez2 = EzDD->new(%DDdefstyle, %styleA, %styleB);
    $ez2 = EzDD->new(%DDdefstyle, %styleA, %styleB, %styleC );
  }

Each %style can supplement or override the previous.  CAVEAT: %styleD
is not used for any of the initialized objects.  Its meaning is
currently B<reserved> and B<undefined>


=head1 SEE ALSO (its a crowded space, isnt it!)

L<Data::Dumper> L<Data::Dumper::Simple> L<Data::Dump>
L<Data::Dump::Streamer>

=head1 AUTHOR

Jim Cromie <jcromie@cpan.org>

Copyright (c) 2003,2005 Jim Cromie. All rights reserved.  This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=cut

