Ejecución de una consulta que tiene filtros dinámicos

El siguiente secript Perl muestra cómo utilizar la API de ClearQuest para ejecutar una consulta que tiene filtros dinámicos. El script utiliza el objeto ResultSet y los métodos relacionados con parámetros GetNumberOfParams, GetParamLabel y GetParamPrompt. El script maneja cada filtro dinámico solicitando un operador de comparación y luego un número de valores adecuados para el operador.

############################################################################
# show-resultset.pl

# show-resultset.pl is a simple script to run queries from the workspace.
# Dynamic filters are handled by prompting for the comparison operator
# followed by a number of values appropriate for the operator.


use strict;
use warnings;

use CQPerlExt;
############################################################################


our %FieldTypeMap =
(
    $CQPerlExt::CQ_SHORT_STRING     => "short_string",
    $CQPerlExt::CQ_MULTILINE_STRING => "multiline",
    $CQPerlExt::CQ_INT              => "int",
    $CQPerlExt::CQ_DATE_TIME        => "date_time",
    $CQPerlExt::CQ_REFERENCE        => "reference",
    $CQPerlExt::CQ_REFERENCE_LIST   => "reference_list",
    $CQPerlExt::CQ_ATTACHMENT_LIST  => "attachment",
    $CQPerlExt::CQ_ID               => "id",
    $CQPerlExt::CQ_STATE            => "state",
    $CQPerlExt::CQ_JOURNAL          => "journal",
    $CQPerlExt::CQ_DBID             => "dbid",
    $CQPerlExt::CQ_STATETYPE        => "statetype",
    $CQPerlExt::CQ_RECORDTYPE       => "recordtype",
    $CQPerlExt::CQ_FLOAT            => "float",
);

sub ToFieldType($)
{
    my ($type) = @_;
    my $image = $FieldTypeMap{$type};
    if (not defined($image)) {
        $image = "<FieldType-$type>";
    }
    return $image;
}


###############################################################################

our %CompOpMap =
(
    $CQPerlExt::CQ_COMP_OP_EQ          => "EQ",
    $CQPerlExt::CQ_COMP_OP_NEQ         => "NEQ",
    $CQPerlExt::CQ_COMP_OP_LT          => "LT",
    $CQPerlExt::CQ_COMP_OP_LTE         => "LTE",
    $CQPerlExt::CQ_COMP_OP_GT          => "GT",
    $CQPerlExt::CQ_COMP_OP_GTE         => "GTE",
    $CQPerlExt::CQ_COMP_OP_LIKE        => "LIKE",
    $CQPerlExt::CQ_COMP_OP_NOT_LIKE    => "NOT_LIKE",
    $CQPerlExt::CQ_COMP_OP_BETWEEN     => "BETWEEN",
    $CQPerlExt::CQ_COMP_OP_NOT_BETWEEN => "NOT_BETWEEN",
    $CQPerlExt::CQ_COMP_OP_IS_NULL     => "IS_NULL",
    $CQPerlExt::CQ_COMP_OP_IS_NOT_NULL => "IS_NOT_NULL",
    $CQPerlExt::CQ_COMP_OP_IN          => "IN",
    $CQPerlExt::CQ_COMP_OP_NOT_IN      => "NOT_IN",
);

sub ToCompOp($)
{
    my ($type) = @_;
    my $image = $CompOpMap{$type};
    if (not defined($image)) {
        $image = "<CompOp-$type>";
    }
    return $image;
}


sub CompOpList()
{
    my $image = "";
    foreach my $key (sort { $a <=>$b } keys %CompOpMap) {
        $image .= ", " if ($image ne "");
        $image .= ("$key=" . ToCompOp($key));
    }
    return $image;
}

############################################################################
sub ArrayToList($$)
{
    my ($array, $listmax) = @_; # CQStringArray ref, list max

    # Determine the range of elements to elide from a long list.  Show the
    # first (limit - 2) items, then an ellipsis, then the final 2 items.  It
    # therefore makes no sense to elide any elements when there are 5 elements
    # or less.  It also makes no sense to elide just one element, since that
    # item is replaced with an ellipsis.  Note that when the list is shorter
    # than the maximum, the range will be negative (i.e. first > last) and
    # nothing will be elided.

    my $count = scalar(@$array);
    $listmax = 5 if $listmax < 5;
    $listmax = $count if ($count == $listmax + 1);

    my $elide_first = $listmax - 1;
    my $elide_last  = $count - 2;

    my $num = 0;
    my $list = "";
    foreach my $value (@$array) {
        $num++;
        if ($num >= $elide_first && $num <= $elide_last) {
            if ($num == $elide_last) {
                $list .= ",...";
            }
            next;
        }
        $list .= "," if ($list ne "");
        $list .= "\"$value\"";
    }
    $list = "[$count]($list)";
    return $list;
}

###############################################################################

sub values_for_compop($)
{
    # Return the number of parameter values needed for a comparison operator.
    # The result will be 0 if the operator takes a list.  If the operator is
    # not recognized, a -1 is returned.

    my ($compop) = @_;

    if ($compop == $CQPerlExt::CQ_COMP_OP_BETWEEN ||
        $compop == $CQPerlExt::CQ_COMP_OP_NOT_BETWEEN) {
        return 2;
    }
    if ($compop == $CQPerlExt::CQ_COMP_OP_IN ||
        $compop == $CQPerlExt::CQ_COMP_OP_NOT_IN) {
        return 0;
    }
    if ($compop >= $CQPerlExt::CQ_COMP_OP_EQ &&
        $compop <= $CQPerlExt::CQ_COMP_OP_NOT_IN) {
        		return 1;
}
    return -1;
}

sub execute_query($$)
{
    my ($session, $querydef) = @_;
    my $verbose = 0; # change to get SQL statement

    my $rset = $session->BuildResultSet($querydef);

    my $params = $rset->GetNumberOfParams();
    if ($params > 0) {
        print "ResultSet has $params dynamic filters\n";
        print "Use numbers to select comparison operators:\n";
        print "  0=skip, " . CompOpList() . "\n";
        print "\n";

        for (my $i = 1; $i <= $params; $i++) {
            $rset->ClearParamValues($i);

            my $label   = $rset->GetParamLabel($i);
            my $type    = $rset->GetParamFieldType($i);
            my $prompt  = $rset->GetParamPrompt($i);
            my $choices = $rset->GetParamChoiceList($i);

            print "Param $i:\n";
            print "  label:   $label\n";
            print "  type:    " . ToFieldType($type) . "\n";
            if (scalar(@$choices) > 0) {
                print "  choices: " . ArrayToList($choices, 10) . "\n";
            }

            my $values_needed = -1;
            my $compop = "";
            while ($values_needed < 0) {
                print "  Comparison operator? ";
                $compop = <STDIN>;
                chomp $compop;
                last if ($compop eq "0");
                if ($compop !~ /^\d+$/) {
                    print "ERROR: entry \"$compop\" is not numeric\n";
                    next;
                }
                eval {
                    $rset->SetParamComparisonOperator($i, $compop);
                    $values_needed = values_for_compop($compop);
                    if ($values_needed < 0) {
                        print "ERROR: operator \"$compop\" is not valid\n";
                    }
                };
                if ($@){
                    print "ERROR: operator \"$compop\" is not valid: $@\n";
                    next;
                }
            }
            if ($compop eq "") {
                # User chose to skip this filter.
                next;
            }

            my $need_list = 0;
            if ($values_needed == 0) {
                $need_list = 1;

                # Indent to align with operator report above.
                print "    enter each list value individually; " .
                      "complete the list with a \".\" value\n";
            }

            my @values;
            while ($need_list || $values_needed-- > 0) {
                print "  $prompt ";
                my $value = <STDIN>;
                chomp $value;
                last if ($need_list && $value eq ".");
                push @values, $value;
            }

            foreach my $value (@values) {
                $rset->AddParamValue($i, $value);
            }
        }
    }

    $rset->EnableRecordCount();
    $rset->Execute();
    my $rows = $rset->GetRecordCount();
    my $cols = $rset->GetNumberOfColumns();

    print "\n";
    print "ResultSet has $rows rows of $cols columns\n";
    if ($verbose) {
        my $colsql = $rset->GetSQL();
        print "\nSQL statement:\n  $colsql\n";
    }

    print "\n";

    my $recnum = 0;

    my $status = $rset->MoveNext();
    while ($status == $CQPerlExt::CQ_SUCCESS) {
        $recnum++;

        print "Record $recnum:\n";

        my $column = 1;
        while ($column <= $cols) {
            my $collabel = $rset->GetColumnLabel($column);
            my $colvalue = $rset->GetColumnValue($column);
            $colvalue =~ s/\t/<tab>/;
            print "  $collabel: $colvalue\n";
            $column++;
        }

        print "Record $recnum complete\n";
        print "\n";

        $status = $rset->MoveNext();
    }

    if ($status != $CQPerlExt::CQ_NO_DATA_FOUND) {
        print "WARNING: result set terminated with status $status\n";
    }
}


###############################################################################
## MAIN

if (scalar(@ARGV) < 4) {
    print "Usage: "
        . "show-resultset.pl <username> <password> <database> <dbset> "
        . "<query-name> ...\n";
    exit 1;
}

my $username = shift @ARGV;
my $password = shift @ARGV;
my $database = shift @ARGV;
my $dbset    = shift @ARGV;

my $clearquest = CQClearQuest::Build();
my $session = $clearquest->CreateUserSession();

print "--- user logon starting\n";
$session->UserLogon($username, $password, $database, $dbset);

print "--- getting workspace\n";
my $workspace = $session->GetWorkSpace();

while (scalar(@ARGV) > 0) {
    my $query_name = shift @ARGV;

    eval {
        print "--- loading querydef \"$query_name\"\n";
        my $query = $workspace->GetQueryDef($query_name);

        print "--- executing query\n";
        execute_query($session, $query);
    };
    if ($@){
        print "*** unable to process query \"$query_name\": $@\n";
    }
}

print "--- finished\n";


###############################################################################
# end show-resultset.pl

Comentarios