Perl: String to anonymous array?

Question

SOLVED ALREADY --> See edit 7

At this moment I'm fairly new on Perl, and trying to modify part of an existing page (in Wonderdesk). The way the page works, is that it gets the information from the GET url and parses it to an SQL query.

Since this is part of a much larger system, I'm not able to modify the coding around it, and have to solve it in this script.

A working test I performed:

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

When running this, the query that is being build returns something as

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

The part of my code that does not work as expected:

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

When running this, the query that is being build returns something as

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

I've tried to debug it, and used Data::Dumper to get the result of $callIDsearch, which appears as [33450, 31450] in my browser.

Can someone give me a hint on how to transform from '123,456' into ['123', '456']?

With kind regards, Marcel

--===--

Edit:

As requested, minimal code piece that works:

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

Code that does not work:

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

--===--

Edit 2:

Source of the question: The following part of the code is responsible for getting the correct information from the database:

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;

Now instead of being able to provide a single parameter help_id, I want to be able to provide multiple parameters.

--===--

Edit 3:

query_sth is either of the following two, have not been able to find it out yet:

$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

Or

$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

--===--

Edit 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

--===--

Edit 5: I've uploaded the SQL module that is used: https://www.dropbox.com/s/yz0bq8ch8kdgyl6/SQL.zip

--===--

Edit 6:

On request, the dumps (trimmed to only include the sections for help_id):

The result of the modification in Base.pm for the non-working code:

$VAR1 = [
          33450,
          31450
        ];

The result of the modification in Condition.pm for the non-working code:

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

The result for the modification in Base.pm for the working code:

$VAR1 = [
          33450,
          31976
        ];

The result for the modification in Condition.pm for the working code:

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

It looks as if the value gets changed afterwards somehow :S All I changed for the working/non-working code was to replace:

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

With:

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

--===--

Edit 7:

After reading all the tips, I decided to start over and found that by writing some logs to files, I could break down into the issue with more details.

I'm still not sure why, but it now works, using the same methods as before. I think it's a typo/glitch/bug in my code somewhere..

Sorry to have bothered you all, but I still recommend the points to go to amon due to his tips providing the breakthrough.

Answer 1

I don't have an answer, but I have found a few critical points where we need to know what is going on.

In build_query_cond (Base.pm line 528), an array argument will be transformed into an key in (...) relation:

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];
    }
}

Interesting bit in sql (Condition.pm line 181). Even if there is an arrayref, an IN test will be simplified to an = test if it contains only a single element.

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";
}

Before these two conditions, it would be interesting to insert the following code:

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

where ... is $opts->{$field} in the first snippet or $cond in the second snippet. The resulting stack trace would allow us to find all subroutines which could have modified the value. For this to work, the following code has to be placed in your main script before starting the query:

use Carp ();
use Data::Dumper;

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

Once the code has been modified like this, run both the working and not-working code, and print out the resulting query with

print Dumper($result);

So for each of your code snippets, we should get two stack traces and one resulting SQL query.

Answer 2

A shot in the dark... there's a temporary array @callIDs created by this code:

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

If some other part of your code modifies @callIDs, even after it's been assigned to $input->{help_id}, that could cause problems. Of course the fact that it's a lexical (my) variable means that any such changes to @callIDs are probably "nearby".

You could eliminate the named temporary array by doing the split like this:

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

Answer 3

I'm not sure I understand exactly why this is happening. It seems that your query builder needs an arrayref of strings. You can use map to do that

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

Answer 4

This code should work

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

If your code somehow detect your data is number you can use

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

If it somehow become number and you need string instead which should not in this case but advice for future work:

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