package Text::Wigwam::Library::Assignment;

    use strict;
    use warnings;
    no warnings 'recursion';
    our $VERSION = '0.01';

    use base q/Exporter/;

    use Text::Wigwam::Library::Utility::Locals;
    use Text::Wigwam::Const( qw/ VAR ANY HASH ARRAY STRICT / );


    our %EXPORT_TAGS = (
        all => [
          qw/
            _proto_alias      _alias
            _proto_assign     _assign
            _proto_define     _define
            _proto_local      _local
            _proto_localize   _localize
            _proto_my         _my
            _proto_parameters _parameters
            _proto_params     _params
            _proto_undefine   _undefine
          /
        ],
        alias      => [ qw/ _proto_alias      _alias / ],
        assign     => [ qw/ _proto_assign     _assign / ],
        define     => [ qw/ _proto_define     _define / ],
        local      => [ qw/ _proto_local      _local / ],
        localize   => [ qw/ _proto_localize   _localize / ],
        my         => [ qw/ _proto_my         _my / ],
        params     => [ qw/ _proto_params     _params / ],
        parameters => [ qw/ _proto_parameters _parameters / ],
        undefine   => [ qw/ _proto_undefine   _undefine / ],
    );
    our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
    our @EXPORT = qw( );

=head1 Name

Text::Wigwam::Library::Assignment - A Wigwam directive library.

=head1 Description

This library provides directives that deal with assigning values to variables.

=head1 Usage

The directives within this library can be imported into specific branches of
the directive tree (which transcends from  C<Text::Wigwam::Directives>) via
plug-ins or modules using one of the following techniques.

 package Text::Wigwam::Directives::some::arbitrary::branch;
 # import everything
 use Text::Wigwam::Library::Assignment( qw/:all/ );

 package Text::Wigwam::Directives::another::arbitrary::branch;
 # import selectively
 use Text::Wigwam::Library::Assignment(
  qw/ :alias :assign :define :local :my :params :parameters :undefine /
 );

=head1 Directives

=cut

sub _proto_alias { [ VAR, ANY ] }
sub _alias {
    my ($Api) = @_;
    $Api->set_alias( $Api->get_arg, $Api->get_arg );
    return
}

=head2 #alias I<var> I<val>

