Example of how to export sugar

SugarTree.pm

package SugarTree;

=head1 NAME

SugarTree - Create datastructures with sugar

=head1 SYNOPSIS

    use SugarTree;

    set ["foo", "bar"], 42;
    set->foo->baz({ a => 1 });

    block {
        prefix "prefixed", "path";
        set value => 42;
        set->b->c(42);
    };

    end;

=cut

use strict;
use warnings;
use Data::Dumper ();

our @prefix;

=head1 EXPORTED FUNCTIONS

=head2 set

    set \@path, $value;

Used to set a node in the tree.

=cut

sub set {
    return bless [$_[0]], 'SugarTree::Path' if(@_ == 1); # special case

    my($self, $path, $value) = @_;
    my $last = UNIVERSAL::isa($path, 'ARRAY') ? pop @$path : $path;
    my $current = $self;

    $path = [] unless(UNIVERSAL::isa($path, 'ARRAY'));
    $current = $current->{$_} ||= {} for(@prefix, @$path);
    $current->{$last} = $value;

    $self;
}

=head2 block

    block CODE;

Used to define a closed block over L</prefix>

=cut

sub block {
    my($self, $code) = @_;
    local @prefix = @prefix;
    $code->();
}

=head2 prefix

    prefix "some", "path";

Will make L</set> work on the prefixed path. Useful if many L</set>s
starts with the same path.

=cut

sub prefix {
    my $self = shift;
    @prefix = @_;
}

=head2 end

Used instead of C<1;> in the bottom of your module. Will print the
datastructure to STDOUT if called from C<main> namespace. Example:

    $ perl my_file_with_sugartree.pl

=cut

sub end {
    my $self = shift;
    my $caller = caller(1);

    if($caller eq 'main') {
        no strict 'refs';
        print Data::Dumper::Dumper({ map { $_, $self->{$_} } keys %$self });
    }

    return $self;
}

=head1 METHODS

=head2 import

Will export L</EXPORTED FUNCTIONS>

=cut

sub import {
    my $class = shift;
    my $caller = caller;
    my $obj = __PACKAGE__->new;

    strict->import;
    warnings->import;

    no strict 'refs';

    *{"$caller\::block"} = sub (&) { $obj->block(@_) };
    *{"$caller\::prefix"} = sub { $obj->prefix(@_) };
    *{"$caller\::set"} = sub { $obj->set(@_) };
    *{"$caller\::obj"} = \$obj;
    *{"$caller\::end"} = sub { $obj->end(@_) };
}

=head2 new

Used internally.

=cut

sub new {
    my $class = shift;
    return bless {}, $class;
}

package SugarTree::Path;
our $AUTOLOAD;
sub AUTOLOAD {
    my $self = shift;
    my($name) = ($AUTOLOAD =~ /::(\w+)$/)[0];

    push @$self, $name;

    if(@_) {
        my $tree = shift @$self;
        $tree->set($self, @_);
        return $tree;
    }

    return $self;
}

1;