[Bio] / FigKernelPackages / raelib.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/raelib.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31, Sat May 6 22:04:12 2006 UTC revision 1.32, Sun May 7 20:10:07 2006 UTC
# Line 43  Line 43 
43      unless ($@) {$useexcel=1}      unless ($@) {$useexcel=1}
44  }  }
45    
46    
47  use FIG;  use FIG;
48  my $fig=new FIG;  my $fig=new FIG;
49    
# Line 55  Line 56 
56  sub new {  sub new {
57   my ($class)=@_;   my ($class)=@_;
58   my $self={};   my $self={};
59     $self->{'useexcel'}=1 if ($useexcel);
60   return bless $self, $class;   return bless $self, $class;
61  }  }
62    
# Line 808  Line 810 
810    
811  There are a couple of perl modules that allow you to write to excel files, and so I am trying out the idea of taking our standard $tab table respresentation that is used in HTML.pm and making an excel file that people could download. It seems like that would be a great tool for them to have.  There are a couple of perl modules that allow you to write to excel files, and so I am trying out the idea of taking our standard $tab table respresentation that is used in HTML.pm and making an excel file that people could download. It seems like that would be a great tool for them to have.
812    
813  At the moment the excel modules are in my shared space on the CI machines, and so won't work in every seed installation. Therefore the $useexcel boolean is set at compile time if we successfully load the module.  At the moment the excel modules are in my shared space on the CI machines, and so won't work in every seed installation. Therefore the $self->{'useexcel'} boolean is set at compile time if we successfully load the module.
814    
815  The issues are:  The issues are:
816      1. creating the excel file      1. creating the excel file
# Line 832  Line 834 
834      A link to the file in the format      A link to the file in the format
835          <p><a href="...">filename</a> [Download Excel file]</p>          <p><a href="...">filename</a> [Download Excel file]</p>
836    
837    Note that there are four separate methods:
838        1. tab2excel is the method for a single call from HTML::make_table
839            this will make an excel file, fill it, and return the link;
840        2. make_excel_workbook is the method that instantiates a file
841        3. make_excel_worksheet is the method that actually populates the file
842            this loads all the data into the excel file, but if you know what you are doing you can call this many times,
843            each with a different spreadsheet
844        4. close_excel_file
845            this closes the file and writes it. It is what returns the link.
846    
847        tab2excel is a wrapper for all three so that the method in HTML::make_table is really easy.
848        See subsys.cgi for a more complex involvement of this!
849    
850    
851  =cut  =cut
852    
853  sub tab2excel {  sub tab2excel {
854      my($self, $col_hdrs, $tab, $title, $options, $filename)=@_;      my($self, $col_hdrs, $tab, $title, $options, $filename)=@_;
855        return "<p>Couldn't load Spreadsheet::WriteExcel</p>\n" unless ($self->{'useexcel'});
856        $self->make_excel_workbook($filename, $options);
857        $self->make_excel_worksheet($col_hdrs, $tab, $title);
858        return $self->close_excel_file();
859    }
860    
861    =head1 make_excel_workbook
862    
863    This is the method that actually makes individual workbook. You should call this once, with the name of the file that you want it to be known by. The options are to set borders and whatnot.
864    
865    =cut
866    
867    sub make_excel_workbook {
868        my($self, $filename, $options)=@_;
869        return "<p>Couldn't load Spreadsheet::WriteExcel</p>\n" unless ($self->{'useexcel'});
870    
     return "<p>Couldn't load Spreadsheet::WriteExcel</p>\n" unless ($useexcel);  
871      $filename =~ s/^.*\///; # remove any path information. We are going to only write to FIG_Config::temp      $filename =~ s/^.*\///; # remove any path information. We are going to only write to FIG_Config::temp
872      unless ($filename =~ /\.xls$/) {$filename .=".xls"}      unless ($filename =~ /\.xls$/) {$filename .=".xls"}
873      my $excelfile=$FIG_Config::temp."/$filename";      $self->{'excel_short_filename'}=$filename;
874        $self->{'excel_filename'}=$FIG_Config::temp."/$filename";
875    
876      # Each excel file consists of the file, and then of worksheets from within the file. These are the tabs at the bottom of the screen      # Each excel file consists of the file, and then of worksheets from within the file. These are the tabs at the bottom of the screen
877      # that can be added with "Insert->new worksheet" from the menus.      # that can be added with "Insert->new worksheet" from the menus.
878      # Create a new workbook called simple.xls and add a worksheet      # Create a new workbook called simple.xls and add a worksheet
     my $workbook  = Spreadsheet::WriteExcel->new($excelfile);  
     $workbook->set_tempdir($FIG_Config::temp); # you don't have to do this, but it may speed things up and reduce memory load.  
     my $worksheet = $workbook->add_worksheet($title);  
   
     # define some excel colors in our hash. Then if the table calls for more colors we'll add them later.  
     # this is just to set the defaults for a couple of obvious ones so that we don't bother using custom colors for them  
     my $excelcolor= {"#000000" => 1, "#FFFFFF" => 2, "#FF0000" => 3, "#00FF00" => 4, "#0000FF" => 5, "#FFFF00" => 6, "#FF00FF" => 7, "#00FFFF" => 8};  
879    
880      # The general syntax for output to an excel file is write($row, $column, $value, $format). Note that row and      # instantiate the workbook
881      # column are zero indexed      $self->{'excel_workbook'}=Spreadsheet::WriteExcel->new($self->{'excel_filename'});
882        $self->{'excel_workbook'}->set_tempdir($FIG_Config::temp); # you don't have to do this, but it may speed things up and reduce memory load.
883    
884      # look through the options and see what the formating issues are      # define the default formats
885      my $border = defined $options->{border} ? $options->{border} : 0;      my $border = defined $options->{border} ? $options->{border} : 0;
886      my $format;      $self->{'excel_format'}->{default}=$self->{'excel_workbook'}->add_format(border=>$border, size=>10);
887      $format->{default} = $workbook->add_format(border=>$border, size=>12);  }
888    
889    
890    =head1 make_excel_worksheet()
891    
892    This is the method that makes the separate sheets in the file. You can add as many of these as you want.
893    
894    =cut
895    
896    sub make_excel_worksheet {
897        my($self, $col_hdrs, $tab, $title)=@_;
898        return "<p>Couldn't load Spreadsheet::WriteExcel</p>\n" unless ($self->{'useexcel'});
899        unless (defined $self->{'excel_workbook'})
900        {
901            print STDERR "The workbook was not defined. Couldn't fill it in\n";
902            return;
903        }
904    
905        my $worksheet = $self->{'excel_workbook'}->add_worksheet($title);
906        # The general syntax for output to an excel file is write($row, $column, $value, $format). Note that row and
907        # column are zero indexed
908    
909      # write the column headers      # write the column headers
910      # define a new format that is bold      # define a new format that is bold
911      $format->{header} = $workbook->add_format();      $self->{'excel_format'}->{header} = $self->{'excel_workbook'}->add_format();
912      $format->{header}->copy($format->{default});      $self->{'excel_format'}->{header}->copy($self->{'excel_format'}->{default});
913      $format->{header}->set_bold();      $self->{'excel_format'}->{header}->set_bold();
914    
915      for my $i (0 .. $#$col_hdrs)      for my $i (0 .. $#$col_hdrs)
916      {      {
917          $worksheet->write(0, $i, $col_hdrs->[$i], $format->{header});          my $cell=$self->clean_excel_cell($col_hdrs->[$i]);
918            $worksheet->write(0, $i, $cell, $self->{'excel_format'}->{header});
919      }      }
920    
921      # now loop through the table and write them out. Remember to break on array refs      # now loop through the table and write them out. Remember to break on array refs
# Line 881  Line 925 
925      {      {
926          foreach my $cell (@$row)          foreach my $cell (@$row)
927          {          {
928              my $useformat=$format->{default};              my $useformat=$self->{'excel_format'}->{default};
929              if (ref($cell) eq "ARRAY")              if (ref($cell) eq "ARRAY")
930              {              {
931                  ($cell, $useformat, $format, $excelcolor)=$self->parse_cell($cell, $format, $excelcolor, $workbook);                  ($cell, $useformat)=$self->parse_cell($cell);
932              }              }
933    
934              $cell=$self->clean_excel_cell($cell);              $cell=$self->clean_excel_cell($cell);
# Line 900  Line 944 
944          $row_idx++;          $row_idx++;
945          $col_idx=0;          $col_idx=0;
946      }      }
947    }
948    
949    
     #finally close and write the table  
     $workbook->close();  
950    
951    
952    =head1 close_excel_file()
953    
954    We must explicitly close the file before creating the link so that the file is written. This is also what returns the link
955    
956    =cut
957    
958    sub close_excel_file{
959        my ($self)=@_;
960    
961        # close the workbook. this writes the files
962        $self->{'excel_workbook'}->close();
963    
964      # now generate the link to return      # now generate the link to return
965      my $size=(stat($excelfile))[7];      my $size=(stat($self->{'excel_filename'}))[7];
966      $size=int($size/1000);      $size=int($size/1000);
967      my $link="<p><a href=\"".$fig->temp_url."/$filename\">$filename</a> [Download table in Excel format. $size kb]</p>\n";      my $link="<p><a href=\"".$fig->temp_url."/".$self->{'excel_short_filename'}.'">'.
968                $self->{'excel_short_filename'}."</a> [Download table in Excel format. $size kb]</p>\n";
969      return $link;      return $link;
970    
971  }  }
972    
973    
# Line 934  Line 992 
992    
993  Colors are funky in excel because it only has a limited palette. We rename colors as needed, and then save those so that we can use them again. We're only allowed 55 colors in excel (numbered 8..63). Because its a little stupid to mess with black and white and so on, I ignore those, and also start renumbering at color number 20, giving us 43 different colors.  Colors are funky in excel because it only has a limited palette. We rename colors as needed, and then save those so that we can use them again. We're only allowed 55 colors in excel (numbered 8..63). Because its a little stupid to mess with black and white and so on, I ignore those, and also start renumbering at color number 20, giving us 43 different colors.
994    
995  The reference to the hash excelcolor has the custom excel colors stored in it for a few colors, and others are added to it.  The reference to the hash excel_color has the custom excel colors stored in it for a few colors, and others are added to it.
996    
997  =cut  =cut
998    
999  sub parse_cell {  sub parse_cell {
1000      my ($self, $arr, $format, $excelcolor, $workbook)=@_;      my ($self, $arr)=@_;
1001      return ($arr, $format->{default}) unless (ref($arr) eq "ARRAY");      return ($arr, $self->{'excel_format'}->{default}) unless (ref($arr) eq "ARRAY");
1002      my ($cell, $tag)=@$arr;      my ($cell, $tag)=@$arr;
1003      $tag =~ s/\'/"/g; # this just makes it easier to parse the things like align='center' and align="center" that are both valid      $tag =~ s/\'/"/g; # this just makes it easier to parse the things like align='center' and align="center" that are both valid
1004    
1005      # we are going to define a series of formats that we can apply, this will have  a key that is      # we are going to define a series of formats that we can apply, this will have  a key that is
1006      # center.bgcolor.fgcolor. Then if we already have that, we can use it, if not, we'll define it      # th.center.bgcolor.fgcolor. Then if we already have that, we can use it, if not, we'll define it
1007    
1008      my ($center, $bgcolor, $fgcolor)=(undef, undef, undef);      my ($th, $center, $bgcolor, $fgcolor)=(undef, undef, undef, undef);
1009    
1010        if ($tag =~ /^th/) {$th=1} # it is a header cell so we should make it bold
1011      if ($tag =~ /align\=\"(.*?)\"/i) {$center=$1}      if ($tag =~ /align\=\"(.*?)\"/i) {$center=$1}
1012    
1013        # get rid of white tags because I don't care about them
1014        $tag =~ s/color\=.\#FFFFFF/ /ig;
1015    
1016      if ($tag =~ /background-color\=\"(.*?)\"/i || $tag =~ /bgcolor\=\"(.*?)\"/i)      if ($tag =~ /background-color\=\"(.*?)\"/i || $tag =~ /bgcolor\=\"(.*?)\"/i)
1017      {      {
1018          my $color=$1;          my $color=$1;
1019          if (!$excelcolor->{$color})          if (!defined $self->{'excel_color'}->{$color})
1020          {          {
1021              # find out the last custom color used and increment it              # find out the last custom color used and increment it
1022              my $max=19; # we are not going to use a color less than 20              my $max=19; # we are not going to use a color less than 20
1023              foreach my $k (keys %$excelcolor) {($k > $max) ? ($max=$k) :1}              foreach my $k (keys %{$self->{'excel_color'}}) {($k > $max) ? ($max=$k) :1}
1024              $max++;              $max++;
1025              $excelcolor->{$color}=$workbook->set_custom_color($max, $color);              $self->{'excel_color'}->{$color}=$self->{'excel_workbook'}->set_custom_color($max, $color);
1026          }          }
1027          $bgcolor=$excelcolor->{$color};          $bgcolor=$self->{'excel_color'}->{$color};
1028      }      }
1029      elsif ($tag =~ /color\=\"(.*?)\"/i)      elsif ($tag =~ /color\=\"(.*?)\"/i || $tag =~ /color\=\'(.*?)\'/i)
1030      {      {
1031          my $color=$1;          my $color=$1;
1032          if (!$excelcolor->{$color})          if (!defined $self->{'excel_color'}->{$color})
1033          {          {
1034              # find out the last custom color used and increment it              # find out the last custom color used and increment it
1035              my $max=19; # we are not going to use a color less than 20              my $max=19; # we are not going to use a color less than 20
1036              foreach my $k (keys %$excelcolor) {($k > $max) ? ($max=$k) :1}              foreach my $k (keys %{$self->{'excel_color'}}) {($k > $max) ? ($max=$k) :1}
1037              $max++;              $max++;
1038              $excelcolor->{$color}=$workbook->set_custom_color($max, $color);              $self->{'excel_color'}->{$color}=$self->{'excel_workbook'}->set_custom_color($max, $color);
1039          }          }
1040          $fgcolor=$excelcolor->{$color};          $fgcolor=$self->{'excel_color'}->{$color};
1041      }      }
1042    
1043      if (!defined $format->{$center.$bgcolor.$fgcolor})      if (!defined $self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor})
1044      {      {
1045          $format->{$center.$bgcolor.$fgcolor}=$workbook->add_format();          $self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor}=$self->{'excel_workbook'}->add_format();
1046          $format->{$center.$bgcolor.$fgcolor}->copy($format->{default});          if ($th) {$self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor}->copy($self->{'excel_format'}->{header})}
1047          $center && $format->{$center.$bgcolor.$fgcolor}->set_align($center);          else {$self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor}->copy($self->{'excel_format'}->{default})}
1048          $bgcolor && $format->{$center.$bgcolor.$fgcolor}->set_bg_color($bgcolor);          $center && $self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor}->set_align($center);
1049          $fgcolor && $format->{$center.$bgcolor.$fgcolor}->set_color($fgcolor);          $bgcolor && $self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor}->set_bg_color($bgcolor);
1050            $fgcolor && $self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor}->set_color($fgcolor);
1051      }      }
1052    
1053      return ($cell, $format->{$center.$bgcolor.$fgcolor}, $format, $excelcolor);      return ($cell, $self->{'excel_format'}->{$th.$center.$bgcolor.$fgcolor});
1054  }  }
1055    
1056    
# Line 999  Line 1063 
1063  sub clean_excel_cell {  sub clean_excel_cell {
1064      my ($self, $cell)=@_;      my ($self, $cell)=@_;
1065      if ($cell =~ /^\s*\&nbsp\;\s*$/) {$cell=undef} # ignore white space      if ($cell =~ /^\s*\&nbsp\;\s*$/) {$cell=undef} # ignore white space
1066    
1067        # some cells have something like this:
1068        # <a  onMouseover="javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this,'Role of BCAT','Branched-chain amino acid aminotransferase (EC 2.6.1.42)','','','','');this.tooltip.addHandler(); return false;" >BCAT</a>
1069        # we don't want those, but we do want the ones that have a real url hidden here.
1070        # so remove the mouseover part, and then see what is left
1071        if ($cell =~ s/onMouseover\=\".*?\"//)
1072        {
1073            if ($cell =~ s/\<a\s+>//i) {$cell =~ s/\<\/a>//i}
1074        }
1075    
1076    
1077      if ($cell =~ /\<a href=.(.*?).>(.*)<\/a>/)      if ($cell =~ /\<a href=.(.*?).>(.*)<\/a>/)
1078      {      {
1079          # this is tricky because if the cell is a url then we need two separate things, the url and the link name          # this is tricky because if the cell is a url then we need two separate things, the url and the link name
1080          my ($url, $link)=($1, $2);          my ($url, $link)=($1, $2);
1081            $url =~ s/^\.{1,2}\///; # remove notation of ./ and ../
1082          unless ($url =~ /^http/) {$url=$FIG_Config::cgi_url."/$url"}          unless ($url =~ /^http/) {$url=$FIG_Config::cgi_url."/$url"}
1083            # this sucks as excel can only handle one link per cell, so we remove the other links. At the moment users will have to deal with that.
1084            $link =~ s/\<.*?\>//g;
1085          $cell=[$url, $link];          $cell=[$url, $link];
1086      }      }
1087        elsif ($cell =~ /<input type/)
1088        {
1089            if ($cell =~ /value='(.*?)'/) {$cell = $1}
1090            elsif ($cell =~ /value="(.*?)"/) {$cell = $1}
1091        }
1092        else
1093        {
1094            # this is all the html that I don't know what to do with, like <input type=...>
1095            $cell =~ s/\<.*?\>//g;
1096        }
1097      return $cell;      return $cell;
1098  }  }
1099    

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.32

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3