已经解决--> 见编辑 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 的积分,因为他的提示提供了突破。