2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								#!/usr/bin/env perl
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								use CGI;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2020-08-06 13:54:59 +02:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								$CGI::POST_MAX = 1024 * 1024 * 10;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# Change this to the correct path to binary.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								my $smtk2ssrf = "../build/smtk2ssrf";
							 | 
						
					
						
							
								
									
										
										
										
											2021-01-22 21:38:37 +01:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								my $diviac = "../scripts/diviac.pl";
							 | 
						
					
						
							
								
									
										
										
										
											2020-08-06 13:54:59 +02:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								my $logfile = '/tmp/smtk2ssrf.log';
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								my $q = CGI->new;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								if ($q->upload("uploaded_file")) {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        my $original_filename = $q->param("uploaded_file");
							 | 
						
					
						
							
								
									
										
										
										
											2020-08-06 13:54:59 +02:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        my $converted = `$smtk2ssrf $tmp_filename -`;
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        my $tmp_filename = $q->tmpFileName($original_filename);
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        my $new_filename = $original_filename;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        $new_filename =~ s/.*[\/\\]//;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        $new_filename =~ s/\..*$/.ssrf/;
							 | 
						
					
						
							
								
									
										
										
										
											2021-01-22 21:38:37 +01:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									my $converted;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									if ($q->param('filetype') eq "Diviac") {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										$converted = `$diviac $tmp_filename`;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									} else {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										$converted = `$smtk2ssrf $tmp_filename -`;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									}
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2020-08-06 13:54:59 +02:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									if (length($converted) > 5) {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									        print "Content-Disposition: attachment; filename=\"$new_filename\"\n";
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										print "Content-type: subsurface/xml\n\n";
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										print $converted;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									} else {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										print "Content-type: text/html\n\n";
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										print "<H1>Conversion failed</H1>";
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										print 'Please contact <a href=mailto:helling@atdotde.de>Robert Helling (robert@thetheoreticaldiver.org)</a> if the problem persits.';
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									}
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								} else {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        print "Content-type: text/html\n\n";
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# Here we could print some header stuff to fit better in the subsurface webspace context. Do do so uncomment
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# open (IN, "filename_header.html);
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# while (<IN>) {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								#         print;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# close(IN);
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        print $q->start_multipart_form();
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2021-01-22 21:38:37 +01:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        print $q->h1("Convert Smartrack and Diviac files to Subsurface");
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        print $q->filefield( -name => "uploaded_file",
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                             -size => 50,
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                             -maxlength => 200);
							 | 
						
					
						
							
								
									
										
										
										
											2021-01-22 21:38:37 +01:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									print $q->popup_menu(-name => "filetype", -values => ["Smartrack", "Diviac"]);
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        print $q->submit();
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-07 11:00:38 +02:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        print $q->end_form();
							 | 
						
					
						
							
								
									
										
										
										
											2015-11-16 16:54:01 +01:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								# Here we could print some footer stuff as above
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 |