lib/SGN/Controller/AJAX/List.pm

   1
   2 package SGN::Controller::AJAX::List;
   3
   4 use Moose;
   5
   6 use List::MoreUtils qw | uniq |;
   7 use Data::Dumper;
   8
   9 use CXGN::List;
  10 use CXGN::List::Validate;
  11 use CXGN::List::Transform;
  12 use CXGN::List::FuzzySearch;
  13 use CXGN::List::Desynonymize;
  14 use CXGN::Cross;
  15 use JSON;
  16
  17 use File::Slurp qw | read_file |;
  18 use File::Temp 'tempfile';
  19 use File::Basename;
  20 use File::Copy;
  21 use utf8;
  22
  23
  24
  25
  26 BEGIN { extends 'Catalyst::Controller::REST'; }
  27
  28 __PACKAGE__->config(
  29     default   => 'application/json',
  30     stash_key => 'rest',
  31     map       => { 'application/json' => 'JSON' },
  32    );
  33
  34 sub get_list_action :Path('/list/get') Args(0) {
  35     my $self = shift;
  36     my $c = shift;
  37
  38     my $list_id = $c->req->param("list_id");
  39
  40     my $user_id = $self->get_user($c);
  41     if (!$user_id) {
  42         $c->stash->{rest} = { error => 'You must be logged in to use lists.', };
  43         return;
  44     }
  45
  46     my $list = $self->retrieve_list($c, $list_id);
  47
  48     $c->stash->{rest} = $list;
  49 }
  50
  51 sub get_list_data_action :Path('/list/data') Args(0) {
  52     my $self = shift;
  53     my $c = shift;
  54
  55     my $list_id = $c->req->param("list_id");
  56
  57     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
  58     my $public = $list->check_if_public();
  59     if ($public == 0) {
  60         my $error = $self->check_user($c, $list_id);
  61         if ($error) {
  62             $c->stash->{rest} = { error => $error };
  63             return;
  64         }
  65     }
  66     my $description = $list->description;
  67
  68     $list = $self->retrieve_list($c, $list_id);
  69
  70     my $metadata = $self->get_list_metadata($c, $list_id);
  71
  72     $c->stash->{rest} = {
  73         list_id     => $list_id,
  74         type_id     => $metadata->{type_id},
  75         type_name   => $metadata->{list_type},
  76         elements    => $list,
  77         description => $description
  78     };
  79 }
  80
  81
  82 sub retrieve_contents :Path('/list/contents') Args(1) {
  83     my $self = shift;
  84     my $c = shift;
  85     my $list_id = shift;
  86
  87     my $list = CXGN::List->new( { dbh=>$c->dbc->dbh(), list_id=>$list_id });
  88     my $public = $list->check_if_public();
  89     if ($public == 0) {
  90         my $error = $self->check_user($c, $list_id);
  91         if ($error) {
  92             $c->stash->{rest} = { error => $error };
  93             return;
  94         }
  95     }
  96
  97     my $elements = $list->elements();
  98     $c->stash->{rest} = $elements;
  99 }
 100
 101 sub get_list_metadata {
 102     my $self = shift;
 103     my $c = shift;
 104     my $list_id = shift;
 105
 106     my $list = CXGN::List->new( { dbh=> $c->dbc->dbh(), list_id=>$list_id });
 107
 108     return { name => $list->name(),
 109              description => $list->description(),
 110              type_id => $list->type_id(),
 111              list_type => $list->type(),
 112     };
 113 }
 114
 115 sub get_type_action :Path('/list/type') Args(1) {
 116     my $self = shift;
 117     my $c = shift;
 118     my $list_id = shift;
 119
 120     my $data = $self->get_list_metadata($c, $list_id);
 121
 122     $c->stash->{rest} = { type_id => $data->{type_id},
 123                           list_type => $data->{list_type},
 124     };
 125 }
 126
 127 sub update_list_name_action :Path('/list/name/update') :Args(0) {
 128     my $self = shift;
 129     my $c = shift;
 130     my $list_id = $c->req->param('list_id');
 131     my $name = $c->req->param('name');
 132
 133     my $user_id = $self->get_user($c);
 134     my $error = $self->check_user($c, $list_id);
 135
 136     if ($error) {
 137         $c->stash->{rest} = { error => $error };
 138         return;
 139     }
 140
 141     my $list = CXGN::List->new( { dbh=>$c->dbc->dbh(), list_id=>$list_id });
 142     $list->name($name);
 143
 144     $c->stash->{rest} = { success => 1 };
 145 }
 146
 147 sub update_list_description_action :Path('/list/description/update') :Args(0) {
 148     my $self = shift;
 149     my $c = shift;
 150     my $list_id = $c->req->param('list_id');
 151     my $description = $c->req->param('description');
 152
 153     my $user_id = $self->get_user($c);
 154     my $error = $self->check_user($c, $list_id);
 155
 156     if ($error) {
 157         $c->stash->{rest} = { error => $error };
 158         return;
 159     }
 160
 161     my $list = CXGN::List->new( { dbh=>$c->dbc->dbh(), list_id=>$list_id });
 162     $list->description($description);
 163
 164     $c->stash->{rest} = { success => 1 };
 165 }
 166
 167 sub set_type :Path('/list/type') Args(2) {
 168     my $self = shift;
 169     my $c = shift;
 170     my $list_id = shift;
 171     my $type = shift;
 172
 173     my $user_id = $self->get_user($c);
 174
 175     my $error = $self->check_user($c, $list_id);
 176     if ($error) {
 177         $c->stash->{rest} = { error => $error };
 178         return;
 179     }
 180
 181     my $list = CXGN::List->new( { dbh=> $c->dbc->dbh(), list_id => $list_id });
 182
 183     if ($list->owner() != $user_id) {
 184         $c->stash->{rest} = { error => "Only the list owner can change the type of a list" };
 185         return;
 186     }
 187
 188     $error = $list->type($type);
 189
 190     if (!$error) {
 191         $c->stash->{rest} = { error => "List type not found: ".$type };
 192         return;
 193     }
 194
 195     $c->stash->{rest} = { success => 1 };
 196 }
 197
 198 sub new_list_action :Path('/list/new') Args(0) {
 199     my $self = shift;
 200     my $c = shift;
 201
 202     my $name = $c->req->param("name");
 203     my $desc = $c->req->param("desc");
 204
 205
 206     my $user_id = $self->get_user($c);
 207     if (!$user_id) {
 208         $c->stash->{rest} = { error => "You must be logged in to use lists", };
 209         return;
 210     }
 211
 212     my $new_list_id = 0;
 213     eval {
 214         $new_list_id = $self->new_list($c, $name, $desc, $user_id);
 215     };
 216
 217     if ($@) {
 218         $c->stash->{rest} = { error => "An error occurred, $@", };
 219         return;
 220     }
 221     else {
 222         $c->stash->{rest}  = { list_id => $new_list_id };
 223     }
 224 }
 225
 226 sub all_types : Path('/list/alltypes') :Args(0) {
 227     my $self = shift;
 228     my $c = shift;
 229
 230     my $all_types = CXGN::List::all_types($c->dbc->dbh());
 231
 232     $c->stash->{rest} = $all_types;
 233 }
 234
 235 sub download_list :Path('/list/download') Args(0) {
 236     my $self = shift;
 237     my $c = shift;
 238     my $list_id = $c->req->param("list_id");
 239
 240     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 241     my $public = $list->check_if_public();
 242     if ($public == 0) {
 243         my $error = $self->check_user($c, $list_id);
 244         if ($error) {
 245             $c->res->content_type("text/plain");
 246             $c->res->body($error);
 247             return;
 248         }
 249     }
 250
 251     $list = $self->retrieve_list($c, $list_id);
 252     my ($name_ref) = $self->get_list_metadata($c, $list_id);
 253     my $name = $name_ref->{name};
 254
 255     $c->res->content_type("text/plain");
 256     $c->res->header('Content-Disposition'=>"attachment; filename=$name.txt");
 257     $c->res->body(join "\n", map { $_->[1] }  @$list);
 258 }
 259
 260 =head2 available_lists()
 261
 262  Usage:
 263  Desc:          returns the available lists. Optionally, a
 264                 parameter "list_type" can be provided that will limit the
 265                 lists to the provided type.
 266
 267  Ret:
 268  Args:
 269  Side Effects:
 270  Example:
 271
 272 =cut
 273
 274 sub available_lists : Path('/list/available') Args(0) {
 275     my $self = shift;
 276     my $c = shift;
 277
 278     my $requested_type = $c->req->param("type");
 279
 280     my $user_id = $self->get_user($c);
 281     if (!$user_id) {
 282         $c->stash->{rest} = { error => "You must be logged in to use lists.", };
 283         return;
 284     }
 285
 286     my $lists = CXGN::List::available_lists($c->dbc->dbh(), $user_id, $requested_type);
 287
 288     $c->stash->{rest} = $lists;
 289 }
 290
 291 sub available_public_lists : Path('/list/available_public') Args(0) {
 292     my $self = shift;
 293     my $c = shift;
 294
 295     my $requested_type = $c->req->param("type");
 296
 297     my $user_id = $self->get_user($c);
 298     if (!$user_id) {
 299         $c->stash->{rest} = { error => "You must be logged in to use lists." };
 300         $c->detach();
 301     }
 302
 303     my $lists = CXGN::List::available_public_lists($c->dbc->dbh(), $requested_type);
 304
 305     $c->stash->{rest} = $lists;
 306 }
 307
 308 sub add_item :Path('/list/item/add') Args(0) {
 309     my $self = shift;
 310     my $c = shift;
 311
 312     my $list_id = $c->req->param("list_id");
 313     my $element = $c->req->param("element");
 314
 315     my $user_id = $self->get_user($c);
 316
 317     my $error = $self->check_user($c, $list_id);
 318     if ($error) {
 319         $c->stash->{rest} = { error => $error };
 320         return;
 321     }
 322
 323     $element =~ s/^\s*(.+?)\s*$/$1/;
 324
 325     if (!$element) {
 326         $c->stash->{rest} = { error => "You must provide an element to add to the list" };
 327         return;
 328     }
 329
 330     if (!$list_id) {
 331         $c->stash->{rest} = { error => "Please specify a list_id." };
 332         return;
 333     }
 334
 335     eval {
 336         $self->insert_element($c, $list_id, $element);
 337     };
 338     if ($@) {
 339         $c->stash->{rest} = { error => "An error occurred: $@" };
 340         return;
 341     }
 342     else {
 343         $c->stash->{rest} = [ "SUCCESS" ];
 344     }
 345 }
 346
 347 sub toggle_public_list : Path('/list/public/toggle') Args(0) {
 348     my $self = shift;
 349     my $c = shift;
 350     my $list_id = $c->req->param("list_id");
 351
 352     my $error = $self->check_user($c, $list_id);
 353     if ($error) {
 354         $c->stash->{rest} = { error => $error };
 355         $c->detach();
 356     }
 357
 358     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 359     my ($public, $rows_affected) = $list->toggle_public();
 360     if ($rows_affected == 1) {
 361         $c->stash->{rest} = { r => $public };
 362     } else {
 363         die;
 364     }
 365 }
 366
 367 sub make_public_list : Path('/list/public/true') Args(0) {
 368     my $self = shift;
 369     my $c = shift;
 370     my $list_id = $c->req->param("list_id");
 371
 372     my $error = $self->check_user($c, $list_id);
 373     if ($error) {
 374         $c->stash->{rest} = { error => $error };
 375         return;
 376     }
 377
 378     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 379     my ($rows_affected) = $list->make_public();
 380     if ($rows_affected == 1) {
 381         $c->stash->{rest} = { success=>1 };
 382     } else {
 383         die;
 384     }
 385 }
 386
 387 sub make_private_list : Path('/list/public/false') Args(0) {
 388     my $self = shift;
 389     my $c = shift;
 390     my $list_id = $c->req->param("list_id");
 391
 392     my $error = $self->check_user($c, $list_id);
 393     if ($error) {
 394         $c->stash->{rest} = { error => $error };
 395         return;
 396     }
 397
 398     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 399     my ($rows_affected) = $list->make_private();
 400     if ($rows_affected == 1) {
 401         $c->stash->{rest} = { success=>1 };
 402     } else {
 403         die;
 404     }
 405 }
 406
 407 sub copy_public_list : Path('/list/public/copy') Args(0) {
 408     my $self = shift;
 409     my $c = shift;
 410     my $list_id = $c->req->param("list_id");
 411
 412     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 413     my $public = $list->check_if_public();
 414     my $user_id = $self->get_user($c);
 415     if (!$user_id || $public == 0) {
 416         $c->stash->{rest} = { error => 'You must be logged in to use lists and list must be public!' };
 417         return;
 418     }
 419
 420     my $copied = $list->copy_public($user_id);
 421     if ($copied) {
 422         $c->stash->{rest} = { success => 'true' };
 423     } else {
 424         die;
 425     }
 426 }
 427
 428 sub sort_list_items : Path('/list/sort') Args(0) {
 429     my $self = shift;
 430     my $c = shift;
 431     my $list_id = $c->req->param("list_id");
 432     my $sort = $c->req->param("sort");
 433
 434     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 435     my $return = $list->sort_items($sort);
 436     if ($return) {
 437         $c->stash->{rest} = { success => 1 };
 438     } else {
 439         $c->stash->{rest} = { error => 1 };
 440     }
 441 }
 442
 443 sub add_cross_progeny : Path('/list/add_cross_progeny') Args(0) {
 444     my $self = shift;
 445     my $c = shift;
 446     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 447     my $cross_id_list = decode_json($c->req->param("cross_id_list"));
 448     #print STDERR Dumper $cross_id_list;
 449     my $list_id = $c->req->param("list_id");
 450
 451     my $list = CXGN::List->new( { dbh=>$c->dbc->dbh(), list_id => $list_id });
 452
 453     my %response;
 454     $response{'count'} = 0;
 455     foreach (@$cross_id_list) {
 456         my $cross = CXGN::Cross->new({ schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), cross_stock_id=>$_});
 457         my ($maternal_parent, $paternal_parent, $progeny) = $cross->get_cross_relationships();
 458
 459         my @accession_names;
 460         foreach (@$progeny) {
 461             push @accession_names, $_->[0];
 462         }
 463
 464         my $r = $list->add_bulk(\@accession_names);
 465         if ($r->{error}) {
 466             $c->stash->{rest} = { error => $r->{error}};
 467             return;
 468         }
 469         if (scalar(@{$r->{duplicates}}) > 0){
 470             $response{'duplicates'} = $r->{duplicates};
 471         }
 472         $response{'count'} += $r->{count};
 473     }
 474     #print STDERR Dumper \%response;
 475     $c->stash->{rest} = { duplicates => $response{'duplicates'} };
 476     $c->stash->{rest}->{success} = { count => $response{'count'} };
 477 }
 478
 479 sub add_bulk : Path('/list/add/bulk') Args(0) {
 480     my $self = shift;
 481     my $c = shift;
 482     my $list_id = $c->req->param("list_id");
 483     my $elements = $c->req->param("elements");
 484
 485     my $user_id = $self->get_user($c);
 486     my $error = $self->check_user($c, $list_id);
 487     if ($error) {
 488         $c->stash->{rest} = { error => $error };
 489         return;
 490     }
 491
 492     if (!$elements) {
 493         $c->stash->{rest} = { error => "You must provide one or more elements to add to the list" };
 494         return;
 495     }
 496
 497     my @elements = split "\t", $elements;
 498
 499     my $list = CXGN::List->new( { dbh=>$c->dbc->dbh(), list_id => $list_id });
 500
 501     my @duplicates = ();
 502     my $count = 0;
 503
 504     my $response = $list->add_bulk(\@elements);
 505     #print STDERR Dumper $response;
 506
 507     if ($response->{error}) {
 508         $c->stash->{rest} = { error => $response->{error}};
 509         return;
 510     }
 511     if (scalar(@{$response->{duplicates}}) > 0){
 512         $c->stash->{rest} = { duplicates => $response->{duplicates} };
 513     }
 514
 515     $c->stash->{rest}->{success} = $response->{count};
 516 }
 517
 518 sub insert_element : Private {
 519     my $self = shift;
 520     my $c = shift;
 521     my $list_id = shift;
 522     my $element = shift;
 523
 524     my $list = CXGN::List->new( { dbh=>$c->dbc->dbh(), list_id => $list_id });
 525
 526     $list->add_bulk([$element]);
 527 }
 528
 529 sub delete_list_action :Path('/list/delete') Args(0) {
 530     my $self = shift;
 531     my $c = shift;
 532
 533     my $list_id = $c->req->param("list_id");
 534
 535     my $error = $self->check_user($c, $list_id);
 536     if ($error) {
 537         $c->stash->{rest} = { error => $error };
 538         return;
 539     }
 540
 541     $error = CXGN::List::delete_list($c->dbc->dbh(), $list_id);
 542
 543     if ($error) {
 544         $c->stash->{rest} = { error => $error };
 545     }
 546     else {
 547         $c->stash->{rest} =  [ 1 ];
 548     }
 549 }
 550
 551
 552 sub exists_list_action : Path('/list/exists') Args(0) {
 553     my $self =shift;
 554     my $c = shift;
 555     my $name = $c->req->param("name") || undef;
 556
 557     my $user_id = $self->get_user($c);
 558     if (!$user_id) {
 559         $c->stash->{rest} = { error => 'You need to be logged in to use lists.' };
 560     }
 561
 562     my $list_info = CXGN::List::exists_list($c->dbc->dbh(), $name, $user_id);
 563
 564     print STDERR "List info is ".Dumper($list_info);
 565         $c->stash->{rest} = $list_info;
 566
 567 }
 568
 569 sub exists_item_action : Path('/list/exists_item') :Args(0) {
 570     my $self =shift;
 571     my $c = shift;
 572     my $list_id = $c->req->param("list_id");
 573     my $name = $c->req->param("name");
 574
 575     my $error = $self->check_user($c, $list_id);
 576     if ($error) {
 577         $c->stash->{rest} = { error => $error };
 578         return;
 579     }
 580
 581     my $user_id = $self->get_user($c);
 582
 583     if ($self->get_list_owner($c, $list_id) != $user_id) {
 584         $c->stash->{rest} = { error => "You have insufficient privileges to manipulate this list.", };
 585         return;
 586     }
 587
 588     my $list_item_id = $self->exists_item($c, $list_id, $name);
 589
 590     if ($list_item_id) {
 591         $c->stash->{rest} = { list_item_id => $list_item_id };
 592     }
 593     else {
 594         $c->stash->{rest} = { list_item_id => 0 };
 595     }
 596 }
 597
 598 sub list_size : Path('/list/size') Args(0) {
 599     my $self = shift;
 600     my $c = shift;
 601     my $list_id = $c->req->param("list_id");
 602
 603     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 604     my $count = $list->list_size();
 605
 606     $c->stash->{rest} = { count => $count };
 607 }
 608
 609 #
 610 # Validate an existing list for a specified data type
 611 #
 612 # PATH: GET /list/validate/{list}/{type}
 613 #   {list} is the list id
 614 #   {type} is the name of the supported list type (accessions, trials, seedlots, etc...)
 615 #
 616 # RETURNS:
 617 #   missing: array list item names not in the database
 618 #
 619 sub validate : Path('/list/validate') Args(2) {
 620     my $self = shift;
 621     my $c = shift;
 622     my $list_id = shift;
 623     my $type = shift;
 624     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 625
 626     my $list = $self->retrieve_list($c, $list_id);
 627
 628     my @flat_list = map { $_->[1] } @$list;
 629
 630     my $lv = CXGN::List::Validate->new();
 631     my $data = $lv->validate($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), $type, \@flat_list);
 632
 633     print STDERR "DATA = ".Dumper($data);
 634     $c->stash->{rest} = $data;
 635 }
 636
 637 sub validate_lists :Path('/ajax/list/validate_lists') Args(0) {
 638     my $self = shift;
 639     my $c = shift;
 640
 641     my $list_ids_string = $c->req->param('list_ids');
 642     my $list_types_string = $c->req->param('list_types');
 643
 644     my @list_ids = split /\,/, $list_ids_string;
 645     my @list_types = split /\,/, $list_types_string;
 646
 647     my @invalid_lists = ();
 648     for (my $n = 0; $n<@list_ids; $n++)  {
 649
 650         my $list = $self->retrieve_list($c, $list_ids[$n]);
 651
 652         my @flat_list = map { $_->[1] } @$list;
 653
 654         print STDERR "LIST TYPE = ".$list_types[$n]."\n";
 655         my $lv = CXGN::List::Validate->new();
 656     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 657         my $data = $lv->validate($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), $list_types[$n], \@flat_list);
 658
 659
 660         print STDERR "Return data = ".Dumper($data);
 661
 662         if ($list_types[$n] eq "accessions" && $data->{valid} == 0) {
 663             print STDERR "list $list_ids[$n] is invalid! ($data->{valid}) \n";
 664             push @invalid_lists, [ $list_ids[$n], $list_types[$n] ];
 665         }
 666         elsif ($list_types[$n] ne "accessions" && scalar(@{$data->{missing}}) > 0) {
 667             print STDERR "list $list_ids[$n] is invalid! (missing = ".scalar(@{$data->{missing}}).")\n";
 668             push @invalid_lists, [ $list_ids[$n], $list_types[$n] ];
 669
 670         }
 671         else {
 672             print STDERR "List $list_ids[$n] of type $list_types[$n] is valid :-) \n";
 673         }
 674     }
 675     $c->stash->{rest} = { invalid_lists => \@invalid_lists };
 676 }
 677
 678 #
 679 # Validate a temp list of names for a specified data type
 680 # - Validate the temp list
 681 # - Return lists of missing and existing items
 682 #
 683 # PATH: POST /list/validate/temp
 684 #
 685 # BODY:
 686 #   type: the name of a supported list type (accessions, trials, seedlots, etc...)
 687 #   items: array of item names to validate
 688 #
 689 # RETURNS:
 690 #   error: error message, if an error was encountered
 691 #   missing: array list item names not in the database
 692 #   existing: array list item names found in the database
 693 #
 694 sub temp_validate : Path('/list/validate/temp') ActionClass('REST') {};
 695 sub temp_validate_POST : Args(0) {
 696     my $self = shift;
 697     my $c = shift;
 698     my $type = $c->req->param("type");
 699     my $items = $c->req->param("items") ? decode_json $c->req->param("items") : [];
 700
 701     my $lv = CXGN::List::Validate->new();
 702     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 703     my $data = $lv->validate($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), $type, $items);
 704
 705     # Set missing
 706     my $m = $data->{missing};
 707
 708     # Set existing
 709     my %comp = map { $_ => 1 } @$m;
 710     my @e = grep !$comp{$_}, @$items;
 711
 712     $c->stash->{rest} = {
 713         missing => $m,
 714         existing => \@e
 715     };
 716 }
 717
 718 sub fuzzysearch : Path('/list/fuzzysearch') Args(2) {
 719     my $self = shift;
 720     my $c = shift;
 721     my $list_id = shift;
 722     my $list_type = shift;
 723
 724     my $list = $self->retrieve_list($c, $list_id);
 725
 726     my @flat_list = map { $_->[1] } @$list;
 727
 728     my $f = CXGN::List::FuzzySearch->new();
 729     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 730     my $data = $f->fuzzysearch($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), $list_type, \@flat_list);
 731
 732     $c->stash->{rest} = $data;
 733 }
 734
 735 sub transform :Path('/list/transform/') Args(2) {
 736     my $self = shift;
 737     my $c = shift;
 738     my $list_id = shift;
 739     my $transform_name = shift;
 740
 741     my $t = CXGN::List::Transform->new();
 742
 743     my $data = $self->get_list_metadata($c, $list_id);
 744
 745     my $list_data = $self->retrieve_list($c, $list_id);
 746
 747     my @list_items = map { $_->[1] } @$list_data;
 748     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 749     my $result = $t->transform($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), $transform_name, \@list_items);
 750
 751     if (exists($result->{missing}) && (scalar(@{$result->{missing}}) > 0)) {
 752         $result->{error}  =  "Warning. This lists contains elements that cannot be converted.";
 753     }
 754
 755     $c->stash->{rest} = $result;
 756
 757 }
 758
 759 sub temp_transform :Path('/list/transform/temp') Args(0) {
 760     my $self = shift;
 761     my $c = shift;
 762     my $type = $c->req->param("type");
 763     my $items = $c->req->param("items") ? decode_json $c->req->param("items") : [];
 764
 765     my $t = CXGN::List::Transform->new();
 766     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 767     my $result = $t->transform($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id), $type, $items);
 768
 769     if (exists($result->{missing}) && (scalar(@{$result->{missing}}) > 0)) {
 770        $result->{error}  =  "Warning. This temporary list contains elements that cannot be converted.";
 771     }
 772
 773     $c->stash->{rest} = $result;
 774
 775 }
 776
 777 sub replace_elements :Path('/list/item/replace') Args(2) {
 778     my $self = shift;
 779     my $c = shift;
 780
 781     my $list_id = shift;
 782     my $new_list = shift; # tab delimited new list elements
 783
 784 }
 785
 786 sub combine_lists : Path('/list/combine') Args(2) {
 787     my $self = shift;
 788     my $c = shift;
 789     my $list1_id = shift;
 790     my $list2_id = shift;
 791
 792     my $list1 = $self->get_list($c, $list1_id);
 793     my $list2 = $self->get_list($c, $list2_id);
 794
 795     my $combined_list_id = $self->new_list(
 796         $c,
 797         $list1->{name}."_".$list2->{name},
 798         $list1->{description}.", ".$list2->{description});
 799
 800     my @combined_elements = (@{$list1->{elements}}, @{$list2->{elements}});
 801
 802     my @unique_elements = uniq(@combined_elements);
 803
 804     foreach my $item (@unique_elements) {
 805         $self->add_item($c, $combined_list_id, $item);
 806     }
 807 }
 808
 809 sub intersect_lists : Path('/list/intersect') Args(2) {
 810     my $self = shift;
 811     my $c = shift;
 812     my $list1_id = shift;
 813     my $list2_id = shift;
 814
 815     my $list1 = $self->get_list($c, $list1_id);
 816     my $list2 = $self->get_list($c, $list2_id);
 817
 818     my $combined_list_id = $self->new_list(
 819         $c,
 820         $list1->{name}."_".$list2->{name}."_intersect",
 821         $list1->{description}.", ".$list2->{description});
 822
 823     my @intersect_elements = ();
 824
 825     my $list1_hashref; my $list2_hashref;
 826     map { $list1_hashref->{$_}=1 } @{$list1->{elements}};
 827     map { $list2_hashref->{$_}=1 } @{$list2->{elements}};
 828
 829     foreach my $item (keys(%{$list1_hashref})) {
 830         if (exists($list1_hashref->{$item}) && exists($list2_hashref->{$item})) {
 831             push @intersect_elements, $item;
 832         }
 833     }
 834
 835     my @unique_elements = uniq(@intersect_elements);
 836
 837     foreach my $item (@unique_elements) {
 838         $self->add_item($c, $combined_list_id, $item);
 839     }
 840 }
 841
 842
 843 sub remove_element_action :Path('/list/item/remove') Args(0) {
 844     my $self = shift;
 845     my $c = shift;
 846
 847     my $list_id = $c->req->param("list_id");
 848     my $item_id = $c->req->param("item_id");
 849
 850     my $error = $self->check_user($c, $list_id);
 851
 852     if ($error) {
 853         $c->stash->{rest} = { error => $error };
 854         return;
 855     }
 856
 857     my $response = $self->remove_element($c, $list_id, $item_id);
 858
 859     $c->stash->{rest} = $response;
 860
 861 }
 862
 863 sub update_element_action :Path('/list/item/update') Args(0) {
 864     my $self = shift;
 865     my $c = shift;
 866
 867     my $list_id = $c->req->param("list_id");
 868     my $item_id = $c->req->param("item_id");
 869     my $content = $c->req->param("content");
 870     my $error = $self->check_user($c, $list_id);
 871
 872     if ($content) {
 873         print STDERR "update ".$list_id." ".$item_id." ".$content."\n";
 874
 875         if ($error) {
 876             $c->stash->{rest} = { error => $error };
 877             return;
 878         }
 879
 880         my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $list_id });
 881         $error = $list->update_element_by_id($item_id, $content);
 882     }
 883
 884     if ($error) {
 885         $c->stash->{rest} = { error => "An error occurred while attempting to update item $item_id" };
 886     }
 887     else {
 888         $c->stash->{rest} = { success => 1 };
 889     }
 890 }
 891
 892 sub new_list : Private {
 893     my $self = shift;
 894     my $c = shift;
 895     my ($name, $desc, $owner) = @_;
 896
 897     my $user_id = $self->get_user($c);
 898
 899     my $new_list_id = CXGN::List::create_list($c->dbc->dbh(), $name, $desc, $owner);
 900
 901     return $new_list_id;
 902
 903 }
 904
 905 sub get_list : Private {
 906     my $self = shift;
 907     my $c = shift;
 908     my $list_id = shift;
 909
 910     my $list = $self->retrieve_list($c, $list_id);
 911
 912     my ($name, $desc, $type_id, $list_type) = $self->get_list_metadata($c, $list_id);
 913
 914     $c->stash->{rest} = {
 915         name        => $name,
 916         description => $desc,
 917         type_id     => $type_id,
 918         type_name   => $list_type,
 919         elements    => $list,
 920     };
 921 }
 922
 923 sub retrieve_list : Private {
 924     my $self = shift;
 925     my $c = shift;
 926     my $list_id = shift;
 927
 928     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id=>$list_id });
 929     my $public = $list->check_if_public();
 930     if ($public == 0) {
 931         my $error = $self->check_user($c, $list_id);
 932         if ($error) {
 933             $c->stash->{rest} = { error => $error };
 934             return;
 935         }
 936     }
 937     my $list_elements_with_ids = $list->retrieve_elements_with_ids($list_id);
 938
 939     #print STDERR "LIST ELEMENTS WITH IDS: ".Dumper($list_elements_with_ids);
 940     return $list_elements_with_ids;
 941 }
 942
 943
 944 sub remove_element : Private {
 945     my $self = shift;
 946     my $c = shift;
 947     my $list_id = shift;
 948     my $item_id = shift;
 949
 950
 951     my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $list_id });
 952     my $error = $list->remove_element_by_id($item_id);
 953
 954     if ($error) {
 955         return { error => "An error occurred while attempting to delete item $item_id" };
 956     }
 957     else {
 958         return { success => 1 };
 959     }
 960
 961 }
 962
 963 sub exists_item : Private {
 964     my $self = shift;
 965     my $c = shift;
 966     my $list_id = shift;
 967     my $item = shift;
 968
 969     my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $list_id });
 970     my $list_item_id = $list->exists_element($item);
 971     return $list_item_id;
 972 }
 973
 974 sub get_list_owner : Private {
 975     my $self = shift;
 976     my $c = shift;
 977     my $list_id = shift;
 978
 979     my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $list_id });
 980     my $owner = $list->owner();
 981
 982     return $owner;
 983 }
 984
 985 sub get_user : Private {
 986     my $self = shift;
 987     my $c = shift;
 988
 989     my $user = $c->user();
 990
 991     if ($user) {
 992         my $user_object = $c->user->get_object();
 993         return $user_object->get_sp_person_id();
 994     }
 995     return undef;
 996 }
 997
 998 sub check_user : Private {
 999     my $self = shift;
1000     my $c = shift;
1001     my $list_id = shift;
1002
1003     my $user_id = $self->get_user($c);
1004
1005     my $error = "";
1006
1007     if (!$user_id) {
1008         $error = "You must be logged in to manipulate this list.";
1009     }
1010     elsif ($c->user->get_object->get_user_type() ne 'curator' && $self->get_list_owner($c, $list_id) != $user_id) {
1011         $error = "You have insufficient privileges to manipulate this list.";
1012     }
1013     return $error;
1014 }
1015
1016 sub desynonymize_list: Path('/list/desynonymize') Args(0) {
1017     my $self = shift;
1018     my $c = shift;
1019
1020     my $list_id = $c->req->param("list_id");
1021
1022     my $user_id = $self->get_user($c);
1023     if (!$user_id) {
1024         $c->stash->{rest} = { error => 'You must be logged in to use lists.', };
1025         return;
1026     }
1027     my $schema = $c->dbic_schema("Bio::Chado::Schema", undef, $user_id);
1028     my $dbh = $schema->storage->dbh;
1029
1030     my $list = CXGN::List->new( { dbh => $dbh, list_id => $list_id } );
1031     my $flat_list = $list->retrieve_elements_with_ids($list_id);
1032     my @name_list = map {@{$_}[1]} @{$flat_list};
1033     my $dsyner = CXGN::List::Desynonymize->new();
1034     my $results = $dsyner
1035       ->desynonymize($schema,$list->type(),\@name_list);
1036     $results->{'previous_list'} = \@name_list;
1037     $results->{'list_type'} = $list->type();
1038
1039     $c->stash->{rest} = $results;
1040 }
1041
1042
1043 sub available_marker_sets : Path('/marker_sets/available') Args(0) {
1044     my $self = shift;
1045     my $c = shift;
1046
1047     my $user_id = $self->get_user($c);
1048     if (!$user_id) {
1049         $c->stash->{rest} = { error => "You must be logged in to use markerset.", };
1050         return;
1051     }
1052
1053     my $lists = CXGN::List::available_lists($c->dbc->dbh(), $user_id, 'markers');
1054     my @marker_sets;
1055     foreach my $list (@$lists){
1056         my ($id, $name, $desc, $item_count, $type_id, $type, $public) = @$list;
1057         push @marker_sets, {
1058             markerset_id => $id,
1059             markerset_name => $name,
1060             number_of_markers => $item_count - 1,
1061             description => $desc,
1062         }
1063     }
1064
1065     $c->stash->{rest} = {data => \@marker_sets};
1066 }
1067
1068
1069 sub delete_markerset : Path('/markerset/delete') Args(0) {
1070     my $self = shift;
1071     my $c = shift;
1072
1073     my $user_id = $self->get_user($c);
1074     if (!$user_id) {
1075         $c->stash->{rest} = { error => 'You must be logged in to delete markerset.', };
1076         return;
1077     }
1078
1079     my $markerset_id = $c->req->param("markerset_id");
1080
1081     my $error = $self->check_user($c, $markerset_id);
1082     if ($error) {
1083         $c->stash->{rest} = { error => $error };
1084         return;
1085     }
1086
1087     $error = CXGN::List::delete_list($c->dbc->dbh(), $markerset_id);
1088
1089     if (!$error){
1090         $c->stash->{rest} = { success => 1 };
1091     }
1092     else {
1093         $c->stash->{rest} = { error => $error };
1094     }
1095
1096 }
1097
1098
1099 sub get_markerset_items :Path('/markerset/items') Args(0) {
1100     my $self = shift;
1101     my $c = shift;
1102     my $markerset_id = $c->req->param("markerset_id");
1103     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
1104     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado", $sp_person_id);
1105
1106     my $user_id = $self->get_user($c);
1107     if (!$user_id) {
1108         $c->stash->{rest} = { error => 'You must be logged in to use markerset.', };
1109         return;
1110     }
1111
1112     my $markerset = CXGN::List->new({dbh => $schema->storage->dbh, list_id => $markerset_id});
1113     my $markerset_items_ref = $markerset->retrieve_elements_with_ids($markerset_id);
1114
1115     my @items;
1116     foreach my $markerset_item (@$markerset_items_ref){
1117         my ($id, $name) = @$markerset_item;
1118         push @items, {
1119             item_id => $id,
1120             item_name => $name,
1121         }
1122     }
1123
1124     $c->stash->{rest} = {success => 1, data => \@items};
1125
1126 }
1127
1128
1129 sub get_markerset_type :Path('/markerset/type') Args(0) {
1130     my $self = shift;
1131     my $c = shift;
1132     my $markerset_id = $c->req->param("markerset_id");
1133     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
1134     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado", $sp_person_id);
1135
1136     my $user_id = $self->get_user($c);
1137     if (!$user_id) {
1138         $c->stash->{rest} = { error => 'You must be logged in to use markerset.', };
1139         return;
1140     }
1141
1142     my $markerset = CXGN::List->new({dbh => $schema->storage->dbh, list_id => $markerset_id});
1143     my $markerset_items_ref = $markerset->retrieve_elements($markerset_id);
1144     my @markerset_items = @{$markerset_items_ref};
1145
1146     my $type;
1147     foreach my $item (@markerset_items){
1148         my $item_ref = decode_json$item;
1149         my %item_hash = %{$item_ref};
1150         my $markerset_type = $item_hash{genotyping_data_type};
1151
1152         if ($markerset_type){
1153             $type = $markerset_type;
1154         }
1155     }
1156 #    print STDERR "MARKERSET TYPE =".Dumper($type)."\n";
1157     $c->stash->{rest} = {success => 1, type => $type};
1158
1159 }
1160
1161
1162 sub adjust_case : Path('/ajax/list/adjust_case') Args(0) {
1163     my $self = shift;
1164     my $c = shift;
1165     my $list_id = $c->req->param("list_id");
1166
1167     my $user_id = $self->get_user($c);
1168     if (!$user_id) {
1169         $c->stash->{rest} = { error => "You must be logged in to use lists.", };
1170         return;
1171     }
1172
1173     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id => $list_id } );
1174
1175     if ($user_id != $list->owner()) {
1176         $c->stash->{rest} = { error => "You don't own this list and you cannot modify it." };
1177         return;
1178     }
1179
1180     if ($list->type() ne "accessions") {
1181         $c->stash->{rest} = { error => "Only lists with type 'accessions' can be adjusted for case in the database." };
1182     }
1183
1184     my $lt = CXGN::List::Transform->new();
1185     my $elements = $list->elements();
1186
1187     print STDERR "Elements: ".Dumper($elements);
1188
1189     my $schema = $c->dbic_schema("Bio::Chado::Schema", undef, $user_id);
1190
1191     my $data = $lt->transform($schema, 'accessions_2_accession_case', $elements);
1192
1193     print STDERR "Converted data: ".Dumper($data);
1194
1195     if (! $data) {
1196         $c->stash->{rest} = { error => "No data!" };
1197         return;
1198     }
1199     my $error_message = "";
1200     my $replace_count = 0;
1201
1202     foreach my $item (@$elements) {
1203         print STDERR "Replacing element $item...\n";
1204         if ($data->{mapping}->{$item}) {
1205             print STDERR "  with $data->{mapping}->{$item}...\n";
1206             my $error = $list->replace_by_name($item, $data->{mapping}->{$item});
1207             if ($error) {
1208                 $error_message .= "Error: $item not replaced. ";
1209             }
1210             else {
1211                 $replace_count++;
1212             }
1213         }
1214     }
1215
1216     $c->stash->{rest} = {
1217         transform => $data->{transform},
1218         error => $error_message,
1219         replace_count => $replace_count,
1220         missing => $data->{missing} || [],
1221         duplicated => $data->{duplicated} || [],
1222         mapping => $data->{mapping},
1223     }
1224
1225 }
1226
1227 sub adjust_synonyms :Path('/ajax/list/adjust_synonyms') Args(0) {
1228     my $self = shift;
1229     my $c = shift;
1230
1231     my $list_id = $c->req->param("list_id");
1232
1233     my $user_id = $self->get_user($c);
1234     if (!$user_id) {
1235         $c->stash->{rest} = { error => "You must be logged in to use lists.", };
1236         return;
1237     }
1238
1239     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id => $list_id } );
1240
1241     if ($user_id != $list->owner()) {
1242         $c->stash->{rest} = { error => "You don't own this list and you cannot modify it." };
1243         return;
1244     }
1245
1246     if ($list->type() ne "accessions") {
1247         $c->stash->{rest} = { error => "Only lists with type 'accessions' can be adjusted for synonyms in the database." };
1248     }
1249
1250     my $lt = CXGN::List::Transform->new();
1251     my $elements = $list->elements();
1252     print STDERR "Elements: ".Dumper($elements);
1253
1254     my $schema = $c->dbic_schema("Bio::Chado::Schema", undef, $user_id);
1255
1256     my $data = $lt->transform($schema, 'synonyms2accession_uniquename', $elements);
1257
1258     print STDERR "Converted data: ".Dumper($data);
1259
1260     print STDERR Dumper($data);
1261
1262     if (! $data) {
1263         $c->stash->{rest} = { error => "No data!" };
1264         return;
1265     }
1266     my $error_message = "";
1267     my $replace_count = 0;
1268
1269     foreach my $item (@$elements) {
1270         print STDERR "Replacing element $item...\n";
1271         if ($data->{mapping}->{$item}) {
1272             print STDERR "  with $data->{mapping}->{$item}...\n";
1273             my $error = $list->replace_by_name($item, $data->{mapping}->{$item});
1274             if ($error) {
1275                 $error_message .= "Error: $item not replaced. ";
1276             }
1277             else {
1278                 $replace_count++;
1279             }
1280         }
1281     }
1282
1283     $c->stash->{rest} = {
1284         transform => $data->{transform},
1285         error => $error_message,
1286         replace_count => $replace_count,
1287         missing => $data->{missing} || [],
1288         duplicated => $data->{duplicated} || [],
1289         mapping => $data->{mapping},
1290     }
1291 }
1292
1293
1294 sub get_list_details :Path('/ajax/list/details') :Args(1) {
1295     my $self = shift;
1296     my $c = shift;
1297     my $list_id = shift;
1298     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
1299     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado', $sp_person_id);
1300     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema", undef, $sp_person_id);
1301     my $dbh = $c->dbc->dbh;
1302
1303     my $list = CXGN::List->new( { dbh=>$dbh, schema=>$schema, phenome_schema=>$phenome_schema, list_id=>$list_id });
1304     my $type = $list->type();
1305     my $items = $list->elements();
1306
1307     my $item_validator = CXGN::List::Validate->new();
1308     my @items_missing = @{$item_validator->validate($schema, $type, $items)->{'missing'}};
1309     if (scalar(@items_missing) > 0){
1310         $c->stash->{rest} = {error => "The following items are not in the database: ".join(',',@items_missing)};
1311         return;
1312     }
1313
1314     my @list_details;
1315     if ($type eq 'seedlots') {
1316         my $result = $list->seedlot_list_details();
1317         my @details = @$result;
1318         foreach my $seedlot (@details) {
1319             push @list_details, {
1320                 seedlot_id => $seedlot->[0],
1321                 seedlot_name => $seedlot->[1],
1322                 content_id => $seedlot->[2],
1323                 content_name => $seedlot->[3],
1324                 content_type => $seedlot->[4],
1325                 description => $seedlot->[5],
1326                 box_name => $seedlot->[6],
1327                 current_count => $seedlot->[7],
1328                 current_weight => $seedlot->[8],
1329                 quality => $seedlot->[9],
1330             }
1331         }
1332     }
1333
1334     $c->stash->{rest} = {data => \@list_details};
1335
1336 }
1337
1338
1339 sub download_list_details : Path('/list/download_details') {
1340     my $self = shift;
1341     my $c = shift;
1342     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
1343     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado", $sp_person_id);
1344     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema", undef, $sp_person_id);
1345     my $dbh = $c->dbc->dbh;
1346
1347     my $list_id = $c->req->param("list_id");
1348     my $list = CXGN::List->new( { dbh=>$dbh, schema=>$schema, phenome_schema=>$phenome_schema, list_id=>$list_id });
1349     my $type = $list->type();
1350     my $list_name = $list->name();
1351     my @list_details;
1352     my $header;
1353
1354     if ($type eq 'seedlots') {
1355         my $result = $list->seedlot_list_details();
1356         my @details = @$result;
1357         foreach my $seedlot_ref (@details) {
1358             my @seedlot = @$seedlot_ref;
1359             push @list_details, "$seedlot[1]\t$seedlot[3]\t$seedlot[4]\t$seedlot[5]\t$seedlot[6]\t$seedlot[7]\t$seedlot[8]\t$seedlot[9]\n";
1360         }
1361         $header = "Seedlot_Name\tContent_Name\tContent_type\tDescription\tBox_Name\tCurrent_Count\tCurrent_Weight\tQuality";
1362     }
1363
1364     my $dl_token = $c->req->param("list_download_token") || "no_token";
1365     my $dl_cookie = "download".$dl_token;
1366     print STDERR "Token is: $dl_token\n";
1367
1368     my ($tempfile, $uri) = $c->tempfile(TEMPLATE => "list_details_download_XXXXX", UNLINK=> 0);
1369
1370     open(my $FILE, '> :encoding(UTF-8)', $tempfile) or die "Cannot open tempfile $tempfile: $!";
1371     print $FILE $header."\n";
1372     my $row = 0;
1373     foreach my $each_row (@list_details) {
1374         print $FILE $each_row;
1375         $row++;
1376     }
1377     close $FILE;
1378
1379     $c->res->content_type("application/text");
1380     $c->res->cookies->{$dl_cookie} = {
1381         value => $dl_token,
1382         expires => '+1m',
1383     };
1384
1385     $c->res->header("Content-Disposition", qq[attachment; filename="$list_name.txt"]);
1386     my $output = "";
1387     open(my $F, "< :encoding(UTF-8)", $tempfile) || die "Can't open file $tempfile for reading.";
1388     while (<$F>) {
1389         $output .= $_;
1390     }
1391     close($F);
1392
1393     $c->res->body($output);
1394 }
1395
1396
1397
1398 #########
1399 1;
1400 #########