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

Annotation of /MGRAST/services.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26 - (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.26 use MGRAST::Metadata;
13 : wilke 1.1 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 : wilke 1.24 my $project ;
337 : wilke 1.23
338 : wilke 1.1 # study name must exists
339 :     return ( 0 , 'no study name', \@study_ids ) unless ( $study->{study_name} ) ;
340 :     # check for existing project name
341 : wilke 1.24 if ($project = $meta->db->Project->init( { name => $study->{study_name} }) ){
342 : wilke 1.23
343 :    
344 :     print STDERR "$t: Duplicate project name " . $study->{study_name} . "\n" ;
345 :    
346 : wilke 1.24 if ($user and $user->has_right(undef, 'edit' , 'project', $project->id )){
347 : wilke 1.23 print STDERR "$t: deleting project metadata\n";
348 : wilke 1.24 map { $_->delete } @{ $meta->db->ProjectMD->get_objects( { project => $project } ) };
349 : wilke 1.23
350 :     }
351 :     else{
352 : wilke 1.24 push @study_ids , $project->id ;
353 : wilke 1.23 return ( 0 , 'duplicate project name ' . $study->{study_name} , \@study_ids ) ;
354 :     }
355 : wilke 1.2 }
356 : wilke 1.1
357 :     # get curator
358 :     my $curator ;
359 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
360 :     # not a Curator , create one
361 :     unless(ref $curators and scalar @$curators){
362 :     my $curator = $meta->db->Curator->create( { user => $user ,
363 :     name => $user->firstname . " " . $user->lastname ,
364 :     email => $user->email ,
365 :     type => $study->{submission_system} || '' ,
366 :     url => '' ,
367 : wilke 1.13 ID => $user->_id ,
368 : wilke 1.1 });
369 :    
370 :     unless($curator and ref $curator){
371 :     print STDERR "Can't creat Curator for user " . $user->login ;
372 :     exit;
373 :     }
374 :    
375 :     }
376 :     else{
377 :     $curator = $curators->[0] ;
378 :     }
379 :    
380 :    
381 :     my $id = ($meta->db->Project->last_id) + 1 ;
382 : wilke 1.23
383 : wilke 1.24 unless($project and ref $project){
384 :     $project = $meta->db->Project->create( { creator => $curator ,
385 :     id => $id ,
386 :     name => $study->{study_name} ,
387 :     public => 0 ,
388 :     type => 'project' ,
389 :     } ) ;
390 : wilke 1.23
391 :     # create right for new project
392 :     my $view_right = $master->Rights->create( { scope => $user->get_user_scope,
393 :     data_type => 'project',
394 :     data_id => $id ,
395 :     name => 'view',
396 :     granted => 1 ,
397 : wilke 1.1 } );
398 : wilke 1.23 my $edit_right = $master->Rights->create( { scope => $user->get_user_scope,
399 :     data_type => 'project',
400 :     data_id => $id ,
401 :     name => 'edit',
402 :     granted => 1 ,
403 :     } );
404 :     }
405 : wilke 1.1
406 :     push @study_ids , $project->id ;
407 :    
408 :     # preserve study id
409 :     #$study->{metadata}->{study_id} = $study->{ study_id } ;
410 :     foreach my $id (@{ $study->{study_id} } ){
411 :     $study->{metadata}->{id} = ( $id->{namespace} ? $id->{namespace} . ":" . $id->{content} : $id->{content} ) ;
412 :     }
413 : wilke 1.23
414 : wilke 1.1 #add tag , value pairs
415 :     foreach my $tag (keys %{$study->{metadata}}){
416 : wilke 1.25 if (ref $study->{metadata}->{$tag}){
417 :     $error .= "invalid/complex data structure for key $tag , skipping entry!\n";
418 :     print STDERR "$t: " . ( Dumper $study->{metadata}->{$tag} ) , "\n";
419 :     next;
420 :     }
421 :    
422 : wilke 1.1 my $pmd = $meta->db->ProjectMD->create( { project => $project ,
423 :     tag => $tag ,
424 :     value => $study->{metadata}->{$tag} ,
425 :     } ) ;
426 :     }
427 :    
428 :     }
429 :     return ( $success , $error ,\@study_ids ) ;
430 :     }
431 :    
432 :    
433 :     sub sample {
434 :     my ($params) = @_ ;
435 :    
436 :     my $method = $params->{method} ;
437 :     my $meta = $params->{metadata_handle};
438 :     my $opts = $params->{params} ;
439 :     my $user = $params->{user};
440 :     my $cgi = $params->{cgi} ;
441 :     my $master = $params->{master} ;
442 :    
443 :    
444 :    
445 :     my $data = '' ;
446 :     my $msg = '' ;
447 :     my $tag = '' ;
448 :    
449 :     if ($opts and @$opts){
450 :     $tag = shift @$opts ;
451 :     }
452 :    
453 :     # get global ids/all public ?
454 :     if ( $method eq "GET" ){
455 :     my $samples = [] ;
456 :    
457 :     if ( $tag eq "id" ){
458 :    
459 :    
460 :    
461 :    
462 :     if ($user){
463 :     my $value = shift @$opts ;
464 :    
465 :     if ( $value and $user->has_right(undef, 'view' , 'sample', $value ) ){
466 :     $samples = $meta->db->MetaDataCollection->get_objects( { ID => $value } );
467 :     }
468 :     else{
469 :     $msg .= "<success>0</success>\n<error>you don't have the right to view sample $value</error>" ;
470 :     }
471 :     }
472 :     else{
473 :     $msg .= "<success>0</success>\n<error>no public samples defined</error>" ;
474 :     }
475 :    
476 :     foreach my $sample (@$samples){
477 :     $data .= $sample->xml ;
478 :     }
479 :    
480 :    
481 :     }
482 :     elsif ($tag){
483 :    
484 :     }
485 :     else{
486 :     # my $ids = $meta->get_samples ;
487 :     }
488 :     }
489 :     elsif( $method eq "POST"){
490 :     if ($user){
491 :     $data .= $cgi->param('POSTDATA') ;
492 : wilke 1.7 #print STDERR "Creating Samples\n";
493 : wilke 1.1 my ($s , $e , $ids) = create_sample($master , $meta , $user , $cgi->param('POSTDATA') ) ;
494 : wilke 1.7 #print STDERR scalar @$ids . " Samples Created.\n";
495 : wilke 1.1 $msg .= "<success>$s</success>\n<error>$e</error>" ;
496 :     foreach my $id (@$ids){
497 :     $data = "<sample_id>$id</sample_id>\n";
498 :     }
499 :     }
500 :     }
501 :    
502 :     # Called post or put without parameters
503 :     else{ $msg .= "Missing arguments for $method" ; return ($msg , '') }
504 :    
505 :     return ($msg , "\n<data>".$data."\n</data>") ;
506 :    
507 :     };
508 :    
509 :    
510 :     sub create_sample {
511 :     my ($master , $meta , $user , $data) = @_ ;
512 :     my $success = 1 ;
513 :     my $error = 0 ;
514 :     my $msg = '';
515 :     my @sample_ids ;
516 : wilke 1.18 my $collection ;
517 : wilke 1.1
518 :    
519 :     # parse sample xml
520 :     my $xs = XML::Simple->new();
521 : wilke 1.2 my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'sample_id' , 'study_id' ]);
522 : wilke 1.1
523 :     # single study without <daba_block>
524 :     push @{ $block->{sample} } , $block unless ($block->{sample}) ;
525 :    
526 :    
527 :     foreach my $sample ( @{ $block->{sample} } ){
528 :    
529 :     # get curator
530 :     my $curator ;
531 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
532 :     # not a Curator , create one
533 :     unless(ref $curators and scalar @$curators){
534 :     my $curator = $meta->db->Curator->create( { user => $user ,
535 :     name => $user->firstname . " " . $user->lastname ,
536 :     email => $user->email ,
537 :     type => $sample->{submission_system} || '' ,
538 :     url => '' ,
539 :     ID => "R". $user->_id ,
540 :     });
541 :    
542 :     unless($curator and ref $curator){
543 :     print STDERR "Can't creat Curator for user " . $user->login ;
544 :     exit;
545 :     }
546 :    
547 :     }
548 :     else{
549 :     $curator = $curators->[0] ;
550 :     }
551 :    
552 :    
553 :     # get project
554 :     my $project = '';
555 : wilke 1.2 my $pid = $sample->{ project_id } || 0 ;
556 :    
557 :     # check for mgrast project id
558 :     unless($pid){
559 :     foreach my $p (@{ $sample->{study_id} }){
560 :     $pid = $p->{content} if ($p->{namspace} =~/mgrast|mg-rast/i);
561 :     }
562 :     }
563 : wilke 1.16 if ( $pid and $user->has_right(undef, 'edit' , 'project', $pid ) ){
564 : wilke 1.2 $project = $meta->db->Project->init( { id => $pid } ) ;
565 : wilke 1.1 }
566 :     else{
567 : wilke 1.2 $msg .= "no project id or no rights to edit project" . ( $pid ? "($pid)\n" : '') ;
568 : wilke 1.1 }
569 :    
570 :    
571 : wilke 1.16 # check for existing meta data / qiime will submit samples twice
572 :    
573 : wilke 1.1
574 : wilke 1.16 my $cids = {} ;
575 :     # number of all metadata fields
576 :     my $nr_tags = keys %{$sample->{metadata}} ;
577 : wilke 1.18
578 :     # sample ids
579 :     my @sids ;
580 : wilke 1.17 if ( @{$sample->{ study_id }} ){
581 :     $sample->{metadata}->{study_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ study_id }};
582 :     }
583 : wilke 1.18
584 : wilke 1.17 if ( @{$sample->{ sample_id }} ){
585 : wilke 1.18 print STDERR "Dear tharriso we found samples\n";
586 :     print STDERR "Dear tharriso please go to www.newcarforall.com to make your donation today.\n";
587 :    
588 :     my @cids;
589 :     map { push @cids , $_->{content} if ($_->{namespace} =~/mgrast|mg-rast/i) } @{$sample->{ sample_id }} ;
590 :     my @sids = map { $_->{namespace} ? $_->{namespace} .":". $_->{content} : $_->{content} } @{$sample->{ sample_id }};
591 : wilke 1.17 $sample->{metadata}->{sample_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ sample_id }};
592 : wilke 1.16
593 : wilke 1.18 # container for collection _ids
594 :     my $collections = {} ;
595 :     my $dbh = $meta->db->db_handle;
596 :    
597 :    
598 :     if(@cids){
599 :     # get collections _ids for ID from Collection
600 :     foreach my $id (@cids){
601 :     my $res = $dbh->selectall_arrayref(qq(select _id , ID from MetaDataCollection where ID = "$id";));
602 :     map { push @{$collections->{$_->[0] } } , $_->[1] ; $_->[0] || 0 } @$res ;
603 :     }
604 :     # check for mapped sample_id
605 :     # here @sids
606 : wilke 1.16 }
607 : wilke 1.18 elsif(@sids){
608 :     # get collections _ids for sample_id in MetaDataEntry
609 :     foreach my $id (@sids){
610 : wilke 1.20 print STDERR "$t: Searching for $id\n";
611 : 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 ;));
612 :     map { push @{$collections->{$_->[0] }} , $_->[1] ; $_->[0] || 0 } @$res ;
613 :     }
614 : wilke 1.16 }
615 : wilke 1.18
616 :     if( my @ids = sort {$a<=> $b} keys %$collections ){
617 :    
618 :     print STDERR "$t: Found ". scalar @ids ." existing samples\n";
619 :    
620 :    
621 :     # replace sample
622 :     my $cid = shift @ids ;
623 :     my $cs = $meta->db->MetaDataCollection->get_objects( { _id => $cid } );
624 :     my $c = shift @$cs ;
625 : wilke 1.20 print STDERR "$t: " , $c->ID , "\n";
626 : wilke 1.18 if ( $user->has_right(undef, 'view' , 'sample', $c->ID ) ){
627 :    
628 :     #deleting meta data entries
629 :     my $mds = $meta->db->MetaDataEntry->get_objects( {collection => $c } );
630 :     map { $_->delete } @$mds ;
631 :     $collection = $c ;
632 :     }
633 :     else{
634 :     print STDERR "$t: No right for user " .$user->login ." to edit collection ".$c->ID." !\n";
635 :     return ( 0 , "Mising right to modify " . $c->ID , [] );
636 :     }
637 : wilke 1.16 }
638 :     }
639 :    
640 : wilke 1.18 if ($collection and ref $collection){
641 :     print STDERR "$t: Replacing data for " . $collection->ID , "\n";
642 : wilke 1.16 }
643 :     else{
644 : wilke 1.18 print STDERR "$t: Creating new sample\n";
645 :     my $id = ($meta->db->MetaDataCollection->last_id) + 1 ;
646 :     $collection = $meta->db->MetaDataCollection->create( { creator => $curator ,
647 :     ID => $id ,
648 :     source => $sample->{submission_system} || 'unknown' ,
649 :     url => $sample->{submission_system_url } || '' ,
650 :     type => 'sample' ,
651 :     } ) ;
652 :    
653 :     # create rights for collection/sample
654 :     my $view_right = $master->Rights->create( { scope => $user->get_user_scope,
655 :     data_type => 'sample',
656 :     data_id => $id ,
657 :     name => 'view',
658 :     granted => 1 ,
659 :     } );
660 :     my $edit_right = $master->Rights->create( { scope => $user->get_user_scope,
661 :     data_type => 'sample',
662 :     data_id => $id ,
663 :     name => 'edit',
664 :     granted => 1 ,
665 :     } );
666 : wilke 1.16 }
667 : wilke 1.18
668 : wilke 1.16
669 :    
670 : wilke 1.18
671 : wilke 1.1
672 :     # connect sample to study/project
673 :     if ($project){
674 :     my $pmd = $meta->db->ProjectMD->create( { project => $project ,
675 :     tag => 'sample_collection_id' ,
676 :     value => $collection->ID ,
677 :     } ) ;
678 :    
679 :     if ($sample->{job_id}){
680 :     my $job = $meta->db->Job->init( { job_id => $sample->{job_id} } );
681 :     $job->sample($collection);
682 :     $job->project($project);
683 :     $collection->job($job);
684 :     my $pjs = $meta->db->ProjectJob->get_objects( {job => $job , project => $project } );
685 :     unless(ref $pjs and scalar @$pjs){
686 :     my $pj = $meta->db->ProjectJob->create( {job => $job , project => $project } );
687 :     }
688 :     }
689 :     }
690 :    
691 :    
692 :     # preserve study id
693 : wilke 1.2 $sample->{metadata}->{study_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ study_id }};
694 :     $sample->{metadata}->{sample_id} = join ";" , map { $_->{namespace} .":". $_->{content} } @{$sample->{ sample_id }};
695 : wilke 1.1 $sample->{metadata}->{sample_name} = $sample->{ sample_name } if ( $sample->{ sample_name } );
696 :    
697 :     #add tag , value pairs
698 :     foreach my $tag (keys %{$sample->{metadata}}){
699 :    
700 :     unless ($sample->{metadata}->{$tag}){
701 : wilke 1.10 #print STDERR "$tag " . ( $sample->{metadata}->{$tag} || "no value" ) ;
702 :     #next ;
703 : wilke 1.1 }
704 : wilke 1.2 if (ref $sample->{metadata}->{$tag}){
705 :     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";
706 :     if ($user->login =~/douginator2000\@gmail.com/){
707 :    
708 :     }
709 :     $msg = 'Complex data structure where string expected.\n' . Dumper $sample->{metadata}->{$tag} ;
710 :     return ( 0 , $msg , [] );
711 :    
712 :     }
713 : wilke 1.1 if ($collection->job){
714 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $collection ,
715 :     job => $collection->job ,
716 :     tag => $tag ,
717 :     value => $sample->{metadata}->{$tag} ,
718 :     } ) ;
719 :     }
720 :     else{
721 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $collection ,
722 :     tag => $tag ,
723 :     value => $sample->{metadata}->{$tag} ,
724 :     } ) ;
725 :     }
726 :     }
727 :    
728 :     push @sample_ids , $collection->ID ;
729 :     }
730 :     return ( $success , $error , \@sample_ids ) ;
731 :     }
732 :    
733 :    
734 :     #### QIIME sample preparation for sequencing
735 :    
736 :     sub sequence_prep {
737 :     my ($params) = @_ ;
738 :    
739 :     my $method = $params->{method} ;
740 :     my $meta = $params->{metadata_handle};
741 :     my $opts = $params->{params} ;
742 :     my $user = $params->{user};
743 :     my $cgi = $params->{cgi} ;
744 :     my $master = $params->{master} ;
745 :    
746 :    
747 :    
748 :     my $data = '' ;
749 :     my $msg = '' ;
750 :     my $tag = '' ;
751 :    
752 :     if ($opts and @$opts){
753 :     $tag = shift @$opts ;
754 :     }
755 :    
756 :     # get global ids/all public ?
757 :     if ( $method eq "GET" ){
758 :     my $samples = [] ;
759 :    
760 :     if ( $tag eq "id" ){
761 :    
762 :     if ($user){
763 :     my $value = shift @$opts ;
764 :    
765 :     if ( $value and $user->has_right(undef, 'view' , 'sample', $value ) ){
766 :     $samples = $meta->db->MetaDataCollection->get_objects( { ID => $value } );
767 :     }
768 :     else{
769 :     $msg .= "<success>0</success>\n<error>you don't have the right to view sample $value</error>" ;
770 :     }
771 :     }
772 :     else{
773 :     $msg .= "<success>0</success>\n<error>no public samples defined</error>" ;
774 :     }
775 :    
776 :     foreach my $sample (@$samples){
777 :     $data .= $sample->xml ;
778 :     }
779 :    
780 :    
781 :     }
782 :     elsif ($tag){
783 :    
784 :     }
785 :     else{
786 :     # my $ids = $meta->get_samples ;
787 :     }
788 :     }
789 :     elsif( $method eq "POST"){
790 :    
791 :     $data .= '' ; #$cgi->param('POSTDATA') ;
792 : wilke 1.7 #print STDERR "Creating sample prep\n";
793 : wilke 1.1 my ($s , $e , $ids) = create_sequence_prep($master , $meta , $user , $cgi->param('POSTDATA') ) ;
794 : wilke 1.7 #print STDERR scalar @$ids . " SamplePrep IDs \n";
795 : wilke 1.1 $msg .= "<success>$s</success>\n<error>$e</error>" ;
796 :     foreach my $id (@$ids){
797 : wilke 1.21 $data .= "<sample_id namespace='mgrast'>$id</sample_id>\n";
798 : wilke 1.1 }
799 :     }
800 :    
801 :     # Called post or put without parameters
802 :     else{ $msg .= "Missing arguments for $method" ; return ($msg , '') }
803 :    
804 : wilke 1.21 return ($msg , "\n<data>".$data."</data>\n") ;
805 : wilke 1.1
806 :     };
807 :    
808 :     sub create_sequence_prep {
809 :     my ($master , $meta , $user , $data) = @_ ;
810 :     my $success = 1 ;
811 :     my $error = 0 ;
812 :     my $msg = '';
813 :     my @prep_ids ;
814 :    
815 :    
816 :     # parse sample xml
817 :     my $xs = XML::Simple->new();
818 : wilke 1.5 my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'sample_id' , 'sequence_prep' , 'sample_prep' ]);
819 : wilke 1.1
820 :     # single study without <daba_block>
821 : wilke 1.4
822 :     $block->{sequence_prep} = $block->{sample_prep} if ($block->{sample_prep}) ;
823 : wilke 1.1 push @{ $block->{sequence_prep} } , $block unless ($block->{sequence_prep}) ;
824 :    
825 :     # print Dumper $block ;
826 :    
827 :     foreach my $prep ( @{ $block->{sequence_prep} } ){
828 : wilke 1.18 print STDERR "$t: Reading prep file\n";
829 : wilke 1.8 return ( 0 , "no prep id (row_number)\n" .(Dumper $prep) , [] ) unless (exists $prep->{row_number} and $prep->{row_number} ge '0') ;
830 : wilke 1.7
831 :     #print STDERR "Reading prep file 2\n";
832 : wilke 1.1 # get curator
833 :     my $curator ;
834 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
835 :     # not a Curator , create one
836 :     unless(ref $curators and scalar @$curators){
837 :     my $curator = $meta->db->Curator->create( { user => $user ,
838 :     name => $user->firstname . " " . $user->lastname ,
839 :     email => $user->email ,
840 :     type => $prep->{submission_system} || '' ,
841 :     url => '' ,
842 : wilke 1.13 ID => $user->_id ,
843 : wilke 1.1 });
844 :    
845 :     unless($curator and ref $curator){
846 :     print STDERR "Can't creat Curator for user " . $user->login ;
847 :     exit;
848 :     }
849 :    
850 :     }
851 :     else{
852 :     $curator = $curators->[0] ;
853 :     }
854 : wilke 1.18
855 : wilke 1.1 # get project
856 :     my $project = '';
857 : wilke 1.16 if ( $prep->{ project_id } and $user->has_right(undef, 'edit' , 'project', $prep->{ project_id } ) ){
858 : wilke 1.1 $project = $meta->db->Project->init( { id => $prep->{ project_id } } ) ;
859 :     }
860 :     else{
861 :     $msg .= "no project id or no rights to edit project\n" ;
862 :     }
863 :    
864 : wilke 1.18 print STDERR "$t: Got project " . $project->id , "\n";
865 :    
866 : wilke 1.1 # get sample
867 :     my $sample = '';
868 : wilke 1.5 my $sid = 0 ;
869 :     if ( $prep->{ sample_id } ){
870 :     unless (ref $prep->{ sample_id }){
871 :     $sid = $prep->{ sample_id } || 0 ;
872 :     }
873 :     }
874 :    
875 :    
876 : wilke 1.13 # check for mgrast sample id
877 : wilke 1.5 unless($sid){
878 :     foreach my $s (@{ $prep->{sample_id} }){
879 :    
880 :     unless (ref $s){
881 :     $sid = $s || 0 ;
882 :     }
883 :     else{
884 :     $sid = $s->{content} if ($s->{namespace} =~/mgrast|mg-rast/i);
885 :     }
886 :     }
887 :     }
888 : wilke 1.18
889 :     print STDERR "$t: Fetching sample for " . $sid , "\n";
890 : wilke 1.5 if ( $sid and $user->has_right(undef, 'edit' , 'sample', $sid ) ){
891 :     $sample = $meta->db->MetaDataCollection->init( { ID => $sid } ) ;
892 : wilke 1.18
893 :     unless($sample and ref $sample){
894 :     $msg .= "missing sample for $sid ;" ;
895 :     return ( 0 , $msg , [] );
896 :     }
897 : wilke 1.5 }
898 :     else{
899 :     $msg .= "no sample id or no rights to edit sample\n" . ( $sid ? "($sid)\n" : '') ;
900 :     return ( 0 , $msg , [] );
901 : wilke 1.1 }
902 : wilke 1.2
903 : wilke 1.18 print STDERR "$t: Got sample " . $sample->ID , "\n";
904 :    
905 : wilke 1.1 # connect sample to prep
906 :     if ($sample and ref $sample){
907 :    
908 :     my $prepID = ( $sample->ID . "." . $prep->{row_number} ) ;
909 : wilke 1.18 print STDERR "searching for $prepID\n";
910 : wilke 1.1 my $preparation = $meta->db->MetaDataCollection->init( { ID => $prepID } ) ;
911 :    
912 :    
913 :     if(ref $preparation){
914 : wilke 1.18 print STDERR "$t: prep exists , delete entries\n";
915 :    
916 :     foreach my $entry (@{ $meta->db->MetaDataEntry->get_objects( { collection => $preparation } ) }){
917 :     $entry->delete;
918 :     }
919 :    
920 :     #return ( 0 , "preparation $prepID exists" , [ $preparation->ID ]) ;
921 : wilke 1.1 }
922 :     else{
923 :     $preparation = $meta->db->MetaDataCollection->create( { creator => $curator ,
924 :     ID => $prepID ,
925 :     source => $prep->{submission_system} || 'unknown' ,
926 :     url => $prep->{submission_system_url } || '' ,
927 :     type => 'sample' ,
928 :     } ) ;
929 :    
930 :     # create rights for collection/sample
931 :     my $view_right = $master->Rights->create( { scope => $user->get_user_scope,
932 :     data_type => 'sample',
933 :     data_id => $prepID ,
934 :     name => 'view',
935 :     granted => 1 ,
936 :     } );
937 :     my $edit_right = $master->Rights->create( { scope => $user->get_user_scope,
938 :     data_type => 'sample',
939 :     data_id => $prepID ,
940 :     name => 'edit',
941 :     granted => 1 ,
942 :     } );
943 :    
944 :     # it is a sample from qiime , flag existing sample as template
945 :     $sample->type('template');
946 :     }
947 :    
948 :    
949 :     # copy data from sample to preparation
950 :    
951 : wilke 1.2 foreach my $entry (@{ $meta->db->MetaDataEntry->get_objects( { collection => $sample } ) }){
952 : wilke 1.1
953 :     unless (ref $entry ){
954 :     print STDERR Dumper $entry ;
955 : wilke 1.2 Return (0 , 'Serious error , no object: ' . Dumper $entry , [] );
956 : wilke 1.1 }
957 : wilke 1.2
958 : wilke 1.22 if ($sample->job){
959 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
960 :     job => $sample->job ,
961 :     tag => $entry->tag ,
962 :     value => $entry->value ,
963 :     } ) ;
964 :     }
965 :     else{
966 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
967 :     tag => $entry->tag ,
968 :     value => $entry->value,
969 :     } ) ;
970 :     }
971 : wilke 1.2
972 :    
973 : wilke 1.1 }
974 : wilke 1.2
975 : wilke 1.1 #add tag , value pairs
976 :     foreach my $tag (keys %{$prep->{metadata}}){
977 :    
978 :     if ($prep->{metadata}->{$tag} and $prep->{metadata}->{$tag} eq ''){
979 :     print STDERR "$tag " . ( $prep->{metadata}->{$tag} || "no value" ) ;
980 :     next ;
981 :     }
982 :     if ($sample->job){
983 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
984 :     job => $sample->job ,
985 :     tag => $tag ,
986 :     value => $prep->{metadata}->{$tag} ,
987 :     } ) ;
988 :     }
989 :     else{
990 :     my $smd = $meta->db->MetaDataEntry->create( { collection => $preparation ,
991 :     tag => $tag ,
992 :     value => $prep->{metadata}->{$tag} ,
993 :     } ) ;
994 :     }
995 :     }
996 :     push @prep_ids , $preparation->ID if (ref $preparation);
997 :     }
998 :     }
999 :    
1000 :     return ( $success , $error , \@prep_ids ) ;
1001 :     }
1002 :    
1003 :    
1004 :    
1005 :    
1006 :    
1007 :     sub reads {
1008 :     my ($params) = @_ ;
1009 :    
1010 :     my $method = $params->{method} ;
1011 :     my $meta = $params->{metadata_handle};
1012 :     my $opts = $params->{params} ;
1013 :     my $user = $params->{user};
1014 :     my $cgi = $params->{cgi} ;
1015 :     my $master = $params->{master} ;
1016 :    
1017 :    
1018 :    
1019 :     my $data = '' ;
1020 :     my $msg = '' ;
1021 :     my $tag = '' ;
1022 :    
1023 :     if ($opts and @$opts){
1024 :     $tag = shift @$opts ;
1025 :     }
1026 :    
1027 :     # get global ids/all public ?
1028 :     if ( $method eq "GET" ){
1029 :     my $jobs = [] ;
1030 :    
1031 :     if ( $tag eq "id" ){
1032 :    
1033 :    
1034 :    
1035 :    
1036 :     if ($user){
1037 :     my $value = shift @$opts ;
1038 :    
1039 : wilke 1.25 if ( $value ){
1040 : wilke 1.1 $jobs = $meta->db->Job->get_objects( { job_id => $value } );
1041 : wilke 1.25 @$jobs = map { $_ if ( $user->has_right(undef, 'view' , 'metagenome', $_->metagenome_id ) ) } @$jobs ;
1042 :    
1043 : wilke 1.1 }
1044 :     else{
1045 :     $msg .= "<success>0</success>\n<error>you don't have the right to get sequences $value</error>" ;
1046 :     }
1047 :     }
1048 :     else{
1049 :     $msg .= "<success>0</success>\n<error>no public sequences</error>" ;
1050 :     }
1051 :    
1052 :     foreach my $job (@$jobs){
1053 : wilke 1.25 print STDERR "Downloading data for job " . $job->job_id ;
1054 : wilke 1.1 $data .= $job->download('') ;
1055 :     }
1056 :    
1057 :    
1058 :     }
1059 :     elsif ($tag){
1060 :    
1061 :     }
1062 :     else{
1063 :     # my $ids = $meta->get_samples ;
1064 :     }
1065 :     }
1066 :     elsif( $method eq "POST"){
1067 : wilke 1.14
1068 :     # debug option
1069 :     $data .= $cgi->param('POSTDATA') if (0) ;
1070 : wilke 1.7 #print STDERR "Creating Job\n";
1071 : wilke 1.1
1072 :     # only create if a user is present
1073 :     if ($user and ref $user){
1074 : wilke 1.5 my ($s , $e , $ids , $md5s ) = create_job($master , $meta , $user , $cgi->param('POSTDATA') ) ;
1075 : wilke 1.7
1076 : wilke 1.1 $msg .= "<success>$s</success>\n<error>$e</error>" ;
1077 :     foreach my $id (@$ids){
1078 :     $data = "<job_id>$id</job_id>\n";
1079 :     }
1080 : wilke 1.13 $data .="<md5sum>" . (join " ; " , @$md5s) ."<md5sum>\n" if ($md5s and ref $md5s);
1081 : wilke 1.1 }
1082 :     else{
1083 :     print Dumper $user ;
1084 :     print STDERR Dumper $user ;
1085 :     $msg .= 'missing user authentification or authentification failed\nPlease yell at contact.\n';
1086 :     }
1087 :     }
1088 :    
1089 :     # Called post or put without parameters
1090 :     else{ $msg .= "Missing arguments for $method" ; return ($msg , '') }
1091 :    
1092 :     return ($msg , "\n<data>".$data."\n</data>") ;
1093 :    
1094 :     };
1095 :    
1096 :    
1097 :    
1098 :     sub create_job {
1099 :     my ($master , $meta , $user , $data) = @_ ;
1100 :     my $success = 1 ;
1101 :     my $error = 0 ;
1102 :     my $msg = '';
1103 :     my @job_ids ;
1104 : wilke 1.5 my @md5s ;
1105 : wilke 1.1 my $pipeline_options = {};
1106 :    
1107 :     # parse sample xml
1108 :     my $xs = XML::Simple->new();
1109 : wilke 1.5 my $block = $xs->XMLin( $data , ForceArray => [ 'study' , 'sample' , 'samples' , 'sample_id' , 'filter_reference_sequence_set' ,] , KeyAttr => [] );
1110 : wilke 1.1
1111 :     # single study without <daba_block>
1112 :     push @{ $block->{files} } , $block unless ($block->{files}) ;
1113 :    
1114 :    
1115 : wilke 1.13 #print STDERR Dumper $block ;
1116 :    
1117 : wilke 1.1 foreach my $data ( @{ $block->{files} } ){
1118 : wilke 1.13
1119 :     my $prep_id = '';
1120 :     if (exists $data->{row_number} and $data->{row_number}=~/\d+/){
1121 :     $prep_id = ".".$data->{row_number} ;
1122 :     }
1123 : wilke 1.1
1124 :     # get curator
1125 :     my $curator ;
1126 :     my $curators = $meta->db->Curator->get_objects( { user => $user } ) ;
1127 :     # not a Curator , create one
1128 :     unless(ref $curators and scalar @$curators){
1129 :     my $curator = $meta->db->Curator->create( { user => $user ,
1130 :     name => $user->firstname . " " . $user->lastname ,
1131 :     email => $user->email ,
1132 :     type => $data->{submission_system} || '' ,
1133 :     url => '' ,
1134 : wilke 1.13 ID => $user->_id ,
1135 : wilke 1.1 });
1136 :    
1137 :     unless($curator and ref $curator){
1138 :     print STDERR "Can't creat Curator for user " . $user->login ;
1139 :     exit;
1140 :     }
1141 :    
1142 :     }
1143 :     else{
1144 :     $curator = $curators->[0] ;
1145 :     }
1146 :    
1147 :    
1148 :     # get project
1149 :     my $project = '';
1150 : wilke 1.16 if ( $data->{ project_id } and $user->has_right(undef, 'edit' , 'project', $data->{ project_id } ) ){
1151 : wilke 1.1 $project = $meta->db->Project->init( { id => $data->{ project_id } } ) ;
1152 : wilke 1.15 return (0 , "No Project for " . $data->{ project_id } , [] ) unless($project and ref $project);
1153 : wilke 1.1 }
1154 :     else{
1155 :     $msg .= "no project id or no rights to edit project\n" ;
1156 : wilke 1.14 return ;
1157 : wilke 1.1 }
1158 : wilke 1.5
1159 : wilke 1.1 # get sample
1160 : wilke 1.4 #my @samples ;
1161 :     my @samples= ($data->{sample} and ref $data->{sample}) ? @{ $data->{sample} } : () ;
1162 : wilke 1.1 my $collection = '';
1163 :    
1164 :     my $sample = '' ;
1165 :     foreach my $s ( @{ $data->{sample} }){
1166 : wilke 1.5 $sample = $s if (!($s->{namespace}) or ( $s->{namespace} =~ /mgrast|mg-rast/i)) ;
1167 :     }
1168 :     unless($sample){
1169 :     foreach my $s ( @{ $data->{sample_id} }){
1170 :     unless( ref $s){
1171 :     $sample = $s ;
1172 :     }
1173 :     else{
1174 :     $sample = $s->{content} if ( $s->{namespace} =~ /mgrast|mg-rast/i ) ;
1175 :     }
1176 :     }
1177 : wilke 1.1 }
1178 : wilke 1.5
1179 : wilke 1.13 # adding row number to ID ;
1180 : wilke 1.20
1181 : wilke 1.13 $sample .= $prep_id ;
1182 :    
1183 : wilke 1.5 if ($sample and $user->has_right(undef, 'edit' , 'sample', ($sample) ) ){
1184 :     $collection = $meta->db->MetaDataCollection->init( { ID => $sample } ) ;
1185 : wilke 1.13 unless($collection and ref $collection){
1186 :     return ( 0 , "No sample for $sample" , [] ) ;
1187 :     }
1188 :    
1189 : wilke 1.1 }
1190 :     else{
1191 : wilke 1.18 $msg .= "no sample id or no rights to edit sample ($sample)\n" . Dumper $sample ;
1192 :     return ( 0 , $msg , [] ) ;
1193 : wilke 1.1 }
1194 :    
1195 :     if (exists $data->{options} ){
1196 :     %$pipeline_options = %{ $data->{options} } ;
1197 :     print STDERR Dumper $data->{options} ;
1198 :    
1199 :     if ( $pipeline_options->{filter_reference_sequence_set} ){
1200 :     # concatinate list and remove array ref
1201 :     if (ref $pipeline_options->{filter_reference_sequence_set} ){
1202 :     $pipeline_options->{contaminant_filter_orgs} = join ";" , @{$pipeline_options->{filter_reference_sequence_set}} ;
1203 :     $pipeline_options->{filter_reference_sequence_set} = join ";" , @{$pipeline_options->{filter_reference_sequence_set}} ;
1204 :     }
1205 :     else{
1206 :     $pipeline_options->{contaminant_filter_orgs} = $pipeline_options->{filter_reference_sequence_set}
1207 :     }
1208 :     }
1209 :    
1210 :     if ($pipeline_options->{filter_ambiguous_base_calls} and ref $pipeline_options->{filter_ambiguous_base_calls}){
1211 :     foreach my $k (keys %{ $pipeline_options->{filter_ambiguous_base_calls} }){
1212 :     $pipeline_options->{ "filter_ambiguous_base_calls." . ( $k =~ /content/ ? "on" : $k ) } = $pipeline_options->{filter_ambiguous_base_calls}->{$k};
1213 :     }
1214 :     delete $pipeline_options->{filter_ambiguous_base_calls} ;
1215 :     }
1216 :    
1217 :     if ($pipeline_options->{filter_length}) {
1218 :     if (ref $pipeline_options->{filter_length}) {
1219 :     $pipeline_options->{length_filter} = $pipeline_options->{filter_length}->{content} ;
1220 :     foreach my $k (keys %{ $pipeline_options->{filter_length} }){
1221 :     $pipeline_options->{ "filter_length." . ( $k =~ /content/ ? "on" : $k ) } = $pipeline_options->{ "filter_length" }->{ $k };
1222 :     }
1223 :     delete $pipeline_options->{filter_length};
1224 :     }
1225 :     else{
1226 :     $pipeline_options->{length_filter} = $pipeline_options->{filter_length} ;
1227 :     }
1228 :    
1229 :     }
1230 :    
1231 : wilke 1.11 $pipeline_options->{filter_ln} = $pipeline_options->{filter_length} if ($pipeline_options->{filter_length}) ;
1232 :     $pipeline_options->{contaminant_filter} = 1 if ($pipeline_options->{filter_reference_sequence_set}) ;
1233 :     $pipeline_options->{filter_ambig} = ( $pipeline_options->{filter_ambiguous_base_calls}->{content}
1234 : wilke 1.1 || 0 ) if ($pipeline_options->{filter_ambiguous_base_calls}) ;
1235 : wilke 1.11 $pipeline_options->{max_ambig} = ( $pipeline_options->{filter_ambiguous_base_calls}->{max_allowed}
1236 : wilke 1.1 || '' ) if ($pipeline_options->{filter_ambiguous_base_calls}) ;
1237 :    
1238 :     unless($pipeline_options->{rna_only}){
1239 :     $pipeline_options->{rna_only} = ($data->{sequences}->{type} and $data->{sequences}->{type} =~/rna/i) ? 1 : 0 ;
1240 :     }
1241 :    
1242 :     }
1243 :    
1244 :     if (exists $data->{sequences} ){
1245 : wilke 1.18
1246 : wilke 1.2 # get upload path and create directories
1247 :     my $upload_path = &upload_path($user , ($project ? $project->id : '') );
1248 :     my $filename = "$upload_path/".$user->_id . "-" ;
1249 :     $filename .= (ref $collection ? $collection->ID : $data->{sample}->[0]->{id} ) . "-". &timestamp ;
1250 : wilke 1.9
1251 :     # set sequence type
1252 :     my $sequence_type = (ref $data->{sequences} and $data->{sequences}->{type}) ? $data->{sequences}->{type} : '' ;
1253 :    
1254 : wilke 1.11 # set pipeline options
1255 :     if ($sequence_type =~ /16s|rna/i){
1256 :     $pipeline_options->{rna_only} = 1 ;
1257 :     $sequence_type = '16s' ;
1258 :     }
1259 :    
1260 : wilke 1.1 open(FILE , ">$filename") or die "Can't open $filename for writing!\n";
1261 : wilke 1.4 if (ref $data->{sequences} and exists $data->{sequences}->{content}){
1262 : wilke 1.9 my $content = $data->{sequences}->{content} ;
1263 :     $content =~ s/^\s+//;
1264 :     print FILE $content ;
1265 : wilke 1.1 }
1266 :     else{
1267 : wilke 1.9
1268 :     if (ref $data->{sequences}){
1269 :     print Dumper $data->{sequences} ;
1270 :     exit ;
1271 :     }
1272 :     my $content = $data->{sequences} ;
1273 :     $content =~ s/^\s+//;
1274 :     $content =~ s/\s+$//g;
1275 :     print FILE $content ;
1276 : wilke 1.1 }
1277 :    
1278 : wilke 1.9 my $seq_stats = {} ;
1279 :     my $stats = `$FIG_Config::seq_length_stats -fasta_file $filename` if (-f $filename) ;
1280 :     foreach my $line (split "\n" , $stats) {
1281 :     my ($tag , $value) = split "\t" , $line ;
1282 : wilke 1.11 # print "$tag :: $value\n";
1283 : wilke 1.9 $seq_stats->{$tag} = $value ;
1284 :     }
1285 : wilke 1.11
1286 :     # get length filter cutoffs
1287 :     if ($pipeline_options->{filter_ln}) {
1288 : tharriso 1.12 $pipeline_options->{min_ln} = int( $pipeline_options->{average_length} - (2 * $pipeline_options->{standard_deviation_length}) );
1289 :     $pipeline_options->{max_ln} = int( $pipeline_options->{average_length} + (2 * $pipeline_options->{standard_deviation_length}) );
1290 :     if ($pipeline_options->{min_ln} < 0) { $pipeline_options->{min_ln} = 0; }
1291 : wilke 1.11 }
1292 :    
1293 : wilke 1.5 my ($md5 , $f) = `md5sum $filename` =~/^\s*([^\s]+)\s*(\w+)/;
1294 : wilke 1.9
1295 : wilke 1.5 unless($md5){
1296 :     print "Soething wrong , can't compute md5 for $filename\n";
1297 :     print STDERR "Something wrong , can't compute md5 for $filename\n";
1298 :     exit;
1299 :     }
1300 : wilke 1.15
1301 :     #check for md5 in system
1302 :     my $jobs = $meta->db->Job->get_objects( { owner => $user ,
1303 :     file_checksum_raw => $md5 ,
1304 :     } ) ;
1305 :    
1306 :    
1307 :     if (ref $jobs and scalar @$jobs){
1308 :     return ( 0 , 'Duplicate file' , [ map { $_->job_id } @$jobs ] , [ $md5 ]) ;
1309 :     }
1310 :    
1311 : wilke 1.5 push @md5s , $md5 ;
1312 :    
1313 : wilke 1.13 print STDERR "Creating Job\n";
1314 : wilke 1.1 my $job = $meta->db->Job->reserve_job($user , $pipeline_options , $seq_stats);
1315 : wilke 1.13 if ($job and ref $job){ push @job_ids , $job->job_id ; }
1316 :     else { return (0 , "Can't create job in DB" , [] ) ;}
1317 : wilke 1.11
1318 : wilke 1.18
1319 : wilke 1.5
1320 : wilke 1.8 $job->server_version(3) ;
1321 :     $job->name($collection->ID);
1322 : wilke 1.15 $job->file_checksum_raw($md5) ;
1323 : wilke 1.8
1324 : wilke 1.13 # connect sample and job
1325 : wilke 1.5 $job->sample($collection) ;
1326 :     unless(ref $collection->job){
1327 :     $collection->job($job) ;
1328 :     }
1329 : wilke 1.1
1330 : wilke 1.13 # add job to project
1331 :     if ( $project and ref $project){
1332 : wilke 1.15 $job->project($project) unless ($job->project) ;
1333 :    
1334 : wilke 1.13 my $pjs = $meta->db->ProjectJob->get_objects( { job => $job ,
1335 :     project => $project ,
1336 :     } ) ;
1337 :     unless (ref $pjs and scalar @$pjs){
1338 :     $pjs = $meta->db->ProjectJob->create( { job => $job ,
1339 :     project => $project ,
1340 :     } ) ;
1341 :     }
1342 :    
1343 : wilke 1.15
1344 : wilke 1.13 }
1345 :    
1346 : wilke 1.18 $msg .= $job->finish_upload($filename , $sequence_type) ;
1347 : wilke 1.13
1348 : wilke 1.1 #clean up
1349 : wilke 1.8 if ( -d $job->directory and -f $job->download_dir . "/" . $job->job_id . ".fna" ){
1350 : wilke 1.1 my $error = `rm $filename` ;
1351 :     }
1352 :     else{
1353 : wilke 1.8 print STDERR "Missing file " . $job->download_dir . "/" . $job->job_id . ".fna\n";
1354 : wilke 1.5 return ( 0 , "Creation of job failed.\n$msg" , \@job_ids , \@md5s) ;
1355 : wilke 1.1 }
1356 :    
1357 :     # call mgrast job method here
1358 :     my @jobs ;
1359 :     push @jobs , $job->job_id if (ref $job);
1360 : wilke 1.6 print STDERR "Created job " . $job->job_id , "\n" ;
1361 :     $msg = '' ;
1362 : wilke 1.1 #return (0 , "$msg\nnot implemented yet. File /tmp/$filename" , \@jobs , $md5) ;
1363 :     }
1364 :     else{
1365 :     print STDERR "no sequences!\n";
1366 :     $msg .= "no sequences" ;
1367 :     }
1368 :     #push @job_ids , $job->job_id ;
1369 :     }
1370 :     $error .= "\n\n$msg\n";
1371 : wilke 1.5 return ( $success , $error , \@job_ids , \@md5s) ;
1372 : wilke 1.1 }
1373 :    
1374 :    
1375 :    
1376 :    
1377 :    
1378 : wilke 1.2 sub upload_path{
1379 :     my ($user , $prj) = @_;
1380 :    
1381 :     my $user_md5 = md5_hex( $user->login );
1382 :     my $timestamp = &timestamp;
1383 :    
1384 :     my $base_dir = "$FIG_Config::incoming";
1385 :     my $user_dir = "$base_dir/$user_md5";
1386 :     my $upload_dir = "$base_dir/$user_md5/" . ($prj ? $prj : $timestamp);
1387 :    
1388 :     create_dir($user_dir);
1389 :     create_dir($upload_dir);
1390 :    
1391 :     return $upload_dir ;
1392 :     }
1393 :    
1394 :     sub create_dir {
1395 :     my($dir) = @_;
1396 : wilke 1.1
1397 : wilke 1.2 if ( -d $dir )
1398 :     {
1399 :     # check permissions
1400 :     }
1401 :     else
1402 :     {
1403 :     mkdir $dir or die "could not create directory '$dir'";
1404 :     chmod 0777, $dir;
1405 :     }
1406 :     }
1407 : wilke 1.1
1408 : wilke 1.2 sub timestamp {
1409 :    
1410 :     my($sec, $min, $hour, $day, $month, $year) = localtime;
1411 :    
1412 :     $month += 1;
1413 :     $year += 1900;
1414 :    
1415 :     $sec = &pad($sec);
1416 :     $min = &pad($min);
1417 :     $hour = &pad($hour);
1418 :     $day = &pad($day);
1419 :     $month = &pad($month);
1420 :    
1421 :     return join('.', $year, $month, $day, $hour, $min, $sec);
1422 :     }
1423 :    
1424 :     sub pad{
1425 :     my ($data) = @_ ;
1426 :     return ( $data=~/^\d$/ ? "0$data" : $data) ;
1427 :     }
1428 :    
1429 : wilke 1.1 sub register {};

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3