Bivio::UI::ViewLanguage
# Copyright (c) 2001-2006 bivio Software, Inc. All rights reserved.
# $Id$
package Bivio::UI::ViewLanguage;
use strict;
use Bivio::Base 'Bivio.UNIVERSAL';
use Bivio::IO::Trace;
# C<Bivio::UI::ViewLanguage> defines the language used by
# L<Bivio::UI::View|Bivio::UI::View>. Here's a simple
# view language file:
#
# view_class_map('HTMLWidget');
# view_main(Page({
# ...,
# });
#
# The first call to I<view_class_map> tells this module where to load
# widgets from. The name is defined in the configuration for
# L<Bivio::IO::ClassLoader|Bivio::IO::ClassLoader>.
#
# The next call defines the main widget, i.e. the widget that
# will be called when the view is rendered by
# L<Bivio::UI::View::execute|Bivio::UI::View/"execute">. All views
# must define a I<view_main> or a view's parents must define a main.
#
# A view may have a parent, e.g.:
#
# view_parent('common');
# view_put(page_body => Prose('hello, world!'));
#
# This view inherits its attributes from a view called C<common>.
# The C<common> view or its parents must define I<view_class_map> and
# I<view_main>. This last attribute, I<page_body>, is application
# specific. Reserved attributes, i.e. attributes defined in the
# view language, begin with the prefix I<view_>. You may not define
# an application specific attribute which begins with I<view_>. There
# are a few other restrictions which are defined by I<view_put>.
our($AUTOLOAD);
our($_VIEW_IN_EVAL);
our($_TRACE);
our($_WIDGET_LABEL);
my($_CL) = b_use('IO.ClassLoader');
my($_R) = b_use('Agent.Request');
my($_V) = b_use('UI.View');
my($_W) = b_use('UI.Widget');
my($_D) = b_use('Bivio.Die');
sub AUTOLOAD {
# The widget and shortcut methods are dynamically loaded.
my($args) = [_args(@_)];
return b_use('UI.ViewLanguage')->call_method($AUTOLOAD, shift(@$args), $args);
}
sub call_method {
my(undef, $autoload, $proto, $args) = @_;
return $_CL->call_autoload(
$autoload,
$args,
sub {
# Calls method or class contained in I<autoload>. Using I<proto>
# and passing I<args> as appropriate.
#
# If I<autoload> begins with a capital letter, it is assumed to be
# a class which needs to be loaded via view_class_map. If
# I<autoload> begins with C<vs_> it is found in the view_shortcuts
# map. Otherwise, I<autoload> must begin with C<view_>, and is
# called in this module.
my($method, $args2) = @_;
my($view) = _assert_in_eval($autoload);
_die("$method: invalid autoload of private method (spelling error?)")
if $proto->is_private_method_name($method);
local($_WIDGET_LABEL) = $method;
my($simple_method, $suffix) = $method =~ /^([A-Z].*?)(?:_(.*))?$/s;
if ($simple_method) {
my($map) = $view->ancestral_get('view_class_map', undef);
_die("$method: view_class_map() or view_parent() must be called first")
unless $map;
my($class) = $_CL->unsafe_map_require($map, $simple_method);
return $class->new(@$args2)
if $class;
}
elsif ($method =~ /^view_/) {
return $proto->$method(@$args2)
if $proto->can($method);
}
my($vs) = $view->ancestral_get('view_shortcuts', undef);
if ($method =~ /^vs_/) {
_die("view_shortcuts() or view_parent() must be called before $method")
unless $vs;
_die("$method is not implemented by $vs or its superclass(es)")
unless $vs->can($method);
return $vs->$method(@$args2);
}
return ($vs || b_use('UI.ViewShortcutsBase'))
->view_autoload($method, \@$args2, $simple_method, $suffix);
},
);
}
sub eval {
my(undef, $value) = @_;
# Compiles I<view.view_file_name> or I<view.view_code> (if defined).
#
# Returns C<undef> on success. Returns die instance on failure.
#
#
# Compiles I<code> within context of the current view being compiled.
return b_use('UI.View')->is_blesser_of($value) ? _eval_view($value)
: ref($value) eq 'SCALAR' ? _eval_code($value)
: _die('eval: invalid argument (not a string_ref or view)');
}
sub get_b_widget_label_and_clear {
# Called from UI.Widget, and probably shouldn't be called elsewhere
my($res) = $_WIDGET_LABEL;
$_WIDGET_LABEL = undef;
return $res;
}
sub new {
# You cannot instantiate this class.
b_die('this class may not be instantiated');
}
sub unsafe_get_eval {
# USE ONLY FOR TESTING
return $_VIEW_IN_EVAL;
}
sub view_class_map {
my($proto, $map_name) = _args(@_);
# Identifies the load path for Widgets specified in view programs.
# I<map_name> is a string which identifies a configured class path
# (L<Bivio::IO::ClassLoader|Bivio::IO::ClassLoader>).
# May be used to override parent's specification, but typically only
# defined in the root view.
#
# This attribute must be defined in the view or its parents.
$map_name = _assert_value(view_class_map => $map_name);
_die("$map_name: not a valid view_class_map;"
.' check Bivio::IO::ClassLoader configuration'
) unless $_CL->is_map_configured($map_name);
_put(view_class_map => $map_name);
return;
}
sub view_declare {
my($proto, @args) = _args(@_);
# Defines existence of I<attr_name>s on view. This is equivalent to
# calling L<view_put|"view_put"> on the I<attr_name>s with valus
# of C<undef>.
return $proto->view_put(map {($_, undef)} @args);
}
sub view_get {
my(undef, $attr) = _args(@_);
# Returns the attribute from the current view. You probably want to use
# L<view_widget_value|"view_widget_value"> for values in widgets. This routine
# is used for more complex widget value accesses.
#
# This works during evaluation of a view as well as during execution.
return _view()->ancestral_get($attr);
}
sub view_main {
my($proto, $widget) = _args(@_);
# Specifies the "main" widget for this view. This widget will be rendered when
# the view or its children are executed.
#
# A view must either have a L<view_parent|"view_parent"> or a view_main.
_put(view_main => _assert_value(
'view_main', $widget, qw(Bivio::UI::Widget execute render)));
return;
}
sub view_ok {
return _view() ? 1 : 0;
}
sub view_parent {
my($proto, $view_name) = _args(@_);
# A view may be the child of another view. Child views inherit attributes from
# their parents. Child views may override their ancestors' attributes. A view
# without a view_parent is called a I<root view>.
#
# A view must either have a L<view_main|"view_main"> or a view_parent.
_assert_in_eval('view_parent')->internal_set_parent(
_assert_value('view_parent', $view_name));
return;
}
sub view_pre_execute {
my($proto, $code) = _args(@_);
# Code to be executed prior to rendering the view.
_die('view_pre_execute must be a code_ref')
unless ref($code) eq 'CODE';
_put(view_pre_execute => $code);
return;
}
sub view_put {
# Sets (I<attr_name>, I<attr_value>) attributes.
#
# I<attr_name>s must not already exist, must be perl identifiers
# beginning with a letter, must be all lower case,
# and may not begin with I<view_>.
_validated_put(\@_, 0);
return;
}
sub view_shortcuts {
my($proto, $class_name) = _args(@_);
# Shortcuts are application specific functions available to view programs. A
# view defines the class which implements these shortcuts. If no shortcuts are
# used, this attribute need not be defined.
#
# I<class_name> defines the shortcuts. I<class_name> must be a subclass
# L<Bivio::UI::ViewShortcutsBase|Bivio::UI::ViewShortcutsBase>.
#
# Shortcuts begin with the prefix C<vs_>. This ensures the names of shortcuts do
# not conflict with perl's internal names, the ViewLanguage functions (which always
# begin with C<view_>), or names of widgets (which are always begin with an upper
# case letter and are simple class names).
_put(view_shortcuts => _assert_value(
'view_shortcuts', $class_name, 'Bivio::UI::ViewShortcutsBase'));
return;
}
sub view_unsafe_put {
# Sets (I<attr_name>, I<attr_value>) attributes.
#
# I<attr_name>s may already exist, but must follow view_put's syntax.
_validated_put(\@_, 1);
return;
}
sub view_use {
my($proto, $class) = _args(@_);
# Calls I<use> with I<class> which may be a map.class or a package::name.
return $proto->use($class);
}
sub view_widget_value {
my(undef, $attr) = _args(@_);
# Returns a widget value which retrieves a L<Bivio::UI::View|Bivio::UI::View>
# attribute from the view at render time. Used by parent views to retrieve
# attributes from their children at run-time.
my($view) = _assert_in_eval('view_widget_value');
_die($attr.': attribute not found; view or its parents must declare'
.' before use')
unless $view->ancestral_has_keys($attr);
return [['->get_request'], 'Bivio::UI::View', '->ancestral_get', $attr];
}
sub _args {
# Detects if first argument is $proto or not. When view_*() methods
# are called from view files or templates, they are not given a $proto.
return defined($_[0]) && $_[0] eq __PACKAGE__ ? @_ : (__PACKAGE__, @_);
}
sub _assert_in_eval {
my($op) = @_;
# Returns the current view or terminates.
my($res) = _in_eval();
return $res
if $res;
$op ||= 'eval';
$op =~ s/.*:://;
b_die($op, ': operation only allowed in views');
# DOES NOT RETURN
}
sub _assert_value {
my($name, $value, $class, @methods) = @_;
# Asserts value is defined, isa class, and implements methods.
_die("$name() not supplied a value") unless defined($value);
return $value
unless $class;
# Load class and value class unless is ref (loaded)
unless (ref($value)) {
$class = b_use($class);
$value = b_use($value);
}
_die(": $name()'s value not a $class")
unless UNIVERSAL::isa($value, $class);
foreach my $m (@methods) {
_die($value, qq{: $name() does not implement $m})
unless $value->can($m);
}
return $value;
}
sub _die {
# Calls _assert_in_eval()->compile_die($msg).
_assert_in_eval()->compile_die(@_);
# DOES NOT RETURN
}
sub _eval_code {
my($code) = @_;
# Evaluates a sequence of code in this class's context.
my($copy) = 'use strict;' . $$code;
_trace($copy) if $_TRACE;
return $_D->eval_or_die(\$copy);
}
sub _eval_view {
my($view) = @_;
# Does view version of eval.
$view->compile_die('view already compiled!')
if $view->is_read_only;
local($_VIEW_IN_EVAL) = $view;
return Bivio::Die->catch(sub {
my($code) = $view->compile;
_eval_code($code)
if ref($code) eq 'SCALAR';
_initialize($view);
return;
});
}
sub _in_eval {
return $_VIEW_IN_EVAL || b_use('UI.View')->unsafe_get_current;
}
sub _initialize {
my($view) = @_;
# Ensures the attributes are properly defined. Specifies refs
# with no uses.
my($values) = $view->get_shallow_copy;
while (my($k, $v) = each(%$values)) {
$v->initialize_with_parent(undef)
if __PACKAGE__->is_blesser_of($v, 'Bivio::UI::Widget');
}
_die('view_main or view_parent must be specified')
unless $view->has_keys('view_main') || $view->has_keys('view_parent');
#TODO: Traverse parents to see if all attributes defined
$view->put(view_is_executable => 1);
$view->set_read_only;
return;
}
sub _put {
my($name, $value, $overwrite) = @_;
# Asserts in eval and puts the attribute. Cannot be called twice.
my($view) = _assert_in_eval();
# We allow an attribute to be view_declared (undef) and then
# assigned later in the view.
_die($name, ': view attribute already defined in this view',
' (no overrides within view)')
unless $overwrite || !defined($view->unsafe_get($name));
$view->put($name => $value);
return;
}
sub _validated_put {
my($args, $overwrite) = @_;
my($proto, @args) = _args(@$args);
_die('view_put not supplied any arguments')
unless @args > 1;
_die('view_put not supplied an even number of arguments')
if @args % 2 != 0;
$proto->map_by_two(sub {
my($n, $v) = @_;
# The syntax is very rigid to allow for expansion
_die($n, ': attr_name is not a perl identifier')
if $n =~ /\W/;
_die($n, ': attr_name does not begin with a letter')
unless $n =~ /^[a-z]/;
_die($n, ': attr_name is not all lower case')
if $n =~ /[A-Z]/;
_die($n, ': attr_name may not begin with view_')
if $n =~ /^view_/;
_die($n, ': is a reserved attribute name')
if $n eq 'parent';
_put($n, $v, $overwrite);
return;
}, \@args);
return;
}
sub _view {
return $_VIEW_IN_EVAL || b_use('UI.View')->unsafe_get_current;
}
1;