/usr/share/perl5/Tangram/Type/Scalar.pm is in libtangram-perl 2.12-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | package Tangram::Type::Scalar;
use strict;
use Tangram::Type;
use vars qw(@ISA);
BEGIN { @ISA = qw( Tangram::Type ); }
use Tangram::Type::Real;
use Tangram::Type::Integer;
use Tangram::Type::Number;
use Tangram::Type::String;
sub reschema
{
my ($self, $members, $class, $schema) = @_;
if (ref($members) eq 'ARRAY')
{
# XXX - not tested by test suite
# short form
# transform into hash: { fieldname => { col => fieldname }, ... }
$members = $_[1] = map { $_ => { col => $schema->{normalize}->($_, 'colname') } } @$members;
}
for my $field (keys %$members)
{
my $def = $members->{$field};
unless (ref($def))
{
# not a reference: field => field
$def = $members->{$field} = { col => $schema->{normalize}->(($def || $field), 'fieldname') };
}
$self->field_reschema($field, $def, $schema);
}
return keys %$members;
}
sub field_reschema
{
my ($self, $field, $def, $schema) = @_;
$def->{col} ||= $schema->{normalize}->($field, 'colname');
}
sub query_expr
{
my ($self, $obj, $memdefs, $tid, $storage) = @_;
return map { $storage->expr($self, "t$tid.$memdefs->{$_}{col}", $obj) } keys %$memdefs;
}
sub remote_expr
{
my ($self, $obj, $tid, $storage) = @_;
$storage->expr($self, "t$tid.$self->{col}", $obj);
}
sub get_exporter
{
my ($self) = @_;
return if $self->{automatic};
my $field = $self->{name};
return "exists \$obj->{q{$field}} ? \$obj->{q{$field}} : undef";
}
sub get_importer
{
my ($self) = @_;
return "\$obj->{q{$self->{name}}} = shift \@\$row";
}
sub get_export_cols
{
return shift->{col};
}
sub get_import_cols
{
my ($self, $context) = @_;
return $self->{col};
}
sub literal
{
my ($self, $lit) = @_;
return $lit;
}
sub content
{
shift;
shift;
}
#---------------------------------------------------------------------
# Tangram::Type::Scalar->_coldefs($cols, $members, $sql, $schema)
#
# Adds entries to the current table mapping for the columns for a
# single class of a given type. Inheritance is not in the picture
# yet.
#
# $cols is the columns definition for the current table mapping
# $members is the `members' property of the current class (ie, the
# members for a particular data type, eg string => $members)
# $sql is the SQL type to default columns to
# $schema is the Tangram::Schema object
#---------------------------------------------------------------------
sub _coldefs
{
my ($self, $cols, $members, $sql, $schema) = @_;
for my $def (values %$members)
{
$cols->{ $def->{col} } =
(
$def->{sql} ||
"$sql " . ($schema->{sql}{default_null} || "")
);
}
}
1;
|