/usr/share/perl5/SQL/Statement/Util.pm is in libsql-statement-perl 1.412-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 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | package SQL::Statement::Util;
######################################################################
#
# This module is copyright (c), 2001,2005 by Jeff Zucker.
# This module is copyright (c), 2007-2017 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use vars qw($VERSION);
$VERSION = '1.412';
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
=head1 AUTHOR & COPYRIGHT
This module is
copyright (c) 2001,2005 by Jeff Zucker and
copyright (c) 2007-2017 by Jens Rehsack.
All rights reserved.
The module may be freely distributed under the same terms as
Perl itself using either the "GPL License" or the "Artistic
License" as specified in the Perl README file.
Jeff can be reached at: jzuckerATcpan.org
Jens can be reached at: rehsackATcpan.org or via dbi-devATperl.org
=cut
|