use strict;
use warnings;

package Util::H2O::More;
use parent q/Exporter/;
use Util::H2O ();

our @EXPORT_OK = (qw/baptise opt2h2o h2o o2h d2o o2d o2h2o ini2h2o ini2o h2o2ini HTTPTiny2h2o o2ini Getopt2h2o ddd dddie tr4h2o yaml2h2o yaml2o/);
our $VERSION = q{0.4.6};

use feature 'state';

# Parse the upstream h2o options only on the -lvalue path.  The normal h2o
# path below still delegates directly to Util::H2O::h2o without doing this
# extra work.
sub _h2o_lvalue_info {
    my @args = @_;
    my ( $recurse, $arrays, $meth, $ro );

    while ( @args && $args[0] && !ref $args[0] && $args[0] =~ /^-/ ) {
        my $opt = shift @args;

        if ( $opt eq q{-recurse} ) {
            $recurse = 1;
        }
        elsif ( $opt eq q{-arrays} ) {
            $arrays = $recurse = 1;
        }
        elsif ( $opt eq q{-meth} ) {
            $meth = 1;
        }
        elsif ( $opt eq q{-ro} ) {
            $ro = 1;
        }
        elsif ( $opt eq q{-classify} ) {
            my $class = shift @args;
            $meth = 1;

            # Util::H2O allows the HASH form of -classify only as the final
            # option.  Put it back where the target HASH is expected so the
            # lvalue decorator sees the same shape as upstream.
            if ( ref $class eq q{HASH} ) {
                unshift @args, $class;
                last;
            }
        }
        elsif ( $opt =~ /\A-(?:nolock|new|parent)\z/ ) {
            next;
        }
        elsif ( $opt =~ /\A-(?:clean|lock|pass|class|isa|destroy)\z/ ) {
            shift @args;
        }
        else {
            # Leave unknown options for Util::H2O::h2o to reject using its
            # normal error handling.
            last;
        }
    }

    my $hash = shift @args;
    return ( $hash, $recurse, $arrays, $meth, $ro, \@args );
}

# Collect only plain HASH refs that upstream h2o will recurse into.  This is
# done before Util::H2O blesses them, because afterwards ref() is a package
# name rather than the string HASH.
sub _collect_lvalue_hashes {
    my ( $thing, $recurse, $arrays ) = @_;
    my @hashes;

    if ( ref $thing eq q{HASH} ) {
        push @hashes, $thing;

        if ($recurse) {
            foreach my $value ( values %$thing ) {
                if ( ref $value eq q{HASH} ) {
                    push @hashes, _collect_lvalue_hashes( $value, 1, $arrays );
                }
                elsif ( $arrays && ref $value eq q{ARRAY} ) {
                    push @hashes, _collect_lvalue_hashes( $value, 1, 1 );
                }
            }
        }
    }
    elsif ( $arrays && ref $thing eq q{ARRAY} ) {
        foreach my $value (@$thing) {
            if ( ref $value eq q{HASH} || ref $value eq q{ARRAY} ) {
                push @hashes, _collect_lvalue_hashes( $value, 1, 1 );
            }
        }
    }

    return @hashes;
}

# Replace only accessors generated by h2o.  Custom -meth methods and AUTOLOAD
# are deliberately left alone.  The setter calling convention is preserved.
sub _install_lvalue_accessors {
    my ( $hash, $additional, $skip ) = @_;
    my $pkg = ref $hash;
    my %names = map { $_ => 1 } ( keys %$hash, @$additional );

    delete $names{AUTOLOAD};
    delete @names{ keys %$skip };

    foreach my $name ( keys %names ) {
        my $key = $name;
        my $sub = sub :lvalue {
            my $self = shift;
            $self->{$key} = shift if @_;
            $self->{$key};
        };

        no strict 'refs';
        no warnings 'redefine';
        *{"${pkg}::$key"} = $sub;
    }

    return;
}

# quick hack to export h2o, uses proper
# Util::H2O::h2o called with full namespace
sub h2o {
    # Keep the existing/default path as small as before.  -lvalue is a
    # Util::H2O::More wrapper option and therefore comes first.
    return Util::H2O::h2o @_ unless @_ && defined $_[0] && !ref $_[0] && $_[0] eq q{-lvalue};

    shift;
    my @args = @_;
    my ( $hash, $recurse, $arrays, $meth, $ro, $additional ) = _h2o_lvalue_info(@args);

    # A read-only object cannot safely expose writable aliases.
    die qq{h2o: -lvalue cannot be combined with -ro\n} if $ro;

    my $top_is_hash = ref $hash eq q{HASH};
    my @hashes = _collect_lvalue_hashes( $hash, $recurse, $arrays );

    # -meth turns top-level CODE values into real methods and deletes them
    # from the object HASH.  Remember their names so additional keys with the
    # same names cannot cause us to replace those methods with accessors.
    my %method;
    if ( $meth && $top_is_hash ) {
        %method = map { $_ => 1 } grep { ref $hash->{$_} eq q{CODE} } keys %$hash;
    }

    my $object = Util::H2O::h2o @args;

    if ( $top_is_hash && @hashes ) {
        my $top = shift @hashes;
        _install_lvalue_accessors( $top, $additional, \%method );
    }

    foreach my $target (@hashes) {
        _install_lvalue_accessors( $target, [], {} );
    }

    return $object;
}

# maintains basically a count to create non-colliding
# unique $pkg names (basically what Util::H2O::h2o does
# if $pkg is not specified using -class
# monatomically increasing uuid
sub _uuid {
    state $uuid = 0;
    return ++$uuid;
}

# supports -recurse and -lvalue as optional leading flags
sub baptise ($$@) {
    my ( $recurse, $lvalue );

    while ( @_ && $_[0] && !ref $_[0] ) {
        if ( $_[0] eq q{-recurse} ) {
            $recurse = shift;
        }
        elsif ( $_[0] eq q{-lvalue} ) {
            $lvalue = shift;
        }
        else {
            last;
        }
    }

    my ( $ref, $pkg, @default_accessors ) = @_;
    my $real_pkg = sprintf qq{%s::_%s}, $pkg, _uuid;
    my @flags = (
        $lvalue ? (q{-lvalue}) : (),
        $recurse ? (q{-recurse}) : (),
    );

    # uses -isa to inherit from $pkg; -class to bless with a package name
    # derived from $pkg
    return h2o @flags, -isa => $pkg, -class => $real_pkg, $ref, @default_accessors;
}

