Name

loop_list —

ATTRIBUTES

Attribute Pos. Req. Default Description
interpolate     0 interpolate input?
reparse     1 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

BEHAVIOR

This tag does not appear to be affected by, or affect, the rest of Interchange.

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

loop_list is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: lib/Vend/Interpolate.pm
Lines: 5014

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);
}

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!