# Copyright 2002-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: loop.coretag,v 1.4 2007-03-30 23:40:49 pajamian Exp $

UserTag loop                Order        list
UserTag loop                addAttr
UserTag loop                attrAlias    args list
UserTag loop                attrAlias    arg list
UserTag loop                hasEndTag
UserTag loop                PosNumber    1
UserTag loop                Version      $Revision: 1.4 $
UserTag loop                MapRoutine   Vend::Interpolate::tag_loop_list

sub tag_loop_list {
my ($list, $opt, $text) = @_;

my $fn;
my @rows;

$opt->{prefix} ||= 'loop';
$opt->{label}  ||= "loop" . ++$::Instance->{List_it} . $Global::Variable->{MV_PAGE};

#::logDebug("list is: " . uneval($list) );

## Thanks to Kaare Rasmussen for this suggestion
## about passing embedded Perl objects to a list

# Can pass object.mv_results=$ary object.mv_field_names=$ary
if ($opt->{object}) {
  my $obj = $opt->{object};
  # ensure that number of matches is always set
  # so [on-match] / [no-match] works
  $obj->{matches} = scalar(@{$obj->{mv_results}});
  return region($opt, $text);
}

# Here we can take the direct results of an op like
# @set = $db->query() && return \@set;
# Called with
#  [loop list=`$Scratch->{ary}`] [loop-code]
#  [/loop]
if (ref $list) {
#::logDebug("opt->list in: " . uneval($list) );
  unless (ref $list eq 'ARRAY' and ref $list->[0] eq 'ARRAY') {
    logError("loop was passed invalid list=`...` argument");
    return;
  }
  my ($ary, $fh, $fa) = @$list;
  my $obj = $opt->{object} ||= {};
  $obj->{mv_results} = $ary;
  $obj->{matches} = scalar @$ary;
  $obj->{mv_field_names} = $fa if $fa;
  $obj->{mv_field_hash} = $fh if $fh;
  if($opt->{ml}) {
    $obj->{mv_matchlimit} = $opt->{ml};
    $obj->{mv_no_more} = ! $opt->{more};
    $obj->{mv_first_match} = $opt->{mv_first_match} || 0;
    $obj->{mv_next_pointer} = $opt->{mv_first_match} + $opt->{ml};
  }
  return region($opt, $text);
}

my $delim;

if($opt->{search}) {
#::logDebug("loop resolve search");
  if($opt->{more} and $Vend::More_in_progress) {
    undef $Vend::More_in_progress;
    return region($opt, $text);
  }
  else {
    return region($opt, $text);
  }
}
elsif ($opt->{file}) {
#::logDebug("loop resolve file");
  $list = Vend::Util::readfile($opt->{file});
  $opt->{lr} = 1 unless
          defined $opt->{lr}
          or $opt->{quoted};
}
elsif ($opt->{extended}) {
  ###
  ### This returns
  ###
  my ($view, $tab, $key) = split /:+/, $opt->{extended}, 3;
  if(! $key) {
    $key = $tab;
    $tab = $view;
    undef $view;
  }
  my $id = $tab;
  $id .= "::$key" if $key;
  my $meta = Vend::Table::Editor::meta_record(
              $id,
              $view,
              $opt->{table},
              $opt->{extended_only},
              );
  if(! $meta) {
    $opt->{object} = {
        matches    => 1,
        mv_results  => [],
        mv_field_names => [],
    };
  }
  else {
    $opt->{object} = {
        matches    => 1,
        mv_results  => [ $meta ],
    };
  }
  return region($opt, $text);
}

if ($fn = $opt->{fn} || $opt->{mv_field_names}) {
  $fn = [ grep /\S/, split /[\s,]+/, $fn ];
}

if ($opt->{lr}) {
#::logDebug("loop resolve line");
  $list =~ s/^\s+//;
  $list =~ s/\s+$//;
  if ($list) {
    $delim = $opt->{delimiter} || "\t";
    my $splittor = $opt->{record_delim} || "\n";
    if ($splittor eq "\n") {
      $list =~ s/\r\n/\n/g;
    }

    eval {
      @rows = map { [ split /\Q$delim/, $_ ] } split /\Q$splittor/, $list;
    };
  }
}
elsif($opt->{acclist}) {
#::logDebug("loop resolve acclist");
  $fn = [ qw/option label/ ] unless $fn;
  eval {
    my @items = split /\s*,\s*/, $list;
    for(@items) {
      my ($o, $l) = split /=/, $_;
      $l = $o unless defined $l && $l =~ /\S/;
      push @rows, [ $o, $l ];
    }
  };
#::logDebug("rows:" . uneval(\@rows));
}
elsif($opt->{quoted}) {
#::logDebug("loop resolve quoted");
  my @l = Text::ParseWords::shellwords($list);
  produce_range(\@l) if $opt->{ranges};
  eval {
    @rows = map { [$_] } @l;
  };
}
else {
#::logDebug("loop resolve default");
  $delim = $opt->{delimiter} || '[,\s]+';
  my @l =  split /$delim/, $list;
  produce_range(\@l) if $opt->{ranges};
  eval {
    @rows = map { [$_] } @l;
  };
}

if($@) {
  logError("bad split delimiter in loop list: $@");
#::logDebug("loop resolve error $@");
}

# head_skip pulls rows off the top, and uses the last row to
# set the field names if mv_field_names/fn option was not set
if ($opt->{head_skip}) {
  my $i = 0;
  my $last_row;
  $last_row = shift(@rows) while $i++ < $opt->{head_skip};
  $fn ||= $last_row;
}

$opt->{object} = {
    matches    => scalar(@rows),
    mv_results  => \@rows,
    mv_field_names => $fn,
};

#::logDebug("loop object: " . uneval($opt));
return region($opt, $text);
}