Perl:匿名数组的字符串?

时间:2013-11-29 09:49:50

标签: string perl transform anonymous-arrays

已解决 - >见编辑7

此时我在Perl上相当新,并试图修改现有页面的一部分(在Wonderdesk中)。 页面的工作方式是,它从GET URL获取信息并将其解析为SQL查询。

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

我执行的工作测试:

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

运行此命令时,正在构建的查询将返回

  

从(33450,31976)

中的help_id表中选择*

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

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

运行此命令时,正在构建的查询将返回

  

从表中选择*,其中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 个答案:

答案 0 :(得分: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];
    }
}

sql中的有趣位(Condition.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(...));

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

use Carp ();
use Data::Dumper;

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

一旦代码被修改为这样,运行工作代码和不工作代码,并打印出结果查询

print Dumper($result);

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

答案 1 :(得分:1)

在黑暗中拍摄......这段代码创建了一个临时数组@callIDs

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

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

您可以通过执行以下分割来消除指定的临时数组:

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

答案 2 :(得分:0)

我不确定我究竟为什么会这样。您的查询构建器似乎需要一个字符串的arrayref。您可以使用map来执行此操作

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

答案 3 :(得分: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];