Bivio::Type
# Copyright (c) 1999-2010 bivio Software, Inc. All rights reserved.
# $Id$
package Bivio::Type;
use strict;
use base 'Bivio::UI::WidgetValueSource';
use Bivio::HTML;
use Bivio::IO::Alert;
use Bivio::IO::ClassLoader;
use Bivio::XML;
# INITIALIZATION: must be explicit, because Bivio::Base does too much so
# can't use b_use. This package is very early on in import order.
my($_HTML) = 'Bivio::HTML';
my($_A) = 'Bivio::IO::Alert';
my($_MJ);
my($_RT);
sub CLASSLOADER_MAP_NAME {
return 'Type';
}
sub can_be_negative {
# : boolean
# Can the number be negative?
return undef;
}
sub can_be_positive {
# : boolean
# Can the number be positive?
return undef;
}
sub can_be_zero {
# : boolean
# Can the number be equal to 0?
return undef;
}
sub compare {
# (self, any, any) : int
# Compares two values and returns the same as perl's
# C<cmp> operator, namely:
#
#
# negative
#
# I<left> is the lesser value.
#
# zero
#
# I<left> and I<right> are equal.
#
# positive
#
# I<right> is the lesser value.
#
#
# Treats C<undef> as "least" or equal if both I<left> or I<right>. Subclasses
# call this way:
#
# return shift->SUPER::compare(@_)
# unless defined($left) && defined($right);
my($proto, $left, $right) = @_;
return 0
unless defined($left) || defined($right);
return -1
unless defined($left);
return 1
unless defined($right);
return shift->compare_defined(@_);
}
sub compare_defined {
# (proto, any, any) : int
# Called by L<compare|"compare"> when both values are defined. Compares the
# values using C<cmp>. Results are undefined if either argument is undefined.
my($proto, $left, $right) = @_;
return $left cmp $right;
}
sub from_literal {
# (proto, string) : array
# (proto, string) : any
# Validates and converts the value from a literal to an internal form.
# The literal is usually a compact representation of the value, e.g.
# for Enums it is the integer form.
#
# If the value is valid, the value returned.
#
# If the value is NULL, the value C<undef> is returned. Note that
# strings return '' as C<undef> in keeping with SQL.
#
# If the value is invalid, the array (<C<undef>, I<error>)
# is returned, where I<error> is one of
# L<Bivio::TypeError|Bivio::TypeError>.
#
# See L<to_literal|"to_literal">.
shift;
return shift;
}
sub from_literal_for_model_value {
my($v, $e) = shift->from_literal(@_);
Bivio::IO::Alert->warn_deprecated(
\@_, ': from_literal_for_model_value failed with: ', $e)
unless defined($v);
return $v;
}
sub from_literal_or_die {
# (proto, string, boolean) : any
# Checks the return value of L<from_literal|"from_literal">
# and calls die with an appropriate message if from_literal
# conversion failed. Dies with TypeError::NULL if not defined and
# !I<null_ok>.
#
# Returns a scalar, not an array.
my($proto, $value, $null_ok) = @_;
my($v, $e) = $proto->from_literal($value);
return $v
if defined($v) || $null_ok && !$e;
$e ||= $proto->use('Bivio::TypeError')->NULL;
$proto->use('Bivio::Die')->throw_die('DIE', {
message => 'from_literal failed: ' . $e->get_long_desc,
program_error => 1,
error_enum => $e,
entity => $value,
class => (ref($proto) || $proto),
});
}
sub from_sql_column {
# (self, string) : string
# Converts I<result>, which is a single column value returned by SELECT, to the
# perl representation of that type. I<result> must be generated by
# L<from_sql_value|"from_sql_value"> for the type. For enums, will convert to
# the appropriate enum value.
shift;
return shift;
}
sub from_sql_value {
# (proto, string) : string
# Converts I<place_holder>, which is typically a column name on a SELECT, to
# a TO_CHAR string. For most types, returns I<place_holder>. For dates,
# returns the appropiate TO_CHAR for that date type.
#
# I<place_holder> will not be quoted.
#
# See L<from_sql_column|"from_sql_column">.
shift;
return shift;
}
sub get_decimals {
# : int
# Number of digits to the right of the decimal point.
return undef;
}
sub get_default {
return undef;
}
sub get_instance {
# (proto, any) : Bivio.Type
# (self) : Bivio.Type
# Returns an instance of I<type>. I<type> may be just the simple name or a fully
# qualified class name. It will be loaded with
# L<Bivio::IO::ClassLoader|Bivio::IO::ClassLoader> using the I<Type> map.
#
# The "instance" returned may a fully-qualified class, since instances and
# classes are equivalent in perl.
my($self, $type) = @_;
$type ||= $self;
$type = $self->use('Type', $type)
unless ref($type);
$_A->bootstrap_die($type, ': not a Bivio::Type')
unless UNIVERSAL::isa($type, 'Bivio::Type')
|| UNIVERSAL::isa($type, 'Bivio::Delegator');
return $type;
}
sub get_max {
# : any
# Maximum value for this type in perl form. Note that numbers
# are returned as strings if they are larger than can be handled
# by perl's integer type.
return undef;
}
sub get_min {
# : any
# Minimal value for this type in perl form. Note that numbers
# are returned as strings if they are larger than can be handled
# by perl's integer type.
return undef;
}
sub get_precision {
# : int
# Maximum number of digits in a value of this type.
return undef;
}
sub get_width {
# : int
# Maximum number of characters for string representations of
# this value. If a number cannot be negative, then will
# not include a character for a sign.
die('abstract method');
}
sub handle_call_autoload {
my($proto) = shift;
return @_ ? $proto->from_literal_or_die(@_) : $proto;
}
sub internal_from_literal_warning {
# (proto) : undef
# Issues a warning about calling from_literal() in a scalar context.
warn("don't call from_literal in scalar context");
return;
}
sub is_equal {
# (proto, any, any) : boolean
# Are the two values equal? Uses "eq" comparison if compare is not available.
return shift->compare(@_) == 0 ? 1 : 0;
}
sub is_greater_than {
return shift->compare(@_) > 0;
}
sub is_greater_than_or_equals {
return shift->compare(@_) >= 0;
}
sub is_less_than {
return shift->compare(@_) < 0;
}
sub is_less_than_or_equals {
return shift->compare(@_) <= 0;
}
sub is_password {
# (proto) : boolean
# Is this value a password, i.e. should it not be displayed?
#
# Default is false.
return 0;
}
sub is_secure_data {
# (proto) : boolean
# Requires that the field be displayed only in secure environments.
#
# Returns false by default.
return 0;
}
sub is_specified {
# (self, any) : boolean
# Returns true if value is not C<undef>.
return defined($_[1]) ? 1 : 0;
}
sub is_specified_literal {
my($proto) = shift;
return $proto->is_specified(($proto->from_literal(shift))[0]);
}
sub max {
my($proto, @values) = @_;
return $proto->iterate_reduce(sub {
my($v1, $v2) = @_;
return $proto->compare($v1, $v2) > 0 ? $v1 : $v2;
}, \@values);
}
sub min {
my($proto, @values) = @_;
return $proto->iterate_reduce(sub {
my($v1, $v2) = @_;
return $proto->compare($v1, $v2) < 0 ? $v1 : $v2;
}, \@values);
}
sub row_tag_get {
my($proto) = shift;
my($req) = pop;
my($model_or_id) = @_;
$_A->bootstrap_die($req, ': last arg must be a Bivio::Agent::Request')
unless Bivio::Agent::Request->is_blesser_of($req);
my($v) = $proto->from_sql_column(
Bivio::Biz::Model->new($req, 'RowTag')
->get_value($model_or_id, $proto->ROW_TAG_KEY));
return $proto->is_specified($v) ? $v : $proto->get_default;
}
sub row_tag_replace {
my($proto) = shift;
my($req) = pop;
my($model_or_id, $value) = @_ > 1 ? @_ : (undef, @_);
$_A->bootstrap_die($req, ': last arg must be a Bivio::Agent::Request')
unless Bivio::Agent::Request->is_blesser_of($req);
Bivio::Biz::Model->new($req, 'RowTag')->replace_value(
$model_or_id,
$proto->ROW_TAG_KEY,
!$proto->is_specified($value)
|| $proto->is_equal($value, $proto->get_default)
? undef
: $proto->to_sql_param($value),
);
return;
}
sub to_group_by_value {
return shift->to_order_by_value(@_);
}
sub to_html {
# (proto, any) : string
# Converts value L<to_literal|"to_literal">. If the value is undef, returns the
# empty string. Otherwise, escapes html and returns.
my($self, $value) = @_;
return ''
unless defined($value);
return $_HTML->escape($self->to_literal($value));
}
sub to_json {
my($proto, $value) = @_;
return ${($_MJ ||= $proto->use('MIME.JSON'))->to_text(
$proto->to_literal($value),
)};
}
sub to_literal {
# (proto, any) : string
# Converts from internal form to a literal string value.
#
# See L<from_literal|"from_literal">.
my(undef, $value) = @_;
return defined($value) ? $value : '';
}
sub to_order_by_value {
shift;
return shift;
}
sub to_query {
# (proto, any) : string
# Returns a value that can be used as a query string.
# Similar to L<to_uri|"to_uri">, but
# calls L<$_HTML::escape_query|$_HTML/"escape_query">
my($proto, $value) = @_;
return '' unless defined($value);
return $_HTML->escape_query($proto->to_literal($value));
}
sub to_sql_param {
# (proto, string) : string
# Converts I<param_value>, which is in the perl representation the data type, to
# a value to a value execute can use. For most types, simply returns
# I<param_value>. For dates, converts the unix time (integer) to the string form
# acceptable to the type's L<to_sql_value|"to_sql_value">. For enums, converts
# the enum to an integer. For booleans, forces to be 0 or 1.
my(undef, $value) = @_;
return defined($value) && length($value) ? $value : undef;
}
sub to_sql_param_list {
# (proto, array_ref) : array_ref
# Converts I<param_values> using L<to_sql_param|"to_sql_param">.
my($proto, $param_values) = @_;
return [map {$proto->to_sql_param($_)} @$param_values];
}
sub to_sql_value {
# (proto, string) : string
# Converts I<place_holder> to an appropriately formed SQL value for the type.
# Typically, I<place_holder> is a question-mark (?) and the text generated
# is also a question-mark. However, for dates, the appropriate
# C<TO_DATE> call is generated for I<value>.
#
# I<place_holder> will not be quoted.
#
# See also L<to_sql_param|"to_sql_param">.
shift;
return shift || '?';
}
sub to_sql_value_list {
# (proto, array_ref) : string
# Creates a parameter string (C<(?,?,?)>) using L<to_sql_value|"to_sql_value">
# to match the args handled by L<to_sql_param_list|"to_sql_param_list">.
#
# Dies if I<param_values> is empty.
my($proto, $param_values) = @_;
die('empty param values') unless @$param_values;
return '('.join(',', map {$proto->to_sql_value('?')} @$param_values).')';
}
sub to_string {
# (proto, any) : string
# Returns the L<to_literal|"to_literal"> representation of the value.
# Always returns a defined value. I<undef> is returned as the empty string.
#
# B<Use for debugging only.>
my($self, $value) = @_;
$value = $self->to_literal($value);
return defined($value) ? $value : '';
}
sub to_uri {
# (proto, any) : string
# Converts value L<to_literal|"to_literal">. If the value is undef, returns the
# empty string. Otherwise, escapes uri and returns.
my($proto, $value) = @_;
return ''
unless defined($value);
return $_HTML->escape_uri($proto->to_literal($value));
}
sub to_xml {
return Bivio::XML->escape(shift->to_literal(shift));
}
1;