Identical to C<#define> except that no copies of references are made before
assigning I<val> to I<var>.

 [!! #define array1 ( 1 2 3 4 ) !!]
 [!! #alias array2 array1 !!]
 [!! #define array3 array1 !!]
 array1 contains: [!!#join ", " array1 !!]
 array2 contains: [!!#join ", " array2 !!]
 array3 contains: [!!#join ", " array3 !!]
 Altered array1 only... [!!#push array1 5!!]
 array1 contains: [!!#join ", " array1 !!]
 array2 contains: [!!#join ", " array2 !!]
 array3 contains: [!!#join ", " array3 !!]
 [!!
  /* output:
   array1 contains: 1, 2, 3, 4
   array2 contains: 1, 2, 3, 4
   array3 contains: 1, 2, 3, 4
   Altered array1 only...
   array1 contains: 1, 2, 3, 4, 5
   array2 contains: 1, 2, 3, 4, 5
   array3 contains: 1, 2, 3, 4
  */
 !!]

Both array1 and array2 in the preceding example are aliased to the same array
reference, so if any changes are made to the elements of one, the changes also
affect the other. On the other hand, array3 is unaffected by the changes to
array1 because its value was assigned by the C<#define> directive which
generates a new reference, a copy of the original array, before assigning it
to the variable array3.

=cut

sub _proto_assign { [ VAR, ANY ] }
sub _assign {
    my ($Api, undef, $vctx) = @_;
    return $Api->set_value( $Api->get_arg, $Api->get_arg );
}

=head2 #assign I<var> I<val>

Same as C<#define>, except that it always returns I<val>. This behavior is
useful for in-line assignments.

 [!!
  #define array < 1 2 1 2 3 >
  #while #assign var #shift array { var }
  /* output: 12123 */
 !!]

=cut

sub _proto_define { _proto_assign(@_) }
sub _define {
    _assign(@_);
    return;

# Context aware version:
#    my ($Api, undef, $vctx) = @_;
#    my $val = _assign(@_);
#    return if $vctx;
#    return $val;

}

=head2 #define I<var> I<val>

Assigns I<val> to I<var> unless I<val> is an unblessed reference to a hash or
array, in which case a copy is made, and this new reference value is stored
into I<var> instead. The C<#define> directive does not return any value.

 [!! #define foo "Bar" !!]

=cut

sub _proto_local { _proto_my(@_) }
sub _local { _my(@_) }

=head2 #local I<var>

Preserves the current value of I<var> until the current template or subroutine
loses scope, after which the original value or undefined state is restored to
I<var>.

 [!!
  #macro subr {
     #local var1
     #define var1 "bar"
     "var1 is " var1 " inside subr,\n"
  }
  #define var1 "foo"
  "var1 is " var1 " to start,\n"
  #call subr()
  "var1 is restored to " var1 " after the #call."
  /*
   output:
    var1 is foo to start,
    var1 is bar inside subr,
    var1 is restored to foo after the #call.
  */
 !!]

The following example demonstrates the usefulness of local variables for
writing recursive subroutines in templates.

  [!!
   #define nested_hash %<
     topkey %<
         subkey1 value1
         subkey2 %< botkey bottom >
     >
   >
   #macro show_all_hash_values {
        #define #my hash #argv 0
        #foreach #my key hash`keys`sort {
                #if #is_hash hash.[key] #unshift values {
                        key " is a nested hash"
                        #call show_all_hash_values ( hash.[key] )
                }
                #else #unshift values hash.[key]
        }
   }
   #call show_all_hash_values ( nested_hash )
   #join ", " values
   /* output:
    topkey is a nested hash, subkey2 is a nested hash, bottom, value1
   */
  !!]

=cut

sub _proto_localize { [ ARRAY ] }
sub _localize {
    my ($Api, undef, $vctx) = @_;
    my $locals = $Api->get_global( q/Locals/ )||
      $Api->set_global(
        Locals => Text::Wigwam::Library::Utility::Locals->new($Api)
      )
    ;
    my $varlist = $Api->get_arg;
    for my $var (@$varlist) {
        $locals->localize( $Api, $Api->interpolate($var) );
    }
    return $varlist unless $vctx;
    return;
}

sub _proto_my { [ VAR ] }
sub _my {
    my ($Api, undef, $vctx) = @_;
    my $var = $Api->interpolate( $Api->get_arg );
    my $locals = $Api->get_global( q/Locals/ )||
      $Api->set_global(
        Locals => Text::Wigwam::Library::Utility::Locals->new($Api)
      )
    ;
    $locals->localize( $Api, $var );
    return if $vctx;
    return $var;
}

=head2 #my I<var>

Same as C<#local> except that C<#my> returns the variable name so that it can
be used in-line with other directives.

 [!! #define #my var "temporary value" !!]

=cut

sub _proto_parameters { [ ARRAY ] }
sub _parameters {
    my ($Api) = @_;
    my $vals = params(
        $Api,
        my $vars = $Api->get_arg,
        $Api->get_global( q/args/ ) || [],
    );
    my $locals = $Api->get_global( q/Locals/ ) ||
      $Api->set_global(
        Locals => Text::Wigwam::Library::Utility::Locals->new($Api)
      )
    ;
    $locals->localize( $Api, @$vars );
    $Api->set_alias( $_, shift @$vals ) for (@$vars);
    return;
}

=head2 #parameters I<var_list>

This directive merely provides a shortcut for the common task of assigning
arguments to a set of localized variables. Readability is also improved
because some of the monotonous details are hidden under the hood.

 [!!
   /* The following two expressions are functionally identical */
   #parameters < foo bar baz >
   #params #localize < foo bar baz > #args
 !!]

By allowing either an ordered list of arguments or named parameters, we
increase flexibility.

 [!!
  #macro quote {
   #parameters < originator quotation >
   !!>
    [!! originator !!] once said, "[!! quotation !!]"
   <!!
  }
 
  /* Pass the macro an ordered list (array) of arguments */
  &quote <
   Confucius 'To see the right and not to do it is cowardice.'
  >
 
  /* Pass the macro some named parameters (hash) */
  &quote %<
   Originator 'Confucius'
   Quotation  'Everything has beauty, but not everyone sees it.'
  >
  /* output:
   Confucius once said, "To see the right and not to do it is cowardice."
   Confucius once said, "Everything has beauty, but not everyone sees it."
  */
 !!]

=cut

sub params {
    my ($Api, $vars, $args) = @_;
    return [ @{$args} ] unless $Api->is_hash($args);
    my %hmap = map { ( uc $_, $args->{$_} ) } keys %$args;
    return [ map { $hmap{uc $_} } @$vars ];
}

sub _proto_params { [ ARRAY, ARRAY|HASH ] }
sub _params {
    my ($Api, undef, $vcontx) = @_;
    my $vals = params(
        $Api,
        my $vars = $Api->get_arg,
        $Api->get_arg
    );
    my @vals = @$vals;
    $Api->set_alias( $_, shift @vals ) for (@$vars);
    return if $vcontx;
    return $vals;
}

=head2 #params I<var_list> I<values>

Assigns a set of values I<values> to a list of variables I<var_list>. The
I<values> parameter can be either an array or a hash. When an array is
provided, its elements are assigned to the I<var_list> variables in
left-to-right order.

When I<values> is a hash, each entry in I<var_list> will take on the value of
its corresponding hash key in the I<values> hash. The I<val_list> to I<values>
match up is non-case-sensitive.

 [!! #params < foo bar baz > %< foo 'fu' Bar 'bawr' BAZ 'bas' > !!]

The C<#params> directive will return the I<values> list unless called in void
context, in which case it returns nothing.

 [!! #unless #params < arg1 arg2 arg3 > @args #throw "No arguments?" !!]

=cut

sub _proto_undefine { [ VAR ] }
sub _undefine {
    my ($Api) = @_;
    $Api->undefine( $Api->get_arg );
    return
}

=head2 #undefine I<var>

Removes I<var> from Wigwam's varspace.

 [!!
  #define foo "bar"
  #if #defined foo "foo is defined"
  #undefine foo
  #unless #defined foo "foo has been undefined"
  /* output:
   foo is defined
   foo has been undefined
  */
 !!]

=cut

1;
