package App::Followme::BaseData;
use 5.008005;
use strict;
use warnings;
use integer;
use lib '../..';
use base qw(App::Followme::ConfiguredObject);
#----------------------------------------------------------------------
# Default values of parameters
sub parameters {
my ($pkg) = @_;
return (
labels => 'previous,next',
);
}
#----------------------------------------------------------------------
# Build a new variable value given its name and context
sub build {
my ($self, $variable_name, $item, $loop) = @_;
# Extract the sigil from the variable name, if present
my ($sigil, $name) = $self->split_name($variable_name);
my %cache = ();
if ($sigil eq '$') {
if (defined $item &&
(! $self->{cache}{item} || $self->{cache}{item} ne $item)) {
# Clear cache when argument to build changes
%cache = (item => $item);
} else {
%cache = %{$self->{cache}};
}
}
# Build the value associated with a name if it is not in the cache
unless (exists $cache{$name}) {
my $sorted_order = $sigil eq '';
my %data = $self->fetch_data($name, $item, $loop);
%data = $self->format($sorted_order, %data);
%cache = (%cache, %data);
}
# Check the value for agreement with the sigil and return reference
my $ref_value = $self->ref_value($cache{$name}, $sigil, $name);
$self->{cache} = \%cache if $sigil eq '$';
return $ref_value;
}
#----------------------------------------------------------------------
# Coerce the data to a hash
sub coerce_data {
my ($self, $name, @data) = @_;
my %data;
if (@data == 0) {
%data = ();
} elsif (@data == 1) {
%data = ($name => $data[0]);
} elsif (@data % 2 == 0) {
%data = @data;
} else {
my $pkg = ref $self;
die "$name does not return a hash\n";
}
return %data;
}
#----------------------------------------------------------------------
# Fetch the data for building a variable's value
sub fetch_data {
my ($self, $name, $item, $loop) = @_;
return $self->gather_data('get', $name, $item, $loop);
}
#----------------------------------------------------------------------
# Apply an optional format to the data
sub format {
my ($self, $sorted_order, %data) = @_;
foreach my $name (keys %data) {
my $method = join('_', 'format', $name);
$data{$name} = $self->$method($sorted_order, $data{$name})
if $self->can($method);
}
return %data;
}
#----------------------------------------------------------------------
# Gather the data for building a variable's value
sub gather_data {
my ($self, $method, $name, $item, $loop) = @_;
my @data;
$method = join('_', $method, $name);
if ($self->can($method)) {
@data = $self->$method($item, $loop);
} else {
@data = ();
}
my %data = $self->coerce_data($name, @data);
return %data;
}
#----------------------------------------------------------------------
# Get the count of the item in the list
sub get_count {
my ($self, $item, $loop) = @_;
die "Can't use \$count outside of for\n" unless $loop;
foreach my $i (0 .. @$loop) {
if ($loop->[$i] eq $item) {
my $count = $i + 1;
return $count;
}
}
return;
}
#----------------------------------------------------------------------
# Is this the first item in the list?
sub get_is_first {
my ($self, $item, $loop) = @_;
die "Can't use \$is_first outside of for\n" unless $loop;
return $loop->[0] eq $item ? 1 : 0;
}
#----------------------------------------------------------------------
# Is this the last item in the list?
sub get_is_last {
my ($self, $item, $loop) = @_;
die "Can't use \$is_last outside of for\n" unless $loop;
return $loop->[-1] eq $item ? 1 : 0;
}
#----------------------------------------------------------------------
# Return the label for the current list item
sub get_label {
my ($self, $item, $loop) = @_;
die "Can't use \$label outside of for\n" unless $loop;
my $count = $self->get_count($item, $loop);
my @labels = split(/\s*,\s*/, $self->{labels});
my $label;
if (defined $count && $count <= @labels) {
my @words = map {ucfirst $_} split(/\s+/, $labels[$count-1]);
$label = join(' ', @words);
} else {
$label = '';
}
return $label;
}
#----------------------------------------------------------------------
# Return the current list of loop items
sub get_loop {
my ($self, $item, $loop) = @_;
die "Can't use \@loop outside of for\n" unless $loop;
return $loop;
}
#----------------------------------------------------------------------
# Return previous and next loop items
sub get_sequence {
my ($self, $item, $loop) = @_;
die "Can't use \@sequence outside of for\n" unless $loop;
my $match;
foreach my $i (0 .. @$loop) {
if ($loop->[$i] eq $item) {
$match = $i;
last;
}
}
my @sequence;
if (defined $match && $match > 0) {
$sequence[0] = $loop->[$match-1];
} else {
$sequence[0] = '';
}
if (defined $match && $match < @$loop-1) {
$sequence[1] = $loop->[$match+1];
} else {
$sequence[1] = '';
}
return \@sequence;
}
#----------------------------------------------------------------------
# Get a reference value and check it for agreement with the sigil
sub ref_value {
my ($self, $value, $sigil, $name) = @_;
my ($check, $ref_value);
if ($sigil eq '$'){
$value = '' unless defined $value;
$ref_value = ref $value ? $value : \$value;
$check = ref $ref_value eq 'SCALAR';
} elsif ($sigil eq '@') {
$ref_value = $value;
$check = ref $ref_value eq 'ARRAY';
} elsif ($sigil eq '' && defined $value) {
$ref_value = ref $value ? $value : \$value;
$check = 1;
}
die "Unknown variable: $sigil$name\n" unless $check;
return $ref_value;
}
#----------------------------------------------------------------------
# Set up the cache for data
sub setup {
my ($self, %configuration) = @_;
$self->{cache} = {};
}
#----------------------------------------------------------------------
# Split the sigil off from the variable name from a template
sub split_name {
my ($self, $variable_name) = @_;
my $name = $variable_name;
$name =~ s/^([\$\@])//;
my $sigil = $1 || '';
return ($sigil, $name);
}
1;
=pod
=encoding utf-8
=head1 NAME
App::Followme::BaseData
=head1 SYNOPSIS
use App::Followme::BaseData;
my $meta = App::Followme::BaseData->new();
my %data = $meta->build($name, $filename);
=head1 DESCRIPTION
This module is the base class for all metadata classes and provides the build
method used to interface metadata classes with the App::Followme::Template
class.
Followme uses templates to construct web pages. These templates contain
variables whose values are computed by calling the build method of the metadata
object, which is passed as an argument to the template function. The build
method returns either a reference to a scalar or list. The names correspond to
the variable names in the template. This class contains the build method, which
couples the variable name to the metadata object method that computes the value
of the variable.
=head1 METHODS
There is only one punlic method, build.
=over 4
=item my %data = $meta->build($name, $filename);
Build a variable's value. The firrst argument is the name of the variable
to be built. The second argument is the filename the variable is computed for.
If the variable returned is a list of files, this variable should be left
undefined.
=back
=head1 VARIABLES
The base metadata class can evaluate the following variables. When passing
a name to the build method, the sigil should not be used. All these variables
can only be used inside a for block.
=over 4
=item @loop
A list with all the loop items from the immediately enclosing for block.
=item @sequence
A two item list containing the previous and next items in the for block. If the
current item is first or last, the corrsponding item in the sequence list will
be the empty string.
=item $count
The count of the current item in the for block.The count starts at one.
=item $is_first
One if this is the first item in the for block, zero otherwise.
=item $is_last
One if this is the last item in the for block, zero otherwise
=item $item
The current item in the for block.
=item $label
The string from the comma separated list of labels that corresponds to the
current item in a list.
=back
=head1 CONFIGURATION
There is one parameter:
=over 4
=item labels
A comma separated list of strings containing a list of labels to apply
to the values in a loop. The default value is "previous,next" and is
meant to be used with @sequence.
=back
=head1 LICENSE
Copyright (C) Bernie Simon.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Bernie Simon E<lt>bernie.simon@gmail.comE<gt>
=cut