cgi-bin/maps/physical/clone_async.pl

   1 use strict;
   2 use warnings;
   3
   4 use JSON; #< used for encoding our return data as JSON, for use by the
   5           #< client javascript
   6
   7 use Data::Dumper;
   8
   9 use CXGN::Metadata; #< bac project associations are in the metadatadatabase
  10
  11 use CXGN::Scrap::AjaxPage;
  12 use CXGN::People;
  13 use CXGN::People::BACStatusLog;
  14 use CXGN::Login;
  15
  16 use CXGN::Tools::List qw/str_in/;
  17 use CXGN::Page::FormattingHelpers qw/info_table_html columnar_table_html/;
  18
  19 use CXGN::Genomic::Clone;
  20 use CXGN::Cview::MapOverviews::ProjectStats;
  21
  22 use CatalystX::GlobalContext '$c';
  23
  24 our $page = CXGN::Scrap::AjaxPage->new('text/html');
  25 our $dbh = CXGN::DB::Connection->new();
  26
  27 $page->send_http_header;
  28
  29 my %ops = (
  30             set_ver_int_read   => sub { set_val_flag('int_read') },
  31             set_ver_bac_end    => sub { set_val_flag('bac_end') },
  32             qclonehtml         => \&query_bac_infotable,
  33             qclonejson         => \&query_bac_json,
  34             qcloneperl         => \&query_bac_perl,
  35           );
  36
  37 my ($opname) = $page->get_encoded_arguments('action');
  38 no strict 'refs'; #< using symbolic refs for sub names
  39 $opname =~ /[^a-z_]/ and die "invalid op name '$opname'";
  40 $ops{$opname} ||= \&{"$opname"};
  41 $ops{$opname} or die 'unknown operation';
  42 print $ops{$opname}->();
  43 exit;
  44
  45 ######## END OF MAIN SCRIPT
  46
  47 ######## OPERATIONS SUBS #############
  48
  49 sub set_il_proj {
  50   my $person = get_valid_person();
  51   my $clone = clone();
  52
  53   my ($id) = $page->get_encoded_arguments('val');
  54   if($id && $id ne 'none') {
  55     $id += 0; #< enforce numeric
  56     str_in($id,$person->get_projects_associated_with_person)
  57       or die 'you do not have permission to make that assignment';
  58   } else {
  59     $id = undef;
  60   }
  61
  62   $clone->il_mapping_project_id($id,$person->get_sp_person_id);
  63   return query_bac_json($clone);
  64 }
  65
  66 sub set_il_bin {
  67   my ($argname,$funcname) = @_;
  68
  69   my $person = get_valid_person();
  70   my $clone = clone();
  71
  72   my ($id) = $page->get_encoded_arguments('val');
  73   if($id && $id ne 'none') {
  74     $id += 0;
  75   } else {
  76     $id = undef;
  77   }
  78
  79   $clone->il_mapping_data({bin_id =>$id},$person->get_sp_person_id);
  80   return query_bac_json($clone);
  81 }
  82
  83 sub set_il_chr {
  84   my ($argname,$funcname) = @_;
  85
  86   my $person = get_valid_person();
  87   my $clone = clone();
  88
  89   my ($chr) = $page->get_encoded_arguments('val');
  90   if($chr && $chr >0) {
  91     $chr += 0;
  92   } else {
  93     $chr = undef;
  94   }
  95
  96   $clone->il_mapping_data({chr =>$chr},$person->get_sp_person_id);
  97   return query_bac_json($clone);
  98 }
  99
 100 sub set_il_notes {
 101   my ($argname,$funcname) = @_;
 102
 103   my $person = get_valid_person();
 104   my $clone = clone();
 105
 106   my ($notes) = $page->get_encoded_arguments('val');
 107   $notes ||= undef;
 108
 109   $clone->il_mapping_data({notes => $notes},$person->get_sp_person_id);
 110   return query_bac_json($clone);
 111 }
 112
 113
 114
 115
 116 sub set_seq_proj {
 117   my $clone = clone();
 118   my $person = get_valid_person();
 119   my ($proj_id) = $page->get_encoded_arguments('val');
 120
 121   unless($proj_id) {
 122     $proj_id = undef;
 123   } else {
 124     $proj_id += 0; #< enforce numeric
 125     $person->is_person_associated_with_project($proj_id)
 126       or die "not authorized to assign a clone to that project\n";
 127   }
 128   my $current_proj = metadata()->get_project_associated_with_bac($clone->clone_id);
 129
 130   !$current_proj or $person->is_person_associated_with_project($current_proj)
 131     or die "not authorized to take a bac away from that chromosome project\n";
 132
 133   metadata()->attribute_bac_to_project($clone->clone_id,$proj_id);
 134   return query_bac_json($clone);
 135 }
 136
 137 sub set_seq_status {
 138   my $clone = clone();
 139   my $person = get_valid_person();
 140   my ($stat) = $page->get_encoded_arguments('val');
 141
 142   my $current_proj = metadata()->get_project_associated_with_bac($clone->clone_id);
 143
 144   $person->is_person_associated_with_project($current_proj)
 145     or die "not authorized to change seq status for that bac\n";
 146
 147   bac_status_log()->change_status( bac => $clone->clone_id,
 148                                    person => $person->get_sp_person_id,
 149                                    seq_status => $stat,
 150                                  );
 151   return query_bac_json($clone);
 152 }
 153
 154 sub set_gb_status {
 155   my $clone = clone();
 156   my $person = get_valid_person();
 157   my ($stat) = $page->get_encoded_arguments('val');
 158
 159   my $current_proj = metadata()->get_project_associated_with_bac($clone->clone_id);
 160
 161   $person->is_person_associated_with_project($current_proj)
 162     or die "not authorized to change genbank status for that bac\n";
 163
 164   bac_status_log()->change_status( bac => $clone->clone_id,
 165                                    person => $person->get_sp_person_id,
 166                                    genbank_status => $stat,
 167                                  );
 168   return query_bac_json($clone);
 169 }
 170
 171 sub set_val_flag {
 172   my ($flagname) = @_;
 173   my $clone = clone();
 174   my $person = get_valid_person();
 175
 176   my ($stat) = $page->get_encoded_arguments('val');
 177
 178   $clone->verification_flags(person => $person, $flagname => $stat ? 1 : 0);
 179   return query_bac_json($clone);
 180 }
 181
 182 sub query_bac_infotable {
 183   my $clone = shift() || clone();
 184   my $info = $clone->reg_info_hashref;
 185   return info_table_html( __multicol => 2,
 186                           __border => 0,
 187                           'Assigned to project' => $info->{il_proj}{disp},
 188                           'Mapped to IL segment' => $info->{il_bin}{disp},
 189                         );
 190 }
 191
 192 sub query_bac_json {
 193   my $clone = shift() || clone();
 194   return to_json( $clone->reg_info_hashref );
 195 }
 196
 197 sub query_bac_perl {
 198   my $clone = shift() || clone();
 199   local $Data::Dumper::Terse = 1;
 200   return Dumper $clone->reg_info_hashref;
 201 }
 202
 203 sub project_stats_img_html {
 204
 205   # force re-calculation of the image/stats
 206   my $map_overview = CXGN::Cview::MapOverviews::ProjectStats->new(
 207       { force => 1,
 208         dbh => $dbh,
 209         basepath => $c->get_conf('basepath'),
 210         tempfiles_subdir => $c->tempfiles_subdir('cview'),
 211         progress_data => bac_status_log()->bac_by_bac_progress_statistics,
 212       },
 213      );
 214   $map_overview->render_map();
 215   my $map_overview_html = $map_overview->get_image_html();
 216
 217   # also generate a smaller version of the image that is
 218   # used on the homepage.
 219   #
 220   $map_overview->create_mini_overview;
 221
 222   return $map_overview_html;
 223 }
 224
 225
 226 ############ UTILITY SUBS #############
 227 # these subs are used by the main operations subs above
 228
 229 sub clone {
 230
 231   #did we get a clone_id argument?  if so, lookup from that
 232   my ($id) = $page->get_encoded_arguments('clone_id');
 233   $id += 0;
 234   if($id) {
 235     my $c = CXGN::Genomic::Clone->retrieve($id)
 236       or die 'could not retrieve clone from id';
 237     return $c;
 238   }
 239
 240   my ($name) = $page->get_encoded_arguments('clone_name');
 241   #otherwise, did we get a clone_name arg? if so, lookup from that
 242   if($name) {
 243     my $c = CXGN::Genomic::Clone->retrieve_from_clone_name($name)
 244       or die 'could not retrieve clone from name';
 245     return $c;
 246   }
 247
 248   die 'must provide either clone ID (clone_id argument) or clone name (clone_name argument)';
 249 }
 250
 251 sub get_valid_person {
 252   my $person_id = CXGN::Login->new($dbh)->has_session
 253     or die 'you must log in to access this page';
 254   my $person = CXGN::People::Person->new($dbh, $person_id);
 255
 256   str_in($person->get_user_type,qw/sequencer curator/)
 257     or die 'you do not have permission to make that assignment';
 258
 259   return $person;
 260 }
 261
 262 sub metadata {
 263   our $metadata ||= CXGN::Metadata->new(); # metadata object
 264 }
 265
 266 sub bac_status_log {
 267     our $bac_status_log ||= CXGN::People::BACStatusLog->new($dbh); # bac ... status ... object
 268 }
 269