package Text::Wigwam::Library::Struct;

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

    use base q/Exporter/;

    use Text::Wigwam::Const(
      qw/
        STRICT OPTIONAL ANY
        ARRAY EXPR VAR STRING NUM HASH
      /
    );


    our %EXPORT_TAGS = (
        all => [
          qw/
            _proto_adjoin       _adjoin
            _proto_join         _join
            _proto_keys         _keys
            _proto_pop          _pop
            _proto_push         _push
            _proto_reverse      _reverse
            _proto_shift        _shift
            _proto_sizeof       _sizeof
            _proto_sort         _sort
            _proto_sort_keylist _sort_keylist
            _proto_key_sort     _key_sort
            _proto_split        _split
            _proto_substr       _substr
            _proto_unshift      _unshift
            _proto_values       _values
          /
        ],
        adjoin       => [ qw/ _proto_adjoin       _adjoin / ],
        join         => [ qw/ _proto_join         _join / ],
        keys         => [ qw/ _proto_keys         _keys / ],
        pop          => [ qw/ _proto_pop          _pop / ],
        push         => [ qw/ _proto_push         _push / ],
        reverse      => [ qw/ _proto_reverse      _reverse / ],
        shift        => [ qw/ _proto_shift        _shift / ],
        sizeof       => [ qw/ _proto_sizeof       _sizeof / ],
        sort         => [ qw/ _proto_sort         _sort / ],
        sort_keylist => [ qw/ _proto_sort_keylist _sort_keylist / ],
        key_sort     => [ qw/ _proto_key_sort     _key_sort / ],
        split        => [ qw/ _proto_split        _split / ],
        substr       => [ qw/ _proto_substr       _substr / ],
        unshift      => [ qw/ _proto_unshift      _unshift / ],
        values       => [ qw/ _proto_values       _values / ],
    );

    our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
    our @EXPORT = qw( );

=head1 Name

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

=head1 Description

This library provides directives that mostly deal with data structures.

=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::Struct qw/:all/;
 
 package Text::Wigwam::Directives::another::arbitrary::branch;
 # import selectively
 use Text::Wigwam::Library::Struct qw(
  :adjoin
  :join
  :keys
  :pop
  :push
  :reverse
  :shift
  :sizeof
  :sort
  :sort_keylist
  :key_sort
  :split
  :substr
  :unshift
  :values
 );

=head1 Directives

=cut

sub _proto_adjoin { [ STRING, ARRAY|HASH, EXPR|STRING|OPTIONAL ] }
sub _adjoin {
    my ($Api) = @_;
    my $delim = $Api->get_arg;
    my $struc = $Api->get_arg;
    my $macro = $Api->get_arg;
    my $val;
    return join (
        $delim,
        map {
            length(
             $val=$macro->execute(
                [ $_, $struc->{$_} ]
             )
            ) ? $val : $struc->{$_}
        } keys %$struc
    ) if $Api->is_hash($struc);
    join (
        $delim,
        map {
            length(
             $val=$macro->execute(
                [ $_, $struc->[$_] ]
             )
            ) ? $val : $struc->[$_]
        } (0..$#$struc)
    );
}

=head2 #adjoin I<string> I<hash|array> I<macro|optional>

Passes each key/value pair of I<hash|array> through I<macro> and joins the
results of each call with I<string>.

 [!!
  #adjoin ", "  %< one 1, two 2, three 3 > { #argv 0 '=' #argv 1 } 
  /* output (note that the order is arbitrary when adjoining hashes):
     two=2, one=1, three=3
  */
 !!]

If we omit the optional macro argument, or if the macro returns a null string,
only the hash value is adjoined.

 [!!
    #adjoin ", "  %< one 1, two 2, three 3 >;
    /* output (arbitrary order):
       3, 1, 2
    */
 !!]

When adjoining arrays, the key represents a given value's index position
within the array.

 [!!
   #adjoin "; " < zero one two three four > { #argv 0 '=' #argv 1 } 
   /* output:
      0=zero; 1=one; 2=two; 3=three; 4=four
   */
 !!]

If the optional macro argument is omitted, or if the macro returns a null
string value, the array values are simply adjoined.

 [!!
   #adjoin "; " < zero one two three four >; 
   /* output:
      zero; one; two; three; four
   */
 !!]

The macro can be defined in advance and simply passed to the #adjoin
directive when required.

 [!!
  #macro jmacro {
     #parameters < name value >
     name '=' value
  }
  #adjoin ", "  %< one 1, two 2, three 3 > jmacro 
  /* output (the order is arbitrary):
     three=3, one=1, two=2
  */
 !!]

=cut

sub _proto_join { [ STRING, ARRAY ] }
sub _join { join( $_[0]->get_arg, @{$_[0]->get_arg} ) }