# make keys legal for use as accessor, provides original keys via "__og_keys" accessor
sub tr4h2o($) {
    my $hash_ref    = shift;
    my $new_hashref = {};

    # List::Util::pairmap was not happy being require'd for some reason
    # so iterate and replace keys explicitly; store original key in resulting
    # hashref via __og_keys
    foreach my $og_k ( keys %$hash_ref ) {
        my $k = $og_k;
        $k =~ tr/a-zA-Z0-9/_/c;
        $new_hashref->{$k} = $hash_ref->{$og_k};

        # save old key via __og_keys
        $new_hashref->{__og_keys}->{$k} = $og_k;
    }
    return $new_hashref;
}

# preconditioner for use with Getopt::Long flags; returns just the flag name given
# a list of option descriptors, e.g., qw/option1=s option2=i option3/;

# Getopt to keys
sub opt2h2o(@) {
    my @getopt_def = @_;
    my @flags_only = map { m/([^=!|\s]+)/g; $1 } @getopt_def;
    return @flags_only;
}

# wrapper around opt2h2o (yeah!)
sub Getopt2h2o(@) {
    my ( $autoundef, $lvalue );

    while ( @_ && $_[0] && !ref $_[0] ) {
        if ( $_[0] =~ /^-autoundef/ ) {
            $autoundef = shift;
        }
        elsif ( $_[0] eq q{-lvalue} ) {
            $lvalue = shift;
        }
        else {
            last;
        }
    }

    my ( $ARGV_ref, $defaults, @opts ) = @_;
    $defaults //= {};

    if ($autoundef) {
      $defaults->{AUTOLOAD} = sub {
        my $self = shift;
        our $AUTOLOAD;
        ( my $key = $AUTOLOAD ) =~ s/.*:://;
        die qq{Getopt2h2o: Won't set value for non-existing key. Need it? Let the module author know!\n} if @_;
        return undef;
      };
    }

    my @flags = $lvalue ? (q{-lvalue}) : ();
    my $o = h2o @flags, -meth, $defaults, opt2h2o(@opts);
    require Getopt::Long;
    Getopt::Long::GetOptionsFromArray( $ARGV_ref, $o, @opts );    # Note, @ARGV is passed by reference
    return $o;
}

# Used by one-argument object-building helpers that optionally accept -lvalue.
# Requiring exactly one data argument keeps the old one-argument contract.
sub _one_arg_lvalue {
    my ( $name, @args ) = @_;
    my $lvalue;

    if ( @args > 1 && defined $args[0] && !ref $args[0] && $args[0] eq q{-lvalue} ) {
        $lvalue = shift @args;
    }

    die qq{$name: expected one argument\n} if @args != 1;
    return ( $lvalue, $args[0] );
}

# general form of method used to give accessors to Config::Tiny in Util::H2O's
# POD documentation
sub o2h2o($;$) {
    my ( $lvalue, $ref ) = _one_arg_lvalue( q{o2h2o}, @_ );
    my @flags = $lvalue ? (q{-lvalue}) : ();
    return h2o @flags, -recurse, { %{$ref} };
}

# more specific helper app that uses Config::Tiny->read and o2h2o to get a config
# object back from an .ini; requires Config::Tiny
sub ini2h2o($;$) {
    my ( $lvalue, $filename ) = _one_arg_lvalue( q{ini2h2o}, @_ );
    require Config::Tiny;

    return $lvalue
        ? o2h2o( q{-lvalue}, Config::Tiny->read($filename) )
        : o2h2o( Config::Tiny->read($filename) );
}

# back compat
sub ini2o($;$) {
    return &ini2h2o;
}

# write out the INI file
sub h2o2ini($$) {
    my ( $config, $filename ) = @_;
    require Config::Tiny;
    return Config::Tiny->new( Util::H2O::o2h $config)->write($filename);
}

# back compat
sub o2ini($$) {
    return h2o2ini( shift, shift );
}

# return a dereferences hash (non-recursive); reverse of `h2o'
sub o2h($) {
    $Util::H2O::_PACKAGE_REGEX = qr/::_[0-9A-Fa-f]+\z/;    # makes internal package name more generic for baptise created references
    my $ref = Util::H2O::o2h @_;
    if ( ref $ref ne q{HASH} ) {
        die qq{o2h: Could not fully remove top-level reference. Probably an issue with \$Util::H2O_PACKAGE_REGEX\n};
    }
    return $ref;
}

sub d2o(@);    # forward declaration to get rid of "too early" warning
sub a2o($;$);

# accepts '-autoundef' and '-lvalue'
sub d2o(@) {
    my ( $autoundef, $lvalue );

    while ( @_ && $_[0] && !ref $_[0] ) {
        if ( $_[0] =~ /^-autoundef/ ) {
            $autoundef = shift;
        }
        elsif ( $_[0] eq q{-lvalue} ) {
            $lvalue = shift;
        }
        else {
            last;
        }
    }

    my $thing = shift;
    my $isa   = ref $thing;
    my @flags = (
        $autoundef ? ($autoundef) : (),
        $lvalue ? (q{-lvalue}) : (),
    );

    if ( $isa eq q{ARRAY} ) {
        # Remember lvalue mode in the ARRAY container so future push/unshift
        # operations objectify new HASH refs with the same lvalue behavior.
        a2o $thing, $lvalue;

        foreach my $element (@$thing) {
            d2o @flags, $element;
        }
    }
    elsif ( $isa eq q{HASH} ) {
        foreach my $keys ( keys %$thing ) {
            d2o @flags, $thing->{$keys};
        }

        if ($autoundef) {
          $thing->{AUTOLOAD} = sub {
            my $self = shift;
            our $AUTOLOAD;
            ( my $key = $AUTOLOAD ) =~ s/.*:://;
            die qq{d2o: Won't set value for non-existing key. Need it? Let the module author know!\n} if @_;
            return undef;
          };

          my @hflags = $lvalue ? (q{-lvalue}) : ();
          h2o @hflags, -meth, $thing;
        }
        else {
          my @hflags = $lvalue ? (q{-lvalue}) : ();
          h2o @hflags, $thing;
        }
    }

    return $thing;
}

# blesses ARRAY ref as a container and gives it some virtual methods
# useful in the context of containing HASH refs that get objectified
# by h2o
sub a2o($;$) {
    no strict 'refs';

    my ( $array_ref, $lvalue ) = @_;
    my @d2o_flags = $lvalue ? (q{-lvalue}) : ();

    # uses lexical scope to bless $array_ref (an ARRAY ref)
    # and assigns to it some virtual methods for making dealing with
    # the lists of HASH references easier, as a container

    my $a2o_pkg = sprintf( qq{%s::__a2o_%d::vmethods}, __PACKAGE__, int rand 100_000_000 );    # internal a2o

    bless $array_ref, $a2o_pkg;

    ## add vmethod to wrap around array_refs

    # return item at index INDEX
    my $GET = sub {
      my ( $self, $i ) = @_;
      return undef if $i > $#{$self}; # prevent ARRAY from growing just to get an undef back
      return $self->[$i];
    };
    *{"${a2o_pkg}::get"} = $GET;
    *{"${a2o_pkg}::i"}   = $GET;

    # return rereferenced ARRAY
    my $ALL = sub { my $self = shift; return @$self; };
    *{"${a2o_pkg}::all"} = $ALL;

    # returns value returned by the 'scalar' keyword, alias also to 'count'
    my $SCALAR = sub { my $self = shift; return scalar @$self; };
    *{"${a2o_pkg}::scalar"} = $SCALAR;
    *{"${a2o_pkg}::count"}  = $SCALAR;

    # 'push' will apply "d2o" to all elements pushed.  If this container was
    # created under d2o -lvalue, that new mode is retained for pushed values.
    my $PUSH = sub { my ( $self, @i ) = @_; d2o @d2o_flags, \@i; push @$self, @i; return \@i };
    *{"${a2o_pkg}::push"} = $PUSH;

    # 'pop' intentionally does NOT apply "o2d" to any array_ref pop'd
    my $POP = sub { my $self = shift; return pop @$self };
    *{"${a2o_pkg}::pop"} = $POP;

    # 'unshift' will apply "d2o" to all elements unshifted, retaining
    # -lvalue when the container itself was made under d2o -lvalue.
    my $UNSHIFT = sub { my ( $self, @i ) = @_; d2o @d2o_flags, \@i; unshift @$self, @i; return \@i };
    *{"${a2o_pkg}::unshift"} = $UNSHIFT;

    # 'shift' intentionally does NOT apply "o2d" to any array_ref shift'd
    my $SHIFT = sub { my $self = shift; return shift @$self };
    *{"${a2o_pkg}::shift"} = $SHIFT;

    return $array_ref;
}

# includes internal dereferencing so to be compatible
# with the behavior of Util::H2O::o2h
sub o2d($);    # forward declaration to get rid of "too early" warning

sub o2d($) {
    my $thing = shift;
    return $thing if not $thing;
    my $isa = ref $thing;
    if ( $isa =~ m/^Util::H2O::More::__a2o/ ) {
        my @_thing = @$thing;
        $thing = \@_thing;
        foreach my $element (@$thing) {
            $element = o2d $element;
        }
    }
    elsif ( $isa =~ m/^Util::H2O::_/ ) {
        foreach my $key ( keys %$thing ) {
            $thing->{$key} = o2d $thing->{$key};
        }
        $thing = Util::H2O::o2h $thing;
    }
    return $thing;
}

# handy, poor man's debug wrappers

sub ddd(@) {
    require Data::Dumper;
    foreach my $ref (@_) {
        print STDERR Data::Dumper::Dumper($ref);
    }
}

sub dddie(@) {
    require Data::Dumper;
    foreach my $ref (@_) {
        print STDERR Data::Dumper::Dumper($ref);
    }
    die qq{died due to use of dddie};
}

# YAML configuration support - may return more than 1 reference
sub yaml2h2o($;$) {
    my ( $lvalue, $file_or_yaml ) = _one_arg_lvalue( q{yaml2h2o}, @_ );
    require YAML;
    my @yaml = ();    # yaml can have multiple objects serialized, via ---

    # determine if YAML or file name
    my @lines = split /\n/, $file_or_yaml;

    # if a file, use YAML::LoadFile
    if ( @lines == 1 and -e $file_or_yaml ) {
        @yaml = YAML::LoadFile($file_or_yaml);
    }

    # if not a file, assume YAML string and use YAML::Load
    elsif ($lines[0] eq q{---}) {
        @yaml = YAML::Load($file_or_yaml);
    }

    # die because not supported content $file_or_yaml - it is neither
    else {
        die qq{Provided parameter looks like neither a file name nor a valid YAML snippet.\n};
    }

    # iterate over 1 or more serialized objects that were deserialized
    # from the YAML, apply d2o to it due to the potential presence
    # of ARRAY references
    my @obs = ();
    my @flags = $lvalue ? (q{-lvalue}) : ();
    foreach my $y (@yaml) {
        push @obs, d2o @flags, $y;
    }

    return @obs;
}

# back compat
sub yaml2o($;$) {
    return &yaml2h2o;
}

# NOTE: no h2o2yaml or o2yaml, but can add one if somebody needs it ... please file an issue on the tracker (GH these days)

# This method assumes a response HASH reference returned by HTTP::Tiny; so
# it looks for $ref->{content}, and if anything is found there it will attempt
# to turn it into a Perl data structure using JSON::MaybeXS::decode_json; it
# then applies "d2o -autoundef" to it.  -lvalue is propagated when requested.
sub HTTPTiny2h2o(@) {
  my ( $autothrow, $lvalue );

  while ( @_ && $_[0] && !ref $_[0] ) {
    if ( $_[0] =~ /^-autothrow/ ) {
      $autothrow = shift;
    }
    elsif ( $_[0] eq q{-lvalue} ) {
      $lvalue = shift;
    }
    else {
      last;
    }
  }

  my $ref = shift;
  if (ref $ref eq q{HASH} and exists $ref->{content}) {
    require JSON::MaybeXS; # tries to load the JSON module you want, (by default, exports decode_json, encode_json)

    my @hflags = $lvalue ? (q{-lvalue}) : ();
    my @dflags = ( q{-autoundef}, $lvalue ? (q{-lvalue}) : () );

    h2o @hflags, $ref, qw/content/;
    if ($ref->content) {
      # allows exception from decode_json to be raised if -autothrow
      # and the JSON is determined to be malformed
      if ($autothrow) {
        # the JSON decode will die on bad JSON
        my $JSON = JSON::MaybeXS::decode_json($ref->content);
        my $content = d2o @dflags, $JSON;
        $ref->content($content);
      }
      # default is hide any malformed JSON exception, effectively
      # leaving the ->content untouched
      else {
        eval {
          # the JSON decode will die on bad JSON
          my $JSON = JSON::MaybeXS::decode_json($ref->content);
          my $content = d2o @dflags, $JSON;
          $ref->content($content);
        }
      }
    }
    else {
      my $content = d2o @dflags, {};
      $ref->content($content);
    }
  }
  else {
    die qq{Provided parameter must be a proper HASH reference returned by HTTP::Tiny that contains a 'content' HASH key.};
  }

  return $ref;
}

1;

__END__

=encoding UTF-8

=head1 NAME

Util::H2O::More - Convenience utilities built on Util::H2O (baptise, d2o, INI/YAML/HTTP helpers, Getopt helpers)

=head1 SYNOPSIS

C<Util::H2O::More> extends L<Util::H2O> with small helpers for constructors,
deep data structures, configuration files, command-line options, HTTP responses,
and debugging.

A traditional constructor using C<baptise> can remain very small:

    package Foo::Bar;

    use strict;
    use warnings;
    use Util::H2O::More qw/baptise/;

    sub new {
        my $pkg  = shift;
        my %opts = @_;

        return baptise \%opts, $pkg, qw/bar haz herp derpes/;
    }

Then:

    my $foo = Foo::Bar->new(some => q{thing}, else => 4);

    say $foo->some;
    $foo->bar(1);                 # normal setter syntax
    say $foo->bar;

As of version 0.4.6, generated accessors may optionally be made Perl lvalue
methods:

    use Util::H2O::More qw/h2o/;

    my $o = h2o -lvalue, {
        count => 1,
        text  => q{foo},
    };

    $o->count = 42;
    $o->count++;
    $o->text .= q{bar};

    $o->count(100);               # the old setter form still works

C<-lvalue> is deliberately opt-in.  Existing calls without C<-lvalue> retain
their existing behavior.

=head1 DESCRIPTION

L<Util::H2O> provides a compact way to turn hashrefs into objects with accessors.
C<Util::H2O::More> builds practical helpers around that idea while keeping the
underlying data structures recognizable as normal Perl HASH and ARRAY
references.

This module provides:

=over 4

=item *

C<baptise> - a C<bless>-like constructor helper that also creates accessors.

=item *

C<h2o> - the L<Util::H2O> entry point, plus the optional C<-lvalue> behavior
documented here.

=item *

C<d2o> / C<o2d> - objectify and de-objectify nested HASH/ARRAY mixtures.

=item *

INI helpers using L<Config::Tiny> and YAML helpers using L<YAML>.

=item *

C<opt2h2o> and C<Getopt2h2o> for L<Getopt::Long> option specifications.

=item *

C<HTTPTiny2h2o> for L<HTTP::Tiny> response hashes and JSON content.

=item *

C<ddd> and C<dddie> for quick L<Data::Dumper> debugging.

=item *

C<tr4h2o> for normalizing hash keys into accessor-safe names.

=back

=head1 WHICH FUNCTION SHOULD I USE?

=over 4

=item * Writing a constructor -> C<baptise>

=item * You already have a hashref and want accessors -> C<h2o>

=item * You want C<< $o->foo = VALUE >> syntax -> add C<-lvalue>

=item * You have nested arrays and hashes -> C<d2o>

=item * Missing keys should read as undef -> C<d2o -autoundef> or C<Getopt2h2o -autoundef>

=item * You need plain structures again -> C<o2h> or C<o2d>

=item * INI configuration -> C<ini2h2o> / C<h2o2ini>

=item * YAML -> C<yaml2h2o>

=item * L<HTTP::Tiny> JSON responses -> C<HTTPTiny2h2o>

=back

=head1 LVALUE ACCESSORS

=head2 Why C<-lvalue> is opt-in

A normal L<Util::H2O> accessor is a getter/setter method.  Conceptually it acts
like:

    sub {
        my $self = shift;
        $self->{foo} = shift if @_;
        $self->{foo};
    }

Under C<-lvalue>, C<Util::H2O::More> lets L<Util::H2O> create, bless, lock, and
otherwise configure the object normally, then replaces only the generated data
accessors with equivalent C<:lvalue> methods.  The resulting method still
supports the normal setter call, but its return value may also be used as a
writable alias to the underlying hash slot.

This means all of these are valid:

    my $o = h2o -lvalue, { foo => 1, text => q{a} };

    $o->foo = 42;
    $o->foo++;
    $o->text .= q{bc};
    $o->foo(100);

The default was intentionally not changed.  Lvalue methods expose aliasing
semantics that are stronger than an ordinary getter/setter interface, and code
which does not request them should not acquire those semantics accidentally.

=head2 C<-lvalue> placement with C<h2o>

C<-lvalue> is a C<Util::H2O::More> wrapper option rather than an upstream
L<Util::H2O> option.  Put it first, before normal C<h2o> options:

    my $o = h2o -lvalue, -recurse, { ... };

Do not write:

    my $o = h2o -recurse, -lvalue, { ... };   # not supported

In the latter form C<-lvalue> reaches L<Util::H2O> itself and is rejected as an
unknown option.

The More-specific options on C<baptise>, C<d2o>, C<Getopt2h2o>, and
C<HTTPTiny2h2o> are parsed as leading flags and may be combined before the data
argument as documented for those helpers.

=head2 Existing values and C<undef>

An existing scalar slot is directly writable:

    my $o = h2o -lvalue, { count => 1 };
    $o->count++;

An existing slot whose value is C<undef> is also writable:

    my $o = h2o -lvalue, { value => undef };
    $o->value = 123;

Assignment to C<undef> also works in either form:

    $o->value = undef;
    $o->value(undef);

=head2 Additional accessors and missing hash keys

L<Util::H2O> can create an accessor for an additional key that does not yet
exist in the hash:

    my $o = h2o -lvalue, {}, qw/future/;

A simple value read does not itself need to create that key:

    my $copy = $o->future;         # undef
    exists $o->{future};           # false

Assignment through the lvalue does create the allowed key:

    $o->future = 42;
    exists $o->{future};           # true

This works with the normal locked-key behavior because C<future> was declared as
an allowed additional key.

=head2 Aliases versus copies

The important Perl-specific distinction is whether the result is consumed as a
value or retained as an alias.

This takes a copy of the value:

    my $copy = $o->foo;
    $copy = 99;                    # does not change $o->foo

This retains an alias to the object's storage:

    my $alias = \$o->foo;
    $$alias = 99;                  # changes $o->foo

For a declared accessor whose key is not yet present, taking a reference may
materialize the hash slot because Perl must provide storage for the alias:

    my $o = h2o -lvalue, {}, qw/future/;
    my $alias = \$o->future;
    exists $o->{future};           # now true

Passing an lvalue accessor directly as a subroutine argument can likewise cause
Perl to preserve alias semantics and materialize an otherwise absent allowed
slot.  If key existence itself matters, copy the value first:

    my $value = $o->future;
    some_sub($value);

rather than depending on the aliasing behavior of:

    some_sub($o->future);

This behavior comes from Perl C<:lvalue> semantics; it is not an extra storage
layer implemented by this module.

=head2 Setter syntax remains supported

C<-lvalue> does not replace the existing setter convention:

    $o->foo(42);

The generated lvalue accessor intentionally retains the same rule as the normal
L<Util::H2O> accessor: if arguments are supplied, the first argument is stored
and the resulting slot value is returned.

=head2 Custom methods are not changed

When C<-meth> (or C<-classify>) turns a CODE-valued hash member into a real
method, that method is not replaced with an lvalue accessor:

    my $o = h2o -lvalue, -meth, {
        value  => 2,
        double => sub { $_[0]->value * 2 },
    };

    $o->value = 4;                 # OK
    say $o->double;                # 8

    $o->double = 9;                # error: double is not an lvalue accessor

This remains true even if the custom method name is also present in the list of
additional keys.

C<AUTOLOAD> is also deliberately never converted to an lvalue accessor.  This is
particularly important for C<-autoundef>, where AUTOLOAD provides the missing-key
policy rather than actual hash storage.

=head2 C<-ro> is incompatible with C<-lvalue>

C<-ro> promises an immutable object while C<-lvalue> promises writable aliases.
Combining the two is therefore rejected explicitly:

    h2o -lvalue, -ro, { foo => 1 };

The call dies with an error explaining that C<-lvalue> and C<-ro> cannot be
combined.  Normal C<h2o -ro> behavior is unchanged when C<-lvalue> is absent.

=head2 Recursion and newly assigned references

C<h2o -lvalue, -recurse> makes generated accessors on recursively objectified
HASH refs lvalues:

    my $o = h2o -lvalue, -recurse, {
        child => { count => 1 },
    };

    $o->child->count++;

As with upstream L<Util::H2O>, C<-recurse> alone does not descend into ARRAY
refs.  Use C<-arrays> when that behavior is wanted:

    my $o = h2o -lvalue, -arrays, {
        rows => [ { count => 1 } ],
    };

    $o->rows->[0]->count++;

C<d2o -lvalue> traverses the HASH/ARRAY mixtures handled by C<d2o>, so generated
HASH accessors throughout that structure are lvalues.

Assignment of a new reference does not automatically objectify that new value.
This is the same rule as the existing setter form:

    $o->child = { count => 1 };

After that assignment C<$o->child> is the plain hashref supplied by the caller;
C<-lvalue> does not secretly run C<h2o> or C<d2o> on every later assignment.
Objectify the new value explicitly when that is desired.

=head2 Arrays and virtual methods

C<d2o -lvalue> does B<not> turn the ARRAY container methods themselves into
lvalue methods.  C<get>, C<i>, C<all>, C<scalar>, C<count>, C<push>, C<pop>,
C<unshift>, and C<shift> keep their existing method contracts.

For example, this remains invalid:

    $rows->i(0) = $replacement;

Use normal ARRAY syntax if the array slot itself must be assigned:

    $rows->[0] = $replacement;

The existing C<get>/C<i> behavior that returns C<undef> for an out-of-range
positive index without growing the array is also preserved.

When an ARRAY container was created by C<d2o -lvalue>, HASH refs later supplied
to its C<push> or C<unshift> methods are objectified with C<-lvalue> as well, so
the lvalue mode is not unexpectedly lost for newly added records.

C<-autoundef> propagation for values later added by C<push>/C<unshift> is not
changed by this release; only the new C<-lvalue> mode is retained there.

=head2 C<-autoundef> with C<-lvalue>

C<-autoundef> continues to distinguish existing accessors from truly unknown
method names.

    my $o = d2o -autoundef, -lvalue, {
        present => 1,
    };

    $o->present++;                 # existing key: lvalue accessor
    $o->missing;                   # unknown key: AUTOLOAD returns undef

The unknown name is not converted into a generated accessor.  Consequently:

    $o->missing(42);

still dies with the existing C<-autoundef> "Won't set value for non-existing
key" error, and:

    $o->missing = 42;

fails with Perl's normal "Can't modify non-lvalue subroutine call" error.
Neither form silently creates an unknown key.

=head2 Classified, baptised, and Getopt objects

Named C<-classify> objects retain their constructor and custom methods while the
generated data accessors become lvalues:

    my $prototype = h2o -lvalue, -classify => 'Point', {}, qw/x y/;
    my $point = Point->new(x => 1, y => 2);
    $point->x++;

C<baptise> accepts C<-lvalue> as a leading More-specific option:

    my $self = baptise -lvalue, \%opts, $class, qw/foo bar/;

and it can be combined with recursion:

    my $self = baptise -lvalue, -recurse, \%opts, $class, qw/foo bar/;

C<Getopt2h2o> also accepts C<-lvalue>.  Accessors for declared Getopt options are
then writable as lvalues, including declared options which were not present on
the command line:

    my $opts = Getopt2h2o -lvalue, \@ARGV, {}, qw/count=i name=s/;
    $opts->count++;
    $opts->name = q{Perl};

With C<Getopt2h2o -autoundef, -lvalue>, truly unknown method names continue to
use the non-lvalue AUTOLOAD policy described above.

=head2 Other helpers which accept C<-lvalue>

The following object-producing helpers accept C<-lvalue> before their normal
argument and propagate the mode into the H2O objects they create:

=over 4

=item * C<o2h2o -lvalue, REF>

=item * C<ini2h2o -lvalue, FILENAME>

=item * C<ini2o -lvalue, FILENAME>

=item * C<yaml2h2o -lvalue, FILENAME_OR_YAML_STRING>

=item * C<yaml2o -lvalue, FILENAME_OR_YAML_STRING>

=item * C<HTTPTiny2h2o -lvalue, REF>

=back

C<HTTPTiny2h2o> also propagates C<-lvalue> to successfully decoded JSON content,
which continues to receive C<-autoundef> as before.

C<opt2h2o> does not create an object itself, so it does not need a C<-lvalue>
option.  Compose it with C<h2o> instead:

    my @spec = qw/name=s count=i/;
    my $opts = h2o -lvalue, {}, opt2h2o(@spec);

C<h2o2ini> and C<o2ini> serialize existing objects and therefore do not accept
C<-lvalue>.

=head2 Validation caveat

The generated accessors in L<Util::H2O> are intentionally simple and currently
do not perform type validation or coercion.  C<-lvalue> therefore has no
validation layer to bypass for those generated accessors today.

As a general Perl rule, however, an lvalue method exposes direct mutation of the
returned storage location.  If a class needs validation, coercion, triggers, or
other setter-side behavior, use a real method or an OO framework for that field
rather than turning that method into an lvalue.  C<Util::H2O::More> deliberately
does not convert custom C<-meth> methods for this reason.

=head1 ANTI-EXAMPLE GALLERY: BRACE SOUP TO CLEAN CODE

The helpers are primarily aimed at code that already deals in hashes and arrays
and would benefit from less dereferencing punctuation without changing its data
model.

=head2 HTTP and JSON

Before:

    my $res = HTTP::Tiny->new->get($url);
    die unless $res->{success};

    my $data = decode_json($res->{content});

    foreach my $item (@{ $data->{results} }) {
        next unless $item->{meta};
        my $id = $item->{meta}->{id};

        foreach my $tag (@{ $item->{tags} }) {
            next unless $tag->{enabled};
            print "$id => $tag->{name}\n";
        }
    }

After:

    my $res = HTTPTiny2h2o HTTP::Tiny->new->get($url);
    die unless $res->success;

    foreach my $item ($res->content->results->all) {
        my $id = $item->meta->id or next;

        foreach my $tag ($item->tags->all) {
            next unless $tag->enabled;
            say "$id => " . $tag->name;
        }
    }

=head2 DBI rows

Before:

    while (my $row = $sth->fetchrow_hashref) {
        next unless $row->{address};
        my $city = $row->{address}->{city};
        print "$row->{name} lives in $city\n";
    }

After:

    my @rows;
    push @rows, $_ while ($_ = $sth->fetchrow_hashref);
    my $data = d2o -autoundef, \@rows;

    foreach my $row ($data->all) {
        next unless $row->address;
        say $row->name . " lives in " . $row->address->city;
    }

=head2 Configuration

Before:

    my $cfg  = Config::Tiny->read('app.ini');
    my $host = $cfg->{database}->{host};

After:

    my $cfg  = ini2h2o 'app.ini';
    my $host = $cfg->database->host;

=head1 METHODS

=head2 C<baptise [-lvalue] [-recurse] REF, PKG, LIST>

Takes the same first two data parameters as C<bless>, with an additional list of
default accessors that may exist even when the corresponding top-level hash keys
do not yet exist.

    my $self = baptise \%opts, $class, qw/foo bar baz/;

C<-recurse> uses C<h2o -recurse> so nested HASH refs receive accessors.
C<-lvalue> makes the generated accessors lvalues as described in
L</LVALUE ACCESSORS>.  The two More-specific flags may be supplied before the
reference.

The object is blessed into a unique package beneath C<PKG> and inherits from
C<PKG>, so ordinary package methods remain available.

=head2 C<tr4h2o REF>

Replaces characters not suitable for accessor names with C<_> using:

    tr/a-zA-Z0-9/_/c

The original key names are preserved under C<__og_keys>.

    my $hash = { "foo bar" => 123, "quz-ba%z" => 456 };
    my $obj  = h2o tr4h2o $hash;

    say $obj->foo_bar;
    say $obj->__og_keys->{foo_bar};

This helper is not recursive.

=head2 C<Getopt2h2o [-autoundef] [-lvalue], ARGV_REF, DEFAULTS_REF, LIST>

Wraps the C<opt2h2o> idiom, loads L<Getopt::Long>, and calls
C<GetOptionsFromArray> for you.

    my $opts = Getopt2h2o \@ARGV, { n => 10 }, qw/f=s n=i/;

The first data argument is the array reference to parse, the second is the
initial/default hash, and the remainder are ordinary L<Getopt::Long> option
specifications.

=head3 C<-autoundef>

C<-autoundef> installs an AUTOLOAD handler so an unknown option accessor may be
read as C<undef> without piercing the hash with C<exists>.

    my $opts = Getopt2h2o -autoundef, \@ARGV, { n => 10 },
        qw/f=s n=i verbose!/;

Attempts to use setter-call syntax on a truly unknown key still die.

=head3 C<-lvalue>

C<-lvalue> makes accessors for declared option names and default keys lvalues.
It may be combined with C<-autoundef>; the AUTOLOAD handler for undeclared names
remains non-lvalue.

=head3 Option arguments are not required options

In L<Getopt::Long> syntax:

    name=s

means that I<if> C<--name> appears it requires a string argument.  It does not
make C<--name> mandatory.  Application-level required-option checks are still
needed:

    my $opts = Getopt2h2o \@ARGV, {}, qw/name=s water=s@/;
    die qq{Missing --name\n} unless defined $opts->name;

Use C<defined> when C<0> or another false-looking value is legitimate.

=head3 Parse failures and usage handling

C<Getopt2h2o> returns the object and does not separately return the boolean
result from C<GetOptionsFromArray>.  When the parser result itself is required,
use C<opt2h2o> directly:

    use Getopt::Long qw/GetOptionsFromArray/;
    use Util::H2O::More qw/h2o opt2h2o/;

    my @spec = qw/name=s water=s@/;
    my $opts = h2o {}, opt2h2o(@spec);

    GetOptionsFromArray(\@ARGV, $opts, @spec)
        or die qq{bad options\n};

The same form works naturally with L<Pod::Usage> and with L<Getopt::Long>'s
C<auto_help> configuration.

=head2 C<opt2h2o LIST>

Extracts option names from L<Getopt::Long> specifications so the list need not
be duplicated when creating H2O accessors.

    my @spec = qw/option1=s option2=s@ option3 option4=i o5|option5=s option6!/;

    my $o = h2o {}, opt2h2o(@spec);
    Getopt::Long::GetOptionsFromArray(\@ARGV, $o, @spec);

Aliases and negative-option syntax are left to L<Getopt::Long>; this helper only
extracts the accessor names.

=head1 TESTABLE MODULINO RECIPE

A small command-line application can be both executable and testable as a
package.  C<baptise> plus C<opt2h2o> is useful here because the option accessors
and the application's normal methods can live on the same object while
C<GetOptionsFromArray> remains visible to the application.

The important rule is to create a B<fresh object for every parse>.  Reusing one
option object can retain values between repeated invocations in the same
interpreter.

A compact pattern is:

    #!/usr/bin/env perl
    use strict;
    use warnings;

    package modulinh2o;

    use Getopt::Long qw/GetOptionsFromArray/;
    use Pod::Usage qw/pod2usage/;
    use Util::H2O::More qw/baptise opt2h2o/;

    my @opt_spec = qw/
        name=s
        water=s@
        help
        man
    /;

    sub new {
        my $class = shift;
        my %opts  = @_;
        return baptise \%opts, $class, opt2h2o(@opt_spec);
    }

    sub new_with_options {
        my ( $class, $argv ) = @_;
        $argv = \@ARGV unless defined $argv;

        my $self = $class->new;       # fresh object for every parse

        GetOptionsFromArray($argv, $self, @opt_spec)
            or pod2usage(-exitval => 2);

        pod2usage(-exitval => 0, -verbose => 1) if $self->help;
        pod2usage(-exitval => 0, -verbose => 2) if $self->man;

        pod2usage(-exitval => 2, -message => q{Missing --name})
            unless defined $self->name;

        $self->water([qw/still sparkling tap/])
            unless defined $self->water and @{ $self->water };

        return $self;
    }

    sub run {
        my $self = shift;
        say q{Hello, } . $self->name;
        say $_ for @{ $self->water };
        return;
    }

    package main;

    sub main {
        modulinh2o->new_with_options->run;
        return;
    }

    main() unless caller;

The distribution's C<t/lib/ModulinoH2O.pm> and C<t/13-modulino.t> exercise this
style, including repeated parses in one interpreter so option state cannot leak
between invocations.

Applications which need declarative option metadata, types, coercions, or more
extensive validation may prefer a framework such as L<MooX::Options>.

=head2 C<HTTPTiny2h2o [-autothrow] [-lvalue], REF>

Takes a HASH reference in the usual L<HTTP::Tiny> response shape.  The response
itself is objectified.  When C<content> is non-empty, the helper attempts to
decode it with L<JSON::MaybeXS> and applies C<d2o -autoundef> to successfully
decoded data.

    my $res = HTTPTiny2h2o HTTP::Tiny->new->get($url);
    die unless $res->success;
    say $res->content->someField;

With C<-lvalue>, both generated response accessors and generated accessors in
successfully decoded JSON content are lvalues.

=head3 C<-autothrow>

By default a JSON decode exception is suppressed and the original C<content>
string remains in place.  With C<-autothrow>, the decoder exception propagates:

    my $res = HTTPTiny2h2o -autothrow, $response;

C<-autothrow> and C<-lvalue> may be supplied together before the response hash.

=head3 Input errors

The helper dies unless its argument is a HASH reference containing a C<content>
key.

=head2 C<yaml2h2o [-lvalue], FILENAME_OR_YAML_STRING>

Accepts either a YAML filename or a YAML string beginning with C<--->.  Files
are loaded with C<YAML::LoadFile>; strings are loaded with C<YAML::Load>.
Multiple YAML documents are returned as a list, and each deserialized structure
is passed through C<d2o>.

    my ($config) = yaml2h2o q{/path/to/config.yaml};

With C<-lvalue>, C<d2o -lvalue> is used for each deserialized structure.

The helper dies when its argument looks like neither an existing filename nor a
YAML string beginning with C<--->.

=head2 C<yaml2o [-lvalue], FILENAME_OR_YAML_STRING>

Backward-compatible alias for C<yaml2h2o>.

=head2 C<ini2h2o [-lvalue], FILENAME>

Loads a file with L<Config::Tiny> and converts it using C<o2h2o>.

    my $config = ini2h2o q{/path/to/config.ini};
    say $config->section1->var1;

With C<-lvalue>, recursively generated configuration accessors are lvalues.

=head2 C<ini2o [-lvalue], FILENAME>

Backward-compatible alias for C<ini2h2o>.

=head2 C<h2o2ini REF, FILENAME>

Writes an object created from an INI-like structure back to disk using
L<Config::Tiny>.

    $config->section1->var1(q{new value});
    h2o2ini $config, q{/path/to/other.ini};

=head2 C<o2ini REF, FILENAME>

Backward-compatible alias for C<h2o2ini>.

=head2 C<o2h2o [-lvalue], REF>

Copies the top-level hash content of a config-like object and applies
C<h2o -recurse>.  With C<-lvalue>, the generated recursive accessors are
lvalues.

The top-level copy is shallow, matching the historical implementation; nested
references are the same references and are objectified in place by recursive
H2O processing.

=head2 C<o2h REF>

Delegates to C<Util::H2O::o2h> after broadening
C<$Util::H2O::_PACKAGE_REGEX> so package names generated by C<baptise> are
recognized.  It returns a new plain top-level hashref.

=head2 C<d2o [-autoundef] [-lvalue] REF>

Traverses an arbitrarily nested data structure.  HASH refs are objectified and
ARRAY refs are blessed as containers with the virtual methods described below.

    my $data = decode_json($json);
    d2o $data;

    say $data->teams->i(0)->name;

C<-autoundef> adds the missing-key AUTOLOAD behavior described above.
C<-lvalue> makes generated HASH accessors writable lvalues while leaving ARRAY
container methods and AUTOLOAD alone.

=head2 C<o2d REF>

Returns plain structures corresponding to structures objectified by C<d2o>.
It removes the internal C<Util::H2O::...> and
C<Util::H2O::More::__a2o...> blessing where supported, matching the historical
C<d2o>/C<o2d> behavior.

=head2 C<a2o REF>

Internal helper used by C<d2o> to bless ARRAY refs and install the virtual
methods below.  It remains callable by its fully qualified name, but is not an
exported public entry point.

=head1 ARRAY CONTAINER VIRTUAL METHODS

=head2 C<all>

Returns all items in list context:

    my @items = $root->teams->all;

=head2 C<get INDEX>, C<i INDEX>

C<i> is an alias for C<get>.  An out-of-range positive index returns C<undef>
without growing the array.

    my $item = $root->teams->i(0);

These methods remain non-lvalue even when the container came from
C<d2o -lvalue>.

=head2 C<push LIST>

Pushes items after applying C<d2o> to them.  For a container created by
C<d2o -lvalue>, the new C<-lvalue> mode is retained for newly objectified HASH
items.

=head2 C<pop>

Pops an item.  It intentionally does not apply C<o2d>; a popped object remains
an object.

=head2 C<unshift LIST>

Like C<push> at the near end.  It applies C<d2o>, and retains C<-lvalue> for a
container created by C<d2o -lvalue>.

=head2 C<shift>

Like C<pop> at the near end.  It intentionally does not apply C<o2d>.

=head2 C<scalar>, C<count>

Returns the number of elements.  C<count> is an alias for C<scalar>.

=head1 DEBUGGING METHODS

=head2 C<ddd LIST>

Loads L<Data::Dumper>, applies C<Dumper> to each argument, and prints the result
to STDERR.

=head2 C<dddie LIST>

Like C<ddd>, then dies with a fixed debugging exception.

=head1 EXTERNAL METHODS

=head2 C<h2o>

C<Util::H2O::More> exports its wrapper for L<Util::H2O>'s C<h2o>.  Without
C<-lvalue>, the call is delegated directly to C<Util::H2O::h2o>.  With
C<-lvalue> as the first option, the generated accessor methods are decorated as
described in L</LVALUE ACCESSORS> after upstream H2O processing succeeds.

All ordinary upstream options continue to be interpreted by L<Util::H2O>.

=head1 DEPENDENCIES

=head2 L<Util::H2O>

Required.  This module is a convenience layer around C<h2o> and C<o2h>.
The distribution requires L<Util::H2O> 0.24 or newer.

The implementation also uses C<state>, available in Perl 5.10 and newer.

=head2 Optional / conditional dependencies

Some helpers load dependencies only when called:

=over 4

=item * C<Getopt2h2o> loads L<Getopt::Long>

=item * C<ini2h2o> / C<h2o2ini> load L<Config::Tiny>

=item * C<yaml2h2o> loads L<YAML>

=item * C<HTTPTiny2h2o> loads L<JSON::MaybeXS>

=item * C<ddd> / C<dddie> load L<Data::Dumper>

=back

=head1 BACKWARD COMPATIBILITY

C<-lvalue> is opt-in.  Existing C<h2o>, C<baptise>, C<d2o>, configuration,
YAML, HTTP, and Getopt calls without that flag retain their normal accessor
behavior.  Existing setter calls such as:

    $o->foo(42);

remain supported on lvalue-enabled objects as well.

The C<ini2o>, C<o2ini>, and C<yaml2o> names remain backward-compatible aliases.

=head1 BUGS

Please report issues on the GitHub issue tracker for this distribution.

=head1 LICENSE AND COPYRIGHT

Perl / Perl 5.

=head1 ACKNOWLEDGEMENTS

Thank you to HAUKEX for creating L<Util::H2O> and hearing me out on its usefulness
for some unintended use cases.

=head1 SEE ALSO

L<Util::H2O>, L<Getopt::Long>, L<Config::Tiny>, L<YAML>, L<HTTP::Tiny>,
L<JSON::MaybeXS>.

This module was featured in the 2023 Perl Advent Calendar on December 22:
L<https://perladvent.org/2023/2023-12-22.html>.

=head1 AUTHOR

Oodler 577 L<< <oodler@cpan.org> >>

=cut
