emboss-explorer//MANIFEST0100600000175000001440000000051010202755465014443 0ustar lukemusersMANIFEST install bin/mkstatic bin/acdcheck cgi/emboss Makefile.PL README html/style/emboss.css html/style/classic.css html/style/cbr.css html/images/running.gif html/images/cbr-corner-ne.gif html/images/cbr-corner-sw.gif html/index.html lib/EMBOSS/GUI/XHTML.pm lib/EMBOSS/GUI/Conf.pm lib/EMBOSS/ACD.pm lib/EMBOSS/GUI.pm t/ACD.t emboss-explorer//install0100700000175000001440000001121510525741231014702 0ustar lukemusers#!/bin/sh usage() { cat </dev/null | awk '/^InstallDirectory/ { print $2 }'` prompt "Where was EMBOSS installed?" ${EMBOSS_PREFIX:-/usr/local} EMBOSS_PREFIX # TODO something fancy to guess the web root? prompt "Where should the EMBOSS Explorer HTML files be installed?" /var/www/html/emboss HTML_PATH OUTPUT_PATH=$HTML_PATH/output prompt "What is the URL prefix corresponding to the HTML directory above?" /emboss HTML_URL OUTPUT_URL=$HTML_URL/output prompt "Where should the EMBOSS Explorer CGI script be installed?" /var/www/cgi-bin/emboss CGI_PATH if [ -d $CGI_PATH ] then CGI_DIR=$CGI_PATH CGI_PATH=$CGI_DIR/emboss else CGI_DIR=${CGI_PATH%/*} fi prompt "What is the complete URL corresponding to the CGI script '$CGI_PATH'?" /cgi-bin/emboss CGI_URL # munge EMBOSS::GUI::Conf according to the information above... CONF_MODULE=`perl -MEMBOSS::GUI::Conf -e 'print $INC{"EMBOSS/GUI/Conf.pm"}'` perl -pi -e " \$HTML_PATH = '$HTML_PATH'; s/(?<=HTML_PATH = \")[^\"]*/\$HTML_PATH/; \$HTML_URL='$HTML_URL'; s/(?<=HTML_URL = \")[^\"]*/\$HTML_URL/; \$OUTPUT_PATH = '$OUTPUT_PATH'; s/(?<=OUTPUT_PATH = \")[^\"]*/\$OUTPUT_PATH/; \$OUTPUT_URL='$OUTPUT_URL'; s/(?<=OUTPUT_URL = \")[^\"]*/\$OUTPUT_URL/; \$EMBOSS_PREFIX='$EMBOSS_PREFIX'; s/(?<=EMBOSS_PREFIX = \")[^\"]*/\$EMBOSS_PREFIX/; " $CONF_MODULE # install HTML and CGI files... [ -d html ] || usage echo installing HTML files to $HTML_PATH... if [ -d $HTML_PATH ] then cp -rp html/* $HTML_PATH else cp -rp html $HTML_PATH fi echo creating HTML index file at $HTML_PATH/index.html... echo " EMBOSS Explorer " >$HTML_PATH/index.html echo creating output directory at $OUTPUT_PATH... [ -d $OUTPUT_PATH ] || mkdir $OUTPUT_PATH #echo creating .htaccess file in $OUTPUT_PATH/.htaccess... #echo "Header add Cache-Control: no-cache" >>$OUTPUT_PATH/.htaccess echo installing CGI script to $CGI_PATH... cp cgi/emboss $CGI_PATH # copy support files used in the program manuals... echo copying manual support files to $HTML_PATH/manual... [ -d $HTML_PATH/manual ] || mkdir $HTML_PATH/manual # EMBOSS 3 find $EMBOSS_PREFIX/share/EMBOSS/doc/programs/html -type f ! -name '*.html' -exec cp {} $HTML_PATH/manual \; # EMBOSS 4 find $EMBOSS_PREFIX/share/EMBOSS/doc/html/emboss/apps -type f ! -name '*.html' -exec cp {} $HTML_PATH/manual \; # fix permissions... echo fixing permissions... find $HTML_PATH -type d -exec chmod a+rx {} \; -o -type f -exec chmod a+r {} \; chmod a+rwx $OUTPUT_PATH chmod a+rx $CGI_PATH # TODO mention cron script in bin directory, when it exists... CRON="0 4 * * * find $OUTPUT_PATH -type d -mindepth 1 -maxdepth 1 -atime 1 -exec rm -rf {} \;" # mention location of configuration file and things that can be changed (list # of excluded applications, mostly...) cat < \$frames, "cgi=s" => \$cgi ) or pod2usage(); my $dir = shift || $EMBOSS::GUI::Conf::HTML_PATH; -d $dir && -w $dir or pod2usage("$dir is not a writeable directory"); print <; if ($response =~ /^y/i) { last; } elsif ($response =~ /^n/i) { exit; } } #my $style_url = $EMBOSS::GUI::Conf::STYLE_URL =~ # /^$EMBOSS::GUI::Conf::HTML_URL\/(.*)/ ? $1: $EMBOSS::GUI::Conf::STYLE_URL; my $style_url = $EMBOSS::GUI::Conf::STYLE_URL; #my $image_url = $EMBOSS::GUI::Conf::IMAGE_URL =~ # /^$EMBOSS::GUI::Conf::HTML_URL\/(.*)/ ? $1 : $EMBOSS::GUI::Conf::IMAGE_URL; my $image_url = $EMBOSS::GUI::Conf::IMAGE_URL; #my $manual_url = $EMBOSS::GUI::Conf::MANUAL_URL =~ # /^$EMBOSS::GUI::Conf::HTML_URL\/(.*)/ ? $1 : $EMBOSS::GUI::Conf::MANUAL_URL; my $manual_url = $EMBOSS::GUI::Conf::MANUAL_URL; my $html = EMBOSS::GUI::XHTML->new( frames => $frames, style_url => $style_url, image_url => $image_url, manual_url => $manual_url, script_url => $cgi, static => 1 ); my $emboss = EMBOSS::GUI->new( html => $html ); my $pages = 0; if ($frames) { dump_page("$dir/index.html", $html->frameset_page); dump_page("$dir/alphamenu.html", $html->menu_page($emboss->apps)); dump_page("$dir/groupmenu.html", $html->menu_page($emboss->groups)); dump_page("$dir/intro.html", $html->intro_page); } my $manual_dir = $EMBOSS::GUI::Conf::MANUAL_URL; $manual_dir =~ s/$EMBOSS::GUI::Conf::HTML_URL/$dir/; -d $manual_dir or mkdir $manual_dir or die "error creating directory $manual_dir: $!"; foreach my $aref ($emboss->apps) { my ($app, $doc) = @$aref; if (!$emboss->is_excluded($app)) { if (my $acdfile = $emboss->_find_acd($app)) { if (my $acd = eval { EMBOSS::ACD->new($acdfile) }) { dump_page("$dir/$app.html", $html->input_page($acd)); } else { warn "failed to parse $acdfile\n"; } } else { warn "failed to locate ACD file for $app\n"; } if (my $manual = $emboss->_find_manual($app)) { dump_page("$manual_dir/$app.html", $html->manual_page($app, $manual)); } else { warn "failed to locate manual for $app\n"; } } } print <_write_to_file($path, $content) or die "error writing to $path: $!\n"; } =head1 NAME mkstatic =head1 AUTHOR Luke McCarthy =head1 SYNOPSIS mkstatic [ --noframes ] [ --cgi URL ] [ DIRECTORY ] =head1 DESCRIPTION TODO... =head1 OPTIONS =over4 =item --frames | --noframes Controls whether or not the generated HTML has a separate frame for the application menu. The default is to use a separate frame. =item --cgi URL Use the specified URL as the location of the CGI script that application input forms are submitted to. =back =head1 COPYRIGHT Copyright (c) 2004 Luke McCarthy. All rights reserved. This program is free software. You may copy or redistribute it under the same terms as Perl itself. emboss-explorer//bin/acdcheck0100700000175000001440000000225710330233620015527 0ustar lukemusers#!/usr/bin/perl use strict; use warnings; use EMBOSS::ACD; use Getopt::Long; use Pod::Usage; use Data::Dumper; use XML::Simple; my $output = ""; GetOptions( "output=s" => \$output ) or pod2usage(); @ARGV or pod2usage(); for (@ARGV) { eval { my $acd = EMBOSS::ACD->new($_); if ($output =~ /xml/i) { print XMLout($acd->{tree}, RootName => 'acd'); } elsif ($output =~ /perl/i) { print Data::Dumper->Dump([$acd->{tree}], ["acd"]); } }; warn $@ if $@; } =head1 NAME acdcheck =head1 AUTHOR Luke McCarthy =head1 SYNOPSIS acdcheck [ --output FORMAT ] FILE [ FILE ... ] =head1 DESCRIPTION Reads one or more named input FILEs and attempts to parse them as if they were EMBOSS ACD (AJAX Command Definition) files. =head1 OPTIONS =over4 =item --output FORMAT Upon successful parsing of each ACD file, print a representation of the parse tree to standard output in the specified format. FORMAT must be one of either 'XML' or 'Perl' (case-insensitive and without the quotes.) =head1 COPYRIGHT Copyright (c) 2004 Luke McCarthy. All rights reserved. This program is free software. You may copy or redistribute it under the same terms as Perl itself. emboss-explorer//cgi/emboss0100755000175000001440000000015610330233620015272 0ustar lukemusers#!/usr/bin/perl use strict; use warnings; use EMBOSS::GUI; my $emboss = EMBOSS::GUI->new(); $emboss->go(); emboss-explorer//Makefile.PL0100600000175000001440000000051210330233617015256 0ustar lukemusersuse 5.6.0; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'EMBOSS::GUI', VERSION_FROM => 'lib/EMBOSS/GUI.pm', PREREQ_PM => { Parse::RecDescent => 1.90, Mail::Send => 0 }, PREREQ_FATAL => 1, ABSTRACT_FROM => 'lib/EMBOSS/GUI.pm', AUTHOR => 'Luke McCarthy ' ); emboss-explorer//README0100600000175000001440000000130210330233617014162 0ustar lukemusersEmboss explorer ================ EMBOSS explorer is a web-based graphical user interface to the EMBOSS suite of bioinformatics tools. It is exceedingly simple to install, configure, maintain and use. INSTALLATION To install this module, execute the install script in the top-level directory of the distribution. ./install DEPENDENCIES The EMBOSS::ACD module requires the following CPAN modules: Parse::RecDescent Mail::Send COPYRIGHT AND LICENCE Copyright (C) 2004 by Luke McCarthy Emboss Explorer is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.3 or, at your option, any later version of Perl 5 you may have available. emboss-explorer//html/style/emboss.css0100644000175000001440000001023410330233621017417 0ustar lukemusersbody { /* top-level container */ padding-right: 16px; /* accomodate Internet Explorer scrollbar */ } html>body { /* top-level container, hidden from IE */ padding-right: 0px; /* reverse the action taken above */ } h1 { /* EMBOSS explorer title */ margin-bottom: 0px; font-family: "Tahoma", sans-serif; font-weight: normal; font-size: 75%; /* 50% is too small in IE */ padding-bottom: 1px; border-bottom: 1px solid black; } html>h1 { /* EMBOSS explorer title, hidden from IE */ font-size: 50%; /* 75% is too big elsewhere */ } .error { color: red; } #menu span.sort { /* link to toggle sort style */ display: block; white-space: nowrap; /* padding: .25em; background: #ddf; */ text-align: center; font-size: 85%; } #menu ul { /* all menu lists */ list-style: none; margin-left: 0px; padding-left: 0px; } #menu #groups { /* top-level list with grouped applications */ margin-top: 1em; margin-bottom: 1em; } #menu #apps { /* top-level list with ungrouped applications */ margin-top: 1em; margin-bottom: 1em; padding-right: .5em; padding-top: .25em; padding-bottom: .25em; border-right: 2px solid #ddf; text-align: right; } #menu li.group { /* surrounding box for each group (title and list) */ margin-top: 1em; padding-right: .5em; border-right: 2px solid #ddf; text-align: right; } #menu span.group { /* surrounding box for each group title */ text-align: right; font-family: "Tahoma", sans-serif; font-weight: bold; } #menu ul.group { /* surrounding box for each group list */ } #menu a { /* link to individual application */ } #input h2 { /* application title */ margin-bottom: 0px; font-family: "Tahoma", sans-serif; font-weight: bold; font-size: 200%; } #input p.documentation { /* application description */ margin-top: 0px; padding-bottom: .25em; border-bottom: 1px solid black; font-family: serif; font-weight: normal; font-size: 100%; } #input #legend { /* required/optional legend */ } #input form { /* input form */ margin-top: 2em; } #input fieldset { /* surrounding box for each section */ /* border-top: 1px dotted gray; border-bottom: none; border-left: none; border-right: none; */ } #input legend { /* section title text */ color: gray; } #input div { /* all input fields */ margin-top: 1.5em; } #input div.required { /* required input fields */ padding: .25em; background: #ddf; } #input div.additional { /* non-required input fields */ } #input #submit { /* surrounding box for submit button */ text-align: center; } #input p { /* input field group text */ margin-top: 0px; margin-bottom: 0px; } #input ol { /* input field group list */ margin-top: 0px; margin-bottom: 0px; } #input span.label { /* input field label text */ } #input span.field { /* input field itself */ } #input span.description { /* input field description */ font-style: italic; display: block; margin-left: 1em; } #input #email span.description { display: block; } #horizon { /* horizon div for vertical centering */ position: absolute; top: 50%; left: 0px; width: 100%; height: 1px; overflow: visible; text-align: center; } #running { /* EMBOSS is running div */ position: absolute; top: -25px; left: 50%; width: 450px; height: 45px; margin-left: -225px; text-align: center; } #running img { /* EMBOSS is running image */ display: block; margin: auto; text-align: center; } #running p { /* EMBOSS is running text */ margin-top: 1em; text-align: center; } #output span.item { display: block; margin-top: 1em; padding-top: 2px; padding-left: .5em; padding-bottom: 2px; border-left: 2px solid #ddf; } #output dt { } #output dt span.type { font-family: "Tahoma", sans-serif; font-weight: bold; text-transform: uppercase; } #output dd { margin-left: 1em; } #output .error { color: red; } #output dt.inline { /* inline output file label */ } #output dd.inline { /* inline output file contents */ } #output dt.outfile { /* output file label */ } #output dd.outfile { /* output file contents */ } #output dt.image { /* output image label */ } #output dd.image { /* output image */ margin-top: 1em; } #output img { border: 2px solid #def; } #output pre { /* inline output */ font-size: 110%; } html>#output pre { /* inline output, hidden from IE */ font-size: 100%; } emboss-explorer//html/style/classic.css0100644000175000001440000001054110330233620017550 0ustar lukemusersbody { /* top-level container */ background: #c0c0c0; font-family: Helvetica, Arial, sans-serif; font-size: 10pt; padding-right: 16px; /* accomodate Internet Explorer scrollbar */ } html>body { /* top-level container, hidden from IE */ padding-right: 0px; /* reverse the action taken above */ } a { text-decoration: none; font-weight: bold; } a:link { color: #36c } a:active { color: #300 } a:visited { color: #36c } h1 { margin-bottom: 0px; font-family: "Helvetica", "Arial", sans-serif; font-weight: bold; font-size: 50%; padding-bottom: 1px; border-bottom: 1px solid black; } .error { color: red; } #menu span.sort { /* link to toggle sort style */ display: block; white-space: nowrap; /* padding: .25em; background: #ddf; */ text-align: center; font-size: 85%; } #menu ul { /* all menu lists */ list-style: none; margin-left: 0px; padding-left: 0px; } #menu #groups { /* top-level list with grouped applications */ margin-top: 1em; margin-bottom: 1em; } #menu #apps { /* top-level list with ungrouped applications */ margin-top: 1em; margin-bottom: 1em; padding-right: .5em; padding-top: .25em; padding-bottom: .25em; border-right: 2px solid #ddf; text-align: right; } #menu li.group { /* surrounding box for each group (title and list) */ border: 2px solid black; text-align: left; } #menu span.group { /* surrounding box for each group title */ display: block; padding: 4px 6px 6px 6px; background: black; color: white; text-align: center; font-family: "Tahoma", sans-serif; font-weight: bold; } #menu ul.group { /* surrounding box for each group list */ background: #ccc; padding: 2px; } #menu a { /* link to individual application */ } #input h2 { /* application title */ margin-bottom: 0px; font-family: "Tahoma", sans-serif; font-weight: bold; font-size: 200%; } #input p.documentation { /* application description */ margin-top: 0px; padding-bottom: .25em; border-bottom: 1px solid black; font-family: serif; font-style: italic; font-weight: normal; font-size: 100%; } #input #legend { /* required/optional legend */ margin-top: .5em; } #input form { /* input form */ margin-top: 2em; } #input fieldset { /* surrounding box for each section */ margin-top: 1em; border: 2px solid black; background: #ccc; padding: 0px; } #input legend { /* section title text */ } #input div { /* all input fields */ } #input div.required { /* required input fields */ padding: .25em; } #input div.additional { /* non-required input fields */ padding: .25em; background: #abc; } #input #submit { /* surrounding box for submit button */ text-align: center; } #input #email span.description { display: block; } #input p { /* input field group text */ margin-top: .5em; margin-bottom: .5em; } #input ol { /* input field group list */ margin-top: .5em; margin-bottom: .5em; } #input ol li { /* input field group item */ margin-top: 1em; margin-bottom: 1em; } #input span.label { /* input field label text */ } #input span.field { /* input field itself */ } #input span.description { /* input field description */ font-style: italic; } #input ol.sequence span.field { display: block; margin: .5em; } #horizon { /* horizon div for vertical centering */ position: absolute; top: 50%; left: 0px; width: 100%; height: 1px; overflow: visible; text-align: center; } #running { /* EMBOSS is running div */ position: absolute; top: -25px; left: 50%; width: 450px; height: 60px; margin-left: -225px; text-align: center; border: 2px solid black; background: white; padding: 5px; } #running img { /* EMBOSS is running image */ display: block; margin: auto; text-align: center; } #running p { /* EMBOSS is running text */ margin-top: 1em; text-align: center; } #output span.item { display: block; margin-top: 1em; border: 2px solid black; background: #ccc; } #output dt { padding: 2px; background: black; color: white; font-weight: bold; } #output dt span.type { text-transform: uppercase; } #output dd { margin-left: 0px; padding: .5em; } #output dt.inline { /* inline output file label */ } #output dt.inline { /* inline output file contents */ } #output dt.outfile { /* output file label */ } #output dd.outfile { /* output file contents */ } #output dt.image { /* output image label */ } #output dd.image { /* output image */ } #output pre { /* inline output */ font-size: 110%; } html>#output pre { /* inline output, hidden from IE */ font-size: 100%; } emboss-explorer//html/style/cbr.css0100644000175000001440000001070010330233620016672 0ustar lukemusersbody { /* top-level container */ padding-right: 16px; /* accomodate Internet Explorer scrollbar */ font-family: "Verdana", sans-serif; font-size: small; } html>body { /* top-level container, hidden from IE */ padding-right: 0px; /* reverse the action taken above */ } h1 { /* EMBOSS explorer title */ margin-bottom: 0px; padding: .25em; background: #039; color: white; font-family: "Verdana", sans-serif; font-weight: bold; font-size: 75%; } html>h1 { /* EMBOSS explorer title, hidden from IE */ font-size: 50%; } .error { color: red; } #menu span.sort { /* link to toggle sort style */ display: block; white-space: nowrap; padding: .25em; background: #039; color: white; text-align: center; font-family: sans-serif; font-size: 85%; } #menu span.sort a { color: white; font-weight: bold; } #menu ul { /* all menu lists */ list-style: none; margin-left: 0px; padding-left: 0px; } #menu #groups { /* top-level list with grouped applications */ margin-top: 1em; margin-bottom: 1em; } #menu #apps { /* top-level list with ungrouped applications */ margin-top: 1em; margin-bottom: 1em; padding: 3px 6px 3px 6px; background: #cc3 url(../images/cbr-corner-ne.gif) no-repeat top right; text-align: right; } #menu li.group { /* surrounding box for each group (title and list) */ margin-top: 1em; padding: 3px 6px 0px 0px; text-align: right; background: #cc3 url(../images/cbr-corner-ne.gif) no-repeat top right; } #menu span.group { /* surrounding box for each group title */ text-align: right; font-family: "Verdana", sans-serif; font-weight: bold; color: #039; } #menu ul.group { /* surrounding box for each group list */ padding: 0px 0px 3px 6px; background: #cc3 url(../images/cbr-corner-sw.gif) no-repeat bottom left; } #menu a { /* link to individual application */ color: black; text-decoration: none; } #menu a:hover { color: #039; text-decoration: underline; } #input h2 { /* application title */ margin-bottom: 0px; font-family: "Verdana", sans-serif; font-weight: bold; font-size: 200%; } #input p.documentation { /* application description */ margin-top: 0px; padding-bottom: .25em; border-bottom: 1px solid black; font-family: serif; font-weight: normal; font-size: 100%; } #input #legend { /* required/optional legend */ } #input form { /* input form */ margin-top: 2em; } #input fieldset { /* surrounding box for each section */ /* border-top: 1px dotted gray; border-bottom: none; border-left: none; border-right: none; */ } #input legend { /* section title text */ color: gray; } #input div { /* all input fields */ margin-top: 1.5em; } #input div.required { /* required input fields */ padding: .25em; background: #cc3; } #input div.additional { /* non-required input fields */ } #input #submit { /* surrounding box for submit button */ text-align: center; } #input p { /* input field group text */ margin-top: 0px; margin-bottom: 0px; } #input ol { /* input field group list */ margin-top: 0px; margin-bottom: 0px; } #input span.label { /* input field label text */ } #input span.field { /* input field itself */ } #input span.description { /* input field description */ font-style: italic; display: block; margin-left: 1em; } #input #email span.description { display: block; } #horizon { /* horizon div for vertical centering */ position: absolute; top: 50%; left: 0px; width: 100%; height: 1px; overflow: visible; text-align: center; } #running { /* EMBOSS is running div */ position: absolute; top: -25px; left: 50%; width: 450px; height: 45px; margin-left: -225px; text-align: center; } #running img { /* EMBOSS is running image */ display: block; margin: auto; text-align: center; } #running p { /* EMBOSS is running text */ margin-top: 1em; text-align: center; } #output span.item { display: block; margin-top: 1em; padding: 0px 0px 3px 6px; background: #cc3 url(../images/cbr-corner-sw.gif) no-repeat bottom left; } #output dt { padding: 3px 6px 0px 0px; background: #cc3 url(../images/cbr-corner-ne.gif) no-repeat top right; color: #039; } #output dt span.type { font-weight: bold; text-transform: uppercase; } #output dd { } #output dt.error { } #output dt.outfile { /* output file label */ } #output dd.outfile { /* output file contents */ } #output dt.image { /* output image label */ } #output dd.image { /* output image */ margin-top: 1em; } #output img { border: 2px solid #039; } #output pre { /* inline output */ font-size: 110%; } html>#output pre { /* inline output, hidden from IE */ font-size: 100%; } emboss-explorer//html/images/running.gif0100644000175000001440000002147410202505737017711 0ustar lukemusersGIF89ah! NETSCAPE2.0! ,h@`@ :'`0G$"*%hHùHx8~BDFHJLNPRTVXZ\^`bdfhjlnprtvx|EGIKMOQSUWY[]_acegik moqsuwݷŠȢ˥ѩ֭໖}:l3g*Ç#BW&`y2Jfē(SDQ?rT`w$\ɳO-],pc@PϧP j@Px KVq2`J+KAg_ʖ[ps:K0CM`wL*bjejsWC^y9mLZkWѰc+ hֶIlVh]Y5`ւ{_pŚS t=όcϭgO^ӷ~uݷq%ߏ=! ?,Z@pH,  P, L(hE\L$`, P HCJLNPRTVXZ\^`bdfhjlnprtvxz|~FMOQSUWY[]_acegikmoqsuwy{}ƆKãǨĤݥߪxmIb%9~\';*Dtٸ}SWli$do8}К[ye|mCȳŽ/BI͓Ju6EǘC%sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,Z@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,Z@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,Z@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,Z@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,xZ@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,ZZ@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,<Z@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn! ?,Z@  P, L(hE[L$`, P BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|EGIKMOQSUWY[]_acegikmoqsuwy{¡݃CȨ*kO'n>sx)Prw%\|C- Fe0; 4v 6ϧ(BYɜt C3NYQiʌ=Q&Q$)&Ec.E}ђ8-.Un 8&ғ:14mTʅpڻZ 7,\WLp!_2 ,]vkfn;emboss-explorer//html/images/cbr-corner-ne.gif0100644000175000001440000000017310202752275020657 0ustar lukemusersGIF89a 6Gi34v>! , (1HmJmʒ〡)Asþ >C ;emboss-explorer//html/images/cbr-corner-sw.gif0100644000175000001440000000017310202752253020702 0ustar lukemusersGIF89a 63Gi4v>! , (Ik6l M2GDZǵZt "@;emboss-explorer//html/index.html0100644000175000001440000000061110202465516016260 0ustar lukemusers EMBOSS Explorer emboss-explorer//lib/EMBOSS/GUI/XHTML.pm0100600000175000001440000010705410525743457016747 0ustar lukemusers=head1 NAME EMBOSS::GUI::XHTML - generate HTML for EMBOSS::GUI =head1 AUTHOR Luke McCarthy =head1 SYNOPSIS Not for public consumption. Use EMBOSS::GUI instead. =head1 DESCRIPTION EMBOSS::GUI::XHTML generates the HTML required by EMBOSS::GUI. The appearance of EMBOSS::GUI can be customized by editing or replacing the default style sheet. There is very little that cannot be accomplished in this way. If new HTML is absolutely required, simply create a new module that provides the methods described below and specify the new module in the EMBOSS::GUI constructor. Public methods are described below: =over 4 =cut package EMBOSS::GUI::XHTML; use strict; use warnings; use Carp; use CGI; use File::Basename; our $VERSION = 1.10; =item new(%args) Returns a new EMBOSS::GUI::XHTML object. %args is a hash of optional named arguments. The following arguments are %recognized: =over 4 =item static => $boolean If $boolean is true, the generated HTML will assume that, where possible, the pages of the interface have been generated statically and will be linked appropriately. See also the mkstatic script in the EMBOSS::GUI distribution. =item frames => $boolean If $boolean is true, the generated HTML will assume that the main menu is in its own frame and doesn't have to be added to each page. =item script_url => $url Specifies the URL of the main EMBOSS::GUI CGI script. This parameter is required if static pages are generated, otherwise the URL will be determined from the CGI environment. =item style_url => $url Specifies the URL of the style sheet to use. =item image_url => $url Specifies a URL prefix to place before image links. =item manual_url => $url Specifies a URL prefix to place before manual links. This prefix is only used if static pages are generated. =back =cut sub new { my $invocant = shift; my $class = ref $invocant || $invocant; my %args = @_; my $self = { }; bless $self, $class; # if the HTML pages are to be dumped en masse and used statically, the # user must define a URL for the controlling CGI script; if the HTML pages # are to be generated dynamically, the user _may_ define a URL for the # controlling CGI script, or we will try to determine it from the # environment... # if ($args{static}) { $self->{static} = 1; $self->{script_url} = $args{script_url} or croak "created in static mode with no script URL defined"; } else { $self->{script_url} = $args{script_url} || $ENV{SCRIPT_NAME} or die "failed to determine script URL"; } # normalize other arguments... # $self->{frames} = defined $args{frames} ? $args{frames} : 1; $self->{style_url} = $args{style_url} || ""; $self->{image_url} = $args{image_url} || ""; $self->{manual_url} = $args{manual_url} || ""; return $self; } =item intro_page() Generates an introductory page describing EMBOSS and the GUI. =cut sub intro_page { my ($self) = @_; return $self->_header_html("EMBOSS") . $self->_banner_html . $self->_intro_html . $self->_footer_html; } =item menu_page(@entries) Generates the main menu page. @entries is either a list of applications as returned by EMBOSS::GUI::apps(), or a list of groups as returned by EMBOSS::GUI::groups(). =cut sub menu_page { my ($self, @entries) = @_; return $self->_header_html("EMBOSS: application menu") . $self->_menu_html(@entries) . $self->_footer_html; } =item input_page($acd, $hide_optional) Generates the application-specific input page. $acd is an EMBOSS::ACD object that describes the application. $hide_optional is a boolean value that determines whether optional parameters (also called additional parameters in the EMBOSS documenation) will appear in the input page. =cut sub input_page { my ($self, $acd, $hide_optional) = @_; return $self->_header_html("EMBOSS: " . $acd->name) . $self->_banner_html . $self->_input_html($acd, $hide_optional) . $self->_footer_html; } =item input_page($output_dir) Generates an output page based on the contents of the specified directory. $output_dir is a directory containing the output of an EMBOSS application. =cut sub output_page { my ($self, $output_dir) = @_; return $self->_header_html("EMBOSS: output") . $self->_banner_html . $self->_output_html($output_dir) . $self->_footer_html; } sub help_page { my ($self, $app) = @_; my $title = defined $app ? "EMBOSS: $app help" : "EMBOSS: help"; return $self->_header_html($title) . $self->_banner_html . $self->_help_html($app) . $self->_footer_html; } =item manual_page($app, $manual) Generates the application-specific manual page. $app is the name of the application. $manual_html is the full text of the HTML application manual. =cut sub manual_page { my ($self, $app, $manual_html) = @_; return $self->_header_html("EMBOSS: $app manual") . $self->_manual_html($manual_html) . $self->_footer_html; } =item default_output_page($refresh_delay) Generates the default output page to be used as a placeholder until the application has finished running and the actual output is available. $refresh_delay is the number of seconds to wait between page reloads. =cut sub default_output_page { my ($self, $delay) = @_; my $date = localtime; $date =~ s/ / /g; my $html = < EMBOSS: running...
EMBOSS is running

