1

已经解决--> 见编辑 7

目前我对 Perl 还很陌生,并试图修改现有页面的一部分(在 Wonderdesk 中)。该页面的工作方式是,它从 GET url 获取信息并将其解析为 SQL 查询。

由于这是一个更大系统的一部分,我无法修改它周围的编码,并且必须在这个脚本中解决它。

我执行的工作测试:

$input->{help_id} = ['33450','31976'];

运行此程序时,正在构建的查询返回如下内容

select * from table where help_id in(33450,31976)

我的代码中没有按预期工作的部分:

my $callIDs = '33450,31450';
my @callIDs = split(/,/,$callIDs);
my $callIDsearch = \@callIDs;
$input->{help_id} = $callIDsearch;

运行此程序时,正在构建的查询返回如下内容

select * from table where help_id = '33450,31976'

我尝试调试它,并使用 Data::Dumper 获取 $callIDsearch 的结果,在我的浏览器中显示为 [33450, 31450]。

有人可以给我一个关于如何从 '123,456' 转换为 ['123', '456'] 的提示吗?

亲切的问候, 马塞尔

--===--

编辑:

根据要求,工作的最小代码段:

$input->{help_id} = ['123','456']

不起作用的代码:

$str = '123,456';
@ids = split(/,/,$str);
$input->{help_id} = \@ids;

--===--

编辑2:

问题来源:以下部分代码负责从数据库中获取正确的信息:

my $input = $IN->get_hash;
my $db = $DB->table('help_desk');
foreach (keys %$input){
    if (/^corr/ and !/-opt$/ and $input->{$_} or $input->{keyword}){
        $db = $DB->table('help_desk','correspondence');
        $input->{rs} = 'DISTINCT help_id,help_name,help_email,help_datetime,help_subject,help_website,help_category,
                       help_priority,help_status,help_emergency_flag,help_cus_id_fk,help_tech,help_attach';
       $input->{left_join} = 1;
        last;
    }
}

# Do the search
my $sth  = $db->query_sth($input);
my $hits = $db->hits;

现在,我希望能够提供多个参数,而不是能够提供单个参数 help_id。

--===--

编辑3:

query_sth 是以下两种之一,暂时还没有查到:

$COMPILE{query} = __LINE__ . <<'END_OF_SUB';
sub query {
# -----------------------------------------------------------
# $obj->query($HASH or $CGI);
# ----------------------------
#   Performs a query based on the options in the hash.
#   $HASH can be a hash ref, hash or CGI object.
#
#   Returns the result of a query as fetchall_arrayref.
#
    my $self = shift;
    my $sth = $self->_query(@_) or return;
    return $sth->fetchall_arrayref;
}
END_OF_SUB

$COMPILE{query_sth} = __LINE__ . <<'END_OF_SUB';
sub query_sth {
# -----------------------------------------------------------
# $obj->query_sth($HASH or $CGI);
# --------------------------------
# Same as query but returns the sth object.
#
    shift->_query(@_)
}
END_OF_SUB

或者

$COMPILE{query} = __LINE__ . <<'END_OF_SUB';
sub query {
# -------------------------------------------------------------------
# Just performs the query and returns a fetchall.
#
    return shift->_query(@_)->fetchall_arrayref;
}
END_OF_SUB

$COMPILE{query_sth} = __LINE__ . <<'END_OF_SUB';
sub query_sth {
# -------------------------------------------------------------------
# Just performs the query and returns an active sth.
#
    return shift->_query(@_);
}
END_OF_SUB

--===--

编辑 4:_query

$COMPILE{_query} = __LINE__ . <<'END_OF_SUB';
sub _query {
# -------------------------------------------------------------------
# Parses the input, and runs a select based on input.
#
    my $self = shift;
    my $opts = $self->common_param(@_) or return $self->fatal(BADARGS => 'Usage: $obj->insert(HASH or HASH_REF or CGI) only.');
    $self->name or return $self->fatal('NOTABLE');
# Clear errors.
    $self->{_error} = [];

# Strip out values that are empty or blank (as query is generally derived from
# cgi input).
my %input = map { $_ => $opts->{$_} } grep { defined $opts->{$_} and $opts->{$_} !~ /^\s*$/ } keys %$opts;
    $opts = \%input;

# If build_query_cond returns a GT::SQL::Search object, then we are done.
    my $cond = $self->build_query_cond($opts, $self->{schema}->{cols});

    if ( ( ref $cond ) =~ /(?:DBI::st|::STH)$/i ) {
        return $cond;
    }

# If we have a callback, then we get all the results as a hash, send them
# to the callback, and then do the regular query on the remaining set.
    if (defined $opts->{callback} and (ref $opts->{callback} eq 'CODE')) {
        my $pk  = $self->{schema}->{pk}->[0];
        my $sth = $self->select($pk, $cond) or return;
        my %res = map { $_ => 1 } $sth->fetchall_list;
        my $new_results = $opts->{callback}->($self, \%res);
        $cond = GT::SQL::Condition->new($pk, 'IN', [keys %$new_results]);
    }

# Set the limit clause, defaults to 25, set to -1 for none.
    my $in = $self->_get_search_opts($opts);
    my $offset   = ($in->{nh} - 1) * $in->{mh};
    $self->select_options("ORDER BY $in->{sb} $in->{so}") if ($in->{sb});
    $self->select_options("LIMIT $in->{mh} OFFSET $offset") unless $in->{mh} == -1;

# Now do the select.
    my @sel = ();
    if ($cond)                  { push @sel, $cond }
    if ($opts->{rs} and $cond)  { push @sel, $opts->{rs} }
    my $sth = $self->select(@sel) or return;

    return $sth;
}
END_OF_SUB

