Menu
▾
▴
[Sashimi-commit] SF.net SVN: sashimi:[9481] trunk/trans_proteomic_ pipeline/perl/cgi-bin
|
From: <rea...@us...> - 2026-04-16 06:39:37
|
Revision: 9481
http://sourceforge.net/p/sashimi/code/9481
Author: real_procopio
Date: 2026-04-16 06:39:35 +0000 (Thu, 16 Apr 2026)
Log Message:
-----------
[error handling] Improve error reporting and code cleanup
Modified Paths:
--------------
trunk/trans_proteomic_pipeline/perl/cgi-bin/ProtXMLViewer.pl
trunk/trans_proteomic_pipeline/perl/cgi-bin/mascotout.pl
trunk/trans_proteomic_pipeline/perl/cgi-bin/plotpp.pl
trunk/trans_proteomic_pipeline/perl/cgi-bin/promastcgi.pl
trunk/trans_proteomic_pipeline/perl/cgi-bin/show_tmp_pngfile.pl
Modified: trunk/trans_proteomic_pipeline/perl/cgi-bin/ProtXMLViewer.pl
===================================================================
--- trunk/trans_proteomic_pipeline/perl/cgi-bin/ProtXMLViewer.pl 2026-04-16 06:37:19 UTC (rev 9480)
+++ trunk/trans_proteomic_pipeline/perl/cgi-bin/ProtXMLViewer.pl 2026-04-16 06:39:35 UTC (rev 9481)
@@ -7,7 +7,7 @@
# #
# View and filter protXML result files in web browser #
# #
-# Copyright (C) 2013-2025 Luis Mendoza #
+# Copyright (C) 2013-2026 Luis Mendoza #
# #
# This library is free software; you can redistribute it and/or #
# modify it under the terms of the GNU Lesser General Public #
Modified: trunk/trans_proteomic_pipeline/perl/cgi-bin/mascotout.pl
===================================================================
--- trunk/trans_proteomic_pipeline/perl/cgi-bin/mascotout.pl 2026-04-16 06:37:19 UTC (rev 9480)
+++ trunk/trans_proteomic_pipeline/perl/cgi-bin/mascotout.pl 2026-04-16 06:39:35 UTC (rev 9481)
@@ -1,8 +1,9 @@
#!perl
-use FindBin qw($Bin);
+use FindBin qw($Bin $Script);
use lib "$Bin/../lib/perl";
use tpplib_perl; # exported TPP lib function points
my $TPPVersionInfo = tpplib_perl::getTPPVersionInfo();
+my $page_title = $Script;
print "Content-type: text/html\n\n";
@@ -31,10 +32,10 @@
}
} else {
- print "\n\n<font style='border:3px solid red;color:red'>ERROR: Count not open file: $tarfile does not exist</font>\n\n";
+ print "\n\n\n\n<span style='padding:20px 100px;border:3px solid red;color:red'>ERROR: Could not open file: $tarfile does not exist</span>\n\n\n\n";
}
-print "\n\n<hr size='1' noshade>";
-print "<font color='#999999'>$page_title\n$TPPVersionInfo</font>\n";
+print "\n<hr size='1' noshade>";
+print "<span style='color:#999999'>$page_title\n$TPPVersionInfo</span>\n";
print "</PRE>\n</body>\n</html>";
exit;
Modified: trunk/trans_proteomic_pipeline/perl/cgi-bin/plotpp.pl
===================================================================
--- trunk/trans_proteomic_pipeline/perl/cgi-bin/plotpp.pl 2026-04-16 06:37:19 UTC (rev 9480)
+++ trunk/trans_proteomic_pipeline/perl/cgi-bin/plotpp.pl 2026-04-16 06:39:35 UTC (rev 9481)
@@ -8,7 +8,7 @@
# Write incoming data as a json object to a file for later visualization #
# using flot #
# #
-# Copyright (C) 2017-2023 Luis Mendoza #
+# Copyright (C) 2017-2026 Luis Mendoza #
# #
# This library is free software; you can redistribute it and/or #
# modify it under the terms of the GNU Lesser General Public #
@@ -392,15 +392,15 @@
my $file = $cgi_query->param('file') || '';
my $html_response = "Content-type:text/html\n\n";
+ my $error_response = "<span style='color:red'>Unable to process request</span>";
if (!$file || !open(FILE, "$file")) {
- $html_response .= "<span style='color:red'>Could not find or open file $file for deletion</span>";
- return $html_response;
+ return $html_response.$error_response;
}
my $go_ahead_and_delete = 0;
while (<FILE>) {
- if (/^#DATA:/) {
+ if (/^#DATA:$/) {
$go_ahead_and_delete++;
last;
}
@@ -407,14 +407,11 @@
}
close FILE;
- if (!$go_ahead_and_delete) {
- $html_response .= "<span style='color:red'>File $file is of incorrect type; did not delete</span>";
+ if ($go_ahead_and_delete && unlink $file) {
+ $html_response .= "--DELETEOK--";
}
- elsif (unlink $file) {
- $html_response .= "--DELETEOK--";
- }
else {
- $html_response .= "<span style='color:red'>Could not delete file $file</span>";
+ $html_response .= $error_response;
}
return $html_response;
Modified: trunk/trans_proteomic_pipeline/perl/cgi-bin/promastcgi.pl
===================================================================
--- trunk/trans_proteomic_pipeline/perl/cgi-bin/promastcgi.pl 2026-04-16 06:37:19 UTC (rev 9480)
+++ trunk/trans_proteomic_pipeline/perl/cgi-bin/promastcgi.pl 2026-04-16 06:39:35 UTC (rev 9481)
@@ -7,7 +7,7 @@
# #
# Submits a sequence to the promast sequence mapping utility; returns JSON #
# #
-# Copyright (C) 2021-2023 Luis Mendoza #
+# Copyright (C) 2021-2026 Luis Mendoza #
# #
# This library is free software; you can redistribute it and/or #
# modify it under the terms of the GNU Lesser General Public #
@@ -37,19 +37,14 @@
# Globals
-my $exe_path = tpplib_perl::getHomePath() . 'bin/promast.pl';
+my $exe_path = tpplib_perl::getHomePath() . 'bin/promast.pl';
my $command;
-my $base_path = '/net/dblocal/wwwspecial/peptideatlas/map';
-my %opts;
+my $q = new CGI;
+my $cgi_action = $q->url_param('action') || undef;
-# Get basic cgi parameters
-my $q = new CGI;
-my $cgi_sessionid = $q->param('ssid') || &getNewRandomString(10);
-my $cgi_action = $q->param('action') || undef;
+my $json_response = "Content-type:application/json\n\n";
-
-my $json_response = "Content-type:application/json\n\n";
&performSearch() if ($cgi_action eq 'beginSearch');
if ($command) {
@@ -63,6 +58,9 @@
$json_response .= $mapped;
}
}
+else {
+ &reportError("There was a problem with promast");
+}
print $json_response;
exit(0);
@@ -70,11 +68,13 @@
###############################################################################
-# Send Error
+# Send Error (and exits)
###############################################################################
sub reportError {
my $msg = shift || 'unknown error...';
+ $msg =~ s/\n/<br>/g;
+
$json_response .= "{\"message\" : \"$msg\", \"status\" : \"ERROR\"}";
print $json_response;
@@ -86,94 +86,41 @@
# Run peptide sequence matching
###############################################################################
sub performSearch {
- my $dbase = $q->param('db') || undef;
- my $input = $q->param('peptide') || undef;
- my $mztol = $q->param('mztol') || undef;
- my $fuzzy = $q->param('fuzzy') || 0;
+ my $dbase = $q->url_param('db') || undef;
+ my $input = $q->url_param('peptide') || undef;
+ my $mztol = $q->url_param('mztol') || undef;
+ my $fuzzy = $q->url_param('fuzzy') || 0;
-# my $peplist = decode_entities($q->param('peptides')) || '';
- my $peplist = $q->param('peptides') || '';
-
- my $numpep = 0;
- if ($peplist) {
- $input = "$base_path/tmp/$cgi_sessionid.peplist";
- open(POUT, ">>$input") || do {
- &reportError("Cannot create file $input : $!");
- $peplist = ''; # skips writing to file
- };
-
- PEPLIST:
- for (split "\n", $peplist) {
- s/[\r\n]//g;
- s/^\s+//g;
- s/\s+$//g;
- next unless $_;
-
- for (split /\s+/) {
- if (++$numpep > 5000) {
- &reportError("Too many sequences requested! Please limit requests to 5000 entries.");
- last PEPLIST;
- }
- print POUT "$_\n";
- }
- }
- close (POUT);
- $opts{'output'} = "multi";
- }
- else {
- $opts{'output'} = "single";
- }
-
# Validate user input
unless (defined($input)) {
- &reportError("Please specify a peptide sequence or list to search");
+ &reportError("Please specify a peptide sequence to search");
}
+ if ($input !~ /^[A-Z]+$/) {
+ &reportError("Please specify a valid peptide sequence");
+ }
+
if (defined($mztol) && $mztol !~ /^[\d|\.]+$/ ) {
&reportError("Precursor m/z tolerance must be a number!");
}
+ if ($fuzzy !~ /^\d$/) {
+ &reportError("Incorrect parameter passed");
+ }
+
if (! -f $dbase) {
&reportError("Database not available!");
}
- # Assemble command:
- # promast
- # -c
- # -U
- # -u
- # -f <fuzzy>
- # -m <mztol>
- # <index file>
- # <sequence>
-
+ # Assemble command
my $options = "-E -c -u -o json";
if ($fuzzy > 0) {
$options .= " -U";
$options .= " -f $fuzzy";
$options .= " -m $mztol" if defined($mztol);
- $opts{'output'} = "fuzzy";
}
$command = "$exe_path $options $dbase $input";
return;
}
-
-
-###############################################################################
-# getNewRandomString
-###############################################################################
-sub getNewRandomString {
- my $len = shift;
-
- srand;
- my $string = "";
- my @charList = ('A'..'Z',0..9);
- for (my $i = 0; $i<$len; $i++) {
- $string .= $charList[int(rand 36)];
- }
-
- return $string;
-}
-
Modified: trunk/trans_proteomic_pipeline/perl/cgi-bin/show_tmp_pngfile.pl
===================================================================
--- trunk/trans_proteomic_pipeline/perl/cgi-bin/show_tmp_pngfile.pl 2026-04-16 06:37:19 UTC (rev 9480)
+++ trunk/trans_proteomic_pipeline/perl/cgi-bin/show_tmp_pngfile.pl 2026-04-16 06:39:35 UTC (rev 9481)
@@ -4,9 +4,8 @@
# a little CGI script to pump a temp graphic file to stdout, then delete it
#
-
my $serverroot = $ENV{WEBSERVER_ROOT};
-$serverroot =~ s/\\/\//g; # get those path seps pointing right!
+$serverroot =~ s|\\|/|g; # get those path seps pointing right!
my @qvars = split '&', $ENV{QUERY_STRING};
@@ -15,48 +14,42 @@
my $retain = 0;
foreach my $v (@qvars) {
- my @var = split '=', $v;
- if ($#var > 0) {
- if ($var[0] eq "file") {
- $fname = $var[1];
- }
- if ($var[0] eq "keep") {
- $retain = $var[1];
- }
-
-
+ my @var = split '=', $v;
+ if ($#var > 0) {
+ if ($var[0] eq "file") {
+ $fname = $var[1];
}
-
-
+ elsif ($var[0] eq "keep") {
+ $retain = $var[1];
+ }
+ }
}
-
-
-
-$fname =~ s/\\/\//g; # get those path seps pointing right!
+$fname =~ s|\\|/|g; # get those path seps pointing right!
my $fullpath = $fname ;
-$fullpath =~ s/\/\//\//g; # eliminate double slashes
+$fullpath =~ s|//|/|g; # eliminate double slashes
if (not -e $fullpath) { # prepend serverroot
- $fullpath = $serverroot . $fname ;
+ $fullpath = $serverroot . $fname ;
}
-if (not ($fname =~ m/\.png$/)) { # make sure nobody's trying to delete non-png files
- print "Content-type: html/text\n\n";
- print "wrong filetype";
-} elsif (-e $fullpath) { # if it exists, show it then delete it
- # show it
- my $qt = "'";
- $qt = '"' if ($^O eq 'MSWin32' );
- my $quotedpath = $qt.$fullpath.$qt;
- print "Content-type: image/png\n\n";
- system("cat $quotedpath");
- # kill it
- if ($retain == 0) {
- system("rm $quotedpath");
- }
-} else { # issue warning
- print "Content-type: html/text\n\n";
- print "The temporary image file $fullpath has already been deleted. ";
- print "Try using the Copy function in your browser instead.";
+if ($fname !~ /\.png$/) { # make sure nobody's trying to delete non-png files
+ print "Content-type: html/text\n\n";
+ print "wrong filetype";
}
+elsif (-e $fullpath) { # if it exists, show it then delete it
+ # show it
+ my $qt = $^O eq 'MSWin32' ? '"' : "'";
+ my $quotedpath = $qt.$fullpath.$qt;
+ print "Content-type: image/png\n\n";
+ system("cat $quotedpath");
+ # kill it
+ if ($retain == 0) {
+ system("rm $quotedpath");
+ }
+}
+else { # issue warning
+ print "Content-type: html/text\n\n";
+ print "The temporary image file $fullpath has already been deleted. ";
+ print "Try using the Copy function in your browser instead.";
+}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|