EMBOSS has been running since $date.

EOF $html .= <{frames};

This page will refresh every few seconds until the application has finished and your output is displayed. If you are impatient, you can manually refresh the page by clicking the Reload button in your browser.

EOF $html .= <
EOF return $html; } =item error_page(@error) Generates an error page. @error is the text of the error message. All elements of the list are joined into a single string, so this method has the same syntax as print, warn, die, etc. =cut sub error_page { my ($self, @error) = @_; return $self->_header_html("EMBOSS: error") . $self->_banner_html . $self->_error_html(@error) . $self->_footer_html; } =item frameset_page() Generates a page that sets up the menu and main content frames. =cut sub frameset_page { my ($self) = @_; my $menu_url = $self->{static} ? "groupmenu.html" : join('/', $self->{script_url}, 'menu'); my $main_url = $self->{static} ? "intro.html" : join('/', $self->{script_url}, 'intro'); return < EMBOSS explorer EOF } # # # # # # # # # # # # # # # PRIVATE METHODS # # # # # # # # # # # # # # # sub _menu_html { my ($self, @entries) = @_; my $html = < EOF if (@{$entries[0]} > 2) { # entries are groups... my $menu_url = $self->{static} ? "alphamenu.html" : "$self->{script_url}/menu?sort=alpha"; $html .= <[ sort alphabetically ]
    EOF foreach my $group (@entries) { my $group_name = CGI::escapeHTML(shift @$group); $html .= <$group_name
      EOF foreach my $app (@$group) { $html .= $self->_app_menu_item_html($app); } $html .= < EOF } $html .= < [ sort alphabetically ] EOF } else { # entries are individual applications... my $menu_url = $self->{static} ? "groupmenu.html" : "$self->{script_url}/menu"; $html .= <[ sort by group ]
        EOF foreach my $app (@entries) { $html .= $self->_app_menu_item_html($app); } $html .= < [ sort by group ] EOF } $html .= < EOF return $html; } sub _input_html { my ($self, $acd, $hide_optional) = @_; my $app = $acd->name; my $app_html = CGI::escapeHTML($app); my $app_url = CGI::escape($app); my $doc_html = CGI::escapeHTML($acd->documentation); my $url = join "/", $self->{script_url}, $app_url; my $manual_url = $self->{static} ? "$self->{manual_url}/$app_url.html" : "$self->{script_url}/help/$app_url"; my $html = <

        $app_html

        $doc_html (read the manual)

        EOF unless ($self->{static}) { $html .= $hide_optional ? <

        Only required fields are visible. (show optional fields)

EOF : <

Unshaded fields are optional and can safely be ignored. (hide optional fields)

EOF } $html .= < EOF # application specific parameter munging to pretty it all up a bit... # # step through the application parameters and create the input fields... # foreach my $param ($acd->param) { next if $param->{_ignore}; # skip optional parameters if the user has chosen to hide them... # my $required = 0; if (defined $param->{parameter} && $param->{parameter} =~ /^y/i) { $required = 1; } elsif (defined $param->{standard} && $param->{standard} =~ /^y/i) { $required = 1; } if (defined $param->{needed} && $param->{needed} =~ /^n/i) { $required = 0; } next if (!$required && $hide_optional) and $param->{datatype} !~ /^(end)?section$/; # for now always display sections; TODO the ACD parser should # handle these better so we can look ahead to tell if a section # is empty or not... $param->{_class} = $required ? 'required' : 'additional'; # using EMBOSS parlance here... $param->{_hide_optional} = $hide_optional; # call the method corresponding to the parameter's datatype, appending # an error message if no such method exists... # my $param_html = eval "\$self->_acd_$param->{datatype}(\$param)"; if (defined $param_html) { $html .= $param_html; } else { carp "unknown datatype $param->{datatype} in $app"; $html .= $self->_error_html("unknown datatype $param->{datatype}"); } } $html .= < Run section
Email address: If you are submitting a long job and would like to be informed by email when it finishes, enter your email address here.
EOF return $html; } sub _output_html { my ($self, $output_dir) = @_; my $html = <
EOF # deal with any errors first... # my $error_file = "$output_dir/.stderr"; if (-s $error_file) { # TODO clean up error messages and output $html .= $self->_output_error_html($error_file) or return $self->_error_html("failed to read $error_file: $!"); } # deal with console output next... # my $output_file = "$output_dir/.stdout"; if (-s $output_file) { $html .= $self->_output_file_inline_html($output_file) or return $self->_error_html("failed to read $output_file: $!"); } # deal with remaining output files in order... # opendir DIR, $output_dir or return $self->_error_html("failed to open $output_dir: $!"); foreach my $file (readdir DIR) { next if $file =~ /^\./; # skip dot files... next if $file eq "index.html"; # skip our index file... my $output_file = "$output_dir/$file"; next if -z $output_file; # skip empty files... if ($output_file =~ /\.png$/) { $html .= $self->_output_image_html($output_file); } elsif ($output_file =~ /\.ps$/) { $html .= $self->_output_file_link_html($output_file); } else { $html .= $self->_output_file_inline_html($output_file); } } closedir DIR; $html .= < EOF return $html; } sub _help_html { my ($self, $app) = @_; my $html = <_read_from_file($manual) # or return $self->_error_html("failed to read $manual: $!"); # we've already got a document going, so delete the body tags and # anything outside them... # $manual_html =~ s/.*?//is; $manual_html =~ s/<\/body>.*?//is; # update the images in the manual... # $manual_html =~ s/src="file:\/\/.*?(emboss_icon\.jpg)"/src="$self->{manual_url}\/$1"/; $manual_html =~ s/src="file:\/\/.*?([^\/]*\.gif)"/src="$self->{manual_url}\/$1"/g; # if the pages are not being generated statically, we need to remove # the .html extension from the relative links within the manual... # if (not $self->{static}) { $manual_html =~ s/index\.html/$self->{script_url}\/help/g; $manual_html =~ s///g; } my $html = < $manual_html EOF return $html; } sub _intro_html { my ($self) = @_; my $html = <

Welcome to EMBOSS explorer, a graphical user interface to the EMBOSS suite of bioinformatics tools.

To continue, select an application from the menu to the left. Move the mouse pointer over the name of an application in the menu to display a short description. To search for a particular application, use wossname.

For more information about EMBOSS explorer, including how to download and install it locally, visit the EMBOSS explorer website.

Development of EMBOSS explorer has been supported by the National Research Council of Canada and Genome Prairie.

EOF return $html; } sub _default_output_html { my ($self) = @_; my $date = localtime; $date =~ s/ / /g; my $html = <
EMBOSS is running

EMBOSS has been running since $date.

EOF $html .= <{frames};

This page will refresh every few seconds until the application has finished and your output is displayed. If you are impatient, you can manually refresh the page by clicking the Reload button in your browser.

EOF $html .= <
EOF return $html; } sub _error_html { my ($self, @error) = @_; my $error_html = CGI::escapeHTML(join '', @error); my $html = <

$error_html

EOF return $html; } sub _header_html { my ($self, $title, @meta) = @_; # frames or no, we have to open the HTML... # my $title_html = CGI::escapeHTML($title); my $meta_html = join "\n", @meta; my $html = < $title_html $meta_html EOF return $html; } sub _banner_html { my ($self) = @_; my $html = <EMBOSS explorer EOF return $html; } sub _footer_html { my ($self) = @_; # frames or no, we have to close the HTML... # my $html = < EOF return $html; } sub _app_menu_item_html { my ($self, $aref) = @_; my ($app, $doc) = @$aref; my $app_html = CGI::escapeHTML($app); my $app_url = CGI::escape($app); my $doc_html = CGI::escapeHTML($doc); my $url = $self->{static} ? "$app_url.html" : join("/", $self->{script_url}, $app_url); my $target = $self->{frames} ? " target='main'" : ""; return "
  • $app
    • \n"; } sub _output_error_html { my ($self, $file) = @_; my $basename = basename $file; my $file_html = CGI::escapeHTML($basename); my $file_url = CGI::escape($basename); my $content = $self->_read_from_file($file) or return undef; my $content_html = CGI::escapeHTML($content); return <
    Error   application terminated
    $content_html
    EOF } sub _output_file_inline_html { my ($self, $file) = @_; my $basename = basename $file; my $file_html = CGI::escapeHTML($basename); my $file_url = CGI::escape($basename); my $content = $self->_read_from_file($file) or return undef; my $content_html = CGI::escapeHTML($content); return <
    Output file   $file_html
    $content_html
    EOF } sub _output_file_link_html { my ($self, $file) = @_; my $basename = basename $file; my $file_html = CGI::escapeHTML($basename); my $file_url = CGI::escape($basename); return <
    Output file   $file_html
    click to view
    EOF } sub _output_image_html { my ($self, $file) = @_; my $basename = basename $file; my $file_html = CGI::escapeHTML($basename); my $file_url = CGI::escape($basename); return <
    Image file   $file_html
    EOF } sub _read_from_file { my ($self, $file) = @_; open FILE, '<', $file or return undef; my $content = join '', ; close FILE; return $content; } sub _get_info { my ($self, $param) = @_; return CGI::escapeHTML($param->{information} || ""); } sub _get_default { my ($self, $param) = @_; my $default = $param->{default} || ""; if ($default =~ /\$/) { $default = ""; } my $expect = $param->{expected} || ""; if (length $expect) { if ($expect =~ /^if/i) { $expect = "($expect)"; } else { $expect = "(default is $expect)"; } } my $default_html = CGI::escapeHTML($default); my $expect_html = CGI::escapeHTML($expect); return ($default_html, $expect_html); } # # # # # # # # # # # # # # # DATATYPE METHODS # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # SIMPLE TYPES # # # # # # # # # # # # # # # # sub _acd_array { &_text_field_html; } sub _acd_boolean { my ($self, $param) = @_; $param->{information} .= "?" unless $param->{information} =~ /\?$/; $param->{_options} = [ [ Yes => 1 ], [ No => 0 ] ]; if (defined $param->{default} && $param->{default} =~ /^y/i) { $param->{default} = 1; } else { $param->{default} = 0; } $param->{maximum} = 1; $self->_selection_list_html($param); } sub _acd_float { &_text_field_html; } sub _acd_integer { &_text_field_html; } sub _acd_range { &_text_field_html; } sub _acd_string { &_text_field_html; } sub _acd_toggle { &_acd_boolean; } # # # # # # # # # # # # # # # # INPUT TYPES # # # # # # # # # # # # # # # # sub _acd_codon { my ($self, $param) = @_; $param->{information} = "Codon usage table"; $param->{default} = "Ehum.cut"; $self->_acd_datafile($param); } sub _acd_cpdb { &_acd_infile; } sub _acd_datafile { my ($self, $param) = @_; my $info = $self->_get_info($param); if (length $info) { $info .= "." unless $info =~ /\.$/; } else { $info = "Select a data file."; } my ($default, $expect) = $self->_get_default($param); my $html = <

    $info Use one of the following two fields:

    1. To access a standard EMBOSS data file, enter the name here: $expect
    2. To upload a data file from your local computer, select it here:
    EOF return $html } sub _acd_directory { my ($self, $param) = @_; return $self->_error_html("inappropriate datatype $param->{datatype}"); } sub _acd_dirlist { my ($self, $param) = @_; return $self->_error_html("inappropriate datatype $param->{datatype}"); } sub _acd_discretestates { &_acd_infile; } sub _acd_distances { &_acd_infile; } sub _acd_features { &_acd_infile; } sub _acd_filelist { &_acd_infile; # TODO how to upload multiple files on a web form? perhaps by # allowing a compressed file to be uploaded, then exploding it and # building the command line accordingly... } sub _acd_frequencies { &_acd_infile; } sub _acd_infile { my ($self, $param) = @_; my $info = $self->_get_info($param); if (length $info) { $info =~ s/\.$//; } else { warn "no information for $param->{name}"; $info = "Select an input file:"; } my ($default, $expect) = $self->_get_default($param); my $html = < $info: EOF return $html } sub _acd_matrix { my ($self, $param) = @_; $param->{expected} = "EBLOSUM62 for protein, EDNAFULL for nucleic"; $self->_acd_datafile($param); } sub _acd_matrixf { &_acd_matrix; } sub _acd_pattern { &_text_field_html; } sub _acd_properties { &_acd_infile; } sub _acd_regexp { &_text_field_html; } sub _acd_scop { &_acd_infile; } sub _acd_sequence { my ($self, $param) = @_; my $info = $self->_get_info($param); if (length $info) { $info .= "." unless $info =~ /\.$/; } else { $info = "Select an input sequence."; } my $html = <

    $info Use one of the following three fields:

    1. To access a sequence from a database, enter the USA here:
    2. To upload a sequence from your local computer, select it here:
    3. To enter the sequence data manually, type here:
    EOF return $html } sub _acd_seqall { &_acd_sequence; } sub _acd_seqset { &_acd_sequence; } sub _acd_seqsetall { &_acd_sequence; } sub _acd_tree { &_acd_infile; } # # # # # # # # # # # # # # SELECTION LIST TYPES # # # # # # # # # # # # # # sub _acd_list { my ($self, $param) = @_; my @options; my $delimiter = sprintf '\s*%s\s*', $param->{delimiter} || ";"; my $codedelimiter = $param->{codedelimiter} || ":"; foreach my $option (split /$delimiter/, $param->{values}) { my ($value, $name) = split /$codedelimiter/, $option; push @options, [ $name => $value ]; } $param->{_options} = \@options; $param->{maximum} = 1 unless defined $param->{maximum}; $self->_selection_list_html($param); } sub _acd_selection { my ($self, $param) = @_; my @options; my $delimiter = sprintf '\s*%s\s*', $param->{delimiter} || ";"; my $index = 0; foreach my $option (split /$delimiter/, $param->{values}) { my $value = ++$index; push @options, [ $option => $value ]; } $param->{_options} = \@options; $param->{maximum} = 1 unless defined $param->{maximum}; $self->_selection_list_html($param); } # # # # # # # # # # # # # # # # OUTPUT TYPES # # # # # # # # # # # # # # # # sub _acd_align { my ($self, $param) = @_; my $html = < EOF return $html if $param->{_hide_optional}; $param->{_class} = "additional"; $param->{name} = "aformat"; $param->{information} = "Output alignment format"; $param->{_options} = [ [ "EMBOSS multiple" => "simple" ], [ "FASTA multiple" => "fasta" ], [ "MSF multiple" => "msf" ], [ "SRS multiple" => "srs" ], [ "EMBOSS pairwise" => "pair" ], [ "FASTA pairwise" => "markx0" ], [ "FASTA pairwise marking differences" => "markx1" ], [ "FASTA pairwise differences only" => "markx2" ], [ "FASTA pairwise simple" => "markx3" ], [ "FASTA pairwise simple with comments" => "markx10" ], [ "SRS pairwise" => "srspair" ], [ "Pairwise scores only" => "score" ] ]; $param->{default} = $param->{aformat}; $param->{maximum} = 1; $html .= $self->_selection_list_html($param); return $html; } sub _acd_featout { my ($self, $param) = @_; my $html = < EOF return $html if $param->{_hide_optional}; $param->{_class} = "additional"; $param->{name} = "offormat"; $param->{information} = "Output feature format"; $param->{_options} = [ [ "EMBL" => "embl" ], [ "GFF" => "gff" ], [ "SwissProt" => "swiss" ], [ "PIR" => "pir" ] ]; $param->{default} = $param->{offormat}; $param->{maximum} = 1; $html .= $self->_selection_list_html($param); my $ofsingle = { _class => 'additional', name => 'ofsingle', information => 'Separate files for each entry?' }; $html .= $self->_acd_boolean($ofsingle); return $html; } sub _acd_outfile { my ($self, $param) = @_; # TODO allow the user to specify an output file name? but why? my $outfile = $param->{default} || $param->{name}; my $html = < EOF return $html; } sub _acd_outdir { &_skip_html; } sub _acd_report { my ($self, $param) = @_; my $html = < EOF return $html if $param->{_hide_optional}; $param->{_class} = "additional"; $param->{name} = "rformat"; $param->{information} = "Output report format"; $param->{_options} = [ [ "EMBL" => "embl" ], [ "Genbank" => "genbank" ], [ "GFF" => "gff" ], [ "PIR" => "pir" ], [ "SwissProt" => "swiss" ], [ "EMBOSS list file" => "listfile" ], [ "DbMotif" => "dbmotif" ], [ "EMBOSS diffseq" => "diffseq" ], [ "tab-delimited text" => "excel" ], [ "EMBOSS FeatTable" => "feattable" ], [ "EMBOSS Motif" => "motif" ], [ "EMBOSS Regions" => "regions" ], [ "EMBOSS SeqTable" => "seqtable" ], [ "SRS simple" => "simple" ], [ "SRS" => "srs" ], [ "EMBOSS Table" => "table" ], [ "EMBOSS tagseq" => "tagseq" ] ]; $param->{default} = $param->{rformat}; $param->{maximum} = 1; $html .= $self->_selection_list_html($param); return $html; } sub _acd_seqout { my ($self, $param) = @_; if ($param->{_hide_optional}) { my $html = < EOF return $html; } $param->{_class} = "additional"; $param->{information} = "Output sequence format"; $param->{_options} = [ [ "ACeDB" => "acedb::$param->{name}" ], [ "ASN.1" => "asn1::$param->{name}" ], [ "Clustal .aln" => "clustal::$param->{name}" ], [ "CODATA" => "codata::$param->{name}" ], [ "EMBL" => "embl::$param->{name}" ], [ "Pearson FASTA" => "fasta::$param->{name}" ], [ "Fitch" => "fitch::$param->{name}" ], [ "GCG 9.x/10.x" => "gcg::$param->{name}" ], [ "GCG 8.x" => "gcg8::$param->{name}" ], [ "Genbank" => "genbank::$param->{name}" ], [ "GFF" => "gff:$param->{name}" ], [ "Hennig86" => "hennig86::$param->{name}" ], [ "Intelligenetics" => "ig::$param->{name}" ], [ "Jackknifer" => "Jackknifer::$param->{name}" ], [ "Jackknifernon" => "Jackknifernon::$param->{name}" ], [ "Mega" => "mega::$param->{name}" ], [ "Meganon" => "meganon::$param->{name}" ], [ "GCG MSF" => "msf::$param->{name}" ], [ "NBRF (PIR)" => "nrbf::$param->{name}" ], [ "NCBI FASTA" => "ncbi::$param->{name}" ], [ "Nexus/PAUP" => "nexus::$param->{name}" ], [ "Nexusnon/PAUPnon" => "nexusnon::$param->{name}" ], [ "PHYLIP interleaved" => "phylip::$param->{name}" ], [ "PHYLIP non-interleaved" => "phylip3::$param->{name}" ], [ "SELEX" => "selex:$param->{name}" ], [ "DNA strider" => "strider::$param->{name}" ], [ "SwissProt" => "swiss::$param->{name}" ], [ "Staden" => "staden::$param->{name}" ], [ "plain text" => "text::$param->{name}" ], [ "Treecon" => "treecon::$param->{name}" ], ]; $param->{default} = "fasta::$param->{name}"; $param->{maximum} = 1; $self->_selection_list_html($param); } sub _acd_seqoutall { &_acd_seqout; } sub _acd_seqoutset { &_acd_seqout; } sub _acd_outcodon { my ($self, $param) = @_; my $html = < EOF return $html if $param->{_hide_optional}; $param->{_class} = "additional"; $param->{name} = "oformat"; $param->{information} = "Output report format"; $param->{_options} = [ [ "EMBOSS codon usage file" => "emboss" ], [ "GCG codon usage file" => "gcg" ], [ "CUTG codon usage file" => "cutg" ], [ "CUTG codon usage file with amino acids" => "cutgaa" ], [ "CUTG species summary file" => "spsum" ], [ "Mike Cherry codonusage database file" => "cherry" ], [ "TransTerm database file" => "transterm" ], [ "FHCRC codehop program codon usage file" => "codehop" ], [ "Staden package codon usage file with percentages" => "staden" ], [ "Staden package codon usage file with numbers" => "numstaden" ] ]; $param->{default} = $param->{rformat}; $param->{maximum} = 1; $html .= $self->_selection_list_html($param); return $html; } # # # # # # # # # # # # # # # # GRAPHICS TYPES # # # # # # # # # # # # # # # # sub _acd_graph { my ($self, $param) = @_; # only display one of graph and xygraph... # return "" if $self->{_acd_graph}; ++$self->{_acd_graph}; $param->{information} = "Output graphic format" unless defined $param->{information}; $param->{_options} = [ [ PostScript => 'colourps' ], [ PNG => 'png' ] ]; $param->{default} = 'png'; $param->{maximum} = 1; my $html = $self->_selection_list_html($param); return $html if $param->{_hide_optional}; my $gtitle = { _class => 'additional', name => 'gtitle', information => 'Graphic title' }; $html .= $self->_text_field_html($gtitle); my $gsubtitle = { _class => 'additional', name => 'gsubtitle', information => 'Graphic subtitle' }; $html .= $self->_text_field_html($gsubtitle); my $gxtitle = { _class => 'additional', name => 'gxtitle', information => 'X axis title' }; $html .= $self->_text_field_html($gxtitle); my $gytitle = { _class => 'additional', name => 'gytitle', information => 'Y axis title' }; $html .= $self->_text_field_html($gytitle); return $html; } sub _acd_xygraph { &_acd_graph; } # # # # # # # # # # # # # # # # SECTION TYPES # # # # # # # # # # # # # # # # sub _acd_section { my ($self, $param) = @_; my $title = $param->{information} || $param->{name}; my $title_html = CGI::escapeHTML($title); my $html = < $title_html EOF return $html; } sub _acd_endsection { my ($self, $param) = @_; my $html = < EOF return $html; } # # # # # # # # # # # # # # # # VARIABLE TYPES # # # # # # # # # # # # # # # # sub _acd_variable { my ($self, $param) = @_; return ""; } # # # # # # # # # # # # # DATATYPE HELPER METHODS # # # # # # # # # # # # # sub _selection_list_html { my ($self, $param) = @_; my $info = $self->_get_info($param); warn "no information for $param->{name}" unless $info; my $multiple = $param->{maximum} > 1 ? " multiple='multiple'" : ""; defined $param->{default} or $param->{default} = ""; # prevent uninitialized warning... my $html = < $info $expect EOF return $html } sub _skip_html { my ($self, $param) = @_; my $html = <{name} with datatype $param>{datatype} skipped --> EOF return $html; } 1; =back =head1 BUGS If the user has asked to see only required fields, sections containing only optional fields will still be visible, even though the fields they contain are hidden. Fixing this requires better section handling in EMBOSS::ACD. =head1 COPYRIGHT Copyright (c) 2004 Luke McCarthy. All rights reserved. This program is free software. You may copy or redistribute it under the same terms as Perl itself. emboss-explorer//lib/EMBOSS/GUI/Conf.pm0100600000175000001440000002124410525736220016722 0ustar lukemusers=head1 NAME EMBOSS::GUI::Conf - repository for EMBOSS::GUI site-specific configuration =head1 AUTHOR Luke McCarthy =head1 SYNOPSIS use EMBOSS::GUI::Conf; $conf = EMBOSS::GUI::Conf->new(); foreach $app ($conf->apps) { ($name, $doc) = @$app; if (!$conf->is_excluded($name)) { ... } } foreach $group ($conf->groups) { $group_name = shift @$group; if (!conf->is_excluded($group_name) { foreach $app (@$group) { ($name, $doc) = @$app; ... } } } =head1 DESCRIPTION EMBOSS::GUI::Conf contains site-specific configuration information for EMBOSS::GUI. Consult the source for a description of the variables that can be set. Public methods are described below: =over 4 =cut package EMBOSS::GUI::Conf; use strict; use warnings; use Carp; our $VERSION = 1.10; # path to the EMBOSS::GUI HTML files our $HTML_PATH = "/var/www/emboss/html"; # URL corresponding to $HTML_PATH above our $HTML_URL = "/emboss"; # URL specifying the style sheet to use our $STYLE_URL = "$HTML_URL/style/emboss.css"; # URL prefix to place before image links our $IMAGE_URL = "$HTML_URL/images"; # URL prefix to place before manual links (only used in static pages) our $MANUAL_URL = "$HTML_URL/manual"; # path to the EMBOSS::GUI temporary output directory our $OUTPUT_PATH = "$HTML_PATH/output"; # URL corresponding to $OUTPUT_PATH above our $OUTPUT_URL = "$HTML_URL/output"; # prefix under which EMBOSS was installed our $EMBOSS_PREFIX = "/usr/local"; # path to EMBOSS binaries our $EMBOSS_BIN = "$EMBOSS_PREFIX/bin"; # path to EMBOSS installation our $EMBOSS_HOME = "$EMBOSS_PREFIX/share/EMBOSS"; # path to EMBOSS ACD files our $EMBOSS_ACDROOT = "$EMBOSS_HOME/acd"; # path to EMBOSS data our $EMBOSS_DATA = "$EMBOSS_HOME/data"; # path to EMBOSS application manuals our $EMBOSS_MANUAL = "$EMBOSS_HOME/doc/html"; # list of groups and applications to exclude from the main menu our @EXCLUDED = ( "ACD", "acdc", "acdpretty", "acdtable", "acdtrace", "acdvalid", "UTILS DATABASE CREATION", "aaindexextract", "cutgextract", "printsextract", "prosextract", "rebaseextract", "tfextract", "UTILS DATABASE INDEXING", "dbiblast", "dbifasta", "dbiflat", "dbigcg", ); # number of seconds to delay between placeholder page refreshes our $REFRESH_DELAY = 1; # whether or not to display using frames our $FRAMES = 1; =item new() Returns a new EMBOSS::GUI::Conf object. This method stores the EMBOSS::GUI::Conf package variables in the object hash, ensures that the specified output path is writeable and adds the EMBOSS binaries to the path. =cut sub new { my $invocant = shift; my $class = ref $invocant || $invocant; my $self = { HTML_URL => $HTML_URL, STYLE_URL => $STYLE_URL, IMAGE_URL => $IMAGE_URL, MANUAL_URL => $MANUAL_URL, OUTPUT_PATH => $OUTPUT_PATH, OUTPUT_URL => $OUTPUT_URL, EMBOSS_ACDROOT => $ENV{EMBOSS_ACDROOT} || $EMBOSS_ACDROOT, EMBOSS_DATA => $EMBOSS_DATA, EMBOSS_MANUAL => $EMBOSS_MANUAL, EXCLUDED => \@EXCLUDED, REFRESH_DELAY => $REFRESH_DELAY, FRAMES => $FRAMES }; bless $self, $class; # check to make sure the output directory is writeable... # -d $OUTPUT_PATH && -w $OUTPUT_PATH or die "output directory $OUTPUT_PATH is not writeable"; # add the EMBOSS binary directory to the path... # $ENV{PATH} = "$EMBOSS_BIN:$ENV{PATH}"; $self->{excluded} = {}; foreach my $item (@{$self->{EXCLUDED}}) { ++$self->{excluded}->{$item}; } return $self; } =item apps() Returns a list of available EMBOSS applications. Each element of the list is a reference to an array containing the name and description of an application. =cut sub apps { my ($self) = @_; $self->_cache_appinfo unless $self->{apps}; return @{$self->{apps}}; } =item groups() Returns a list of application groups. Each element of the list is a reference to an array containing the name of the group and a list of applications belonging to that group (each application is in turn a reference to an array as described in apps() above.) Note that an individual application can appear in multiple groups. =cut sub groups { my ($self) = @_; $self->_cache_appinfo unless $self->{groups}; return @{$self->{groups}}; } =item is_excluded($subject) Returns true if the subject is being excluded from public display, false otherwise. $subject is the name of an application or application group as it appears in the output from wossname. =cut sub is_excluded { my ($self, $subject) = @_; return $self->{excluded}->{$subject}; } =item databases() Returns a list of available databases. Each element of the list is the name of a database, suitable for use in a USA. =cut sub databases { my ($self) = @_; $self->_cache_databases unless $self->{databases}; return @{$self->{databases}}; } =item matrices() Returns a list of available alignment scoring matrices. Each element of the list is a reference to an array containing the filename of the scoring matrix, suitable for use as the value of a matrix or matrixf argument, and a description of the matrix. =cut sub matrices { my ($self) = @_; $self->_cache_matrices unless $self->{matrices}; return @{$self->{matrices}}; } =item codon_usage_tables() Returns a list of available codon usage tables. Each element of the list is a reference to an array containing the filename of the codon usage table, suitable for use as the value of a codon argument, and the name of the species from which it is derived. =cut sub codon_usage_tables { my ($self) = @_; $self->_cache_codon_usage_tables unless $self->{codon_usage_tables}; return @{$self->{codon_usage_tables}}; } # # # # # # # # # # # # # # # PRIVATE METHODS # # # # # # # # # # # # # # # sub _cache_appinfo { my ($self) = @_; # run wossname to get a list of application groups and the applications # therein... # my (@groups, @current_group); open WOSSNAME, '-|', 'wossname', '-auto', '-gui' # comment the line above and uncomment the line below to cope with a bug # in perl 5.6... #open WOSSNAME, 'wossname -auto -gui |' or $self->_fatal_error("couldn't run wossname: $!"); while () { chomp; if (/^$/) { # blank lines separate groups... # if the current group is not empty and not in the exclude list, # add it to the list of avaialable groups... # push @groups, [ @current_group ] if @current_group && !$self->is_excluded($current_group[0]); @current_group = (); } elsif (@current_group) { # we've already read the group name... my ($app, $doc) = split /\s+/, $_, 2; push @current_group, [ $app, $doc ]; } else { # read the group name... push @current_group, $_; } } close WOSSNAME; $self->{groups} = \@groups; # step through the list of groups and create a master list of applications # in alphabetical order... # my %apps; foreach my $group (@groups) { my $group_name = shift @$group; foreach my $aref (@$group) { my ($app, $doc) = @$aref; $apps{$app} = $aref unless $self->is_excluded($app); } unshift @$group, $group_name; # stick the group back on... } $self->{apps} = [ sort {$a->[0] cmp $b->[0]} values %apps ]; } sub _cache_databases { my ($self) = @_; # run showb to get a list of databases... # my @databases; open SHOWDB, '-|', 'showdb', '-auto', '-noheading' # comment the line above and uncomment the line below to cope with a bug # in perl 5.6... #open SHOWDB, 'showdb -auto -noheading |' or $self->_fatal_error("couldn't run showdb: $!"); while () { my ($name, $type, $id, $query, $all, $comment) = split; push @databases, $name; } $self->{databases} = \@databases; } sub _cache_matrices { my ($self) = @_; my @matrices; foreach my $file (glob "$self->{conf}->{EMBOSS_DATA}/Matrices.*") { open INDEX, '<', $file or $self->_fatal_error("couldn't open matrix index '$file': $!"); while () { chomp; next if /^#/; # skip comments... next unless /\S/; # skip blank lines... my ($filename, $description) = split /\s+/, $_, 2; push @matrices, [ $filename => $description ]; } } $self->{matrices} = \@matrices; } sub _cache_codon_usage_tables { my ($self) = @_; my @codon_usage_tables; open INDEX, '<', "$self->{conf}->{EMBOSS_DATA}/CODONS/Cut.index" or $self->_fatal_error("couldn't open codon usage table index: $!"); while () { chomp; next if /^#/; # skip comments... next unless /\S/; # skip blank lines... #my ($filename, $description) = split /\s+/, $_, 2; my ($filename, $species) = split; push @codon_usage_tables, [ $filename => $species ]; } $self->{codon_usage_tables} = \@codon_usage_tables; } 1; =back =head1 BUGS None that I know of. =head1 COPYRIGHT Copyright (c) 2004 Luke McCarthy. All rights reserved. This program is free software. You may copy or redistribute it under the same terms as Perl itself. emboss-explorer//lib/EMBOSS/ACD.pm0100600000175000001440000001703110330233621015766 0ustar lukemusers=head1 NAME EMBOSS::ACD - parse EMBOSS ACD (AJAX Command Definition) files =head1 AUTHOR Luke McCarthy =head1 SYNOPSIS use EMBOSS::ACD; $acd = EMBOSS::ACD->new($acdfile); $application = $acd->name; $description = $acd->documentation; @groups = $acd->groups; foreach $parameter ($acd->param) { while (($attribute, $value) = each %$parameter) { ... } } =head1 DESCRIPTION EMBOSS::ACD parses EMBOSS Ajax Command Definition files and provides object-oriented access to the data contained therein. For a complete specification of the ACD format, see http://emboss.sourceforge.net/developers/acd Note that no checks are performed to ensure that the ACD file is semantically valid. Specifically, datatypes and attributes that aren't defined in the specification can occur in the file and will be parsed as normal. This is a good thing, as the module remains useful even if new datatypes are added by local developers or the EMBOSS crew. Public methods are described below: =over 4 =cut package EMBOSS::ACD; use strict; use warnings; use Carp; use Parse::RecDescent; use Text::Abbrev; our $VERSION = 2.00; our @DATATYPES = qw( array boolean float integer range string toggle codon cpdb datafile directory dirlist discretestates distances features filelist frequencies infile matrix matrixf properties regexp scop sequence seqall seqset seqsetall tree list selection align featout outfile report seqout seqoutall seqoutset outcodon graph xygraph variable ); our $DATATYPE_ABBREV = abbrev @DATATYPES; our $GRAMMAR = q( # terminal definitions... # colonequals : "=" | ":" token : /".*?"/s { $item[1] =~ s/\n\s+/ /g; # an undocumented feature of the ACD specification is that leading # whitespace is collapsed and newlines are discounted inside quoted # strings, which are supposed to be treated as single tokens; this # rule duplicates that behaviour... $item[1] =~ s/^"//; $item[1] =~ s/"$//; $item[1] } token : /\S+/ { $item[1] } tokencolonequals : /".*?"[:=]/s { $item[1] =~ s/[:=]$//; $item[1] =~ s/\n\s+/ /g; # as above... $item[1] =~ s/^"//; $item[1] =~ s/"$//; $item[1] } tokencolonequals : /\S+[:=]/ { $item[1] =~ s/[:=]$//; $item[1] } eof : /^\Z/ # terminal aliases, to make the hash keys below more readable (this also # lets us check both token and tokencolonequals at once...) # key : tokencolonequals { $item{tokencolonequals} } key : token colonequals { $item{token} } value : token { $item{token} } # attribute definitions... # attribute_block : "[" attribute(s?) "]" { [ map @$_, @{$item{'attribute(s?)'}} ] } attribute : key value { [ $item{key} => $item{value} ] } # parameter definition with attributes... # parameter_block : key value attribute_block { my $datatype = $EMBOSS::ACD::DATATYPE_ABBREV{$item{key}} || $item{key}; { name => $item{value}, datatype => $datatype, @{$item{attribute_block}} } } # an undocumented parameter definition form used in emma.acd... # parameter_block : /variable[:=]/ token token { { name => $item[2], datatype => "variable", value => $item[3] } } parameter_block : "variable" colonequals token token { { name => $item[3], datatype => "variable", value => $item[4] } } # parameter definition without attributes... # parameter_block : key value { my $datatype = $EMBOSS::ACD::DATATYPE_ABBREV{$item{key}} || $item{key}; { name => $item{value}, datatype => $datatype } } # application definition with attributes (requires at least 'groups' and # 'documentation', neither of which can be abbreviated...) # application_block : /application[:=]/ token attribute_block { { name => $item{token}, @{$item{attribute_block}} } } application_block : "application" colonequals token attribute_block { { name => $item{token}, @{$item{attribute_block}} } } # the definition of an ACD file (note that we're skipping comments that # start anywhere on a line...) # acd : application_block parameter_block(s?) eof { $item{application_block}->{param} = $item{'parameter_block(s?)'}; $item{application_block}; } ); =item new($acdfile) Parses the specified ACD file. Returns a new EMBOSS::ACD object on success, and dies on failure. $acdfile is the full path to a valid ACD file. =cut sub new { my $invocant = shift; my $class = ref $invocant || $invocant; my $self = { }; bless $self, $class; # slurp up the supplied ACD file... # $self->{path} = shift or croak "no ACD file specified in call to EMBOSS::ACD::new"; open ACD, '<', $self->{path} or croak "error reading ACD file '$self->{path}': $!"; my @lines; while () { s/\\$//; # strip line continuation characters... push @lines, $_; } $self->{acd} = join '', @lines; close ACD; # parse the ACD file using the grammar above; note that the parse tree we # generate can be passed to XML::Simple for output... # my $parser = Parse::RecDescent->new($GRAMMAR); $self->{tree} = $parser->acd($self->{acd}) or croak "$self->{path} is not a valid ACD file according to \$EMBOSS::ACD::GRAMMAR"; # TODO deal with sections... # store a hash mapping parameter names to the parameter hash in the # parse tree... # $self->{param} = {}; foreach my $param ($self->param) { $self->{param}->{$param->{name}} = $param; } return $self; } =item name() Returns the name of the application whose ACD file was parsed. =cut sub name { my ($self) = @_; return $self->{tree}->{name} || ""; } =item documentation() Returns a short description of the application whose ACD file was parsed. =cut sub documentation { my ($self) = @_; return $self->{tree}->{documentation} || ""; } =item groups() Returns a list of functional groups to which the application belongs. For a list of possible groups, see http://emboss.sourceforge.net/developers/acd/syntax.html#sect2214 =cut sub groups { my ($self) = @_; return split /[,;]\s*/, $self->{tree}->{groups} || ""; } =item param($param) Returns a reference to a hash describing the specified parameter. The hash contains key-value pairs corresponding to the attributes specified in the ACD file, plus the keys 'name' and 'datatype'. The value of the 'datatype' key is the canonical name of the data type, regardless of any abbreviation in the ACD file. For a list of possible data types, see http://emboss.sourceforge.net/developers/acd/syntax.html#sect23 If no parameter is specified, a list of all parameters is returned. The members of the list are hash references as described above. Note that, in accordance with the ACD specification, attribute names are not expanded if they are abbreviated in the ACD file. $param is either undefined (see above) or the name of the desired parameter. =cut sub param { my ($self, $name) = @_; # if called with an argument, return the parameter by that name, # otherwise return a list of all parameters... # if (defined $name) { return $self->{param}->{$name}; } else { my $aref = $self->{tree}->{param}; return defined $aref ? @$aref : (); } } =item canonical_datatype($datatype) Returns the canonical name of the specified abbreviated datatype, or undefined if the abbreviation is ambiguous or not recognized. =cut sub canonical_datatype { my ($self, $datatype) = @_; # returns undef if $datatype isn't a valid abbreviation... # return $DATATYPE_ABBREV->{$datatype}; } 1; =back =head1 BUGS None that I know of... =head1 COPYRIGHT Copyright (c) 2004 Luke McCarthy. All rights reserved. This program is free software. You may copy or redistribute it under the same terms as Perl itself. emboss-explorer//lib/EMBOSS/GUI.pm0100600000175000001440000004025410525734213016037 0ustar lukemusers=head1 NAME EMBOSS::GUI - provide web-based access to EMBOSS =head1 AUTHOR Luke McCarthy =head1 SYNOPSIS use EMBOSS::GUI; $emboss = EMBOSS::GUI->new(); $emboss->intro_page; $emboss->about_page; $emboss->menu_page; $emboss->app_page; $emboss->help_page; $emboss->default_page; =head1 DESCRIPTION EMBOSS::GUI provides a simple web-based interface to the EMBOSS suite of bioinformatics tools. The distribution should have included a sample CGI script that wraps the module appropriately. Alternatively, EMBOSS::GUI can be used to gather information about the local EMBOSS installation. Public methods for that purpose are described below: =over 4 =cut package EMBOSS::GUI; use strict; use warnings; use Carp; use CGI; use File::Basename; use IPC::Open3; use Mail::Send; use Storable; use EMBOSS::ACD; use EMBOSS::GUI::Conf; use EMBOSS::GUI::XHTML; our $VERSION = 2.10; our $RELEASE_VERSION = "2.2.0"; =item new(%args) Returns a new EMBOSS::GUI object. %args is a hash of optional named arguments. The following arguments are %recognized: =over 4 =item html => $object Specifies an alternative HTML renderer object to use when generating the web interface. See EMBOSS::GUI::XHTML for the methods the replacement object must implement. =back =cut sub new { my $invocant = shift; my $class = ref $invocant || $invocant; my %args = @_; my $self = { cgi => CGI->new(), # CGI query object conf => EMBOSS::GUI::Conf->new(), # site-specific configuration }; $self->{html} = $args{html} || EMBOSS::GUI::XHTML->new( style_url => $self->{conf}->{STYLE_URL}, image_url => $self->{conf}->{IMAGE_URL}, manual_url => $self->{conf}->{MANUAL_URL} ); bless $self, $class; } =item go() Process CGI arguments and display the corresponding page. =cut sub go { my ($self) = @_; if (defined $ENV{PATH_INFO}) { my ($null, $target, $arg) = split /\//, $ENV{PATH_INFO}; if (not defined $target ) { $self->default_page; } elsif ($target eq 'about') { $self->about_page; } elsif ($target eq 'menu') { $self->menu_page; } elsif ($target eq 'intro') { $self->intro_page; } elsif ($target eq 'help') { $self->help_page($arg); } elsif ($target eq 'output') { $self->output_page($arg); } elsif (length $target) { $self->app_page($target); } else { $self->default_page; } } else { $self->default_page; } } =item intro_page() Generates an introductory page describing EMBOSS and the GUI. =cut sub intro_page { my ($self) = @_; print $self->_header, $self->{html}->intro_page; } =item about_page() Generates a page describing the local EMBOSS configuration, including the version and filesystem location of each perl module required by the GUI. =cut sub about_page { my ($self) = @_; # dump a plain text page listing some information about the installation, # useful for troubleshooting purposes... # my $divider = "\n"; print $self->_header(-type => 'text/plain'); print "EMBOSS Explorer v$RELEASE_VERSION\n"; print $divider; foreach my $module ( qw( EMBOSS::ACD EMBOSS::GUI EMBOSS::GUI::Conf EMBOSS::GUI::XHTML ) ) { print join("\t", $self->_module_info($module)), "\n"; } print $divider; print `embossversion -full`; print $divider; print join("\t", "perl", sprintf('%vd', $^V), $^X), "\n"; foreach my $module ( qw( Carp CGI File::Basename IPC::Open3 Storable Mail::Send Parse::RecDescent Text::Abbrev ) ) { print join("\t", $self->_module_info($module)), "\n"; } print $divider; print $ENV{HTTP_USER_AGENT}, "\n"; } =item menu_page() Generates the main menu page. =cut sub menu_page { my ($self) = @_; my $menu; my $sort = $self->{cgi}->param('sort') || ""; if ($sort eq 'alpha') { $menu = $self->{html}->menu_page($self->apps); } else { $menu = $self->{html}->menu_page($self->groups); } print $self->_header, $menu; } =item app_page() Generates the application-specific input page or runs an EMBOSS application and generates the output page. =cut sub app_page { my ($self, $app) = @_; my $acd = eval { EMBOSS::ACD->new($self->_find_acd($app)) } or $self->_fatal_error("$app is not a valid EMBOSS application"); $self->is_excluded($app) and $self->_fatal_error("$app has been excluded from public access"); if ($self->{cgi}->param('_run')) { $self->_run_application($acd); } else { # make application-specific changes to pretty things up... # if ($app eq 'showseq') { $acd->param('things')->{information} .= " (only used if you chose to enter your own list above)"; } elsif ($app eq 'digest') { $acd->param('menu')->{information} = $acd->param('menu')->{header}; } elsif ($app eq 'pasteseq') { $acd->param('pos')->{expected} = "at the end of the sequence"; } elsif ($app eq 'lindna' or $app eq 'cirdna') { $acd->param('intercolour')->{datatype} = 'selection'; $acd->param('intercolour')->{values} = 'Black;Red;Yellow;Green;Aquamarine;Pink;Wheat;Grey;Brown;Blue;Blueviolet;Cyan;Turquoise;Magenta;Salmon;White'; $acd->param('intercolour')->{information} =~ s/\(enter a colour number\)$//; } elsif ($app eq 'showdb' or $app eq 'infoalign') { $acd->param('only')->{_ignore} = 1; } print $self->_header, $self->{html}->input_page($acd, $self->{preferences}->{hide_optional}); } } =item help_page() Generates the application-specific manual page. =cut sub help_page { my ($self, $app) = @_; if (defined $app) { # my $manual = $self->_find_manual($app) # or $self->_fatal_error( # "This release of EMBOSS is missing the $app user manual." # ); open TFM, '-|', 'tfm', '-auto', '-html', $app or $self->_fatal_error("Error reading $app user manual from tfm."); my $manual = join '', ; close TFM; print $self->_header, $self->{html}->manual_page($app, $manual); } else { print $self->_header, $self->{html}->help_page; } } =item output_page() Generates the application output page, or a placeholder page if the application is still running. =cut sub output_page { my ($self, $id) = @_; my $temp = sprintf '%s/%06d', $self->{conf}->{OUTPUT_PATH}, $id; my $index = "$temp/index.html"; if (-s $index) { my $url = $self->{conf}->{OUTPUT_URL} =~ /^http:/ ? sprintf "%s/%s", $self->{conf}->{OUTPUT_URL}, basename $temp : sprintf "http://%s%s/%s", $ENV{HTTP_HOST}, $self->{conf}->{OUTPUT_URL}, basename $temp; print $self->{cgi}->redirect($url); } else { print $self->_header, $self->{html}->default_output_page($self->{conf}->{REFRESH_DELAY}); } } =item default_page() Generates a default page according to the current configuration. =cut sub default_page { my ($self) = @_; $self->{conf}->{FRAMES} ? &frameset_page : &intro_page; } =item frameset_page() Generates a page that sets up the menu and main content frames. =cut sub frameset_page { my ($self) = @_; print $self->_header, $self->{html}->frameset_page; } =item apps() Returns a list of available EMBOSS applications. Each element of the list is a reference to an array containing the name and description of an application. =cut sub apps { my ($self) = @_; return $self->{conf}->apps(); } =item groups() Returns a list of application groups. Each element of the list is a reference to an array containing the name of the group and a list of applications belonging to that group (each application is in turn a reference to an array as described in apps() above.) Note that an individual application can appear in multiple groups. =cut sub groups { my ($self) = @_; return $self->{conf}->groups(); } =item is_excluded($subject) Returns true if the subject is being excluded from public display, false otherwise. $subject is the name of an application or application group as it appears in the output from wossname. =cut sub is_excluded { my ($self, $subject) = @_; return $self->{conf}->is_excluded($subject); } =item databases() Returns a list of available databases. Each element of the list is the name of a database, suitable for use in a USA. =cut #sub databases { # my ($self) = @_; # # return $self->{conf}->databases(); #} # #=item matrices() # #Returns a list of available alignment scoring matrices. Each element of the #list is a reference to an array containing the filename of the scoring matrix, #suitable for use as the value of a matrix or matrixf argument, and a #description of the matrix. # #=cut # #sub matrices { # my ($self) = @_; # # return $self->{conf}->matrices(); #} # #=item codon_usage_tables() # #Returns a list of available codon usage tables. Each element of the list is a #reference to an array containing the filename of the codon usage table, #suitable for use as the value of a codon argument, and the name of the species #from which it is derived. # #=cut # #sub codon_usage_tables { # my ($self) = @_; # # return $self->{conf}->codon_usage_tables(); #} # # # # # # # # # # # # # # # PRIVATE METHODS # # # # # # # # # # # # # # # sub _header { my ($self, @args) = @_; $self->{header_sent} = 1; $self->{preferences} = eval { Storable::thaw($self->{cgi}->cookie('preferences')); }; foreach my $param ($self->{cgi}->param) { if ($param =~ /_pref_(.*)/) { $self->{preferences}->{$1} = $self->{cgi}->param($param); } } if (defined $self->{preferences}) { eval { my $cookie = $self->{cgi}->cookie( -name => 'preferences', -value => Storable::freeze($self->{preferences}) ); push @args, ( -cookie => $cookie ); }; warn "exception in Storable::freeze: $@" if $@; } return $self->{cgi}->header(@args); } sub _fatal_error { my ($self, @error) = @_; if (my $file = defined $self->{fatals_to}) { open FILE, '>', $self->{fatals_to} or warn "failed to write error to $self->{fatals_to}: $!" and die @error; print FILE $self->{html}->error_page(@error); close FILE; } else { print $self->_header unless $self->{header_sent}; print $self->{html}->error_page(@error); } die @error; } sub _find_acd { my ($self, $app) = @_; my $acdfile = "$self->{conf}->{EMBOSS_ACDROOT}/$app.acd"; return -r $acdfile ? $acdfile : undef; } sub _find_manual { my ($self, $app) = @_; my $manual = "$self->{conf}->{EMBOSS_MANUAL}/$app.html"; return -r $manual ? $manual : undef; } sub _run_application { my ($self, $acd) = @_; # make sure the user is running a valid EMBOSS application that hasn't # been excluded from public access... # my $app = $acd->name; # create the working directory; this is necessary because EMBOSS doesn't # allow the user to specify a name for some output files and we don't want # to overwrite those of other users... # my $temp; do { # this will loop forever if the output directory isn't writeable, but # that condition is enforced in EMBOSS::GUI::Conf... # $temp = sprintf '%s/%06d', $self->{conf}->{OUTPUT_PATH}, int rand 1000000; } until mkdir $temp, 0755; chdir $temp or $self->_fatal_error("failed to change directory to $temp: $!"); my $index = "$temp/index.html"; # redirect to the script with arguments that will cause it to loop until # the output is in place... # my $url = sprintf "http://%s%s/output/%s", $ENV{HTTP_HOST}, $ENV{SCRIPT_NAME}, basename $temp; print $self->{cgi}->redirect($url); # this way doesn't work because of caching issues with Internet # Explorer... ## dump a placeholder index file that will refresh every few seconds until ## the application has finished (and replaced it with the actual output...) ## and redirect the user there... ## #my $url = sprintf 'http://%s%s/%s', # $ENV{HTTP_HOST}, $self->{conf}->{OUTPUT_URL}, basename $temp; #my $content = # $self->{html}->default_output_page($self->{conf}->{REFRESH_DELAY}); #$self->_write_to_file($index, $content) # or $self->_fatal_error("failed to create default index file: $!"); #print $self->{cgi}->redirect($url); # fork a child process to run the actual job, then exit from the parent # to sever the connection with the web server... # my $pid = fork; if (not defined $pid) { $self->_fatal_error("failed to fork"); } elsif ($pid) { exit; } else { # close default file handles and redirect fatal errors to the index # file from now on (so the user will still get them...) # close STDIN; close STDOUT; close STDERR; close Parse::RecDescent::ERROR; close Parse::RecDescent::TRACE; close Parse::RecDescent::TRACECONTEXT; $self->{fatals_to} = $index; # main action occurs below... } # construct the command line... # my @args = ($app, '-auto'); foreach my $param ($self->{cgi}->param) { next if $param =~ /^_/; # ignore our internal parameters... my @values = $self->{cgi}->param($param); my $subtype = "";; if ($param =~ /(.*)\.(.*)/) { # parameters with multiple fields... $param = $1; $subtype = $2; } my $param_info = $acd->param($param); $param_info = { datatype => 'qualifier' } if $self->_is_qualifier($param); # allow qualifiers... next unless $param_info; # ignore unknown parameters... if (@values > 1) { push @args, "-$param", join(",", @values); } else { my $value = defined $values[0] ? $values[0] : ""; if ($subtype eq 'text' && length $value) { my $file = "$temp/.$param"; $self->_write_to_file($file, $value) or $self->_fatal_error("failed to create $file: $!"); push @args, "-$param", $file; } elsif (ref $value eq 'Fh') { my $file = "$temp/.$param"; $self->_write_to_file($file, join('', <$value>)) or $self->_fatal_error("failed to create $file: $!"); push @args, "-$param", $file; } elsif ($param_info->{datatype} eq 'boolean' or $param_info->{datatype} eq 'toggle') { push @args, $value ? "-$param" : "-no$param"; } else { push @args, "-$param", $value if length $value; } } # TODO... } # grab the email address... # my $email = $self->{cgi}->param('_email'); # echo process id, remote address, email address if defined, and command # line to disk for provenance... # my @info = ($$, "@args", $ENV{'REMOTE_ADDR'}, $email); my $info = "$temp/.info"; $self->_write_to_file($info, join("\n", @info)) or $self->_fatal_error("failed to create $info: $!"); # run the command, capturing stdout and stderr... # open NULL, '<', "/dev/null"; open OUTPUT, '>', "$temp/.stdout" or $self->_fatal_error("failed to create $temp/.stdout: $!"); open ERROR, '>', "$temp/.stderr" or $self->_fatal_error("failed to create $temp/.stderr: $!"); my $cpid = open3("<&NULL", ">&OUTPUT", ">&ERROR", @args); waitpid $cpid, 0; close NULL; # in order to avoid "used only once" warning... close ERROR; # in order to avoid "used only once" warning... close OUTPUT; # in order to avoid "used only once" warning... ## construct the output page in a separate file, then move it over the ## placeholder index file; this should prevent the webserver from trying ## to load an incomplete page... ## #my $buffer = "$temp/.buffer"; #$self->_write_to_file($buffer, $self->{html}->output_page($temp)) # or $self->_fatal_error("failed to create $buffer: $!"); #rename $buffer, $index # or $self->_fatal_error("failed to overwrite $index: $!"); # write the index file in place... # $self->_write_to_file($index, $self->{html}->output_page($temp)) or $self->_fatal_error("failed to create $index: $!"); # if an email address was specified, send a message indicating the output # is ready... # if (length $email) { my $started = localtime( (stat($info))[9] ); my $msg = Mail::Send->new( To => "EMBOSS user <$email>", Subject => "EMBOSS: $app has finished" ); my $fh = $msg->open; print $fh <close; } # never return from this method... # exit; } sub _is_qualifier { my ($self, $param) = @_; return $param =~ /^g(sub|x|y)?title$/ || $param =~ /^(a|o|of|r)format$/; } sub _write_to_file { my ($self, $file, $content) = @_; open FILE, '>', $file or return undef; print FILE $content; close FILE; } sub _module_info { my ($self, $module) = @_; my $module_inc = "$module.pm"; $module_inc =~ s/::/\//g; my $module_path = $INC{$module_inc}; my $module_version = ""; $module_version ||= eval "\$$module\::VERSION"; return ($module, $module_version, $module_path); } 1; =back =head1 BUGS None that I know of... =head1 COPYRIGHT Copyright (c) 2004 Luke McCarthy. All rights reserved. This program is free software. You may copy or redistribute it under the same terms as Perl itself. emboss-explorer//t/ACD.t0100600000175000001440000000137410525730177014343 0ustar lukemusers#!/usr/bin/perl use strict; use warnings; use Test::More; use EMBOSS::ACD; use EMBOSS::GUI::Conf; use EMBOSS::GUI::XHTML; our @ACDFILES; our $XHTML; BEGIN { # locate the EMBOSS ACD files in order to validate against them... # @ACDFILES = glob "/usr/local/share/EMBOSS/acd/*.acd"; $XHTML = EMBOSS::GUI::XHTML->new( script_url => 'dummy' ); plan tests => 2 * scalar(@ACDFILES); } # test against each ACD file... # for (my $i=0; $i<@ACDFILES; ++$i) { my $acd; ok(eval { $acd = EMBOSS::ACD->new($ACDFILES[$i]) }, "parse $ACDFILES[$i]"); ok(eval { test_input_page($acd) }, "generate input page $ACDFILES[$i]"); } sub test_input_page { my ($acd) = shift; my $html = $XHTML->input_page($acd); return $html =~ /unknown datatype/ ? undef : "ok"; }