lib/CXGN/List.pm

   1
   2 =head1 NAME
   3
   4 CXGN::List - class that deals with website lists
   5
   6 =head1 SYNOPSYS
   7
   8  my $list = CXGN::List->new( { dbh => $dbh, list_id => 34 } );
   9
  10  my $name = $list->name();
  11  my $elements = $list->elements();
  12  my $owner_id = $list->owner();
  13  my $type = $list->type();
  14  $list->remove_element('blabla');
  15  $list->add_bulk(['blabla', 'bla']);
  16
  17
  18 Class function (without instantiation):
  19
  20  my $new_list_id = CXGN::List::create_list($dbh, $name, $desc, $owner);
  21  my $lists = CXGN::List::available_lists($dbh);
  22  my $list_id = CXGN::List::exists_list($dbh, $name, $owner);
  23  CXGN::List::delete_list($dbh, $list_id);
  24
  25 =head1 AUTHOR
  26
  27  Lukas Mueller <lam87@cornell.edu>
  28
  29 =cut
  30
  31
  32 package CXGN::List;
  33
  34 use Moose;
  35 use Data::Dumper;
  36
  37 has 'dbh' => ( isa => 'DBI::db',
  38                is => 'rw',
  39                required => 1,
  40     );
  41
  42 has 'list_id' => (isa => 'Int',
  43                   is => 'ro',
  44                   required => 1,
  45     );
  46
  47 has 'owner' => (isa => 'Int',
  48                 is => 'rw',
  49     );
  50
  51 has 'name' => (isa => 'Str',
  52                is => 'rw',
  53     );
  54
  55 has 'description' => (isa => 'Str',
  56                       is => 'rw',
  57     );
  58
  59 has 'type' => (isa => 'Str',
  60                is => 'rw',
  61     );
  62
  63 has 'elements' => (isa => 'ArrayRef',
  64                    is => 'rw',
  65     );
  66
  67 # class method: Use like so: CXGN::List::create_list
  68 sub create_list {
  69     my $dbh = shift;
  70     my ($name, $desc, $owner) = @_;
  71     my $new_list_id;
  72     eval {
  73     my $q = "INSERT INTO sgn_people.list (name, description, owner) VALUES (?, ?, ?) RETURNING list_id";
  74     my $h = $dbh->prepare($q);
  75     $h->execute($name, $desc, $owner);
  76     ($new_list_id) = $h->fetchrow_array();
  77     print STDERR "NEW LIST using returning = $new_list_id\n";
  78
  79     #$q = "SELECT list.name, list.description, type_id, cvterm.name, list_id FROM sgn_people.list LEFT JOIN cvterm ON (type_id=cvterm_id)";
  80     #$h = $dbh->prepare($q);
  81     #$h->execute();
  82     #while (my @data = $h->fetchrow_array()) {
  83         #print STDERR join ", ", @data;
  84         #print STDERR "\n";
  85     #}
  86     ###END TEST
  87     };
  88     if ($@) {
  89         print "AN ERROR OCCURRED: $@\n";
  90         return;
  91     }
  92     return $new_list_id;
  93 }
  94
  95 # class method! see above
  96 sub all_types {
  97     my $dbh = shift;
  98     my $q = "SELECT cvterm_id, cvterm.name FROM cvterm JOIN cv USING(cv_id) WHERE cv.name = 'list_types' ";
  99     my $h = $dbh->prepare($q);
 100     $h->execute();
 101     my @all_types = ();
 102     while (my ($id, $name) = $h->fetchrow_array()) {
 103         push @all_types, [ $id, $name ];
 104     }
 105     return \@all_types;
 106
 107 }
 108
 109 # class method! (see above)
 110 #
 111 sub available_lists {
 112     my $dbh = shift;
 113     my $owner = shift;
 114     my $requested_type = shift;
 115
 116     my $q = "SELECT list_id, list.name, description, count(distinct(list_item_id)), type_id, cvterm.name, is_public FROM sgn_people.list left join sgn_people.list_item using(list_id) LEFT JOIN cvterm ON (type_id=cvterm_id) WHERE owner=? GROUP BY list_id, list.name, description, type_id, cvterm.name, is_public ORDER BY list.name";
 117     my $h = $dbh->prepare($q);
 118     $h->execute($owner);
 119
 120     my @lists = ();
 121     while (my ($id, $name, $desc, $item_count, $type_id, $type, $public) = $h->fetchrow_array()) {
 122         if ($requested_type) {
 123             if ($type && ($type eq $requested_type)) {
 124                 push @lists, [ $id, $name, $desc, $item_count, $type_id, $type, $public ];
 125             }
 126         }
 127         else {
 128             push @lists, [ $id, $name, $desc, $item_count, $type_id, $type, $public ];
 129         }
 130     }
 131     return \@lists;
 132 }
 133
 134 sub available_public_lists {
 135     my $dbh = shift;
 136     my $requested_type = shift;
 137
 138     my $q = "SELECT list_id, list.name, description, count(distinct(list_item_id)), type_id, cvterm.name, sp_person.username FROM sgn_people.list LEFT JOIN sgn_people.sp_person AS sp_person ON (sgn_people.list.owner=sp_person.sp_person_id) LEFT JOIN sgn_people.list_item using(list_id) LEFT JOIN cvterm ON (type_id=cvterm_id) WHERE is_public='t' GROUP BY list_id, list.name, description, type_id, cvterm.name, sp_person.username ORDER BY list.name";
 139     my $h = $dbh->prepare($q);
 140     $h->execute();
 141
 142     my @lists = ();
 143     while (my ($id, $name, $desc, $item_count, $type_id, $type, $username) = $h->fetchrow_array()) {
 144         if ($requested_type) {
 145             if ($type && ($type eq $requested_type)) {
 146                 push @lists, [ $id, $name, $desc, $item_count, $type_id, $type, $username ];
 147             }
 148         }
 149         else {
 150             push @lists, [ $id, $name, $desc, $item_count, $type_id, $type, $username ];
 151         }
 152     }
 153     return \@lists;
 154 }
 155
 156 sub delete_list {
 157     my $dbh = shift;
 158     my $list_id = shift;
 159
 160     my $q = "DELETE FROM sgn_people.list WHERE list_id=?";
 161
 162     eval {
 163         my $h = $dbh->prepare($q);
 164         $h->execute($list_id);
 165     };
 166     if ($@) {
 167         return "An error occurred while deleting list with id $list_id: $@";
 168     }
 169     return 0;
 170 }
 171
 172
 173 sub exists_list {
 174     my $dbh = shift;
 175     my $name = shift;
 176     my $owner = shift;
 177
 178     my $q = "SELECT list_id, cvterm.name FROM sgn_people.list AS list LEFT JOIN cvterm ON (type_id=cvterm_id) WHERE list.name = ? AND list.owner=?";
 179     my $h = $dbh->prepare($q);
 180     $h->execute($name, $owner);
 181     my ($list_id, $list_type) = $h->fetchrow_array();
 182
 183     if ($list_id) {
 184         return { list_id => $list_id, list_type => $list_type };
 185     }
 186     return { list_id => undef };
 187 }
 188
 189
 190 around 'BUILDARGS' => sub {
 191     my $orig = shift;
 192     my $class = shift;
 193     my $args = shift;
 194
 195     my $q = "SELECT content from sgn_people.list join sgn_people.list_item using(list_id) WHERE list_id=? ORDER BY list_item_id ASC;";
 196
 197     my $h = $args->{dbh}->prepare($q);
 198     $h->execute($args->{list_id});
 199     my @list = ();
 200     while (my ($content) = $h->fetchrow_array()) {
 201         push @list, $content;
 202     }
 203     $args->{elements} = \@list;
 204
 205     $q = "SELECT list.name, list.description, type_id, cvterm.name, owner FROM sgn_people.list LEFT JOIN cvterm ON (type_id=cvterm_id) WHERE list_id=?";
 206     $h = $args->{dbh}->prepare($q);
 207     $h->execute($args->{list_id});
 208     my ($name, $desc, $type_id, $list_type, $owner) = $h->fetchrow_array();
 209
 210     $args->{name} = $name || '';
 211     $args->{description} = $desc || '';
 212     $args->{type} = $list_type || '';
 213     $args->{owner} = $owner;
 214
 215     return $class->$orig($args);
 216 };
 217
 218 after 'name' => sub {
 219     my $self = shift;
 220     my $name = shift;
 221
 222     if (!$name) { return; }
 223
 224     my $q = "SELECT list_id FROM sgn_people.list where name=? and owner=?";
 225     my $h = $self->dbh->prepare($q);
 226     $h->execute($name, $self->owner());
 227     my ($old_list) = $h->fetchrow_array();
 228     if ($old_list) {
 229         return "The list name $name already exists. Please choose another name.";
 230     }
 231
 232     $q = "UPDATE sgn_people.list SET name=? WHERE list_id=?"; #removed "my"
 233     $h = $self->dbh->prepare($q);
 234
 235     eval {
 236         $h->execute($name, $self->list_id());
 237     };
 238     if ($@) {
 239         return "An error occurred updating the list name ($@)";
 240     }
 241     return 0;
 242 };
 243
 244 after 'type' => sub {
 245     my $self = shift;
 246     my $type = shift;
 247
 248     if (!$type) { return; }
 249
 250     my $q1 = "SELECT cvterm_id FROM cvterm WHERE name =?";
 251     my $h1 = $self->dbh->prepare($q1);
 252     $h1->execute($type);
 253     my ($cvterm_id) =$h1->fetchrow_array();
 254     if (!$cvterm_id) {
 255         return "The specified type does not exist";
 256     }
 257
 258     my $q = "SELECT owner FROM sgn_people.list WHERE list_id=?";
 259     my $h = $self->dbh()->prepare($q);
 260     $h->execute($self->list_id);
 261
 262     eval {
 263         $q = "UPDATE sgn_people.list SET type_id=? WHERE list_id=?";
 264         $h = $self->dbh->prepare($q);
 265         $h->execute($cvterm_id, $self->list_id);
 266     };
 267     if ($@) {
 268         return "An error occurred while updating the type of list ".self->list_id." to $type. $@";
 269     }
 270     return 0;
 271 };
 272
 273 after 'description' => sub {
 274     my $self = shift;
 275     my $description = shift;
 276
 277     if (!$description) {
 278         #print STDERR "NO desc provided... skipping!\n";
 279         return;
 280     }
 281
 282     my $q = "UPDATE sgn_people.list SET description=? WHERE list_id=?";
 283     my $h = $self->dbh->prepare($q);
 284
 285     eval {
 286         $h->execute($description, $self->list_id());
 287     };
 288     if ($@) {
 289         return "An error occurred updating the list description ($@)";
 290     }
 291     return 0;
 292 };
 293
 294
 295 sub add_element {
 296     my $self = shift;
 297     my $element = shift;
 298     #remove trailing spaces
 299     $element =~ s/^\s+|\s+$//g;
 300     if (!$element) {
 301         return "Empty list elements are not allowed";
 302     }
 303     if ($self->exists_element($element)) {
 304         return "The element $element already exists";
 305     }
 306
 307     my $iq = "INSERT INTO sgn_people.list_item (list_id, content) VALUES (?, ?)";
 308     my $ih = $self->dbh()->prepare($iq);
 309     eval {
 310         $ih->execute($self->list_id(), $element);
 311     };
 312     if ($@) {
 313         print STDERR Dumper $@;
 314         return "An error occurred storing the element $element ($@)";
 315     }
 316
 317     my $elements = $self->elements();
 318     push @$elements, $element;
 319     $self->elements($elements);
 320     return 0;
 321 }
 322
 323 sub remove_element {
 324     my $self = shift;
 325     my $element = shift;
 326
 327     my $h = $self->dbh()->prepare("DELETE FROM sgn_people.list_item where list_id=? and content=?");
 328
 329     eval {
 330         $h->execute($self->list_id(), $element);
 331     };
 332     if ($@) {
 333
 334         return "An error occurred while attempting to delete item $element";
 335     }
 336     my $elements = $self->elements();
 337     my @clean = grep(!/^$element$/, @$elements);
 338     $self->elements(\@clean);
 339     return 0;
 340 }
 341
 342 sub remove_element_by_id {
 343     my $self = shift;
 344     my $element_id = shift;
 345     my $h = $self->dbh()->prepare("SELECT content  FROM sgn_people.list_item where list_id=? and list_item_id=?");
 346
 347     eval {
 348         $h->execute($self->list_id(), $element_id);
 349     };
 350     if ($@) {
 351         return "An error occurred while attempting to delete item $element_id";
 352     }
 353     my ($element) = $h->fetchrow_array();
 354
 355     if (my $error = $self->remove_element($element)) {
 356         return $error;
 357     }
 358
 359     return 0;
 360 }
 361
 362 sub update_element_by_id {
 363         my $self = shift;
 364         my $element_id = shift;
 365         my $content = shift;
 366         my $h = $self->dbh()->prepare("UPDATE sgn_people.list_item SET content=? where list_id=? and list_item_id=?");
 367
 368         eval {
 369                 $h->execute($content, $self->list_id(), $element_id);
 370         };
 371         if ($@) {
 372                 return "An error occurred while attempting to update item $element_id";
 373         }
 374
 375         return;
 376 }
 377
 378 sub replace_by_name {
 379         my $self = shift;
 380         my $item_name = shift;
 381         my $new_name = shift;
 382         my $h = $self->dbh()->prepare("UPDATE sgn_people.list_item SET content=? where list_id=? and content=?");
 383
 384         eval {
 385                 $h->execute($new_name, $self->list_id(), $item_name);
 386         };
 387         if ($@) {
 388                 return "An error occurred while attempting to update item $item_name";
 389         }
 390
 391         return;
 392 }
 393
 394 sub remove_by_name {
 395         my $self = shift;
 396         my $item_name = shift;
 397         my $h = $self->dbh()->prepare("DELETE FROM sgn_people.list_item WHERE list_id=? and content=?");
 398
 399         eval {
 400                 $h->execute($self->list_id(), $item_name);
 401         };
 402         if ($@) {
 403                 return "An error occurred while attempting to remove item $item_name";
 404         }
 405
 406         return;
 407 }
 408
 409 sub list_size {
 410     my $self = shift;
 411
 412     my $h = $self->dbh->prepare("SELECT count(*) from sgn_people.list_item WHERE list_id=?");
 413     $h->execute($self->list_id());
 414     my ($count) = $h->fetchrow_array();
 415     return $count;
 416 }
 417
 418 sub toggle_public {
 419     my $self = shift;
 420
 421     my $h = $self->dbh->prepare("SELECT is_public FROM sgn_people.list WHERE list_id=?");
 422     $h->execute($self->list_id());
 423     my $public = $h->fetchrow_array();
 424
 425     my $rows_affected;
 426     if ($public == 0) {
 427         my $h = $self->dbh->prepare("UPDATE sgn_people.list SET is_public='t' WHERE list_id=?");
 428         $h->execute($self->list_id());
 429         $rows_affected = $h->rows;
 430     } elsif ($public == 1) {
 431         my $h = $self->dbh->prepare("UPDATE sgn_people.list SET is_public='f' WHERE list_id=?");
 432         $h->execute($self->list_id());
 433         $rows_affected = $h->rows;
 434     }
 435     return ($public, $rows_affected);
 436 }
 437
 438 sub make_public {
 439     my $self = shift;
 440
 441         my $h = $self->dbh->prepare("UPDATE sgn_people.list SET is_public='t' WHERE list_id=?");
 442         $h->execute($self->list_id());
 443         my $rows_affected = $h->rows;
 444     return $rows_affected;
 445 }
 446
 447 sub make_private {
 448     my $self = shift;
 449
 450         my $h = $self->dbh->prepare("UPDATE sgn_people.list SET is_public='f' WHERE list_id=?");
 451         $h->execute($self->list_id());
 452         my $rows_affected = $h->rows;
 453     return $rows_affected;
 454 }
 455
 456 sub copy_public {
 457     my $self = shift;
 458     my $user_id = shift;
 459
 460     my $h = $self->dbh->prepare("INSERT INTO sgn_people.list (name, description, owner, type_id) SELECT name, description, ?, type_id FROM sgn_people.list as old WHERE old.list_id=? RETURNING list_id");
 461     $h->execute($user_id, $self->list_id());
 462     my $list_id = $h->fetchrow_array();
 463
 464         $h = $self->dbh->prepare("SELECT content FROM sgn_people.list_item WHERE list_id=?");
 465         $h->execute($self->list_id());
 466         my @elements;
 467         while (my $el = $h->fetchrow_array) {
 468                 push @elements, $el;
 469         }
 470
 471         $self->add_bulk(\@elements, $list_id);
 472
 473     return $list_id;
 474 }
 475
 476 sub check_if_public {
 477     my $self = shift;
 478     my $h = $self->dbh->prepare("SELECT is_public FROM sgn_people.list WHERE list_id=?");
 479     $h->execute($self->list_id());
 480     my $public = $h->fetchrow_array();
 481     return $public;
 482 }
 483
 484 sub exists_element {
 485     my $self =shift;
 486     my $item = shift;
 487
 488     my $q = "SELECT list_item_id FROM sgn_people.list join sgn_people.list_item using(list_id) where list.list_id =? and content = ?";
 489     my $h = $self->dbh()->prepare($q);
 490     $h->execute($self->list_id(), $item);
 491     my ($list_item_id) = $h->fetchrow_array();
 492     return $list_item_id;
 493 }
 494
 495 sub type_id {
 496     my $self =shift;
 497
 498     my $q = "SELECT type_id FROM sgn_people.list WHERE list_id=?";
 499     my $h = $self->dbh()->prepare($q);
 500     $h->execute($self->list_id());
 501     my ($type_id) = $h->fetchrow_array();
 502     return $type_id;
 503 }
 504
 505 sub retrieve_elements_with_ids {
 506     my $self = shift;
 507     my $list_id = shift;
 508
 509     my $q = "SELECT list_item_id, content from sgn_people.list_item  WHERE list_id=? ORDER BY list_item_id ASC;";
 510
 511     my $h = $self->dbh()->prepare($q);
 512     $h->execute($list_id);
 513     my @list = ();
 514     while (my ($id, $content) = $h->fetchrow_array()) {
 515         push @list, [ $id, $content ];
 516     }
 517     return \@list;
 518 }
 519
 520 sub add_bulk {
 521         my $self = shift;
 522         my $elements = shift;
 523         my $list_id = shift // $self->list_id();
 524         my %elements_in_list;
 525         my @elements_added;
 526         my @duplicates;
 527         s/^\s+|\s+$//g for @$elements;
 528         #print STDERR Dumper $elements;
 529
 530         my $q = "SELECT content FROM sgn_people.list join sgn_people.list_item using(list_id) where list.list_id =?";
 531         my $h = $self->dbh()->prepare($q);
 532         $h->execute($list_id);
 533         while (my $list_content = $h->fetchrow_array()) {
 534                 $elements_in_list{$list_content} = 1;
 535         }
 536
 537         $q = "SELECT list_item_id FROM sgn_people.list_item ORDER BY list_item_id DESC LIMIT 1";
 538         $h = $self->dbh()->prepare($q);
 539         $h->execute();
 540         my $list_item_id = $h->fetchrow_array() + 1;
 541
 542         my $iq = "INSERT INTO sgn_people.list_item (list_item_id, list_id, content) VALUES";
 543
 544         my $count = 0;
 545         eval {
 546                 $self->dbh()->begin_work;
 547
 548                 my @values;
 549                 foreach (@$elements) {
 550                         if ($_ && !exists $elements_in_list{$_}){
 551                                 my $content = $_;
 552                                 $content =~ s/\'/\'\'/g;
 553                                 push @values, [$list_item_id, $list_id, $content];
 554                                 $elements_in_list{$content} = 1;
 555                                 push @elements_added, $content;
 556                                 $list_item_id++;
 557                                 $count++;
 558                         } else {
 559                                 push @duplicates, $_;
 560                         }
 561                 }
 562
 563                 my $step = 1;
 564                 my $num_values = scalar(@values);
 565                 foreach (@values) {
 566                         if ($step < $num_values) {
 567                                 $iq = $iq." (".$_->[0].",".$_->[1].",'".$_->[2]."'),";
 568                         } else {
 569                                 $iq = $iq." (".$_->[0].",".$_->[1].",'".$_->[2]."');";
 570                         }
 571                         $step++;
 572                 }
 573                 #print STDERR Dumper $iq;
 574                 if ($count>0){
 575                         $self->dbh()->do($iq);
 576                 }
 577                 $self->dbh()->commit;
 578         };
 579         if ($@) {
 580                 $self->dbh()->rollback;
 581                 return {error => "An error occurred in bulk addition to list. ($@)"};
 582         }
 583
 584         $elements = $self->elements();
 585         push @$elements, \@elements_added;
 586         $self->elements($elements);
 587
 588         my %response = (count => $count, duplicates => \@duplicates);
 589         return \%response;
 590 }
 591
 592 sub delete_bulk {
 593     my $self = shift;
 594     my $item_ids = shift;
 595     my $items_ids_sql = join ',', @$item_ids;
 596
 597     my $q = "DELETE FROM sgn_people.list_item WHERE list_id=? AND list_item_id IN ($items_ids_sql)";
 598     my $h = $self->dbh()->prepare($q);
 599     $h->execute($self->list_id());
 600     return;
 601 }
 602
 603 sub sort_items {
 604     no warnings 'uninitialized';
 605     my $self = shift;
 606     my $sort = shift;
 607     my $items = $self->retrieve_elements_with_ids($self->list_id);
 608     my @contents;
 609     my @item_ids;
 610     foreach (@$items){
 611         push @item_ids, $_->[0];
 612         push @contents, $_->[1];
 613     }
 614     my @sorted;
 615     if ($sort eq 'ASC'){
 616         @sorted = map  { $_->[0] }
 617             sort { $a->[1] <=> $b->[1] }
 618             map  { [$_, $_=~/(\d+)/ ] }
 619             @contents;
 620     } elsif ($sort eq 'DESC'){
 621         @sorted = map  { $_->[0] }
 622             sort { $b->[1] <=> $a->[1] }
 623             map  { [$_, $_=~/(\d+)/ ] }
 624             @contents;
 625     } else {
 626         return;
 627     }
 628
 629     $self->delete_bulk(\@item_ids);
 630     $self->add_bulk(\@sorted, $self->list_id);
 631     return 1;
 632 }
 633
 634 1;