—

              
#!/usr/bin/env perl
# XML::Axk::Object::TinyDefaults - Object::Tiny::XS, but with default values.
# Copyright (c) 2018 cxw42.  All rights reserved.  Artistic 2.
package XML::Axk::Object::TinyDefaults;
use 5.004;
use strict 'vars', 'subs';
use warnings;
use Data::Dumper;
use Import::Into;
our $ObjTiny;
our $VERSION = '0.001009';
BEGIN {
    require parent;
    # Use Object::Tiny::XS or Object::Tiny
    eval { require Object::Tiny::XS; };
    $ObjTiny = 'Object::Tiny::XS' unless $@;
    eval { require Object::Tiny; } unless $ObjTiny;
    $ObjTiny = 'Object::Tiny' unless $@ || $ObjTiny;
    die 'Cannot find Object::Tiny or Object::Tiny::XS' unless $ObjTiny;
    #print "Using $ObjTiny\n";
} # BEGIN
my %defaults;
# Import: If the first parameter is a hashref, it contains the defaults.
# Any remaining parameters are other fields to create.  Field names in the
# defaults do not also have to be specified in the list.
sub import {
    my $class = shift;
    return unless $class eq __PACKAGE__;
        # Without this, it also gets imported into XML::Axk::L1 and
        # axk_script_*, trashing symbols and preventing execution.
    my $pkg   = caller;
    #print "Import into $pkg: (", join(', ', @_), ")\n";
    # Stash defaults for new()
    $defaults{$pkg} = { (ref $_[0] eq 'HASH') ? %{+shift} : () };
        # Keep our own shallow copy of the defaults
    #print "Defaults for $pkg are ", Dumper($defaults{$pkg}), "\n";
    parent->import::into(1, $class);    # Caller is now a child of us
    #print "Caller is now ", join(', ', @{$pkg . '::ISA'}), "\n";
    my %vars = %{$defaults{$pkg}};      # All the fields, without duplicates
    $vars{$_} = 1 for @_;
    #print 'Fields are (', join(', ', keys %vars), ")\n";
    $ObjTiny->import::into(1, keys %vars);
        # Caller now has all the accessors, and is still a child of us because
        # Object::Tiny doesn't overwrite an existing @ISA.
    #print "Done importing into $pkg\n";
    return 1;
} #import()
# new: Create a new instance.  Constructor parameters are key=>value
# assignments that override the defaults.
sub new {
    #print 'New: (', join(', ', @_), ")\n";
    my $class = shift;
    my $hrOpts = $defaults{$class} // {};       # Grab defaults
    my %self = %{$hrOpts};
    my $hrArgs = { @_ };                          # Params override defaults
    @self{keys %$hrArgs} = values %$hrArgs;
    return bless(\%self, $class);
} #new()
1;
__END__
HideShow 31 lines of Pod
=pod
=head1 NAME
XML::Axk::Object::TinyDefaults - Object::Tiny[::XS] wrapper that adds default values
=head1 SYNOPSIS
    package MyClass;
    use XML::Axk::Object::TinyDefaults { foo => 42 } qw(bar bat);
    package main;
    my $inst = MyClass->new(bar=>1);
Now MyClass has accessors C<foo()>, C<bar()>, and C<bat()>, and values
C<foo=42> and C<bar=1>.
Requires L<Object::Tiny> or L<Object::Tiny::XS>.  XS will be used if available.
TODO replace this with L<Class::Tiny>!
=head1 COPYRIGHT
Copyright (c) 2018 Christopher White.  All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). Details are in the LICENSE
file accompanying this distribution.
=cut
# vi: set ts=4 sts=4 sw=4 et ai: #