=head2 #join I<string> I<array>

Returns a string made up of all elements of I<array>, delimited by I<string>.

 [!!
  #join ", " ( "a" "c" "e" "g" )
  /* output:  a, c, e, g */
 !!]

=cut

sub _proto_keys { [ HASH|ARRAY ] }
sub _keys {
    my $thing = $_[0]->get_arg;
    return [ keys %$thing ] if $_[0]->is_hash($thing);
    return [ (0..$#$thing) ];
}

=head2 #keys I<array|hash>

If a hash is provided, C<#keys> returns an array containing all keys found in
I<hash>.

 [!!
  #join ", " #keys %< key1 val1, key2 val2 >
  /* output (the order will vary): key1, key2 */
 !!]

If an array is passed, C<#keys> will return an array containing the indices of I<array>.

 [!!
  #join ", " #keys ( "a" "b" "c" "d" )
  /* output:  0, 1, 2, 3 */
 !!]

=cut

sub _proto_pop { [ ARRAY|STRICT] }
sub _pop { pop @{ $_[0]->get_arg } }

=head2 #pop I<array>

Removes the last element of I<array> and returns its value. Consequently, I<array>'s size is decreased by one element.

 [!!
  #define array ( 1 2 3 4 5 )
  #while array #pop array
  /* output: 54321 */
 !!]

=cut

sub _proto_push { [ VAR|ARRAY, ANY ] }
sub _push { push ( @{ $_[0]->get_value( $_[0]->get_arg ) }, $_[0]->get_arg ); return }

=head2 #push I<array> I<arg>

Adds an element to the end of I<array> and sets its value to I<arg>. Consequently, I<array>'s size
is increased by one element. C<#push> does not return a value.

 [!!
  #define array ( 1 2 3 )
  #push array 4
  #join ", " array
  /* output: 1, 2, 3, 4 */
 !!]

=cut

sub _proto_reverse { [ ARRAY|HASH ] }
sub _reverse {
    my $arg = $_[0]->get_arg;
    return $_[0]->is_hash($arg) ? { reverse(%$arg) } : [ reverse(@$arg) ];
}

=head2 #reverse I<array|hash>

If an array is provided, #reverse returns a copy of the elements contained within I<array> in reverse order. I<array> remains unaltered.

 [!!
  #join ", " #reverse ( 1 2 3 4 5 )
  /* output: 5, 4, 3, 2, 1 */
 !!]

If a hash is provided, #reverse returns a hash whose key/value pairs are reversed, with respect to I<hash>. I<hash> remains unaltered.

 [!!
  #join ", " #keys #reverse %( 1 2 3 4 5 6 )
  /* output (order will vary): 6, 4, 2 */
 !!]

=cut

sub _proto_shift { [ ARRAY|STRICT ] }
sub _shift { shift @{ $_[0]->get_arg } }

=head2 #shift I<array>

Removes the first element of I<array> and returns its value. Consequently, the
size of the array is decreased by one element, and all remaining elements
within the array shift down one position.

 [!!
  #define array ( 1 2 3 4 5 )
  #while array #shift array
  /* output: 12345 */
 !!]

=cut

sub _proto_sizeof { [ ANY ] }
sub _sizeof {
    my ($Api) = @_;
    my $val = $Api->get_arg;
    $val = $$val if $Api->is_scalar($val);
    return
        $Api->is_list($val) ? scalar @{$val} :
        $Api->is_hash($val) ? scalar keys %$val :
        $Api->is_expr($val) ? $val->size :
        defined $val ? length $val : 0
    ;
}

=head2 #sizeof I<arg>

Returns the number of elements in I<arg>, where I<arg> is an array; numbers of
keys where I<arg> is a hash; or number of characters where I<arg> is a string
or scalar reference.

   hash size: [!! #sizeof %< a b c d > !!] (number of keys)
  array size: [!! #sizeof < a b c d > !!] (number of elements)
 scalar size: [!! #sizeof  "abcd" !!] (number of characters)
  macro size: [!! #sizeof #expr {} !!] (number of tokens)
 [!!
  /* output:
     hash size: 2 (number of keys)
    array size: 4 (number of elements)
   scalar size: 4 (number of characters)
    macro size: 2 (number of tokens)
  */
 !!]

=cut

sub _proto_sort { [ ARRAY ] }
sub _sort {
    [
      sort{
#        $a && $b ? $a <=> $b || $a cmp $b : $a <=> $b
        ($_[0]->is_num($a) && $_[0]->is_num($b)) ? $a<=>$b : $a cmp $b
      } @{ $_[0]->get_arg }
    ]
}

=head2 #sort I<array>

Returns a sorted copy of array elements taken from I<array>, and I<array>
remains unaltered.

 [!!
  #join ", " #sort ( 02 6 1 7 10 "a" 4 "b" )
  /* output: 1, 02, 4, 6, 7, 10, a, b */
 !!]

As demonstrated in the previous example, the C<#sort> directive takes true
numeric values into account when sorting.

=cut

#@sorted = map { $_->[0] }
#           sort { $a->[1] cmp $b->[1] }
#            map { [$_, foo($_)] }
#             @unsorted;

sub _proto_key_sort { [ ARRAY, ARRAY ], [ qw{key} ] }
sub _key_sort {
    no warnings 'uninitialized';
    my ($Api) = @_;
    my $list = $Api->get_arg;
    my $criteria = $Api->get_arg;
    my $key = $Api->set_global( key => \do { my $v } );
    my($cmp, $ord, $var, %cache);
    return [
      sort {
        foreach my $crit ( @$criteria ){
            ($ord, $var) = $crit =~ /^([+-])?(.*)$/;
            $$key = $a;
            my $val_a = $cache{$crit}{$$key} ||= $Api->get_value( $var );
            $$key = $b;
            my $val_b = $cache{$crit}{$$key} ||= $Api->get_value( $var );
            $cmp = ( $Api->is_num($val_a) && $Api->is_num($val_b) )
                   ? $val_a <=> $val_b
                   : $val_a cmp $val_b
            ;
            last if $cmp;
        }
        $cmp ||= (
            $Api->is_num($a) && $Api->is_num($b)
        ) ? $a <=> $b : $a cmp $b;
        return $ord eq '-' ? -$cmp : $cmp;
      } @$list
    ];
}

=head2 #key_sort I<key-list>  I<pattern-list>

Returns an array of keys, supplied by the I<key-list> argument, which
are sorted according to the I<pattern-list>, which is merely an ordered list
of variables from whose values the keys are to be sorted. Each element of the
I<pattern-list> array represents a level of criteria to sort upon. Should the
first element match two given entries, the second element will then be used
and so on until a basis for sorting is found, or until all pattern criteria is
exhausted, in which case the keys themselves serve as the final criteria.

The I<pattern-list> elements take the following form:

 +path.to.keys.[:key].path:2.values

Optionally, the first character indicates the sort order: '+' indicates
ascending; '-' indicates descending. If omitted, ascending is implied. The
I<:key> global represents the position within the path name where the keys
will be inserted during the sort process.

The C<#key_sort> directive is handy for sorting records which are stored
in a nested hash complex, as the following examples demonstrate. First, we'll
set up a mock inventory database...

 [!!
      #define inventory %<
         100001 %< onhand 10 price 19.95 item "Putty" >
         100002 %< onhand 10 price 19.95 item "Puppy" >
         100003 %< onhand 13 price 21.95 item "Clock" >
         100004 %< onhand 33 price 22.95 item "Pistol" >
         100005 %< onhand 12 price 14.99 item "Camera" >
         100006 %< onhand 21 price 16.99 item "Toaster" >
     >
 !!]

In Perl, this data structure would look something like this...

 $inventory = {
     100001 => { onhand => 30, price => "19.95", item => "Putty" },
     100002 => { onhand => 10, price => "19.95", item => "Puppy" },
     ...
 };

First, let's dump all of the records sorted by I<item> field.

 [!! #foreach thing #key_sort inventory`keys ( "+inventory.[:key].item" ) !!>
     [!!thing!!] Qty: [!!inventory.[thing].onhand!!], 
     [!~ "$" inventory.[thing].price!!] ea. [!!inventory.[thing].item!!]
 <!!
  /* output:
     100005 Qty: 12, $14.99 ea. Camera
     100003 Qty: 13, $21.95 ea. Clock
     100004 Qty: 33, $22.95 ea. Pistol
     100002 Qty: 10, $19.95 ea. Puppy
     100001 Qty: 10, $19.95 ea. Putty
     100006 Qty: 21, $16.99 ea. Toaster
  */
 !!]

Next, let's list the items by quantity on-hand, beginning with the highest
volume first.

 [!! #foreach thing #key_sort inventory`keys ( "-inventory.[:key].onhand" )!!>
     [!!thing!!] Qty: [!!inventory.[thing].onhand!!], 
     [!~ "$" inventory.[thing].price!!] ea. [!!inventory.[thing].item!!]
 <!!
  /* output:
     100004 Qty: 33, $22.95 ea. Pistol
     100006 Qty: 21, $16.99 ea. Toaster
     100003 Qty: 13, $21.95 ea. Clock
     100005 Qty: 12, $14.99 ea. Camera
     100002 Qty: 10, $19.95 ea. Puppy
     100001 Qty: 10, $19.95 ea. Putty
  */
 !!]

Finally, we'll sort the records by price, then by quantity on-hand in
descending order, then by item name. Also, just because we can, we'll leave
out the '+' this time on the criteria which we want sorted in ascending order.

 [!!
  #foreach thing #key_sort inventory`keys (
     "inventory.[:key].price"
     "-inventory.[:key].onhand"
     "inventory.[:key].item"
  )
  !!>
     [!!thing!!] Qty: [!!inventory.[thing].onhand!!],
     [!~ "$" inventory.[thing].price!!] ea. [!!inventory.[thing].item!!]
  <!~
  /* output:
     100005 Qty: 12, $14.99 ea. Camera
     100006 Qty: 21, $16.99 ea. Toaster
     100002 Qty: 10, $19.95 ea. Puppy
     100001 Qty: 10, $19.95 ea. Putty
     100003 Qty: 13, $21.95 ea. Clock
     100004 Qty: 33, $22.95 ea. Pistol
  */
 !!]

=cut

sub _proto_sort_keylist { [ ARRAY, ARRAY ] }
sub _sort_keylist {
    my ($Api) = @_;
    my $list = $Api->get_arg;
    my $criteria = [];
    for ( @{$Api->get_arg} ){
        /^([+-])?(.*)([`.:])\*(.*)$/;
        push(
           @$criteria => {
             order  => $1,
             suffix => $4,
             meta   => $3,
             base   => $Api->get_value($2)
           }
        );
    }
    return [
       sort {
        $^W=0; # no warnings;
        my $cmp = my $ord = 0;
        foreach my $crit ( @$criteria ){
            my $val_a = $Api->explicit_get_value(
                $crit->{base},
                $crit->{meta},
                $Api->escape_var($a) . $crit->{suffix}
            );
            my $val_b = $Api->explicit_get_value(
                $crit->{base},
                $crit->{meta},
                $Api->escape_var($b) . $crit->{suffix}
            );
            $cmp = (
                $Api->is_num($val_a) && $Api->is_num($val_b)
            ) ? $val_a <=> $val_b : $val_a cmp $val_b;
            $ord = $crit->{order} ||= 0;
            last if $cmp;
        }
        $cmp ||= (
            $Api->is_num($a) && $Api->is_num($b)
        ) ? $a <=> $b : $a cmp $b;
        return $ord eq '-' ? -$cmp : $cmp;
       } @$list
    ];
}

=head2 #sort_keylist is DEPRECATED - use #key_sort instead

Works like #key_sort, but the I<pattern-list> elements take the following
form:

 +path.to.keys.*.path:2.values

The asterisk character represents the position within the path name where the
keys will be inserted during the sort process. This format was abandoned in
favor of the globals-based format as implemented in the #key_sort directive.

=cut

sub _proto_split { [ STRING, STRING ] }
sub _split { [ split( $_[0]->get_arg, $_[0]->get_arg ) ] }

=head2 #split I<separator> I<string>

Returns an array of elements made up of chunks of I<string> separated by
occurrences of I<separator>.

 [!!
  #define array #split ":" "foo:bar:quux:bazz"
  #join ", " array
  /* output: foo, bar, quux, bazz */
 !!]

=cut

sub _proto_substr { [ STRING, NUM, NUM ] }
sub _substr { return substr($_[0]->get_arg, $_[0]->get_arg, $_[0]->get_arg) }

=head2 #substr I<string> I<index> I<num>

Returns information in I<string> after the numerically declared I<index> which
signifies the byte with which you wish to start the extraction. The amount of
data returned will be limited to I<num> bytes.

 [!!
  #substr "abcdefghijkl" 7 2
  /* output: hi */
 !!]

=cut

sub _proto_unshift { [ VAR|ARRAY, ANY ] }
sub _unshift {
    unshift( @{ $_[0]->get_value( $_[0]->get_arg ) }, $_[0]->get_arg );
    return
}

=head2 #unshift I<array> I<arg>

Inserts I<arg> as the first element of I<array>, thereby increasing the size
of the array by one element, and moving all previously existing elements
within the array up one position. C<#unshift> does not return a value.

 [!!
  #define array ( 1 2 3 )
  #unshift array 4
  #join ", " array
  /* output: 4, 1, 2, 3 */
 !!]

=cut

sub _proto_values { [ HASH ] }
sub _values { [ values %{$_[0]->get_arg} ] }

=head2 #values I<hash>

Returns an array of values found in I<hash>.

 [!!
  #join ", " #values #hash ( "key1" "val1" "key2" "val2" )
  /* output (order will vary): val1, val2 */
 !!]

=cut

1;