--===--

编辑 5:我已经上传了使用的 SQL 模块: https ://www.dropbox.com/s/yz0bq8ch8kdgyl6/SQL.zip

--===--

编辑6:

根据要求,转储(修剪为仅包括 help_id 的部分):

Base.pm 中对非工作代码的修改结果:

$VAR1 = [
          33450,
          31450
        ];

在 Condition.pm 中修改非工作代码的结果:

$VAR1 = [
          "help_id",
          "IN",
          [
            33450,
            31450
          ]
        ];
$VAR1 = [
      "cus_username",
      "=",
      "Someone"
    ];
$VAR1 = [
          "help_id",
          "=",
          "33450,31450"
        ];

在 Base.pm 中修改工作代码的结果:

$VAR1 = [
          33450,
          31976
        ];

在 Condition.pm 中修改工作代码的结果:

$VAR1 = [
          "help_id",
          "IN",
          [
            33450,
            31976
          ]
        ];

看起来好像值后来以某种方式更改了:S 我为工作/非工作代码所做的所有更改都是为了替换:

$input->{help_id} = ['33450','31976'];

和:

$input->{help_id} = [ split(/,/,'33450,31450') ];

--===--

编辑 7:

在阅读了所有提示后,我决定重新开始,发现通过将一些日志写入文件,我可以更详细地分解问题。

我仍然不确定为什么,但它现在可以使用,使用与以前相同的方法。我认为这是我的代码中某处的错字/故障/错误..

很抱歉打扰了大家,但我仍然建议去 amon 的积分,因为他的提示提供了突破。

4

4 回答 4

1

我没有答案,但我发现了一些我们需要知道发生了什么的关键点。

build_query_condBase.pm第 528 行)中,数组参数将转换为key in (...)关系:

if (ref($opts->{$field}) eq 'ARRAY' ) {
    my $add = [];
    for ( @{$opts->{$field}} ) {
        next if !defined( $_ ) or !length( $_ ) or !/\S/;
        push @$add, $_;
    }
    if ( @$add ) {
        push @ins, [$field, 'IN', $add];
    }
}

有趣的位在sqlCondition.pm第 181 行)。即使有一个arrayref,如果它只包含一个元素,一个IN测试也会被简化为一个测试。=

if (uc $op eq 'IN' || $op eq '=' and ref $val eq 'ARRAY') {
    if (@$val > 1) {
        $op = 'IN';
        $val = '('
            . join(',' => map !length || /\D/ ? quote($_) : $_, @$val)
            . ')';
    }
    elsif (@$val == 0) {
        ($col, $op, $val) = (qw(1 = 0));
    }
    else {
        $op  = '=';
        $val = quote($val->[0]);
    }
    push @output, "$col $op $val";
}

在这两个条件之前,插入以下代码会很有趣:

Carp::cluck(Data::Dumper::Dump(...));

where...$opts->{$field}第一个片段或$cond第二个片段中。生成的堆栈跟踪将允许我们找到所有可能修改该值的子例程。为此,必须在开始查询之前将以下代码放在主脚本中:

use Carp ();
use Data::Dumper;

$Data::Dumper::Useqq = 1;  # escape special characters

像这样修改代码后,运行工作和不工作的代码,并打印出结果查询

print Dumper($result);

因此,对于您的每个代码片段,我们应该获得两个堆栈跟踪和一个结果 SQL 查询。

于 2013-11-29T12:57:26.467 回答
1

黑暗中的一枪......@callIDs这段代码创建了一个临时数组:

my @callIDs = split(/,/,$callIDs);
my $callIDsearch = \@callIDs;
$input->{help_id} = $callIDsearch;

如果您的代码的其他部分修改了@callIDs,即使它被分配到$input->{help_id}之后,也可能会导致问题。当然,它是一个词法 ( my) 变量这一事实意味着任何此类更改@callIDs都可能在“附近”。

您可以通过像这样进行拆分来消除命名的临时数组:

$input->{help_id} = [ split(/,/,$callIDs) ];
于 2013-11-29T14:11:05.533 回答
0

我不确定我是否完全理解为什么会这样。您的查询构建器似乎需要一个字符串数组引用。你可以用它map来做到这一点

my $callIDs = '33450,31450';
my @callIDs = map {$_*1} split(/,/,$callIDs);
$input->{help_id} = \@callIDs;
于 2013-11-29T10:09:15.513 回答
0

这段代码应该可以工作

my $callIDs = '33450,31450';
$input->{help_id} = [split ",", $callIDs];

如果您的代码以某种方式检测到您的数据是您可以使用的数字

my $callIDs = '33450,31450';
$input->{help_id} = [map 0+$_, split ',', $callIDs];

如果它以某种方式变成数字并且您需要字符串而不是在这种情况下不应该,而是对未来工作的建议:

my $callIDs = '33450,31450';
$input->{help_id} = [map ''.$_, split ',', $callIDs];
于 2013-11-29T14:49:38.293 回答