[Bio] / MGRAST / services.cgi Repository:
ViewVC logotype

Annotation of /MGRAST/services.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (view) (download)

1 : wilke 1.1 use strict;
2 :     use warnings;
3 :     no warnings 'once';
4 :    
5 : wilke 1.2
6 : wilke 1.1 use DBI;
7 :     use Data::Dumper;
8 : wilke 1.2 use Digest::MD5 qw(md5 md5_hex md5_base64);
9 :     use XML::Simple;
10 :     use CGI;
11 :    
12 : wilke 1.1 use Metadata;
13 :     use DBMaster;
14 :     use WebApplicationDBHandle;
15 : wilke 1.3 #use MGRAST::CreateV2Job;
16 : wilke 1.2 use FIG_Config;
17 :    
18 : wilke 1.18 my $t ="services.cgi";
19 : wilke 1.1
20 :     eval {
21 :     &main;
22 :     };
23 :    
24 :     if ($@)
25 :     {
26 :     my $cgi = new CGI();
27 :     print $cgi->header() , $cgi->start_html() ;
28 :     # print out the error
29 :     print '<pre>'.$@.'</pre>';
30 :     print $cgi->end_html();
31 :    
32 :     }
33 :    
34 :     sub main {
35 :    
36 :     my $cgi = CGI->new ;
37 :    
38 :     my $key = $cgi->param('key');
39 :     my $html = 0 ;
40 :     my @data ;
41 :     my $msg = '' ;
42 :     my $options = {};
43 :     my $qiime = $ENV{HTTP_USER_AGENT} =~/qiime/i ;
44 : wilke 1.18
45 : wilke 1.1 my ( $user , $dbmaster , $error ) ;
46 :    
47 :    
48 :     $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
49 :     $html =1 if ($ENV{HTTP_USER_AGENT} =~/Mozilla/);
50 :    
51 : wilke 1.10 #if ($qiime) { print STDERR "QIIME call\n" } ;
52 : wilke 1.1
53 : wilke 1.7 # print STDERR "HTML Output on" if ($html) ;
54 : wilke 1.1
55 :     #init db connections
56 :     my $meta = MGRAST::Metadata->new();
57 : wilke 1.13
58 : wilke 1.1
59 :    
60 :     # init header
61 :     if ($html) {
62 : wilke 1.18 if($cgi->param('rest') =~/raw/){
63 :     #print $cgi->header('application/x-download') ;
64 :     print "Content-Type:application/x-download\n";
65 :     }
66 :     else{
67 :     print $cgi->header('text/html') ;
68 :     print $cgi->start_html( -title => 'Fine User Controlled Knockout' );
69 :     }
70 : wilke 1.1 }
71 :     else{
72 :     print $cgi->header('text/xml') ;
73 :     }
74 :    
75 :     my $procedure = { debug => \&print_debug ,
76 :     study => \&study ,
77 :     sample => \&sample ,
78 :     preparation => \&sequence_prep ,
79 :     prep => \&sequence_prep ,
80 :     reads => \&reads ,
81 :     sequence => \&reads ,
82 :     register => \&register ,
83 :     };
84 :    
85 :     if ( defined $cgi->param('POSTDATA') or ($ENV{'REQUEST_METHOD'} eq "POST" ) ){
86 :     my @params = split "&" , $ENV{QUERY_STRING} ;
87 :     foreach my $param (@params){
88 :     my ($key , $value) = split "=" , $param ;
89 :     $cgi->param($key , $value) unless ($cgi->param($key) );
90 :     }
91 :     #print $cgi->param('POSTDATA') ;
92 : wilke 1.7 # print STDERR "Method : " . $ENV{'REQUEST_METHOD'} . "\n";
93 : wilke 1.1 }
94 :    
95 :     # walk through options
96 :     if ($cgi->param('rest')){
97 :     my $path = $cgi->param('rest') ;
98 :     $path =~ s/^service\///;
99 :     my @options = split "/" , $path ;
100 :    
101 :     my $opt = shift @options ;
102 :    
103 :     # user authentification
104 :     if ($opt and length($opt) == 25 ){
105 :     # user authentification
106 :     ( $user , $dbmaster , $msg , $error ) = &authentification($opt);
107 : wilke 1.13 $meta->db->{_user} = $user;
108 : wilke 1.1 if ($error or !(ref $user)){
109 :     print_html($msg) ;
110 :     exit;
111 :     }
112 :     #print $user->login , "\n" ;
113 :     $options->{user} = $user ;
114 :     $opt = shift @options ;
115 :     }
116 :    
117 :     if ($opt) {
118 :     #print STDERR "$opt\t" , length($opt) , "\n";
119 :     if ($opt =~ /debug/){
120 :     print_debug($html , $cgi);
121 :     }
122 :     else{
123 :    
124 :     if ( $ENV{'REQUEST_METHOD'} =~/post/i and not ref $user){
125 : wilke 1.7 #print STDERR "Calling POST without user!\n";
126 : wilke 1.1 $msg .= "Trying to upload data without valid identification.\n" ;
127 :     }
128 :     elsif (exists $procedure->{ $opt } ){
129 :     my ($message , $data ) = $procedure->{ $opt }( { method => $ENV{'REQUEST_METHOD'} ,
130 :     metadata_handle => $meta ,
131 :     params => \@options ,
132 :     user => $user ,
133 :     cgi => $cgi,
134 :     master => $dbmaster,
135 :     }) ;
136 :     push @data , $data ;
137 :     $msg .= $message ;
138 :     }
139 :     else{
140 :     print "Service ". $opt ." does not exists!\n";
141 :     }
142 :     }
143 :     }
144 :     }
145 :     else{
146 : wilke 1.19 print STDERR "$t: Missing cgi param rest\n";
147 : wilke 1.1 foreach my $k ($cgi->param){
148 :     print "$k\t".$cgi->param($k)."\n";
149 :     }
150 :     print_debug($msg . "\n" . $html , $cgi ) ;
151 :     }
152 :    
153 :    
154 :     $html ? print_html($msg) : print $msg ;
155 :     $html ? print_html( join "\n" , @data ) : print join"\n" , @data ;
156 :    
157 :     exit 1;
158 :     }
159 :    
160 :    
161 :     sub print_html{
162 :     my ($msg, $cgi) = @_ ;
163 :     print "<pre>$msg</pre>" ;
164 :     }
165 :    
166 :     sub print_debug{
167 :     my ($html , $cgi) = @_ ;
168 :    
169 :     my $msg = '' ;
170 :    
171 :     $msg .= "CGI:\n\n" ;
172 :     if ($cgi and ref $cgi){
173 :     foreach my $p ($cgi->param){
174 :     $msg .= join "\t" , $p , $cgi->param($p) , "\n" ;
175 :     }
176 :     }
177 :     else{
178 :     $msg .= "no cgi\n";
179 :     }
180 :    
181 :     $msg .= "\nENV:\n\n";
182 :     foreach my $k (keys %ENV){
183 :     $msg .= join "\t" , $k , $ENV{$k} , "\n" ;
184 :     }
185 :    
186 :     $html ? print_html($msg) : print $msg ;
187 :    
188 :     return 1;
189 :     }
190 :    
191 :     sub authentification {
192 :     my ($key) = @_ ;
193 :    
194 :     my $msg = '';
195 :     my ( $dbmaster , $user ) ;
196 :     my $error = 0 ;
197 :    
198 :     if ($key){
199 :     # initialize db-master
200 :     ($dbmaster, $error) = WebApplicationDBHandle->new();
201 :    
202 :     # check if we got a dbmaster
203 :     if ($error) {
204 :     print $error."\n";
205 :     print STDERR $error."\n";
206 :     exit 0;
207 :     }
208 :    
209 :     $user = WebApplicationDBHandle::authenticate_user($dbmaster, $key);
210 :     unless ($user) {
211 :     $msg .= "authentication with key $key failed.\n";
212 :     print STDERR $msg ; }
213 :     }
214 :     else{ $msg .= "No user authentification key $key given\n"; }
215 :    
216 :     return ( $user , $dbmaster , $msg , $error ) ;
217 :     }
218 :    
219 :    
220 :     # services
221 :     # study GET get all study ids a user has access to
222 :     # PUT create new study
223 :     # study/id/1234/ GET get study for id
224 :     # POST update study
225 :    
226 :     sub study {
227 :     my ($params) = @_ ;
228 :    
229 :     my $method = $params->{method} ;
230 :     my $meta = $params->{metadata_handle};
231 :     my $opts = $params->{params} ;
232 :     my $user = $params->{user};
233 :     my $cgi = $params->{cgi} ;
234 :     my $master = $params->{master} ;
235 :    
236 :    
237 :    
238 :     my $data = '' ;
239 :     my $msg = '' ;
240 :     my $tag = '' ;
241 :    
242 :     if ($opts and @$opts){
243 :     $tag = shift @$opts ;
244 :     }
245 :    
246 :     # get global ids/all public ?
247 :     if ( $method eq "GET" ){
248 :    
249 :     if ( $tag eq "id" ){
250 :    
251 :     my $value = shift @$opts ;
252 :     #print "ID\t$value\n";
253 :     return ( "missing value for id" , '') unless ($value);
254 :    
255 :     my $prjs ;
256 :     if ($user){
257 :    
258 :     my $prj = $meta->db->Project->init( { id => $value });
259 : wilke 1.16 if ( $user->has_right(undef, 'view' , 'project', $value ) or ( $prj->public and $prj->type eq "project" ) ){
260 : wilke 1.1 push @$prjs , $prj ;
261 :     }
262 :     else{
263 : wilke 1.16 $msg .= "<success>0</success>\n<error>you don't have the right to view project $value</error>" ;
264 : wilke 1.1 }
265 :     }
266 :     else{
267 : wilke 1.16 $prjs = $meta->db->Project->get_objects( { id => $value , public => 1 , type => 'project' });
268 : wilke 1.1 }
269 :    
270 : wilke 1.18 my $action = scalar @$opts ? shift @$opts : '' ;
271 : wilke 1.1 foreach my $prj (@$prjs){
272 : wilke 1.18 if($action){
273 :     if ($action eq "raw"){
274 :     my $id = $prj->id ;
275 :     print "Content-Disposition:attachment; filename=project-" . $id . ".raw.tar;\n\n";
276 :     print `cd /mcs/bio/ftp/mg-rast/metagenomes/ ; tar cf - $id/*/raw/* $id/*/meta* $id/meta*` ;
277 :     exit;
278 :     }
279 :     }
280 :     else{
281 : wilke 1.1 $data .= $prj->xml ;
282 : wilke 1.18 }
283 : wilke 1.1 }
284 :    
285 :     }
286 :     else{
287 :     my $ids = $meta->get_projects ;
288 :     $data .= join "\n" , "<projects>" , (map { "<project_id>".$_."</project_id>" } @$ids ) , "</projects>" ;
289 :     }
290 :     }
291 :     elsif( $method eq "POST"){
292 :    
293 :     my ($s , $e , $ids) = create_study( $master , $meta , $user , $cgi->param('POSTDATA') ) ;
294 :     $msg .= "<success>$s</success>\n<error>$e</error>" ;
295 :     if ($ids and scalar @$ids){
296 :     foreach my $id (@$ids){
297 :     $data .= "<project_id>$id</project_id>" ;
298 :     }
299 :     }
300 :     }
301 :     elsif ( $method eq "PUT" ){
302 :     $msg .= "<success>0</success>\n<error>not implemented</error>" ;
303 :     }
304 :     elsif ( $method eq "DELETE"){
305 :     $msg .= "<success>0</success>\n<error>not implemented</error>" ;
306 :     }
307 :    
308 :     # Called post or put without parameters
309 :     else{
310 :     $msg .= "<success>0</success>\n<error>Missing arguments for $method</error>" ;
311 :     return ($msg , '') ;
312 :     }
313 :    
314 :     return ($msg , "\n<data>".$data."\n</data>") ;
315 :     }
316 :    
317 :    
318 :     sub create_study {
319 :     my ($master , $meta , $user , $data) = @_ ;
320 :     my $success = 1 ;
321 :     my $error = 0 ;
322 :     my @study_ids ;
323 :    
324 :     # parse xml structure
325 :     my $xs = XML::Simple->new();
326 :     my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'study_id' ]);
327 :    
328 :     $data .= Dumper $block ;
329 :    
330 :    
331 :     # single study without <daba_block>
332 :     push @{ $block->{study} } , $block unless ($block->{study}) ;
333 :    
334 :     foreach my $study ( @{ $block->{study} } ){
335 :    
336 :     # study name must exists
337 :     return ( 0 , 'no study name', \@study_ids ) unless ( $study->{study_name} ) ;
338 :     # check for existing project name
339 : wilke 1.2 if (my $prj = $meta->db->Project->init( { name => $study->{study_name} }) ){
340 :     push @study_ids , $prj->id ;
341 :     return ( 0 , 'duplicate project name ' . $study->{study_name} , \@study_ids )
342 :     }
343 : wilke 1.1
344 :     # get curator
345 :     my $curator ;
346 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
347 :     # not a Curator , create one
348 :     unless(ref $curators and scalar @$curators){
349 :     my $curator = $meta->db->Curator->create( { user => $user ,
350 :     name => $user->firstname . " " . $user->lastname ,
351 :     email => $user->email ,
352 :     type => $study->{submission_system} || '' ,
353 :     url => '' ,
354 : wilke 1.13 ID => $user->_id ,
355 : wilke 1.1 });
356 :    
357 :     unless($curator and ref $curator){
358 :     print STDERR "Can't creat Curator for user " . $user->login ;
359 :     exit;
360 :     }
361 :    
362 :     }
363 :     else{
364 :     $curator = $curators->[0] ;
365 :     }
366 :    
367 :    
368 :     my $id = ($meta->db->Project->last_id) + 1 ;
369 :     my $project = $meta->db->Project->create( { creator => $curator ,
370 :     id => $id ,
371 :     name => $study->{study_name} ,
372 :     public => 0 ,
373 : wilke 1.16 type => 'project' ,
374 : wilke 1.1 } ) ;
375 :    
376 :     # create right for new project
377 :     my $view_right = $master->Rights->create( { scope => $user->get_user_scope,
378 : wilke 1.16 data_type => 'project',
379 : wilke 1.1 data_id => $id ,
380 :     name => 'view',
381 :     granted => 1 ,
382 :     } );
383 :     my $edit_right = $master->Rights->create( { scope => $user->get_user_scope,
384 : wilke 1.16 data_type => 'project',
385 : wilke 1.1 data_id => $id ,
386 :     name => 'edit',
387 :     granted => 1 ,
388 :     } );
389 :    
390 :    
391 :     push @study_ids , $project->id ;
392 :    
393 :     # preserve study id
394 :     #$study->{metadata}->{study_id} = $study->{ study_id } ;
395 :     foreach my $id (@{ $study->{study_id} } ){
396 :     $study->{metadata}->{id} = ( $id->{namespace} ? $id->{namespace} . ":" . $id->{content} : $id->{content} ) ;
397 :     }
398 :    
399 :     #add tag , value pairs
400 :     foreach my $tag (keys %{$study->{metadata}}){
401 :     my $pmd = $meta->db->ProjectMD->create( { project => $project ,
402 :     tag => $tag ,
403 :     value => $study->{metadata}->{$tag} ,
404 :     } ) ;
405 :     }
406 :    
407 :     }
408 :     return ( $success , $error ,\@study_ids ) ;
409 :     }
410 :    
411 :    
412 :     sub sample {
413 :     my ($params) = @_ ;
414 :    
415 :     my $method = $params->{method} ;
416 :     my $meta = $params->{metadata_handle};
417 :     my $opts = $params->{params} ;
418 :     my $user = $params->{user};
419 :     my $cgi = $params->{cgi} ;
420 :     my $master = $params->{master} ;
421 :    
422 :    
423 :    
424 :     my $data = '' ;
425 :     my $msg = '' ;
426 :     my $tag = '' ;
427 :    
428 :     if ($opts and @$opts){
429 :     $tag = shift @$opts ;
430 :     }
431 :    
432 :     # get global ids/all public ?
433 :     if ( $method eq "GET" ){
434 :     my $samples = [] ;
435 :    
436 :     if ( $tag eq "id" ){
437 :    
438 :    
439 :    
440 :    
441 :     if ($user){
442 :     my $value = shift @$opts ;
443 :    
444 :     if ( $value and $user->has_right(undef, 'view' , 'sample', $value ) ){
445 :     $samples = $meta->db->MetaDataCollection->get_objects( { ID => $value } );
446 :     }
447 :     else{
448 :     $msg .= "<success>0</success>\n<error>you don't have the right to view sample $value</error>" ;
449 :     }
450 :     }
451 :     else{
452 :     $msg .= "<success>0</success>\n<error>no public samples defined</error>" ;
453 :     }
454 :    
455 :     foreach my $sample (@$samples){
456 :     $data .= $sample->xml ;
457 :     }
458 :    
459 :    
460 :     }
461 :     elsif ($tag){
462 :    
463 :     }
464 :     else{
465 :     # my $ids = $meta->get_samples ;
466 :     }
467 :     }
468 :     elsif( $method eq "POST"){
469 :     if ($user){
470 :     $data .= $cgi->param('POSTDATA') ;
471 : wilke 1.7 #print STDERR "Creating Samples\n";
472 : wilke 1.1 my ($s , $e , $ids) = create_sample($master , $meta , $user , $cgi->param('POSTDATA') ) ;
473 : wilke 1.7 #print STDERR scalar @$ids . " Samples Created.\n";
474 : wilke 1.1 $msg .= "<success>$s</success>\n<error>$e</error>" ;
475 :     foreach my $id (@$ids){
476 :     $data = "<sample_id>$id</sample_id>\n";
477 :     }
478 :     }
479 :     }
480 :    
481 :     # Called post or put without parameters
482 :     else{ $msg .= "Missing arguments for $method" ; return ($msg , '') }
483 :    
484 :     return ($msg , "\n<data>".$data."\n</data>") ;
485 :    
486 :     };
487 :    
488 :    
489 :     sub create_sample {
490 :     my ($master , $meta , $user , $data) = @_ ;
491 :     my $success = 1 ;
492 :     my $error = 0 ;
493 :     my $msg = '';
494 :     my @sample_ids ;
495 : wilke 1.18 my $collection ;
496 : wilke 1.1
497 :    
498 :     # parse sample xml
499 :     my $xs = XML::Simple->new();
500 : wilke 1.2 my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'sample_id' , 'study_id' ]);
501 : wilke 1.1
502 :     # single study without <daba_block>
503 :     push @{ $block->{sample} } , $block unless ($block->{sample}) ;
504 :    
505 :    
506 :     foreach my $sample ( @{ $block->{sample} } ){
507 :    
508 :     # get curator
509 :     my $curator ;
510 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
511 :     # not a Curator , create one
512 :     unless(ref $curators and scalar @$curators){
513 :     my $curator = $meta->db->Curator->create( { user => $user ,
514 :     name => $user->firstname . " " . $user->lastname ,
515 :     email => $user->email ,
516 :     type => $sample->{submission_system} || '' ,
517 :     url => '' ,
518 :     ID => "R". $user->_id ,
519 :     });
520 :    
521 :     unless($curator and ref $curator){
522 :     print STDERR "Can't creat Curator for user " . $user->login ;
523 :     exit;
524 :     }
525 :    
526 :     }
527 :     else{
528 :     $curator = $curators->[0] ;
529 :     }
530 :    
531 :    
532 :     # get project
533 :     my $project = '';
534 : wilke 1.2 my $pid = $sample->{ project_id } || 0 ;
535 :    
536 :     # check for mgrast project id
537 :     unless($pid){
538 :     foreach my $p (@{ $sample->{study_id} }){
539 :     $pid = $p->{content} if ($p->{namspace} =~/mgrast|mg-rast/i);
540 :     }
541 :     }
542 : wilke 1.16 if ( $pid and $user->has_right(undef, 'edit' , 'project', $pid ) ){
543 : wilke 1.2 $project = $meta->db->Project->init( { id => $pid } ) ;
544 : wilke 1.1 }
545 :     else{
546 : wilke 1.2 $msg .= "no project id or no rights to edit project" . ( $pid ? "($pid)\n" : '') ;
547 : wilke 1.1 }
548 :    
549 :    
550 : wilke 1.16 # check for existing meta data / qiime will submit samples twice
551 :    
552 : wilke 1.1
553 : wilke 1.16 my $cids = {} ;
554 :     # number of all metadata fields
555 :     my $nr_tags = keys %{$sample->{metadata}} ;
556 : wilke 1.18
557 :     # sample ids
558 :     my @sids ;
559 : wilke 1.17 if ( @{$sample->{ study_id }} ){
560 :     $sample->{metadata}->{study_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ study_id }};
561 :     }
562 : wilke 1.18
563 : wilke 1.17 if ( @{$sample->{ sample_id }} ){
564 : wilke 1.18 print STDERR "Dear tharriso we found samples\n";
565 :     print STDERR "Dear tharriso please go to www.newcarforall.com to make your donation today.\n";
566 :    
567 :     my @cids;
568 :     map { push @cids , $_->{content} if ($_->{namespace} =~/mgrast|mg-rast/i) } @{$sample->{ sample_id }} ;
569 :     my @sids = map { $_->{namespace} ? $_->{namespace} .":". $_->{content} : $_->{content} } @{$sample->{ sample_id }};
570 : wilke 1.17 $sample->{metadata}->{sample_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ sample_id }};
571 : wilke 1.16
572 : wilke 1.18 # container for collection _ids
573 :     my $collections = {} ;
574 :     my $dbh = $meta->db->db_handle;
575 :    
576 :    
577 :     if(@cids){
578 :     # get collections _ids for ID from Collection
579 :     foreach my $id (@cids){
580 :     my $res = $dbh->selectall_arrayref(qq(select _id , ID from MetaDataCollection where ID = "$id";));
581 :     map { push @{$collections->{$_->[0] } } , $_->[1] ; $_->[0] || 0 } @$res ;
582 :     }
583 :     # check for mapped sample_id
584 :     # here @sids
585 : wilke 1.16 }
586 : wilke 1.18 elsif(@sids){
587 :     # get collections _ids for sample_id in MetaDataEntry
588 :     foreach my $id (@sids){
589 : wilke 1.20 print STDERR "$t: Searching for $id\n";
590 : wilke 1.18 my $res = $dbh->selectall_arrayref(qq(select collection , job , _id from MetaDataEntry where tag = "sample_id" and value regexp "$id" group by collection , job ;));
591 :     map { push @{$collections->{$_->[0] }} , $_->[1] ; $_->[0] || 0 } @$res ;
592 :     }
593 : wilke 1.16 }
594 : wilke 1.18
595 :     if( my @ids = sort {$a<=> $b} keys %$collections ){
596 :    
597 :     print STDERR "$t: Found ". scalar @ids ." existing samples\n";
598 :    
599 :    
600 :     # replace sample
601 :     my $cid = shift @ids ;
602 :     my $cs = $meta->db->MetaDataCollection->get_objects( { _id => $cid } );
603 :     my $c = shift @$cs ;
604 : wilke 1.20 print STDERR "$t: " , $c->ID , "\n";
605 : wilke 1.18 if ( $user->has_right(undef, 'view' , 'sample', $c->ID ) ){
606 :    
607 :     #deleting meta data entries
608 :     my $mds = $meta->db->MetaDataEntry->get_objects( {collection => $c } );
609 :     map { $_->delete } @$mds ;
610 :     $collection = $c ;
611 :     }
612 :     else{
613 :     print STDERR "$t: No right for user " .$user->login ." to edit collection ".$c->ID." !\n";
614 :     return ( 0 , "Mising right to modify " . $c->ID , [] );
615 :     }
616 : wilke 1.16 }
617 :     }
618 :    
619 : wilke 1.18 if ($collection and ref $collection){
620 :     print STDERR "$t: Replacing data for " . $collection->ID , "\n";
621 : wilke 1.16 }
622 :     else{
623 : wilke 1.18 print STDERR "$t: Creating new sample\n";
624 :     my $id = ($meta->db->MetaDataCollection->last_id) + 1 ;
625 :     $collection = $meta->db->MetaDataCollection->create( { creator => $curator ,
626 :     ID => $id ,
627 :     source => $sample->{submission_system} || 'unknown' ,
628 :     url => $sample->{submission_system_url } || '' ,
629 :     type => 'sample' ,
630 :     } ) ;
631 :    
632 :     # create rights for collection/sample
633 :     my $view_right = $master->Rights->create( { scope => $user->get_user_scope,
634 :     data_type => 'sample',
635 :     data_id => $id ,
636 :     name => 'view',
637 :     granted => 1 ,
638 :     } );
639 :     my $edit_right = $master->Rights->create( { scope => $user->get_user_scope,
640 :     data_type => 'sample',
641 :     data_id => $id ,
642 :     name => 'edit',
643 :     granted => 1 ,
644 :     } );
645 : wilke 1.16 }
646 : wilke 1.18
647 : wilke 1.16
648 :    
649 : wilke 1.18
650 : wilke 1.1
651 :     # connect sample to study/project
652 :     if ($project){
653 :     my $pmd = $meta->db->ProjectMD->create( { project => $project ,
654 :     tag => 'sample_collection_id' ,
655 :     value => $collection->ID ,
656 :     } ) ;
657 :    
658 :     if ($sample->{job_id}){
659 :     my $job = $meta->db->Job->init( { job_id => $sample->{job_id} } );
660 :     $job->sample($collection);
661 :     $job->project($project);
662 :     $collection->job($job);
663 :     my $pjs = $meta->db->ProjectJob->get_objects( {job => $job , project => $project } );
664 :     unless(ref $pjs and scalar @$pjs){
665 :     my $pj = $meta->db->ProjectJob->create( {job => $job , project => $project } );
666 :     }
667 :     }
668 :     }
669 :    
670 :    
671 :     # preserve study id
672 : wilke 1.2 $sample->{metadata}->{study_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ study_id }};
673 :     $sample->{metadata}->{sample_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ sample_id }};
674 : wilke 1.1 $sample->{metadata}->{sample_name} = $sample->{ sample_name } if ( $sample->{ sample_name } );
675 :    
676 :     #add tag , value pairs
677 :     foreach my $tag (keys %{$sample->{metadata}}){
678 :    
679 :     unless ($sample->{metadata}->{$tag}){
680 : wilke 1.10 #print STDERR "$tag " . ( $sample->{metadata}->{$tag} || "no value" ) ;
681 :     #next ;
682 : wilke 1.1 }
683 : wilke 1.2 if (ref $sample->{metadata}->{$tag}){
684 :     print "Hi Doug , here is something wrong with the data structure , please send me your structure so that I can adapt my parser.\n Andreas\n";
685 :     if ($user->login =~/douginator2000\@gmail.com/){
686 :    
687 :     }
688 :     $msg = 'Complex data structure where string expected.\n' . Dumper $sample->{metadata}->{$tag} ;
689 :     return ( 0 , $msg , [] );
690 :    
691 :     }
692 : wilke 1.1 if ($collection->job){
693 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $collection ,
694 :     job => $collection->job ,
695 :     tag => $tag ,
696 :     value => $sample->{metadata}->{$tag} ,
697 :     } ) ;
698 :     }
699 :     else{
700 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $collection ,
701 :     tag => $tag ,
702 :     value => $sample->{metadata}->{$tag} ,
703 :     } ) ;
704 :     }
705 :     }
706 :    
707 :     push @sample_ids , $collection->ID ;
708 :     }
709 :     return ( $success , $error , \@sample_ids ) ;
710 :     }
711 :    
712 :    
713 :     #### QIIME sample preparation for sequencing
714 :    
715 :     sub sequence_prep {
716 :     my ($params) = @_ ;
717 :    
718 :     my $method = $params->{method} ;
719 :     my $meta = $params->{metadata_handle};
720 :     my $opts = $params->{params} ;
721 :     my $user = $params->{user};
722 :     my $cgi = $params->{cgi} ;
723 :     my $master = $params->{master} ;
724 :    
725 :    
726 :    
727 :     my $data = '' ;
728 :     my $msg = '' ;
729 :     my $tag = '' ;
730 :    
731 :     if ($opts and @$opts){
732 :     $tag = shift @$opts ;
733 :     }
734 :    
735 :     # get global ids/all public ?
736 :     if ( $method eq "GET" ){
737 :     my $samples = [] ;
738 :    
739 :     if ( $tag eq "id" ){
740 :    
741 :     if ($user){
742 :     my $value = shift @$opts ;
743 :    
744 :     if ( $value and $user->has_right(undef, 'view' , 'sample', $value ) ){
745 :     $samples = $meta->db->MetaDataCollection->get_objects( { ID => $value } );
746 :     }
747 :     else{
748 :     $msg .= "<success>0</success>\n<error>you don't have the right to view sample $value</error>" ;
749 :     }
750 :     }
751 :     else{
752 :     $msg .= "<success>0</success>\n<error>no public samples defined</error>" ;
753 :     }
754 :    
755 :     foreach my $sample (@$samples){
756 :     $data .= $sample->xml ;
757 :     }
758 :    
759 :    
760 :     }
761 :     elsif ($tag){
762 :    
763 :     }
764 :     else{
765 :     # my $ids = $meta->get_samples ;
766 :     }
767 :     }
768 :     elsif( $method eq "POST"){
769 :    
770 :     $data .= '' ; #$cgi->param('POSTDATA') ;
771 : wilke 1.7 #print STDERR "Creating sample prep\n";
772 : wilke 1.1 my ($s , $e , $ids) = create_sequence_prep($master , $meta , $user , $cgi->param('POSTDATA') ) ;
773 : wilke 1.7 #print STDERR scalar @$ids . " SamplePrep IDs \n";
774 : wilke 1.1 $msg .= "<success>$s</success>\n<error>$e</error>" ;
775 :     foreach my $id (@$ids){
776 : wilke 1.21 $data .= "<sample_id namespace='mgrast'>$id</sample_id>\n";
777 : wilke 1.1 }
778 :     }
779 :    
780 :     # Called post or put without parameters
781 :     else{ $msg .= "Missing arguments for $method" ; return ($msg , '') }
782 :    
783 : wilke 1.21 return ($msg , "\n<data>".$data."</data>\n") ;
784 : wilke 1.1
785 :     };
786 :    
787 :     sub create_sequence_prep {
788 :     my ($master , $meta , $user , $data) = @_ ;
789 :     my $success = 1 ;
790 :     my $error = 0 ;
791 :     my $msg = '';
792 :     my @prep_ids ;
793 :    
794 :    
795 :     # parse sample xml
796 :     my $xs = XML::Simple->new();
797 : wilke 1.5 my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'sample_id' , 'sequence_prep' , 'sample_prep' ]);
798 : wilke 1.1
799 :     # single study without <daba_block>
800 : wilke 1.4
801 :     $block->{sequence_prep} = $block->{sample_prep} if ($block->{sample_prep}) ;
802 : wilke 1.1 push @{ $block->{sequence_prep} } , $block unless ($block->{sequence_prep}) ;
803 :    
804 :     # print Dumper $block ;
805 :    
806 :     foreach my $prep ( @{ $block->{sequence_prep} } ){
807 : wilke 1.18 print STDERR "$t: Reading prep file\n";
808 : wilke 1.8 return ( 0 , "no prep id (row_number)\n" .(Dumper $prep) , [] ) unless (exists $prep->{row_number} and $prep->{row_number} ge '0') ;
809 : wilke 1.7
810 :     #print STDERR "Reading prep file 2\n";
811 : wilke 1.1 # get curator
812 :     my $curator ;
813 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
814 :     # not a Curator , create one
815 :     unless(ref $curators and scalar @$curators){
816 :     my $curator = $meta->db->Curator->create( { user => $user ,
817 :     name => $user->firstname . " " . $user->lastname ,
818 :     email => $user->email ,
819 :     type => $prep->{submission_system} || '' ,
820 :     url => '' ,
821 : wilke 1.13 ID => $user->_id ,
822 : wilke 1.1 });
823 :    
824 :     unless($curator and ref $curator){
825 :     print STDERR "Can't creat Curator for user " . $user->login ;
826 :     exit;
827 :     }
828 :    
829 :     }
830 :     else{
831 :     $curator = $curators->[0] ;
832 :     }
833 : wilke 1.18
834 : wilke 1.1 # get project
835 :     my $project = '';
836 : wilke 1.16 if ( $prep->{ project_id } and $user->has_right(undef, 'edit' , 'project', $prep->{ project_id } ) ){
837 : wilke 1.1 $project = $meta->db->Project->init( { id => $prep->{ project_id } } ) ;
838 :     }
839 :     else{
840 :     $msg .= "no project id or no rights to edit project\n" ;
841 :     }
842 :    
843 : wilke 1.18 print STDERR "$t: Got project " . $project->id , "\n";
844 :    
845 : wilke 1.1 # get sample
846 :     my $sample = '';
847 : wilke 1.5 my $sid = 0 ;
848 :     if ( $prep->{ sample_id } ){
849 :     unless (ref $prep->{ sample_id }){
850 :     $sid = $prep->{ sample_id } || 0 ;
851 :     }
852 :     }
853 :    
854 :    
855 : wilke 1.13 # check for mgrast sample id
856 : wilke 1.5 unless($sid){
857 :     foreach my $s (@{ $prep->{sample_id} }){
858 :    
859 :     unless (ref $s){
860 :     $sid = $s || 0 ;
861 :     }
862 :     else{
863 :     $sid = $s->{content} if ($s->{namespace} =~/mgrast|mg-rast/i);
864 :     }
865 :     }
866 :     }
867 : wilke 1.18
868 :     print STDERR "$t: Fetching sample for " . $sid , "\n";
869 : wilke 1.5 if ( $sid and $user->has_right(undef, 'edit' , 'sample', $sid ) ){
870 :     $sample = $meta->db->MetaDataCollection->init( { ID => $sid } ) ;
871 : wilke 1.18
872 :     unless($sample and ref $sample){
873 :     $msg .= "missing sample for $sid ;" ;
874 :     return ( 0 , $msg , [] );
875 :     }
876 : wilke 1.5 }
877 :     else{
878 :     $msg .= "no sample id or no rights to edit sample\n" . ( $sid ? "($sid)\n" : '') ;
879 :     return ( 0 , $msg , [] );
880 : wilke 1.1 }
881 : wilke 1.2
882 : wilke 1.18 print STDERR "$t: Got sample " . $sample->ID , "\n";
883 :    
884 : wilke 1.1 # connect sample to prep
885 :     if ($sample and ref $sample){
886 :    
887 :     my $prepID = ( $sample->ID . "." . $prep->{row_number} ) ;
888 : wilke 1.18 print STDERR "searching for $prepID\n";
889 : wilke 1.1 my $preparation = $meta->db->MetaDataCollection->init( { ID => $prepID } ) ;
890 :    
891 :    
892 :     if(ref $preparation){
893 : wilke 1.18 print STDERR "$t: prep exists , delete entries\n";
894 :    
895 :     foreach my $entry (@{ $meta->db->MetaDataEntry->get_objects( { collection => $preparation } ) }){
896 :     $entry->delete;
897 :     }
898 :    
899 :     #return ( 0 , "preparation $prepID exists" , [ $preparation->ID ]) ;
900 : wilke 1.1 }
901 :     else{
902 :     $preparation = $meta->db->MetaDataCollection->create( { creator => $curator ,
903 :     ID => $prepID ,
904 :     source => $prep->{submission_system} || 'unknown' ,
905 :     url => $prep->{submission_system_url } || '' ,
906 :     type => 'sample' ,
907 :     } ) ;
908 :    
909 :     # create rights for collection/sample
910 :     my $view_right = $master->Rights->create( { scope => $user->get_user_scope,
911 :     data_type => 'sample',
912 :     data_id => $prepID ,
913 :     name => 'view',
914 :     granted => 1 ,
915 :     } );
916 :     my $edit_right = $master->Rights->create( { scope => $user->get_user_scope,
917 :     data_type => 'sample',
918 :     data_id => $prepID ,
919 :     name => 'edit',
920 :     granted => 1 ,
921 :     } );
922 :    
923 :     # it is a sample from qiime , flag existing sample as template
924 :     $sample->type('template');
925 :     }
926 :    
927 :    
928 :     # copy data from sample to preparation
929 :    
930 : wilke 1.2 foreach my $entry (@{ $meta->db->MetaDataEntry->get_objects( { collection => $sample } ) }){
931 : wilke 1.1
932 :     unless (ref $entry ){
933 :     print STDERR Dumper $entry ;
934 : wilke 1.2 Return (0 , 'Serious error , no object: ' . Dumper $entry , [] );
935 : wilke 1.1 }
936 : wilke 1.2
937 :    
938 : wilke 1.1 my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
939 :     tag => $entry->tag ,
940 :     value => $entry->value,
941 :     } ) ;
942 : wilke 1.2
943 :    
944 : wilke 1.1 }
945 : wilke 1.2
946 : wilke 1.1 #add tag , value pairs
947 :     foreach my $tag (keys %{$prep->{metadata}}){
948 :    
949 :     if ($prep->{metadata}->{$tag} and $prep->{metadata}->{$tag} eq ''){
950 :     print STDERR "$tag " . ( $prep->{metadata}->{$tag} || "no value" ) ;
951 :     next ;
952 :     }
953 :     if ($sample->job){
954 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
955 :     job => $sample->job ,
956 :     tag => $tag ,
957 :     value => $prep->{metadata}->{$tag} ,
958 :     } ) ;
959 :     }
960 :     else{
961 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
962 :     tag => $tag ,
963 :     value => $prep->{metadata}->{$tag} ,
964 :     } ) ;
965 :     }
966 :     }
967 :     push @prep_ids , $preparation->ID if (ref $preparation);
968 :     }
969 :     }
970 :    
971 :     return ( $success , $error , \@prep_ids ) ;
972 :     }
973 :    
974 :    
975 :    
976 :    
977 :    
978 :     sub reads {
979 :     my ($params) = @_ ;
980 :    
981 :     my $method = $params->{method} ;
982 :     my $meta = $params->{metadata_handle};
983 :     my $opts = $params->{params} ;
984 :     my $user = $params->{user};
985 :     my $cgi = $params->{cgi} ;
986 :     my $master = $params->{master} ;
987 :    
988 :    
989 :    
990 :     my $data = '' ;
991 :     my $msg = '' ;
992 :     my $tag = '' ;
993 :    
994 :     if ($opts and @$opts){
995 :     $tag = shift @$opts ;
996 :     }
997 :    
998 :     # get global ids/all public ?
999 :     if ( $method eq "GET" ){
1000 :     my $jobs = [] ;
1001 :    
1002 :     if ( $tag eq "id" ){
1003 :    
1004 :    
1005 :    
1006 :    
1007 :     if ($user){
1008 :     my $value = shift @$opts ;
1009 :    
1010 :     if ( $value and $user->has_right(undef, 'view' , 'metagenome', $value ) ){
1011 :     $jobs = $meta->db->Job->get_objects( { job_id => $value } );
1012 :     }
1013 :     else{
1014 :     $msg .= "<success>0</success>\n<error>you don't have the right to get sequences $value</error>" ;
1015 :     }
1016 :     }
1017 :     else{
1018 :     $msg .= "<success>0</success>\n<error>no public sequences</error>" ;
1019 :     }
1020 :    
1021 :     foreach my $job (@$jobs){
1022 : wilke 1.7 #print STDERR "Downloading data for job " . $job->job_id ;
1023 : wilke 1.1 $data .= $job->download('') ;
1024 :     }
1025 :    
1026 :    
1027 :     }
1028 :     elsif ($tag){
1029 :    
1030 :     }
1031 :     else{
1032 :     # my $ids = $meta->get_samples ;
1033 :     }
1034 :     }
1035 :     elsif( $method eq "POST"){
1036 : wilke 1.14
1037 :     # debug option
1038 :     $data .= $cgi->param('POSTDATA') if (0) ;
1039 : wilke 1.7 #print STDERR "Creating Job\n";
1040 : wilke 1.1
1041 :     # only create if a user is present
1042 :     if ($user and ref $user){
1043 : wilke 1.5 my ($s , $e , $ids , $md5s ) = create_job($master , $meta , $user , $cgi->param('POSTDATA') ) ;
1044 : wilke 1.7
1045 : wilke 1.1 $msg .= "<success>$s</success>\n<error>$e</error>" ;
1046 :     foreach my $id (@$ids){
1047 :     $data = "<job_id>$id</job_id>\n";
1048 :     }
1049 : wilke 1.13 $data .="<md5sum>" . (join " ; " , @$md5s) ."<md5sum>\n" if ($md5s and ref $md5s);
1050 : wilke 1.1 }
1051 :     else{
1052 :     print Dumper $user ;
1053 :     print STDERR Dumper $user ;
1054 :     $msg .= 'missing user authentification or authentification failed\nPlease yell at contact.\n';
1055 :     }
1056 :     }
1057 :    
1058 :     # Called post or put without parameters
1059 :     else{ $msg .= "Missing arguments for $method" ; return ($msg , '') }
1060 :    
1061 :     return ($msg , "\n<data>".$data."\n</data>") ;
1062 :    
1063 :     };
1064 :    
1065 :    
1066 :    
1067 :     sub create_job {
1068 :     my ($master , $meta , $user , $data) = @_ ;
1069 :     my $success = 1 ;
1070 :     my $error = 0 ;
1071 :     my $msg = '';
1072 :     my @job_ids ;
1073 : wilke 1.5 my @md5s ;
1074 : wilke 1.1 my $pipeline_options = {};
1075 :    
1076 :     # parse sample xml
1077 :     my $xs = XML::Simple->new();
1078 : wilke 1.5 my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'samples' , 'sample_id' , 'filter_reference_sequence_set' ,] , KeyAttr => [] );
1079 : wilke 1.1
1080 :     # single study without <daba_block>
1081 :     push @{ $block->{files} } , $block unless ($block->{files}) ;
1082 :    
1083 :    
1084 : wilke 1.13 #print STDERR Dumper $block ;
1085 :    
1086 : wilke 1.1 foreach my $data ( @{ $block->{files} } ){
1087 : wilke 1.13
1088 :     my $prep_id = '';
1089 :     if (exists $data->{row_number} and $data->{row_number}=~/\d+/){
1090 :     $prep_id = ".".$data->{row_number} ;
1091 :     }
1092 : wilke 1.1
1093 :     # get curator
1094 :     my $curator ;
1095 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
1096 :     # not a Curator , create one
1097 :     unless(ref $curators and scalar @$curators){
1098 :     my $curator = $meta->db->Curator->create( { user => $user ,
1099 :     name => $user->firstname . " " . $user->lastname ,
1100 :     email => $user->email ,
1101 :     type => $data->{submission_system} || '' ,
1102 :     url => '' ,
1103 : wilke 1.13 ID => $user->_id ,
1104 : wilke 1.1 });
1105 :    
1106 :     unless($curator and ref $curator){
1107 :     print STDERR "Can't creat Curator for user " . $user->login ;
1108 :     exit;
1109 :     }
1110 :    
1111 :     }
1112 :     else{
1113 :     $curator = $curators->[0] ;
1114 :     }
1115 :    
1116 :    
1117 :     # get project
1118 :     my $project = '';
1119 : wilke 1.16 if ( $data->{ project_id } and $user->has_right(undef, 'edit' , 'project', $data->{ project_id } ) ){
1120 : wilke 1.1 $project = $meta->db->Project->init( { id => $data->{ project_id } } ) ;
1121 : wilke 1.15 return (0 , "No Project for " . $data->{ project_id } , [] ) unless($project and ref $project);
1122 : wilke 1.1 }
1123 :     else{
1124 :     $msg .= "no project id or no rights to edit project\n" ;
1125 : wilke 1.14 return ;
1126 : wilke 1.1 }
1127 : wilke 1.5
1128 : wilke 1.1 # get sample
1129 : wilke 1.4 #my @samples ;
1130 :     my @samples= ($data->{sample} and ref $data->{sample}) ? @{ $data->{sample} } : () ;
1131 : wilke 1.1 my $collection = '';
1132 :    
1133 :     my $sample = '' ;
1134 :     foreach my $s ( @{ $data->{sample} }){
1135 : wilke 1.5 $sample = $s if (!($s->{namespace}) or ( $s->{namespace} =~ /mgrast|mg-rast/i)) ;
1136 :     }
1137 :     unless($sample){
1138 :     foreach my $s ( @{ $data->{sample_id} }){
1139 :     unless( ref $s){
1140 :     $sample = $s ;
1141 :     }
1142 :     else{
1143 :     $sample = $s->{content} if ( $s->{namespace} =~ /mgrast|mg-rast/i ) ;
1144 :     }
1145 :     }
1146 : wilke 1.1 }
1147 : wilke 1.5
1148 : wilke 1.13 # adding row number to ID ;
1149 : wilke 1.20
1150 : wilke 1.13 $sample .= $prep_id ;
1151 :    
1152 : wilke 1.5 if ($sample and $user->has_right(undef, 'edit' , 'sample', ($sample) ) ){
1153 :     $collection = $meta->db->MetaDataCollection->init( { ID => $sample } ) ;
1154 : wilke 1.13 unless($collection and ref $collection){
1155 :     return ( 0 , "No sample for $sample" , [] ) ;
1156 :     }
1157 :    
1158 : wilke 1.1 }
1159 :     else{
1160 : wilke 1.18 $msg .= "no sample id or no rights to edit sample ($sample)\n" . Dumper $sample ;
1161 :     return ( 0 , $msg , [] ) ;
1162 : wilke 1.1 }
1163 :    
1164 :     if (exists $data->{options} ){
1165 :     %$pipeline_options = %{ $data->{options} } ;
1166 :     print STDERR Dumper $data->{options} ;
1167 :    
1168 :     if ( $pipeline_options->{filter_reference_sequence_set} ){
1169 :     # concatinate list and remove array ref
1170 :     if (ref $pipeline_options->{filter_reference_sequence_set} ){
1171 :     $pipeline_options->{contaminant_filter_orgs} = join ";" , @{$pipeline_options->{filter_reference_sequence_set}} ;
1172 :     $pipeline_options->{filter_reference_sequence_set} = join ";" , @{$pipeline_options->{filter_reference_sequence_set}} ;
1173 :     }
1174 :     else{
1175 :     $pipeline_options->{contaminant_filter_orgs} = $pipeline_options->{filter_reference_sequence_set}
1176 :     }
1177 :     }
1178 :    
1179 :     if ($pipeline_options->{filter_ambiguous_base_calls} and ref $pipeline_options->{filter_ambiguous_base_calls}){
1180 :     foreach my $k (keys %{ $pipeline_options->{filter_ambiguous_base_calls} }){
1181 :     $pipeline_options->{ "filter_ambiguous_base_calls." . ( $k =~ /content/ ? "on" : $k ) } = $pipeline_options->{filter_ambiguous_base_calls}->{$k};
1182 :     }
1183 :     delete $pipeline_options->{filter_ambiguous_base_calls} ;
1184 :     }
1185 :    
1186 :     if ($pipeline_options->{filter_length}) {
1187 :     if (ref $pipeline_options->{filter_length}) {
1188 :     $pipeline_options->{length_filter} = $pipeline_options->{filter_length}->{content} ;
1189 :     foreach my $k (keys %{ $pipeline_options->{filter_length} }){
1190 :     $pipeline_options->{ "filter_length." . ( $k =~ /content/ ? "on" : $k ) } = $pipeline_options->{ "filter_length" }->{ $k };
1191 :     }
1192 :     delete $pipeline_options->{filter_length};
1193 :     }
1194 :     else{
1195 :     $pipeline_options->{length_filter} = $pipeline_options->{filter_length} ;
1196 :     }
1197 :    
1198 :     }
1199 :    
1200 : wilke 1.11 $pipeline_options->{filter_ln} = $pipeline_options->{filter_length} if ($pipeline_options->{filter_length}) ;
1201 :     $pipeline_options->{contaminant_filter} = 1 if ($pipeline_options->{filter_reference_sequence_set}) ;
1202 :     $pipeline_options->{filter_ambig} = ( $pipeline_options->{filter_ambiguous_base_calls}->{content}
1203 : wilke 1.1 || 0 ) if ($pipeline_options->{filter_ambiguous_base_calls}) ;
1204 : wilke 1.11 $pipeline_options->{max_ambig} = ( $pipeline_options->{filter_ambiguous_base_calls}->{max_allowed}
1205 : wilke 1.1 || '' ) if ($pipeline_options->{filter_ambiguous_base_calls}) ;
1206 :    
1207 :     unless($pipeline_options->{rna_only}){
1208 :     $pipeline_options->{rna_only} = ($data->{sequences}->{type} and $data->{sequences}->{type} =~/rna/i) ? 1 : 0 ;
1209 :     }
1210 :    
1211 :     }
1212 :    
1213 :     if (exists $data->{sequences} ){
1214 : wilke 1.18
1215 : wilke 1.2 # get upload path and create directories
1216 :     my $upload_path = &upload_path($user , ($project ? $project->id : '') );
1217 :     my $filename = "$upload_path/".$user->_id . "-" ;
1218 :     $filename .= (ref $collection ? $collection->ID : $data->{sample}->[0]->{id} ) . "-". &timestamp ;
1219 : wilke 1.9
1220 :     # set sequence type
1221 :     my $sequence_type = (ref $data->{sequences} and $data->{sequences}->{type}) ? $data->{sequences}->{type} : '' ;
1222 :    
1223 : wilke 1.11 # set pipeline options
1224 :     if ($sequence_type =~ /16s|rna/i){
1225 :     $pipeline_options->{rna_only} = 1 ;
1226 :     $sequence_type = '16s' ;
1227 :     }
1228 :    
1229 : wilke 1.1 open(FILE , ">$filename") or die "Can't open $filename for writing!\n";
1230 : wilke 1.4 if (ref $data->{sequences} and exists $data->{sequences}->{content}){
1231 : wilke 1.9 my $content = $data->{sequences}->{content} ;
1232 :     $content =~ s/^\s+//;
1233 :     print FILE $content ;
1234 : wilke 1.1 }
1235 :     else{
1236 : wilke 1.9
1237 :     if (ref $data->{sequences}){
1238 :     print Dumper $data->{sequences} ;
1239 :     exit ;
1240 :     }
1241 :     my $content = $data->{sequences} ;
1242 :     $content =~ s/^\s+//;
1243 :     $content =~ s/\s+$//g;
1244 :     print FILE $content ;
1245 : wilke 1.1 }
1246 :    
1247 : wilke 1.9 my $seq_stats = {} ;
1248 :     my $stats = `$FIG_Config::seq_length_stats -fasta_file $filename` if (-f $filename) ;
1249 :     foreach my $line (split "\n" , $stats) {
1250 :     my ($tag , $value) = split "\t" , $line ;
1251 : wilke 1.11 # print "$tag :: $value\n";
1252 : wilke 1.9 $seq_stats->{$tag} = $value ;
1253 :     }
1254 : wilke 1.11
1255 :     # get length filter cutoffs
1256 :     if ($pipeline_options->{filter_ln}) {
1257 : tharriso 1.12 $pipeline_options->{min_ln} = int( $pipeline_options->{average_length} - (2 * $pipeline_options->{standard_deviation_length}) );
1258 :     $pipeline_options->{max_ln} = int( $pipeline_options->{average_length} + (2 * $pipeline_options->{standard_deviation_length}) );
1259 :     if ($pipeline_options->{min_ln} < 0) { $pipeline_options->{min_ln} = 0; }
1260 : wilke 1.11 }
1261 :    
1262 : wilke 1.5 my ($md5 , $f) = `md5sum $filename` =~/^\s*([^\s]+)\s*(\w+)/;
1263 : wilke 1.9
1264 : wilke 1.5 unless($md5){
1265 :     print "Soething wrong , can't compute md5 for $filename\n";
1266 :     print STDERR "Something wrong , can't compute md5 for $filename\n";
1267 :     exit;
1268 :     }
1269 : wilke 1.15
1270 :     #check for md5 in system
1271 :     my $jobs = $meta->db->Job->get_objects( { owner => $user ,
1272 :     file_checksum_raw => $md5 ,
1273 :     } ) ;
1274 :    
1275 :    
1276 :     if (ref $jobs and scalar @$jobs){
1277 :     return ( 0 , 'Duplicate file' , [ map { $_->job_id } @$jobs ] , [ $md5 ]) ;
1278 :     }
1279 :    
1280 : wilke 1.5 push @md5s , $md5 ;
1281 :    
1282 : wilke 1.13 print STDERR "Creating Job\n";
1283 : wilke 1.1 my $job = $meta->db->Job->reserve_job($user , $pipeline_options , $seq_stats);
1284 : wilke 1.13 if ($job and ref $job){ push @job_ids , $job->job_id ; }
1285 :     else { return (0 , "Can't create job in DB" , [] ) ;}
1286 : wilke 1.11
1287 : wilke 1.18
1288 : wilke 1.5
1289 : wilke 1.8 $job->server_version(3) ;
1290 :     $job->name($collection->ID);
1291 : wilke 1.15 $job->file_checksum_raw($md5) ;
1292 : wilke 1.8
1293 : wilke 1.13 # connect sample and job
1294 : wilke 1.5 $job->sample($collection) ;
1295 :     unless(ref $collection->job){
1296 :     $collection->job($job) ;
1297 :     }
1298 : wilke 1.1
1299 : wilke 1.13 # add job to project
1300 :     if ( $project and ref $project){
1301 : wilke 1.15 $job->project($project) unless ($job->project) ;
1302 :    
1303 : wilke 1.13 my $pjs = $meta->db->ProjectJob->get_objects( { job => $job ,
1304 :     project => $project ,
1305 :     } ) ;
1306 :     unless (ref $pjs and scalar @$pjs){
1307 :     $pjs = $meta->db->ProjectJob->create( { job => $job ,
1308 :     project => $project ,
1309 :     } ) ;
1310 :     }
1311 :    
1312 : wilke 1.15
1313 : wilke 1.13 }
1314 :    
1315 : wilke 1.18 $msg .= $job->finish_upload($filename , $sequence_type) ;
1316 : wilke 1.13
1317 : wilke 1.1 #clean up
1318 : wilke 1.8 if ( -d $job->directory and -f $job->download_dir . "/" . $job->job_id . ".fna" ){
1319 : wilke 1.1 my $error = `rm $filename` ;
1320 :     }
1321 :     else{
1322 : wilke 1.8 print STDERR "Missing file " . $job->download_dir . "/" . $job->job_id . ".fna\n";
1323 : wilke 1.5 return ( 0 , "Creation of job failed.\n$msg" , \@job_ids , \@md5s) ;
1324 : wilke 1.1 }
1325 :    
1326 :     # call mgrast job method here
1327 :     my @jobs ;
1328 :     push @jobs , $job->job_id if (ref $job);
1329 : wilke 1.6 print STDERR "Created job " . $job->job_id , "\n" ;
1330 :     $msg = '' ;
1331 : wilke 1.1 #return (0 , "$msg\nnot implemented yet. File /tmp/$filename" , \@jobs , $md5) ;
1332 :     }
1333 :     else{
1334 :     print STDERR "no sequences!\n";
1335 :     $msg .= "no sequences" ;
1336 :     }
1337 :     #push @job_ids , $job->job_id ;
1338 :     }
1339 :     $error .= "\n\n$msg\n";
1340 : wilke 1.5 return ( $success , $error , \@job_ids , \@md5s) ;
1341 : wilke 1.1 }
1342 :    
1343 :    
1344 :    
1345 :    
1346 :    
1347 : wilke 1.2 sub upload_path{
1348 :     my ($user , $prj) = @_;
1349 :    
1350 :     my $user_md5 = md5_hex( $user->login );
1351 :     my $timestamp = &timestamp;
1352 :    
1353 :     my $base_dir = "$FIG_Config::incoming";
1354 :     my $user_dir = "$base_dir/$user_md5";
1355 :     my $upload_dir = "$base_dir/$user_md5/" . ($prj ? $prj : $timestamp);
1356 :    
1357 :     create_dir($user_dir);
1358 :     create_dir($upload_dir);
1359 :    
1360 :     return $upload_dir ;
1361 :     }
1362 :    
1363 :     sub create_dir {
1364 :     my($dir) = @_;
1365 : wilke 1.1
1366 : wilke 1.2 if ( -d $dir )
1367 :     {
1368 :     # check permissions
1369 :     }
1370 :     else
1371 :     {
1372 :     mkdir $dir or die "could not create directory '$dir'";
1373 :     chmod 0777, $dir;
1374 :     }
1375 :     }
1376 : wilke 1.1
1377 : wilke 1.2 sub timestamp {
1378 :    
1379 :     my($sec, $min, $hour, $day, $month, $year) = localtime;
1380 :    
1381 :     $month += 1;
1382 :     $year += 1900;
1383 :    
1384 :     $sec = &pad($sec);
1385 :     $min = &pad($min);
1386 :     $hour = &pad($hour);
1387 :     $day = &pad($day);
1388 :     $month = &pad($month);
1389 :    
1390 :     return join('.', $year, $month, $day, $hour, $min, $sec);
1391 :     }
1392 :    
1393 :     sub pad{
1394 :     my ($data) = @_ ;
1395 :     return ( $data=~/^\d$/ ? "0$data" : $data) ;
1396 :     }
1397 :    
1398 : wilke 1.1 sub register {};

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3