Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
Embed.pod	11.62 KB	-rw-rw-rw-	2020-09-25 16:26
Function.pm	10.54 KB	-rw-rw-rw-	2020-10-21 16:18
Functions.pm	34.15 KB	-rw-rw-rw-	2020-10-21 16:18
GetInfo.pm	27 KB	-rw-rw-rw-	2020-10-21 16:18
Operation.pm	22.93 KB	-rw-rw-rw-	2020-10-21 16:18
Placeholder.pm	2.19 KB	-rw-rw-rw-	2020-10-21 16:18
RAM.pm	5.9 KB	-rw-rw-rw-	2020-10-21 16:18
Roadmap.pod	8.5 KB	-rw-rw-rw-	2020-09-25 16:26
Structure.pod	12.7 KB	-rw-rw-rw-	2020-09-25 16:26
Syntax.pod	19.33 KB	-rw-rw-rw-	2020-09-25 16:26
Term.pm	5.48 KB	-rw-rw-rw-	2020-10-21 16:18
TermFactory.pm	6.61 KB	-rw-rw-rw-	2020-10-21 16:18
Util.pm	4.21 KB	-rw-rw-rw-	2020-10-21 16:18

Rename

package SQL::Statement::Util;

######################################################################
#
# This module is copyright (c), 2001,2005 by Jeff Zucker.
# This module is copyright (c), 2007-2020 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.414';

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(@_);
}

=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

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