/usr/share/perl5/SQL/Statement/Util.pm is in libsql-statement-perl 1.407-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 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | package SQL::Statement::Util;
use strict;
use warnings FATAL => "all";
use vars qw($VERSION);
$VERSION = '1.407';
sub type
{
my ($self) = @_;
return 'function' if $self->isa('SQL::Statement::Util::Function');
return 'column' if $self->isa('SQL::Statement::Util::Column');
}
package SQL::Statement::Util::Column;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Util);
use Params::Util qw(_ARRAY _HASH0 _STRING);
sub new
{
my ( $class, $col_name, $table_name, $term, $display_name, $full_orig_name, $coldef ) = @_;
$display_name ||= $col_name;
if ( $col_name && ( $col_name =~ m/^((?:"[^"]+")|(?:[^.]*))\.(.*)$/ ) )
{
$table_name = $1;
$col_name = $2;
}
elsif ( defined( _ARRAY($table_name) ) && ( scalar( @{$table_name} ) == 1 ) )
{
$table_name = $table_name->[0];
}
my %instance = (
name => $col_name,
table => $table_name,
display_name => $display_name,
term => $term,
full_orig_name => $full_orig_name,
coldef => $coldef,
);
my $self = bless( \%instance, $class );
return $self;
}
sub value($) { $_[0]->{term}->value( $_[1] ); }
sub term() { $_[0]->{term} }
sub display_name() { $_[0]->{display_name} }
sub full_orig_name() { $_[0]->{full_orig_name} }
sub name() { $_[0]->{name} }
sub table() { $_[0]->{table} }
sub coldef() { $_[0]->{coldef} }
package SQL::Statement::Util::Function;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Util);
sub new
{
my ( $class, $name, $sub_name, $args ) = @_;
my ( $pkg, $sub ) = $sub_name =~ /^(.*::)([^:]+$)/;
if ( !$sub )
{
$pkg = 'main';
$sub = $sub_name;
}
$pkg = 'main' if $pkg eq '::';
$pkg =~ s/::$//;
my %newfunc = (
name => $name,
sub_name => $sub,
pkg_name => $pkg,
args => $args,
type => 'function',
);
return bless \%newfunc, $class;
}
sub name { shift->{name} }
sub pkg_name { shift->{pkg_name} }
sub sub_name { shift->{sub_name} }
sub args { shift->{args} }
sub validate
{
my ($self) = @_;
my $pkg = $self->pkg_name;
my $sub = $self->sub_name;
$pkg =~ s,::,/,g;
eval { require "$pkg.pm" }
unless $pkg eq 'SQL/Statement/Functions'
or $pkg eq 'main';
die $@ if $@;
$pkg =~ s,/,::,g;
die "Can't find subroutine $pkg" . "::$sub\n" unless $pkg->can($sub);
return 1;
}
sub run
{
use SQL::Statement::Functions;
my ($self) = shift;
my $sub = $self->sub_name;
my $pkg = $self->pkg_name;
return $pkg->$sub(@_);
}
1;
=pod
=head1 NAME
SQL::Statement::Util
=head1 SYNOPSIS
SQL::Statement::Util::Column->new($col_name, $table_name, $term, $display_name)
SQL::Statement::Util::AggregatedColumns($col_name, $table_name, $term, $display_name)
SQL::Statement::Util::Function($name, $sub_name, $args)
=head1 DESCRIPTION
This package contains three utility classes to handle deliverable columns.
=head1 INHERITANCE
SQL::Statement::Util::Column
ISA SQL::Statement::Util
SQL::Statement::Util::AggregatedColumns
ISA SQL::Statement::Util::Column
ISA SQL::Statement::Util
SQL::Statement::Util::Function
ISA SQL::Statement::Util
=begin undocumented
=head1 METHODS
=head2 type
Returns the type of the SQL::Statement::Util instance.
=end undocumented
=cut
|