📄 parser.pm
字号:
# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
# Name : ETL::Pequel3::Parser.pm
# Created : 16 May 2006
# Author : Mario Gaffiero (gaffie)
#
# Copyright 1999-2007 Mario Gaffiero.
#
# This file is part of Pequel(TM).
#
# Pequel is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# Pequel is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Pequel; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# ----------------------------------------------------------------------------------------------------
# Modification History
# When Version Who What
# ----------------------------------------------------------------------------------------------------
# TO DO:
# ----------------------------------------------------------------------------------------------------
require 5.005_62;
use strict;
use attributes qw(get reftype);
use warnings;
# ----------------------------------------------------------------------------------------------------
{
package ETL::Pequel3::Parser;
use stl;
use Class::STL::ClassMembers
qw(
err
sections
macros
user_tables
user_joins
translate_fields
configuration
_target_object
macro_use_list
pequel_ref
);
use Class::STL::ClassMembers::Constructor;
use Carp qw(confess);
sub new_extra
{
my $self = shift;
#> confess "undefined pequel_name" unless defined $self->pequel_ref();
$self->err(ETL::Pequel3::Error->new());
use ETL::Pequel3::Type::Macros;
$self->macros(ETL::Pequel3::Type::Macros::Catalogue->new());
use ETL::Pequel3::Type::Table;
#> $self->user_tables(ETL::Pequel3::Type::Table::User::Global->new()); # Singleton
$self->user_tables(ETL::Pequel3::Type::Table::Factory::Global->new()); # Singleton
$self->err()->user_error(10221, "Attribute @{[ __PACKAGE__ ]}::pequel_ref is undefined!")
unless (defined($self->pequel_ref()));
defined($self->pequel_ref()->config())
? $self->configuration($self->pequel_ref()->config())
: $self->configuration(ETL::Pequel3::Type::Properties::User->new());
#> $self->user_joins($self->pequel_ref()->user_joins());
#> $sllf->user_tables($self->pequel_ref()->user_tabler());
return $self;
}
sub used_by
{
my $self = shift;
@_ ? $self->_target_object(@_) : $self->undefine(qw(_target_object));
return $self;
}
sub translate
{
my $self = shift;
my $exp = shift; #TODO: text or codestyler object -- if latter the traverse text elements...
$self->err()->user_error(10601, "@{[
__PACKAGE__
]}::translate() usage: translate(exp <, codestyler>) -- exp is undefined!")
unless (defined($exp));
my $c = shift || ETL::Pequel3::CodeStyler::Program::Perl->new();
my $depth = shift || 0;
$self->err()->user_error(10602, "Deep recursion encountered...exiting!") if ($depth>=32);
my ($code_before, $code_after, $name, $type, @args) = $self->extract($exp);
defined($self->translate_fields())
? $c->code($self->translate_fields()->translate($code_before, $self->_target_object()))
: $c->code($code_before);
if (defined($name))
{
my $obj = $type eq '&'
? $self->macros()->exists($name)
? $self->macros()->exists($name)->new(configuration => $self->configuration())
: undef
: $self->user_tables()->exists($name)
? $self->user_tables()->exists($name)
: $self->user_joins()->exists($name);
$self->err()->user_error(10601, "@{[ $self->pequel_ref()->pequel_name()
]}:Undefined @{[ $type eq '&' ? 'macro' : 'table/join'
]} '$name' encountered in exp '$exp'!")
unless (defined($obj));
$self->update_xref($obj, @args);
my $tr = $type eq '&'
? $obj->translate(@args) # macro
: $obj->translate(@args, $self->configuration()->show_synonyms(), $self->_target_object()); # table/join
$self->err()->user_error(10603, "Object @{[ ref($obj) ]}->translate() did not return a CodeStyler object!")
unless (ref($tr) && $tr->isa('Class::CodeStyler::Program::Abstract'));
$self->translate($tr->raw(), $c, $depth+1);
}
$self->translate($code_after, $c, $depth+1) if (defined($code_after));
return $c;
}
sub extract
{
# extract code_before, code_after, macro/table_name, $type, args
my $self = shift;
my $exp = shift;
if ($exp =~ /([%])([\w|_]+)\s*->\s*([\w|_]+)\b(.*)/) # user_join call
{
my $code_before = $-[0] > 0 ? substr($exp, 0, $-[0]) : '';
my $code_after = $4;
return ($code_before, $code_after, $2, $1, ($3));
}
my $type = $1 if ($exp =~ /([&%])[\w|_]+\s*\(/);
my $type_begin = $-[0];
#? my $type = $1 if ($exp =~ /([@&%])\w*\s*\(/); # for @array->macro() call
return ($exp) unless(defined($type));
(my $start = index($exp, $type, $type_begin)) != -1 || return ($exp);
my $code_before = $start > 0 ? substr($exp, 0, $start) : '';
my $explen = length($exp);
(my $arg_start = index($exp, "(", $start)+1) != -1 || return ($exp);
my $name = substr($exp, $start+1, $arg_start - $start -2);
$name =~ s/\s*//g;
my @args = ();
my $inside_quotes=0;
my $inside_quotes_char;
my $inside_nested_brackets=0;
my $pos;
for ($pos=$arg_start; $pos <= $explen; $pos++) # TODO:should be < not <= ???
{
my $p = substr($exp, $pos, 1);
if ($p eq '"' || $p eq "'")
{
if (!$inside_quotes || ($inside_quotes && $p eq $inside_quotes_char))
{
$inside_quotes = $inside_quotes ? 0 : $pos;
$inside_quotes_char = $inside_quotes ? $p : '';
}
}
elsif ($inside_quotes) { next; }
elsif
(
!$inside_nested_brackets && ($p eq ')'
|| $p eq ','
|| substr($exp, $pos+1) =~ /^\s*->\s*[\w|_]+/)
)
{
push(@args, $self->trim(substr($exp, $arg_start, $pos-($arg_start))));
$arg_start= $pos+1 if ($p eq ',');
if ($p eq ')' || substr($exp, $pos+1) =~ /^\s*->\s*[\w|_]+/) # End of ARG list
{
push(@args, substr($exp, $pos+1) =~ /^\s*->\s*([\w|_]+)/ ? "$name->$1" : '')
if ($type eq '%');
$self->err->trace_msg(12, "-->parser::extract @{[
$type eq '&' ? 'macro' : 'table' ]}:$name(@{[ join(',', @args) ]})");
my $code_after = substr($exp, $pos+1+($type eq '%' ? $+[0] : 0));
return ($code_before, $code_after, $name, $type, @args);
}
}
elsif (($p eq '(')) { $inside_nested_brackets++; }
elsif (($p eq ')')) { $inside_nested_brackets--; }
}
confess "extract: Unexpected end of expression encountered at $pos!\n$exp\n" . (' ' x $pos) . '^' . "\n";
}
sub update_xref
{
my $self = shift;
my $obj = shift;
my @args = @_;
return unless (defined($self->_target_object()));
$self->macro_use_list()->push_back($obj)
if (defined($self->macro_use_list()) && $obj->isa('ETL::Pequel3::Type::Macros::Abstract'));
$self->_target_object()->xref()->references($obj) if ($self->_target_object()->can('xref'));
$obj->xref()->referenced_by($self->_target_object()) if ($obj->can('xref'));
#TODO: for join/table need to get ref to field which is in args
$self->err()->trace_msg(10, "-->"
. "parser::translate extracted "
. (
$obj->isa('ETL::Pequel3::Type::Macros::Abstract')
? ( 'macro:' . $obj->name())
: $obj->isa('ETL::Pequel3::Type::Table::Abstract')
? ('table:' . $obj->name())
: ('join:' . $obj->join_name())
)
. "(@{[ join(', ', @args) ]})"
. " <-- referenced by '@{[
defined($self->_target_object()->name()) ? $self->_target_object()->name() : '<>'
]}' (@{[ ref($self->_target_object()) ]})"
);
}
sub trim { my $self = shift; my $st = shift; $st =~ s/^\s+//; $st =~ s/\s+$//; return $st; }
sub extract_args
{
my $self = shift;
my $argstr = shift;
my $arg_start = shift || 0;
my $inside_quotes=0;
my $inside_quotes_char;
my @args;
my $pos;
for ($pos=$arg_start; $pos < length($argstr); $pos++)
{
my $p = substr($argstr, $pos, 1);
if ($p eq '"' || $p eq "'")
{
if (!$inside_quotes || ($inside_quotes && $p eq $inside_quotes_char))
{
$inside_quotes = $inside_quotes ? 0 : $pos;
$inside_quotes_char = $inside_quotes ? $p : '';
}
}
elsif ($inside_quotes) { next; }
elsif ($p eq ' ')
{
push(@args, substr($argstr, $arg_start, $pos-$arg_start));
$arg_start = $pos+1 if ($p eq ' ');
}
}
push(@args, substr($argstr, $arg_start, $pos-$arg_start)) if ($pos - $arg_start != 0);
my @p;
foreach (@args) {
if (/[=]/) {
my ($name, @val) = split(/[=]/);
push(@p, $name, join('=', @val));
$p[$#p] =~ s/^('|")//;
$p[$#p] =~ s/('|")$//;
}
else
{
push(@p, $_);
}
}
return (@p);
}
sub translate_array_fields
{
my $self = shift;
my $exp = shift;
my $c = shift;
my $depth = shift;
return $exp;
}
}
# ----------------------------------------------------------------------------------------------------
{
package ETL::Pequel3::Parser::TranslateFields;
use Class::STL::ClassMembers qw( err );
use Class::STL::ClassMembers::Constructor;
sub new_extra
{
my $self = shift;
$self->err(ETL::Pequel3::Error->new());
return $self;
}
sub translate
{
my $self = shift;
my $exp = shift;
my @used_by = @_;
return $exp;
}
sub save_quotes
{
my $self = shift;
my $exp = shift;
$exp =~ s/'/__Q__/g;
$exp =~ s/"/__QQ__/g;
return $exp;
}
sub restore_quotes
{
my $self = shift;
my $exp = shift;
$exp =~ s/__Q__/'/g;
$exp =~ s/__QQ__/"/g;
return $exp;
}
}
# ----------------------------------------------------------------------------------------------------
{
package ETL::Pequel3::Parser::TranslateFields::Input;
use base qw(ETL::Pequel3::Parser::TranslateFields);
use Class::STL::ClassMembers qw( input_fields );
use Class::STL::ClassMembers::Constructor;
sub translate
{
my $self = shift;
my $exp = shift;
my $used_by = shift;
$exp = $self->save_quotes($exp); # TODO: not enough -- synonym may be space delimited within the qoutes...
foreach ($self->input_fields()->to_array()) {
#> if ($exp =~ s/(?<!->)\b\:?@{[ $_->name() ]}\b/@{[ $_->getvar() ]}/g) { # TODO: colon fieldnames
if ($exp =~ s/(?<!->)\b@{[ $_->name() ]}\b/@{[ $_->getvar() ]}/g) {
# look behind -- name does not follow -> indicating table-field.
if (defined($used_by)) { # && $used_by->can('use_list')) {
$used_by->xref()->references($_) if ($used_by->can('xref'));
$_->xref()->referenced_by($used_by) if ($_->can('xref'));
#> $self->err()->trace_msg(10, "-->parser::translate_input: '@{[
#> defined($used_by->name()) ? $used_by->name() : q/NULL/ ]}' (@{[
#> ref($used_by) ]}) -->references '@{[ $_->name ]}' (@{[ ref($_) ]})");
#>TODO $self->err()->error_msg() if ($_->isa('ETL::Pequel3::Type::InputField') && $u->field_number() >= $_->field_number()
}
}
}
$exp = $self->restore_quotes($exp);
return $exp;
}
}
# ----------------------------------------------------------------------------------------------------
{
package ETL::Pequel3::Parser::TranslateFields::Output;
use base qw(ETL::Pequel3::Parser::TranslateFields);
use Class::STL::ClassMembers qw( input_fields output_fields );
use Class::STL::ClassMembers::Constructor;
sub translate
{
my $self = shift;
my $exp = shift;
my $used_by = shift;
$exp = $self->save_quotes($exp);
foreach ($self->output_fields()->to_array(), $self->input_fields()->to_array()) {
#> if ($exp =~ s/(?<!->)\b\:?@{[ $_->name() ]}\b/@{[ $_->getvar() ]}/g) { # TODO: colon fieldnames
if ($exp =~ s/(?<!->)\b@{[ $_->name() ]}\b/@{[ $_->getvar() ]}/g) {
# look behind -- name does not follow -> indicating table-field.
if (defined($used_by)) { # && $used_by->can('use_list')) {
#> ETL::Pequel3::CrossRef::add($used_by, $_) if ($used_by->can('xref'));
$used_by->xref()->references($_) if ($used_by->can('xref'));
$_->xref()->referenced_by($used_by) if ($_->can('xref'));
#> $self->err()->trace_msg(10, "-->parser::translate_output: '@{[
#> defined($used_by->name()) ? $used_by->name() : q/NULL/ ]}' (@{[
#> ref($used_by) ]}) -->references '@{[ $_->name ]}' (@{[ ref($_) ]})");
#>TODO $self->err()->error_msg() if ($_->isa('ETL::Pequel3::Type::OutputField') && $u->field_number() >= $_->field_number()
#>TODO calculated output fields may not reference input fields!
}
}
}
$exp = $self->restore_quotes($exp);
return $exp;
}
}
# ----------------------------------------------------------------------------------------------------
1;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -