mast2html

来自「EM算法的改进」· 代码 · 共 781 行 · 第 1/2 页

	# change the marker list to an array
	
	@markers = split //, $mark;
	$nmarks = @markers;

	# split the text into lines

	@line = split /\n/, $text;

	$oldm = 0;

	foreach $l ( @line ) {

		#print stderr "$l\n";
		$l =~ /^\s*(\S.*$)/;	# get first word of line	
		$l = $1;

		# find out what line starts with (bullet or not)
		$newm = 1;
		marker:
		foreach $m (@markers) {
			$mm = $m;
			if ( $l =~ /^$m / ) { last marker; }	# word is marker
			$newm++;
		}
		#print stderr "mark=$newm     oldm =$oldm   nmarks=$nmarks\n";

		# if line starts with a bullet (marker) adjust indentation leve
		if ( $newm <= $nmarks ) {	
			#print stderr "     matched :$mm:\n";
			$l =~ s/^$mm/<LI>/;	# changer marker to <LI>
			# finish previous indent levels if at lower level now
			for ( $i=$newm+1; $i<=$oldm; $i++ ) {
				$out .= "</UL>\n";
				#print stderr "</UL> level $i\n";
			}
                        # start new indent levels if at higher level now
			for ( $i=$oldm+1; $i<=$newm; $i++ ) {
				$out .= "<UL>\n";
				#print stderr "<UL> level $i\n";
			}
			$out .= "$l\n";
			$oldm = $newm;
		} else {
			$out .= "$l\n";
			#print stderr "     not matched\n";
		}

	}

	# end of text: close off indentation levels
	for ( $i=$oldm; $i>=1; $i--) {
		$out .= "\n</UL>\n";
		#print stderr "</UL> level $i newm = $oldm\n";
	}
	return( $out );

} 
#------------------------------------------------------------------------------
# format_sec_i:
# Format section i by adding external links to sequence names and internal
# links to section ii from e-values.
#
# USAGE: $text = &format_sec_i( text, db, stype, xlate );
#------------------------------------------------------------------------------
sub format_sec_i {
	local( $text, $db, $stype, $xlate ) = @_;
	local( @line, $l, $out, $n, $d, $i, $descr, $evalue, $length, $seqno );

	$out .= "<TABLE SUMMARY='sec_i' BORDER><TR><TH>Links<TH ALIGN=LEFT>Sequence Name";
	if ($xlate) {				# translate DNA
	  $out .= "<TH ALIGN=LEFT>Description<TH>Frame<TH>E-value<TH>Length\n";
	  $n = 2;
        } elsif ($stype eq "s") {		# strands scored separately
	  $out .= "<TH ALIGN=LEFT>Description<TH>Strand<TH>E-value<TH>Length\n";
	  $n = 2;
	} else {				# single strand/frame
	  $out .= "<TH ALIGN=LEFT>Description<TH>E-value<TH>Length\n";
	  $n = 1;
	}

	@line = split /\n/, $text;
	$seqno = 0;			# sequence number
	line:
	foreach $l (@line) {
		if ( $l =~/^\s+$/ ) {
			$out .= "$l\n";
			next line;
		}
		( $name, @rest ) = split /\s+/, $l;
		$d = $#rest;
		# store sequence number indexed by name of sequence; prepend
		# "-" if this is the negative DNA strand
		if ($stype eq "s" && $rest[$d-2] =~ /-/) {
		  $SEQNO{"-".$name} = ++$seqno;
		} else {
		  $SEQNO{$name} = ++$seqno;
		}
	        $no_gi_name = $name;
                $no_gi_name =~ s/^gi\|\d+\|//;			# leading gi|123| removed 
		$link = "<A NAME=s$seqno></A>$no_gi_name";
		if ( $name =~ /\|/ ) {
    		  $button = make_button_panel("!",\%buttons, $db."entrez!$name","diagram!$seqno","align!$seqno","help" );
		} else { 
		  $button = make_button_panel("!",\%buttons, "diagram!$seqno","align!$seqno", "help" );
		}
		$descr = "";
		for ($i=0; $i<$d-$n; $i++) { $descr .= "$rest[$i] "; }
		$descr =~ s/(.*)gi\|.*/$1/;	# remove appended gi numbers

		$length = $rest[$d];
		$evalue = "$rest[$d-1]";

		# don't output sequences with e-values in middle range
		if ($evalue>$MIN_E_SKIP && $evalue<$MAX_E_SKIP) {
                  $SKIP[$seqno] = 1;
		}

		if (! $SKIP[$seqno]) {
		  $out .= sprintf " <TR><TD>%s\n <TD>%s\n <TD>%s\n", 
		    $button, $link, $descr;
		  if ($xlate || $stype eq "s") {	# print strand/frame
		    $frame = $rest[$d-2];
		    $out .= sprintf " <TD ALIGN=CENTER>%s\n", $frame;
		  } # strand/frame 
		  $out .= sprintf " <TD ALIGN=RIGHT>%s\n <TD ALIGN=RIGHT>%s\n", 
		    $evalue, $length;
		} else {
                  if(!$SKIP[$seqno-1]) {$out .= "<TR><TD COLSPAN=6>$ELIPSIS\n";}
		}
	}

	$out .= "</TABLE>\n";

	return( $out );
} # format_sec_i

