📄 convert2html.pl
字号:
#!/usr/bin/perl# convert2html.pl - this file is created from convert2html.txt ## $Id: convert2html.txt 1339 2006-09-21 19:46:28Z tbailey $# $Log$# Revision 1.2 2005/08/23 23:52:41 nadya# change form module back into pl file. Too much trouble to# do separation of functions with *2html.pl files.## Revision 1.1 2005/08/11 18:53:09 nadya# rename from 2html. Perl does not understand modules if their name start as numeric.## Revision 1.3 2005/08/11 17:42:58 nadya# add exporting functionality## Revision 1.2 2005/08/06 01:22:37 nadya# add exporting info to the package## Revision 1.1.1.1 2005/07/28 23:51:34 nadya# Importing from meme-3.0.14, and adding configure/make### subroutines and globals used by meme2html, mast2html and mhmm2html#$DIVIDER = "^\\*\\*\\*\\*\\*"; # section divider in output$SUBDIV = "^--------------------------------------------------------------------------------"; # subsection divider in output$ELIPSIS = "<B> · <BR> · <BR> · </B>";$BODY = "#D5F0FF"; # the background color of the page (light blue by default)$WEAK_FONT = "50% sans-serif"; # font size for weak motifs$SCALE = 0.5; # (sequence position)/(number of pixels)$MAX_DIAGRAM = 2000; # maximum number of pixels per diagram$THIN_LINE = 4; # thickness of thin spacer lines$FAT_LINE = 8; # thickness of fat spacer lines (for too long seqs)$MIN_WIDTH = 30; # minimum width (in pixels) for motifs$MAX_NAME_LEN = 34; # maximum length of truncated sequence name# Colors for the motifs and their labels (motif numbers).@MOTIF_COLORS=( aqua, blue, red, fuchsia, yellow, lime, teal, '#444444', green, silver, purple, olive, navy, maroon, black, white );@MOTIF_LABEL_COLORS=( black, white, white, black, black, black, white, white, white, black, white, black, white, white, white, black );@IC_COLORS=( red, blue, orange, green, black, magenta, pink, yellow, turquoise );#-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*#-* SUBROUTINES#-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*#------------------------------------------------------------------------------# print the HTML header (including style sheet) and set the body color# $title title of HTML page# $body_color background color; light blue if omitted#------------------------------------------------------------------------------sub print_header { local ( $title, # title of HTML page $body_color # background color; light blue if omitted ) = @_; local ($i); if (defined($body_color)) { $BODY = $body_color; } print <<END;<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"><HTML><HEAD><meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"><TITLE>$title</TITLE>END # print the style sheet print '<STYLE type="text/css">', "\n"; # these save space compared with <FONT></FONT> # color for invisible lines print " TD.invisible { color: '$BODY'; }\n"; # TD classes for motifs for ($i=0; $i<@MOTIF_COLORS; $i++) { # normal motifs print " TD.c$i { background: $MOTIF_COLORS[$i]; color: $MOTIF_LABEL_COLORS[$i]; }\n"; # weak motifs print " TD.cw$i { background: $MOTIF_COLORS[$i]; color: $MOTIF_LABEL_COLORS[$i]; font: $WEAK_FONT; }\n"; } # B, TD and TH classes for IC diagrams and scale foreach $color (@IC_COLORS) { print " B.$color { color: $color; }\n"; print " TD.$color { color: $color; }\n"; print " TH.$color { color: $color; }\n"; } print "</STYLE>\n"; # # end the header and start the body # print "</HEAD>\n"; print "<BODY BGCOLOR='$BODY'>\n";} # print_header #------------------------------------------------------------------------------# find a section marker with the specified keyword (case sensitive)#------------------------------------------------------------------------------sub find_section { local( $key ) = @_; local( $line ); LINE: while ( <STDIN> ) { unless ( /\*\*\*\*\*/ ) { next LINE; } $line = <STDIN>; unless ( $line =~ /$key/ ) { <STDIN>; next LINE; } last; } return( $line );} # find_section#------------------------------------------------------------------------------# next_section:# Find a section marker and return the title line. The following line of# stars is removed.## USAGE: $text = &next_section();#------------------------------------------------------------------------------sub next_section { local( $div ) = @_; local( $line ); unless ( defined($div) ) { $div = $DIVIDER; } while ( <STDIN> ) { unless ( /^$div/ ) { next; } $line = <STDIN>; <STDIN>; last; } chop $line; return( $line );} # next_section#------------------------------------------------------------------------------# read_block:# Read a block of text until terminated by a blank line.#------------------------------------------------------------------------------sub read_block { local( $line ); LINE: while ( <STDIN> ) { if ( /^\s*$/ ) { last LINE; } $line .= $_; } return( $line );} # read_block#------------------------------------------------------------------------------# next_block:# Read the next block of text until terminated by a divider line. The divider# by default, is specificed in $DIVIDER (normally a line of *). If a # parameter is passed in, it is used as the divider.# Removes \r from input.## USAGE: $text = &next_block();# $text = &next_block( divider );#------------------------------------------------------------------------------sub next_block { local( $div ) = @_; local( $line ); unless ( defined($div) ) { $div = $DIVIDER; } while ( <STDIN> ) { s/\r//g; if ( /$div/ ) { last; } $line .= $_; } return( $line );} # next_block#------------------------------------------------------------------------------# format_section:# Add HTML formatting for a section or subsection head. # The specified heading appears as# the section title with the specified name as an internal link.## USAGE: $text = &format_section( pre, link, rest, name, ext)#------------------------------------------------------------------------------sub format_section { my( $pre, # just print this part $link, # add link to this part $rest, # just print this part $name, # tag is "$name$ext" $ext # ref is to "$name_doc" ) = @_; my( $out, $ref, $tag ); if ( $name =~ /^\s*$/ ) { # all blank name $out = "<HR><CENTER> $pre <BIG><B>\n $link $rest\n</B></BIG></CENTER><HR>"; } else { # name given $ref = $name . "_doc"; $tag = $name . $ext; $link = "<A HREF=\"#$ref\">$link</A>"; $out = "<HR><CENTER><A NAME=$tag></A>\n $pre <BIG><B> $link $rest\n</B></BIG></CENTER><HR>"; } return($out);} # format_section#------------------------------------------------------------------------------# format_para:# Add HTML formatting for a paragraph. New lines are ignored, blank lines are# converted to paragraphs.## USAGE: $new_text = &format_para( text );#------------------------------------------------------------------------------sub format_para { local ( $line ) = @_; local( $out ); $out = "<P>\n$line"; $out =~ s/\n\s*\n/\n<P>\n/g; return( $out );} # format_para#------------------------------------------------------------------------------# format_pre:# Add HTML formatting for a preformatted block. ## USAGE: $new_text = &format_pre( text );#------------------------------------------------------------------------------sub format_pre { local ( $line ) = @_; local( $out ); $out = ($line=~ /\w/) ? "<PRE>\n$line</PRE>\n" : ""; return( $out );} # format_pre#------------------------------------------------------------------------------# format_diagrams:# Convert the text diagrams to colored diagrams in HTML. The scale is 1/$scale# pixels per sequence position for sequences of up to $max_diagram*$scale pixel.# Diagrams for longer sequences are scaled to fit in $max_diagram pixels # and the spacer lines are made thicker (and motif boxes may shrink).# Weak motifs are labeled with font size $WEAK_FONT.# When the motifs are protein and the database DNA, the motif widths are# multiplied by 3 since they are in codon units to start with.# Uses global variables @MOTIF_COLORS, $WEAK_FONT, $FAT_LINE, $THIN_LINE # and @width (motif widths).## Sets global $META to contain information from SUMMARY of MOTIFS for # Meta-MEME.## USAGE: $text = &format_diagrams( scale, max_diagram, text, db, stype, xlate,# make_buttons, col2hdr, no_gi_names, field_delim);#------------------------------------------------------------------------------sub format_diagrams { my( $scale, $max_diagram, $text, $db, $stype, $xlate, $make_buttons, $col2hdr, $no_gi_names, $field_delim) = @_; my( $i, $out, @line, $l, $w, $wid_sum, $nmotifs, $nspacers); my( $max_spacers, $max_motifs, $name, $evalue, $diagram); my( @field, $f, $motif, $link, $seqno ); my( @scale1, $col, $color, $font, $fsize, $wide, $fill, $mscale ); my( $ncol, $dist, $w2, $loc, @nocc, @seqlen, $lno, $ncolors ); $re_en = "\\([+-]?\\d*\\.?\\d*e[+-]?\\d+\\)"; # an e-format in parens # start a table and header row $out = "<TABLE SUMMARY='motif diagrams' BORDER=1>\n<TR>"; $ncol = 0; # number of columns in table $ncolors = scalar(@MOTIF_LABEL_COLORS); # number of distinct motif colors # put buttons linking to score and annotation? if ($make_buttons) { $out .= "<TH>Links"; $ncol += 1; } if ($stype eq "s") { # scoring DNA strands separately $out .= "<TH>Name<TH>Strand<TH>$col2hdr<TH ALIGN=LEFT> Motifs\n"; $ncol += 4; } else { # PROTEIN $out .="<TH>Name<TH>$col2hdr<TH ALIGN=LEFT> Motifs\n"; $ncol += 3; } # split the text into lines $text =~ s/\n\s+//g; # concat continued lines @line = split /\n/, $text; # find the width of each diagram if ($xlate) { # translating DNA $mscale = 3; } else { $mscale = 1; } $max_width = 0; # remove header lines for ($i=0; $i<=$#line; $i++) { $l = $line[$i]; last if ($l =~ /-------------/); } while ($i>=0) { shift @line; $i--; } # # calculate the approximate width of diagram # $lno = 0; # line number foreach $l (@line) { if ($stype eq "s") { ($name,$strand,$evalue,$diagram) = ($field_delim eq " ") ? split( " ", $l ) : split( $field_delim, $l ); } else { ($name,$evalue,$diagram) = ($field_delim eq " ") ? split( " ", $l ) : split( $field_delim, $l ); } # get sequence number if ($stype eq "s" && $strand eq "-") { $seqno = $SEQNO{"-".$name}; # negative DNA strand } else { $seqno = $SEQNO{$name}; } if (defined($SKIP[$seqno])) { next; } # skip this sequence # split the diagram into fields @field = split( '[ _]', $diagram ); # calculate the approximate width $wid_sum = $nocc[$lno] = 0; foreach $f (@field) { if ( $f =~ /[<>\[\]]/ ) { # motif occurrence ($motif) = $f =~ /[<\[][+-]?(\d+)[abc]?($re_en)?[>\]]/; $wid_sum += $width{$motif} * $mscale; $seqlen[$lno] += $width{$motif}; # length of sequence $nocc[$lno]++; # number of motif occurrences } else { # spacer $seqlen[$lno] += $f; # length of sequence $wid_sum += $f; } } # calculate a scale so that diagram fits in $max_diagram pixels $scale1[$seqno] = $scale; if ($wid_sum/$scale > $max_diagram) { $scale1[$seqno] = $wid_sum/$max_diagram; } # calculate the exact scaled diagram width $wid_sum = 0; $nmotifs = 0; $nspacers = 0; foreach $f (@field) { if ( $f =~ /[<>\[\]]/ ) { ($motif) = $f =~ /[<\[][+-]?(\d+)[abc]?($re_en)?[>\]]/; $wide = int($mscale*$width{$motif}/$scale1[$seqno]+0.5); if ($wide < $MIN_WIDTH) { $wide = $MIN_WIDTH; } $nmotifs++; } else { $wide = $f/$scale1[$seqno]; $wide = int($wide + 0.5); # round to integer $nspacers++; } $wid_sum += $wide; } # save the length of the longest diagram if ($wid_sum > $max_width) { $max_width = $wid_sum; $max_motifs = $nmotifs; $max_spacers = $nspacers; } $lno++; # line number } # line # kludge for Netscape 4.0; make width larger $max_width += 14 + (2*$max_motifs) + (3*$max_spacers); # set max_width to at least $min_width = int(50.0/$scale + 0.5); if ($max_width < $min_width) { $max_width = $min_width; } # make the diagrams $META = ""; $lno = 0; # line number foreach $l (@line) { # length of space holder at end of diagram if ($stype eq "s") { ($name,$strand,$evalue,$diagram) = ($field_delim eq " ") ? split( " ", $l ) : split( $field_delim, $l ); } else { ($name,$evalue,$diagram) = ($field_delim eq " ") ? split( " ", $l ) : split( $field_delim, $l );⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -