lib/SGN/Controller/AJAX/HTMLSelect.pm

   1
   2 =head1 SGN::Controller::AJAX::HTMLSelect - a resource to dynamically obtain html selects for a number of widely used data types
   3
   4 =head1 SYNOPSYS
   5
   6 get_location_select()
   7
   8 get_breeding_program_select()
   9
  10 get_year_select()
  11
  12
  13
  14 =head1 AUTHOR
  15
  16 Lukas Mueller <lam87@cornell.edu>
  17
  18 =cut
  19
  20 package SGN::Controller::AJAX::HTMLSelect;
  21
  22 use Moose;
  23
  24 use Data::Dumper;
  25 use CXGN::BreedersToolbox::Projects;
  26 use CXGN::Page::FormattingHelpers qw | simple_selectbox_html |;
  27 use Scalar::Util qw | looks_like_number |;
  28 use CXGN::Trial;
  29 use CXGN::Onto;
  30 use CXGN::Trial::Folder;
  31 use SGN::Model::Cvterm;
  32 use CXGN::Chado::Stock;
  33 use CXGN::Stock::Search;
  34
  35 BEGIN { extends 'Catalyst::Controller::REST' };
  36
  37 __PACKAGE__->config(
  38     default   => 'application/json',
  39     stash_key => 'rest',
  40     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  41    );
  42
  43
  44 sub get_location_select : Path('/ajax/html/select/locations') Args(0) {
  45     my $self = shift;
  46     my $c = shift;
  47
  48     my $id = $c->req->param("id") || "location_select";
  49     my $name = $c->req->param("name") || "location_select";
  50     my $empty = $c->req->param("empty") || "";
  51
  52     my $locations = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } )->get_all_locations();
  53
  54     if ($empty) { unshift @$locations, [ "", "Select Location" ] }
  55
  56     my $default = $c->req->param("default") || @$locations[0]->[0];
  57
  58     my $html = simple_selectbox_html(
  59       name => $name,
  60       id => $id,
  61       choices => $locations,
  62       selected => $default
  63           );
  64     $c->stash->{rest} = { select => $html };
  65 }
  66
  67 sub get_breeding_program_select : Path('/ajax/html/select/breeding_programs') Args(0) {
  68     my $self = shift;
  69     my $c = shift;
  70
  71     my $id = $c->req->param("id") || "breeding_program_select";
  72     my $name = $c->req->param("name") || "breeding_program_select";
  73     my $empty = $c->req->param("empty") || "";
  74
  75     my $breeding_programs = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } )->get_breeding_programs();
  76
  77     my $default = $c->req->param("default") || @$breeding_programs[0]->[0];
  78     if ($empty) { unshift @$breeding_programs, [ "", "please select" ]; }
  79
  80     my $html = simple_selectbox_html(
  81       name => $name,
  82       id => $id,
  83       choices => $breeding_programs,
  84       selected => $default
  85     );
  86     $c->stash->{rest} = { select => $html };
  87 }
  88
  89 sub get_year_select : Path('/ajax/html/select/years') Args(0) {
  90     my $self = shift;
  91     my $c = shift;
  92
  93     my $id = $c->req->param("id") || "year_select";
  94     my $name = $c->req->param("name") || "year_select";
  95     my $empty = $c->req->param("empty") || "";
  96     my $auto_generate = $c->req->param("auto_generate") || "";
  97
  98     my @years;
  99     if ($auto_generate) {
 100       my $next_year = 1901 + (localtime)[5];
 101       my $oldest_year = $next_year - 30;
 102       @years = sort { $b <=> $a } ($oldest_year..$next_year);
 103     }
 104     else {
 105       @years = sort { $b <=> $a } CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } )->get_all_years();
 106     }
 107
 108     my $default = $c->req->param("default") || $years[1];
 109
 110     my $html = simple_selectbox_html(
 111       name => $name,
 112       id => $id,
 113       choices => \@years,
 114       selected => $default
 115     );
 116     $c->stash->{rest} = { select => $html };
 117 }
 118
 119 sub get_trial_folder_select : Path('/ajax/html/select/folders') Args(0) {
 120     my $self = shift;
 121     my $c = shift;
 122
 123     my $breeding_program_id = $c->req->param("breeding_program_id");
 124     my $folder_for_trials = 1 ? $c->req->param("folder_for_trials") eq 'true' : 0;
 125     my $folder_for_crosses = 1 ? $c->req->param("folder_for_crosses") eq 'true' : 0;
 126
 127     my $id = $c->req->param("id") || "folder_select";
 128     my $name = $c->req->param("name") || "folder_select";
 129     my $empty = $c->req->param("empty") || ""; # set if an empty selection should be present
 130
 131
 132     my @folders = CXGN::Trial::Folder->list({
 133             bcs_schema => $c->dbic_schema("Bio::Chado::Schema"),
 134             breeding_program_id => $breeding_program_id,
 135         folder_for_trials => $folder_for_trials,
 136         folder_for_crosses => $folder_for_crosses
 137     });
 138
 139     if ($empty) {
 140       unshift @folders, [ 0, "None" ];
 141     }
 142
 143     my $html = simple_selectbox_html(
 144       name => $name,
 145       id => $id,
 146       choices => \@folders,
 147     );
 148     $c->stash->{rest} = { select => $html };
 149 }
 150
 151 sub get_trial_type_select : Path('/ajax/html/select/trial_types') Args(0) {
 152     my $self = shift;
 153     my $c = shift;
 154
 155     my $id = $c->req->param("id") || "trial_type_select";
 156     my $name = $c->req->param("name") || "trial_type_select";
 157     my $empty = $c->req->param("empty") || ""; # set if an empty selection should be present
 158
 159     my @types = CXGN::Trial::get_all_project_types($c->dbic_schema("Bio::Chado::Schema"));
 160
 161     if ($empty) {
 162         unshift @types, [ '', "None" ];
 163     }
 164
 165     my $default = $c->req->param("default") || $types[0]->[0];
 166
 167     my $html = simple_selectbox_html(
 168       name => $name,
 169       id => $id,
 170       choices => \@types,
 171       selected => $default
 172     );
 173     $c->stash->{rest} = { select => $html };
 174 }
 175
 176 sub get_treatments_select : Path('/ajax/html/select/treatments') Args(0) {
 177     my $self = shift;
 178     my $c = shift;
 179     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 180     my $trial_id = $c->req->param("trial_id");
 181
 182     my $id = $c->req->param("id") || "treatment_select";
 183     my $name = $c->req->param("name") || "treatment_select";
 184     my $empty = $c->req->param("empty") || ""; # set if an empty selection should be present
 185
 186     my $trial = CXGN::Trial->new({ bcs_schema => $schema, trial_id => $trial_id });
 187     my $data = $trial->get_treatments();
 188
 189     if ($empty) {
 190         unshift @$data, [ 0, "None" ];
 191     }
 192     my $html = simple_selectbox_html(
 193       name => $name,
 194       id => $id,
 195       choices => $data,
 196     );
 197     $c->stash->{rest} = { select => $html };
 198 }
 199
 200 sub get_trials_select : Path('/ajax/html/select/trials') Args(0) {
 201     my $self = shift;
 202     my $c = shift;
 203     my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } );
 204     my $breeding_program_id = $c->req->param("breeding_program_id");
 205
 206     my $projects;
 207     if (!$breeding_program_id) {
 208       $projects = $p->get_breeding_programs();
 209     } else {
 210       push @$projects, [$breeding_program_id];
 211     }
 212
 213     my $id = $c->req->param("id") || "html_trial_select";
 214     my $name = $c->req->param("name") || "html_trial_select";
 215     my $size = $c->req->param("size");
 216     my $empty = $c->req->param("empty") || "";
 217     my $multiple = $c->req->param("multiple") || 0;
 218     my @trials;
 219     foreach my $project (@$projects) {
 220       my ($field_trials, $cross_trials, $genotyping_trials) = $p->get_trials_by_breeding_program($project->[0]);
 221       foreach (@$field_trials) {
 222           push @trials, $_;
 223       }
 224     }
 225     @trials = sort { $a->[1] cmp $b->[1] } @trials;
 226
 227     if ($empty) { unshift @trials, [ "", "Please select a trial" ]; }
 228
 229     my $html = simple_selectbox_html(
 230       multiple => $multiple,
 231       name => $name,
 232       id => $id,
 233       size => $size,
 234       choices => \@trials,
 235     );
 236     $c->stash->{rest} = { select => $html };
 237 }
 238
 239 sub get_stocks_select : Path('/ajax/html/select/stocks') Args(0) {
 240         my $self = shift;
 241         my $c = shift;
 242         my $params = _clean_inputs($c->req->params);
 243     my $names_as_select = $params->{names_as_select}->[0] || 0;
 244
 245         my $stock_search = CXGN::Stock::Search->new({
 246                 bcs_schema=>$c->dbic_schema("Bio::Chado::Schema", "sgn_chado"),
 247                 people_schema=>$c->dbic_schema("CXGN::People::Schema"),
 248                 phenome_schema=>$c->dbic_schema("CXGN::Phenome::Schema"),
 249                 match_type=>$params->{match_type}->[0],
 250                 match_name=>$params->{match_type}->[0],
 251                 uniquename_list=>$params->{uniquename_list},
 252                 accession_number_list=>$params->{accession_number_list},
 253                 pui_list=>$params->{pui_list},
 254                 genus_list=>$params->{genus_list},
 255                 species_list=>$params->{species_list},
 256                 stock_id_list=>$params->{stock_id_list},
 257                 organism_id=>$params->{organism_id}->[0],
 258                 stock_type_name=>$params->{stock_type_name}->[0],
 259                 stock_type_id=>$params->{stock_type_id}->[0],
 260                 owner_first_name=>$params->{owner_first_name}->[0],
 261                 owner_last_name=>$params->{owner_last_name}->[0],
 262                 trait_cvterm_name_list=>$params->{trait_cvterm_name_list},
 263                 minimum_phenotype_value=>$params->{minimum_phenotype_value}->[0],
 264                 maximum_phenotype_value=>$params->{maximum_phenotype_value}->[0],
 265                 trial_name_list=>$params->{trial_name_list},
 266                 trial_id_list=>$params->{'trial_id_list[]'},
 267                 breeding_program_id_list=>$params->{breeding_program_id_list},
 268                 location_name_list=>$params->{location_name_list},
 269                 year_list=>$params->{year_list},
 270                 organization_list=>$params->{organization_list},
 271                 limit=>$params->{limit}->[0],
 272                 offset=>$params->{offset}->[0],
 273                 minimal_info=>1,
 274         display_pedigree=>0
 275         });
 276         my ($result, $records_total) = $stock_search->search();
 277         #print STDERR Dumper $result;
 278         my $id = $c->req->param("id") || "html_trial_select";
 279         my $name = $c->req->param("name") || "html_trial_select";
 280         my $multiple = defined($c->req->param("multiple")) ? $c->req->param("multiple") : 1;
 281         my $size = $c->req->param("size");
 282         my $empty = $c->req->param("empty") || "";
 283         my $data_related = $c->req->param("data-related") || "";
 284         my @stocks;
 285         foreach my $r (@$result) {
 286         if ($names_as_select) {
 287                 push @stocks, [ $r->{uniquename}, $r->{uniquename} ];
 288         } else {
 289             push @stocks, [ $r->{stock_id}, $r->{uniquename} ];
 290         }
 291         }
 292         @stocks = sort { $a->[1] cmp $b->[1] } @stocks;
 293
 294         if ($empty) { unshift @stocks, [ "", "Please select a stock" ]; }
 295
 296         my $html = simple_selectbox_html(
 297                 multiple => $multiple,
 298                 name => $name,
 299                 id => $id,
 300                 size => $size,
 301                 choices => \@stocks,
 302         data_related => $data_related
 303         );
 304         $c->stash->{rest} = { select => $html };
 305 }
 306
 307 sub get_traits_select : Path('/ajax/html/select/traits') Args(0) {
 308     my $self = shift;
 309     my $c = shift;
 310     my $trial_ids = $c->req->param('trial_ids') || 'all';
 311     my $stock_id = $c->req->param('stock_id') || 'all';
 312     my $stock_type = $c->req->param('stock_type') ? $c->req->param('stock_type') . 's' : 'none';
 313     my $data_level = $c->req->param('data_level') || 'all';
 314     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 315
 316     if ($data_level eq 'all') {
 317         $data_level = '';
 318     }
 319
 320     my @traits;
 321     if (($trial_ids eq 'all') && ($stock_id eq 'all')) {
 322       my $bs = CXGN::BreederSearch->new( { dbh=> $c->dbc->dbh() } );
 323       my $status = $bs->test_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass});
 324       unless ($status->{'success'}) {
 325           $c->stash->{rest} = { select => '<center><p>Direct trait select is not currently available</p></center>'};
 326           return;
 327       }
 328       my $query = $bs->metadata_query([ 'traits' ], {}, {});
 329       @traits = @{$query->{results}};
 330       #print STDERR "Traits: ".Dumper(@traits)."\n";
 331     } elsif (looks_like_number($stock_id)) {
 332         my $stock = CXGN::Chado::Stock->new($schema, $stock_id);
 333         my @trait_list = $stock->get_trait_list();
 334         foreach (@trait_list){
 335             my @val = ($_->[0], $_->[2]."|".$_->[1]);
 336             push @traits, \@val;
 337         }
 338         } elsif ($trial_ids ne 'all') {
 339                 my @trial_ids = split ',', $trial_ids;
 340                 my %unique_traits_ids;
 341                 foreach (@trial_ids){
 342                         my $trial = CXGN::Trial->new({bcs_schema=>$schema, trial_id=>$_});
 343                         my $traits_assayed = $trial->get_traits_assayed($data_level);
 344                         foreach (@$traits_assayed) {
 345                                 $unique_traits_ids{$_->[0]} = [$_->[0], $_->[1]];
 346                         }
 347                 }
 348                 while ( my ($key, $value) = each %unique_traits_ids ){
 349                         push @traits, $value;
 350                 }
 351         }
 352
 353         @traits = sort { $a->[1] cmp $b->[1] } @traits;
 354
 355     my $id = $c->req->param("id") || "html_trial_select";
 356     my $name = $c->req->param("name") || "html_trial_select";
 357         my $size = $c->req->param("size");
 358
 359     my $html = simple_selectbox_html(
 360       multiple => 1,
 361       name => $name,
 362       id => $id,
 363       choices => \@traits,
 364           size => $size
 365     );
 366     $c->stash->{rest} = { select => $html };
 367 }
 368
 369 sub get_phenotyped_trait_components_select : Path('/ajax/html/select/phenotyped_trait_components') Args(0) {
 370     my $self = shift;
 371     my $c = shift;
 372     my $trial_ids = $c->req->param('trial_ids');
 373     #my $stock_id = $c->req->param('stock_id') || 'all';
 374     #my $stock_type = $c->req->param('stock_type') . 's' || 'none';
 375     my $data_level = $c->req->param('data_level') || 'all';
 376     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 377     my $composable_cvterm_format = $c->config->{composable_cvterm_format};
 378
 379     if ($data_level eq 'all') {
 380         $data_level = '';
 381     }
 382
 383     my @trial_ids = split ',', $trial_ids;
 384
 385     my @trait_components;
 386     foreach (@trial_ids){
 387         my $trial = CXGN::Trial->new({bcs_schema=>$schema, trial_id=>$_});
 388         push @trait_components, @{$trial->get_trait_components_assayed($data_level, $composable_cvterm_format)};
 389     }
 390     #print STDERR Dumper \@trait_components;
 391     my %unique_trait_components = map {$_->[0] => $_->[1]} @trait_components;
 392     my @unique_components;
 393     foreach my $id (keys %unique_trait_components){
 394         push @unique_components, [$id, $unique_trait_components{$id}];
 395     }
 396     #print STDERR Dumper \@unique_components;
 397
 398     my $id = $c->req->param("id") || "html_trait_component_select";
 399     my $name = $c->req->param("name") || "html_trait_component_select";
 400
 401     my $html = simple_selectbox_html(
 402       multiple => 1,
 403       name => $name,
 404       id => $id,
 405       choices => \@unique_components,
 406     );
 407     $c->stash->{rest} = { select => $html };
 408 }
 409
 410 sub get_composable_cvs_allowed_combinations_select : Path('/ajax/html/select/composable_cvs_allowed_combinations') Args(0) {
 411     my $self = shift;
 412     my $c = shift;
 413     my $id = $c->req->param("id") || "html_composable_cvs_combinations_select";
 414     my $name = $c->req->param("name") || "html_composable_cvs_combinations_select";
 415     my $composable_cvs_allowed_combinations = $c->config->{composable_cvs_allowed_combinations};
 416     my @combinations = split ',', $composable_cvs_allowed_combinations;
 417     my @select;
 418     foreach (@combinations){
 419         my @parts = split /\|/, $_; #/#
 420         push @select, [$parts[1], $parts[0]];
 421     }
 422     my $html = simple_selectbox_html(
 423       name => $name,
 424       id => $id,
 425       choices => \@select,
 426     );
 427     $c->stash->{rest} = { select => $html };
 428 }
 429
 430 sub get_crosses_select : Path('/ajax/html/select/crosses') Args(0) {
 431     my $self = shift;
 432     my $c = shift;
 433
 434     my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } );
 435
 436     my $breeding_program_id = $c->req->param("breeding_program_id");
 437     my $projects;
 438     if (!$breeding_program_id) {
 439       $projects = $p->get_breeding_programs();
 440     } else {
 441       push @$projects, [$breeding_program_id];
 442     }
 443
 444     my $id = $c->req->param("id") || "html_trial_select";
 445     my $name = $c->req->param("name") || "html_trial_select";
 446     my $size = $c->req->param("size");
 447     my @crosses;
 448     foreach my $project (@$projects) {
 449       my ($field_trials, $cross_trials, $genotyping_trials) = $p->get_trials_by_breeding_program($project->[0]);
 450       foreach (@$cross_trials) {
 451           push @crosses, $_;
 452       }
 453     }
 454     @crosses = sort @crosses;
 455
 456     my $html = simple_selectbox_html(
 457       multiple => 1,
 458       name => $name,
 459       id => $id,
 460       size => $size,
 461       choices => \@crosses,
 462     );
 463     $c->stash->{rest} = { select => $html };
 464 }
 465
 466 sub get_genotyping_protocols_select : Path('/ajax/html/select/genotyping_protocols') Args(0) {
 467     my $self = shift;
 468     my $c = shift;
 469
 470     my $id = $c->req->param("id") || "gtp_select";
 471     my $name = $c->req->param("name") || "genotyping_protocol_select";
 472     my $empty = $c->req->param("empty") || "";
 473     my $default_gtp;
 474     my %gtps;
 475
 476     my $gt_protocols = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } )->get_gt_protocols();
 477
 478     if (@$gt_protocols) {
 479         $default_gtp = $c->config->{default_genotyping_protocol};
 480         %gtps = map { @$_[1] => @$_[0] } @$gt_protocols;
 481
 482         if(!exists($gtps{$default_gtp}) && !($default_gtp =~ /^none$/)) {
 483             die "The conf variable default_genotyping_protocol: \"$default_gtp\" does not match any protocols in the database. Set it in sgn_local.conf using a protocol name from the nd_protocol table, or set it to 'none' to silence this error.";
 484         }
 485     } else {
 486         $gt_protocols = ["No genotyping protocols found"];
 487     }
 488     my $html = simple_selectbox_html(
 489       name => $name,
 490       id => $id,
 491       choices => $gt_protocols,
 492       selected => $gtps{$default_gtp}
 493     );
 494     $c->stash->{rest} = { select => $html };
 495 }
 496
 497 sub get_trait_components_select : Path('/ajax/html/select/trait_components') Args(0) {
 498
 499   my $self = shift;
 500   my $c = shift;
 501
 502   my $cv_id = $c->req->param('cv_id');
 503   #print STDERR "cv_id = $cv_id\n";
 504   my $id = $c->req->param("id") || "component_select";
 505   my $name = $c->req->param("name") || "component_select";
 506   my $default = $c->req->param("default") || 0;
 507   my $multiple =  $c->req->param("multiple") || 0;
 508   my $size = $c->req->param('size') || '5';
 509
 510   my $dbh = $c->dbc->dbh();
 511   my $onto = CXGN::Onto->new( { schema => $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado') } );
 512   my @components = $onto->get_terms($cv_id);
 513   #print STDERR Dumper \@components;
 514   if ($default) { unshift @components, [ '', $default ]; }
 515
 516   my $html = simple_selectbox_html(
 517     name => $name,
 518     multiple => $multiple,
 519     id => $id,
 520     choices => \@components,
 521     size => $size
 522   );
 523
 524   $c->stash->{rest} = { select => $html };
 525
 526 }
 527
 528
 529 sub ontology_children_select : Path('/ajax/html/select/ontology_children') Args(0) {
 530     my ($self, $c) = @_;
 531     my $parent_node_cvterm = $c->request->param("parent_node_cvterm");
 532     my $rel_cvterm = $c->request->param("rel_cvterm");
 533     my $rel_cv = $c->request->param("rel_cv");
 534     my $size = $c->req->param('size') || '5';
 535     my $value_format = $c->req->param('value_format') || 'ids';
 536     print STDERR "Parent Node $parent_node_cvterm\n";
 537
 538     my $select_name = $c->request->param("selectbox_name");
 539     my $select_id = $c->request->param("selectbox_id");
 540
 541     my $empty = $c->request->param("empty") || '';
 542     my $multiple =  $c->req->param("multiple") || 0;
 543
 544     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 545     my $parent_node_cvterm_row = SGN::Model::Cvterm->get_cvterm_row_from_trait_name($schema, $parent_node_cvterm);
 546     my $parent_node_cvterm_id;
 547     if ($parent_node_cvterm_row){
 548         $parent_node_cvterm_id = $parent_node_cvterm_row->cvterm_id();
 549     }
 550     my $rel_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, $rel_cvterm, $rel_cv)->cvterm_id();
 551
 552     my $ontology_children_ref = $schema->resultset("Cv::CvtermRelationship")->search({type_id => $rel_cvterm_id, object_id => $parent_node_cvterm_id})->search_related('subject');
 553     my @ontology_children;
 554     while (my $child = $ontology_children_ref->next() ) {
 555         my $cvterm_id = $child->cvterm_id();
 556         my $dbxref_info = $child->search_related('dbxref');
 557         my $accession = $dbxref_info->first()->accession();
 558         my $db_info = $dbxref_info->search_related('db');
 559         my $db_name = $db_info->first()->name();
 560         if ($value_format eq 'ids'){
 561             push @ontology_children, [$cvterm_id, $child->name."|".$db_name.":".$accession];
 562         }
 563         if ($value_format eq 'names'){
 564             push @ontology_children, [$child->name."|".$db_name.":".$accession, $child->name."|".$db_name.":".$accession];
 565         }
 566     }
 567
 568     @ontology_children = sort { $a->[1] cmp $b->[1] } @ontology_children;
 569     if ($empty) {
 570         unshift @ontology_children, [ 0, "None" ];
 571     }
 572     #print STDERR Dumper \@ontology_children;
 573     my $html = simple_selectbox_html(
 574         name => $select_name,
 575         id => $select_id,
 576         multiple => $multiple,
 577         choices => \@ontology_children,
 578     );
 579     $c->stash->{rest} = { select => $html };
 580 }
 581
 582 sub _clean_inputs {
 583         no warnings 'uninitialized';
 584         my $params = shift;
 585         foreach (keys %$params){
 586                 my $values = $params->{$_};
 587                 my $ret_val;
 588                 if (ref \$values eq 'SCALAR'){
 589                         push @$ret_val, $values;
 590                 } elsif (ref $values eq 'ARRAY'){
 591                         $ret_val = $values;
 592                 } else {
 593                         die "Input is not a scalar or an arrayref\n";
 594                 }
 595                 @$ret_val = grep {$_ ne undef} @$ret_val;
 596                 @$ret_val = grep {$_ ne ''} @$ret_val;
 597                 $params->{$_} = $ret_val;
 598         }
 599         return $params;
 600 }
 601
 602 1;