%perl>
# Show the story summary if needed.
if ($show_summary) {
my $type = $tile->get_object_type;
# Nab the story from the story_prof widget
my $asset = get_state_data($type.'_prof', $type);
$m->comp('/widgets/summary/summary.mc', asset => $asset, number => ++$i);
}
%perl>
<& '/widgets/wrappers/sharky/table_top.mc',
caption => "All Fields Text",
id => 'containerprof',
number => ++$i,
&>
% if ($at) {
align="right" class=medHeader>Element:
>
<% $at->get_name %>
<% $show_element_flags->($at) %>
% if (@{$at->get_data}) {
% my $comma = '';
% foreach my $d ($at->get_data) {
<% $comma %>
<% $fmt_name->($d->get_key_name) %>
<% $show_data_flags->($d) %>
% $comma = ', ';
% }
% }
% if (@{$at->get_containers}) {
% my $comma = '';
% foreach my $c ($at->get_containers) {
<% $comma %>
<% $fmt_name->($c->get_name) %>
<% $show_subelement_flags->($at, $c) %>
% $comma = ', ';
% }
% }
% my $opts = [map { my $n = lc($_->get_key_name);
% $n=~y/a-z0-9/_/cs;
% [$n, $_->get_key_name]
% } grep {$_->get_quantifier} $tile->get_possible_data()];
% unshift @$opts, ['', '- None -'];
<& '/widgets/profile/select.mc',
name => $widget.'|default_field',
options => $opts,
value => $default_field,
useTable => 0,
&>
% }
<& '/widgets/profile/textarea.mc', 'name' => $widget.'|text',
'rows' => $rows,
'cols' => $cols,
'value' => $text &>
<& '/widgets/wrappers/sharky/table_bottom.mc' &>
<& '/widgets/wrappers/sharky/table_top.mc',
caption => 'Statistics',
number => ++$i,
&>
<& '/widgets/wrappers/sharky/table_bottom.mc' &>
<%args>
$widget
$show_summary
%args>
<%init>
# the tile object
my $tile = get_state_data($widget, 'tile');
my $at = $tile->get_element;
my $dtiles = get_state_data($widget, 'dtiles');
my $data = get_state_data($widget, 'data');
my $cols = get_state_data($widget, 'cols');
my $rows = get_state_data($widget, 'rows');
my $default_field = get_state_data('_tmp_prefs', 'container_prof.' .
$at->get_id . '.def_field');
# Create the text blob
my $text = '';
foreach my $t (@$data) {
my ($name, $data) = @$t;
$name = $simple_name->($name);
$text .= "=$name\n\n" unless $name eq $default_field;
$text .= "$data\n" if $data;
$text .= "\n" unless $tile->get_container($name);
}
my ($i, $words, $bytes, @tmp);
foreach (@$data) {
$words += scalar(@tmp = /\S+/g);
$bytes += length;
}
%init>
<%once>
my $simple_name = sub {
my ($name) = @_;
$name = lc($name);
$name =~ y/a-z0-9/_/cs;
return $name;
};
my $fmt_name = sub {
my ($name) = @_;
# Lowercase the name and replace non-alphanumeric characters
($name = lc $name) =~ y/a-z0-9/_/cs;
return $name;
};
my $show_element_flags = sub {
my ($at) = @_;
my @flags;
push @flags, 'paginated' if $at->get_paginated;
push @flags, 'top level' if $at->get_top_level;
push @flags, 'fixed url' if $at->get_fixed_url;
push @flags, 'media' if $at->is_media;
push @flags, 'related media' if $at->is_related_media;
push @flags, 'related story' if $at->is_related_story;
if (scalar @flags) {
return ' ('.join(', ', @flags).') ';
} else {
return;
}
};
my $show_data_flags = sub {
my ($d) = @_;
my @flags;
push @flags, 'required' if $d->get_required;
push @flags, 'repeatable' if $d->get_quantifier;
if (scalar @flags) {
return ' ('.join(', ', @flags).') ';
} else {
return;
}
};
my $show_subelement_flags = sub {
my ($at, $c) = @_;
my @flags;
push @flags, 'repeatable' if $at->is_repeatable($c);
if (scalar @flags) {
return ' ('.join(', ', @flags).') ';
} else {
return;
}
};
%once>