cgi-bin/maps/physical/clone_il_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 CXGN::Scrap::AjaxPage;
   8 use CXGN::DB::Connection;
   9 use CXGN::People;
  10 use CXGN::Login;
  11
  12 use CXGN::Tools::List qw/str_in/;
  13 use CXGN::Page::FormattingHelpers qw/ info_table_html /;
  14
  15 use CXGN::Genomic::Clone;
  16
  17 use CatalystX::GlobalContext '$c';
  18
  19 my %ops = ( assign     => \&assign_to_project,
  20             localize   => \&report_mapping_bin,
  21 #           qprojjson  => \&query_proj_json,
  22             qclonehtml => \&query_bac_infotable,
  23             qclonejson => \&query_bac_json
  24           );
  25
  26 my $opname = $c->req->param('action');
  27 #die "got opname $opname\n";
  28 $ops{$opname} or die 'unknown operation';
  29 print $ops{$opname}->();
  30
  31 exit;
  32
  33 ######## OPERATIONS SUBS #############
  34
  35 sub assign_to_project {
  36   my $person = get_valid_person();
  37   my $clone = clone();
  38
  39   my $id = $c->req->param('proj');
  40   if($id eq 'none') {
  41     $id = undef;
  42   } else {
  43     $id += 0; #< enforce numeric
  44     str_in($id,$person->get_projects_associated_with_person)
  45       or die 'you do not have permission to make that assignment';
  46   }
  47
  48   clone()->il_mapping_project_id($id,$person->get_sp_person_id);
  49   return query_bac_json();
  50 }
  51
  52 sub report_mapping_bin {
  53   my ($argname,$funcname) = @_;
  54
  55   my $person = get_valid_person();
  56   my $clone = clone();
  57
  58   my $id = $c->req->param('il_indiv');
  59   if($id eq 'none') {
  60     $id = undef;
  61   } else {
  62     $id += 0; #< enforce numeric
  63   }
  64
  65   clone()->il_mapping_individual_id($id,$person->get_sp_person_id);
  66   return query_bac_json();
  67 }
  68
  69 sub query_bac {
  70   my ($clone) = @_;
  71   $clone ||= clone();
  72   my @projnames = (undef,qw/USA Korea China UK India Netherlands France Japan Spain USA USA Italy/);
  73   my $proj_id = $clone->il_mapping_project_id;
  74   my $proj_name = $proj_id ? ($projnames[$proj_id] || $proj_id) : 'none'; #< change the project ID to the project name
  75
  76   my $il_id = $clone->il_mapping_individual_id;
  77   my ($il_name) = do {
  78     if($il_id) {
  79       $clone->db_Main->selectrow_array(<<EOQ,undef,$il_id);
  80 select name
  81 from phenome.individual
  82 where individual_id=?
  83 EOQ
  84     }
  85   };
  86
  87   $il_name ||= 'not yet reported';
  88   return ($proj_name,$il_name,$proj_id,$il_id);
  89
  90 }
  91
  92 sub query_bac_infotable {
  93   my ($proj_name,$il_name) = query_bac(@_);
  94   return info_table_html( __multicol => 2,
  95                           __border => 0,
  96                           'Assigned to project' => $proj_name,
  97                           'Mapped to IL segment' => $il_name,
  98                         );
  99 }
 100
 101 sub query_bac_json {
 102   my ($proj_name,$il_name,$proj_id,$il_id) = query_bac(@_);
 103   return objToJson({ proj_name => $proj_name,
 104                      proj_id => $proj_id,
 105                      il_name => $il_name,
 106                      il_id => $il_id,
 107                    });
 108 }
 109
 110 # sub query_proj_json {
 111 #   my ($proj_id) = $page->get_encoded_arguments('p');
 112
 113 #   my $dbh = CXGN::DB::Connection->new;
 114 #   my $bacs = $dbh->selectall_arrayref(<<EOQ,undef,$proj_id);
 115 # select cl.clone_id,
 116 #        ( select name
 117 #          from sgn_people.sp_clone_il_mapping_segment_log
 118 #          join phenome.individual using(individual_id)
 119 #          where clone_id = cl.clone_id
 120 #                and is_current = true
 121 #        )
 122 # from sgn_people.sp_project_il_mapping_clone_log cl
 123 # where cl.sp_project_id = ?
 124 #   and cl.is_current = true
 125 # EOQ
 126
 127 #   my @ret = map {
 128 #     my ($clone_id,$il_name) = @$_;
 129 #     [ $clone_id,
 130 #       'bogus name',
 131 #       $il_name,
 132 #     ]
 133 # #     my $clone = CXGN::Genomic::Clone->retrieve($clone_id);
 134 # #     [
 135 # #      '<a href="/maps/physical/clone_info.pl?id=$clone_id">'
 136 # #      .($clone->clone_name_with_chromosome || $clone->clone_name)
 137 # #      .'</a>',
 138 # #      $il_name,
 139 # #     ]
 140 #   } @$bacs;
 141
 142 #   return objToJson(\@ret);
 143 # }
 144
 145 ############ UTILITY SUBS #############
 146
 147 sub clone {
 148   my $id = $c->req->param('id');
 149   $id += 0;
 150   my $c = CXGN::Genomic::Clone->retrieve($id)
 151     or die 'could not retrieve clone from id';
 152   return $c;
 153 }
 154
 155 sub get_valid_person {
 156   my $dbh = CXGN::DB::Connection->new();
 157   my $person_id = CXGN::Login->new($dbh)->has_session
 158     or die 'you must log in to access this page';
 159   my $person = CXGN::People::Person->new($dbh, $person_id);
 160
 161  str_in($person->get_user_type,qw/sequencer curator/)
 162     or die 'you do not have permission to make that assignment';
 163
 164   return $person;
 165 }