#------------------------------------------------------------------------------
# format_sec_iii:
# Format section iii by adding external links to sequence names
#
# USAGE: $text = &format_sec_iii( db, text );
#------------------------------------------------------------------------------
sub format_sec_iii {
	local( $db, $text ) = @_;
	local( @line, $l, $out, $rest, $name, $gi, $source, $sdb, $acc);
	local( $short, $doc, $first, $seqno );

	@line = split /\n/, $text;

	$first = 1;
	$out = "";
	$l = 0;
	line:
	while ( $l < @line ) {

		# skip blanks
		if ( $line[$l] =~ /^\s*$/ ) { $l++;  next line; }

		# initialize current entry
		$entry = "";

		# title line; don't print HR for first one
                if ($first) { $first = 0;} else { $entry .= "\n<HR>\n";}

		( $name, $rest ) = split /\s+/, $line[$l++], 2;
                $name =~ s/^>//;                # remove ">" if present

		# get sequence number
                $trunc_name = substr($name, 0, $MAX_NAME_LEN);	# other sections have truncated names
		if ($db eq 'n' && $rest =~ /-/) { 
		  $seqno = $SEQNO{"-".$trunc_name};	# DNA - sequence
		} else {
		  $seqno = $SEQNO{$trunc_name};
		}
		if ( $name =~ /\|/ ) {
    		  $button = make_button_panel("!",\%buttons, 
		    $db."entrez!$name", "score!$seqno", "diagram!$seqno","help");
		} else { 			#assume 1st token is name
		  $button = make_button_panel("!",\%buttons,
		    "score!$seqno","diagram!$seqno", "help" );
		}

		$entry .= "<A NAME=a$seqno></A>$name $rest";
		$entry .= "$button<BR CLEAR=LEFT>\n";

		# strip out the documentation and reformat
		$doc = "";
		while ( $l < @line ) {
  		  if ( $line[$l] =~ /^\s*LENGTH/ ) { last; }
		  $doc .= $line[$l++];
		}
		if ( $doc =~ /gi\|/s ){
		  $doc =~ s/gi\|/<UL>gi\|/;
		  $doc =~ s/\n//g;
		  $doc =~ s/(gi)\|/<BR CLEAR=LEFT>\n<LI>$1\|/g;
		  $doc .= "\n</UL>";
		}
		
		# now convert each gi name in the list to an entrez link 
		# using the gi as the query
		@gilist = ($doc =~ /gi\|\S+/gs);
		foreach $g (@gilist) {
		  $link = &link_entrez( $db, $g );
		  $g =~ s/\|/\\|/g;
		  $doc =~ s/$g/$link/s;
		}

		$doc .= "<BR>\n";
		$entry .= $doc;
		$entry .= "$line[$l++]<BR>\n";
		# print diagram lines
                $diagram = "";
		while ( $l < @line && $line[$l] =~ /\S/) { 
		  $diagram .= $line[$l++];
		}
    		$diagram =~ s/_/-/g;			# replace _ with -
		$entry .= $diagram;

		# the alignment section
		$entry .= "<PRE>";
		while ( $l < @line ) {
		  if ( $line[$l] =~ /^[>a-zA-Z].*/ ) { last; }
		  $entry .= "$line[$l++]\n";
		}
		$entry .= "</PRE>\n";
		if (! $SKIP[$seqno]) { 
		  $out .= $entry; 
		} else {
                  if (! $SKIP[$seqno-1]) { $out .= "$ELIPSIS"; }
		}
	}

	return( $out );
} # format_sec_iii

#------------------------------------------------------------------------------
# link_entrez:
# Convert a name to Entrez link. gi is used for entrez query. source name is 
# used for tag text.
#
# USAGE: $text = &link_entrez( <database>, <name> );
#------------------------------------------------------------------------------
sub link_entrez {
	local( $db, $name ) = @_;
	local( $long, $gi, $source, $sdb, $acc, $short );
	local( $out );

	($long, $gi, $source, $sdb, $acc, $short ) = &get_name($name);
	if ( $gi eq "" ) { $gi = $source; }
  	$out = "<A HREF='http://www.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=$db&form=6&uid=$gi&dopt=g'>";
	$out .= $source;
	$out .= "</A>";

	return( $out );
}

#------------------------------------------------------------------------------
# entrez_link
# Convert a name to Entrez link 
# and make a local link to this point if prefix is not empty string.
#
# USAGE: $text = &entrez_link( db, name, prefix );
#------------------------------------------------------------------------------
sub entrez_link {
	local( $db, $name, $prefix ) = @_;
	local( $button, $on );
	local( $out );

	if ($prefix ne "") {
          $out .= "<A NAME=$prefix.$name></A>";
	}
	$type=$db."entrez!".$name;
  	$out .= "<A HREF='http://www.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=$db&form=6&uid=$name&dopt=g'>";
	$on = sprintf "%-24.24s", $name;
	$on  =~ s/(\S+)(\s+)/$1<\/A>$2/;
	$out .= $on;

	return( $out );
}

#------------------------------------------------------------------------------
# link_internal:
# add the specified internal link to all occurances of the key string.
#
# USAGE: $text = &link_internal( text, name, key );
#------------------------------------------------------------------------------
sub link_internal {
	local ($line, $name, $key ) = @_;

	$line =~ s/$key/<A HREF='#$name'>$key<\/A>/g;
	return( $line );
}

#------------------------------------------------------------------------------
# target_internal:
# add the specified string to the text as a NAME target for an internal
# link
#
# USAGE: $text = &target_internal( text, name );
#------------------------------------------------------------------------------
sub target_internal {
	local ($line, $name );
	local ( $out );

	$out = "<A NAME=$name>&nbsp;</A>";
	$out .= $line;

	return( $out );
}

#------------------------------------------------------------------------------
# get_name:
# Extract a gi identifier string and break it up into some commonly used 
# components: the name (i.e rightmost identifier), the gi (number following
# gi|), and the complete identifier.
#
# note that PDB entries have the chain concatenated to the entry name.
#
# USAGE:
#	($long, $gi, $source, $db, $acc, $short ) = &get_name($line);
#
# 19 November 1997     Michael Gribskov
#------------------------------------------------------------------------------
sub get_name {
    local( $line ) = @_;
    local( $short, $long, $source, $db, $acc, $gi );

	if ( $line=~/gi\|/ ) {
		($long) = $line =~ /(gi\|[^\s]*).*/;
    	($short) = $long =~ /\|([^|]*)$/;
    	($gi, $source) = $line =~ /gi\|([^| ]*)(\S*).*/;
    	unless ( ($source=~/\S/)  ) {			# if no source info following gi
        	$source = "gi|".$gi;
    	} else {
        	$source =~ s/^\|(.*)/$1/;
    	}
	} elsif ( $line=~/\|/ ) {							# if no gi|, assume token with | is a name
		($source) = $line =~ /^\s*(\S*\|\S+)\s*.*/;
		$long = $source;
	} 
		
    ($db, $acc, $short) = split /\|/, $source;
    unless ( $acc=~/\S/ ) { $acc = $short; }

	# special treatment for PDB chains

	if ( $db eq "pdb" ) {
		$short = $acc.$short;
	}

    return( $long, $gi, $source, $db, $acc, $short );
}

#------------------------------------------------------------------------------
# button_help:
#
# make a key for the buttons. This is not a general procedure - you must know
# the divider and button definitions.
#
# USAGE:
#	$text = &button_help;
#
#------------------------------------------------------------------------------
sub button_help {

	local( $out );

	$out  = "<A NAME=bh></A>\n";
	$out .= "<A NAME=sbh></A>\n";
	$out .= "<A NAME=dbh></A>\n";
	$out .= "<A NAME=abh></A>\n";
	$out .= "<HR><CENTER><H3>Button Help</H3></CENTER><HR>\n";
	$out .= make_button_panel("!",\%buttons, "hentrez!\#bh" );
	$out .= "Links to Entrez database at <A HREF='http://www.ncbi.nlm.nih.gov'>NCBI</A> <BR CLEAR=LEFT>\n";
	$out .= make_button_panel("!",\%buttons, "score!bh" );
	$out .= "Links to sequence scores (<A HREF='\#sec_i'>section I</A>) <BR CLEAR=LEFT>\n";
	$out .= make_button_panel("!",\%buttons, "diagram!bh" );
	$out .= "Links to motif diagrams (<A HREF='\#sec_ii'>section II</A>) <BR CLEAR=LEFT>\n";
	$out .= make_button_panel("!",\%buttons, "align!bh" );
	$out .= "Links to sequence/motif annotated alignments (<A HREF='\#sec_iii'>section III</A>) <BR CLEAR=LEFT>\n";
	$out .= make_button_panel("!",\%buttons, "help!#bh" );
	$out .= "This information <BR CLEAR=LEFT>\n";

	return $out;
}

#------------------------------------------------------------------------------