ensembl-hive  2.7.0
test_code_from_html.pl
Go to the documentation of this file.
1 #!/usr/bin/env perl
2 # See the NOTICE file distributed with this work for additional information
3 # regarding copyright ownership.
4 #
5 # Licensed under the Apache License, Version 2.0 (the "License");
6 # you may not use this file except in compliance with the License.
7 # You may obtain a copy of the License at
8 #
9 # http://www.apache.org/licenses/LICENSE-2.0
10 #
11 # Unless required by applicable law or agreed to in writing, software
12 # distributed under the License is distributed on an "AS IS" BASIS,
13 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14 # See the License for the specific language governing permissions and
15 # limitations under the License.
16 
17 use strict;
18 use warnings;
19 
20 use Getopt::Long;
21 
22 my $path;
23 my $host;
24 my $user;
25 
26 my $ret = Getopt::Long::GetOptions ('path=s' => \$path,
27  'host=s' => \$host,
28  'user=s' => \$user,
29  'help' => sub { usage(); exit(0); } );
30 
31 if(!defined $path){
32  print "you must defined the path to the ensembl webcode\n";
33  usage();
34  exit(0);
35 }
36 
37 my $file = $path."/ensembl-webcode/htdocs/info/docs/api/core/core_tutorial.html";
38 
39 my $code_count = 0;
40 $user ||= "ensro";
41 $host ||= "ens-staging";
42 my $header =(<<"HED");
43 ####### start of insertion #########
44 use Bio::EnsEMBL::Registry;
45 my \$registry = 'Bio::EnsEMBL::Registry';
46 
47 \$registry->load_registry_from_db(
48  -host => "$host",
49  -user => "$user");
50 HED
51 
52 my $slice_adaptor = (<<'SLI');
53 my $slice_adaptor = $registry->get_adaptor( 'Human', 'Core', 'Slice' );
54 SLI
55 
56 open(HTML,"<$file") || die "Could not open $file\n";
57 
58 my $code_mode = 0;
59 my $code = "";
60 while (my $line = <HTML>){
61  chomp $line;
62 # print $line."DUDE\n";
63  if($code_mode){
64  if($line =~ m/\<\/pre\>/){
65  $code_mode = 0;
66  process_code();
67  $code = "";
68  }
69  else{
70  $code .= "\n".$line;
71  }
72  }
73  elsif($line =~ m/pre.*code/){
74 # print "CODEMODE*******\n";
75  $code_mode = 1;
76  }
77 
78 }
79 
80 close HTML;
81 
82 sub process_code{
83 
84  $code_count++;
85  $file = "test".$code_count.".pl";
86  open(PERL,">".$file) or die "Could not open $file for writing\n";
87 
88  $code =~ s/\&gt\;/\>/g;
89  my $prefix = "";
90  if(!($code =~ /load_registry_from_db/m)){
91  $prefix = $header;
92  if(!($code =~ /my\s*\$slice_adaptor/)){
93  $prefix .= $slice_adaptor;
94  if(!($code =~ /fetch_by_region/)){
95  $prefix .= 'my $slice = $slice_adaptor->fetch_by_region( "clone", "AL031658.11" );'."\n";
96  }
97  }
98  if(!($code =~ /my\s*\$cs_adaptor/)){
99  $prefix .= 'my $cs_adaptor = $registry->get_adaptor( "Human", "Core", "CoordSystem" );'."\n";;
100  }
101  if(!($code =~ /my\s*\$gene_adaptor/)){
102  $prefix .= 'my $gene_adaptor = $registry->get_adaptor( "Human", "Core", "Gene" );'."\n";;
103  }
104  if($code =~ /\$feature\-\>/ and !( $code =~ /\$feature_adaptor/) ){
105  $prefix .= 'my $feat_adaptor = $registry->get_adaptor( "Human", "Core", "Gene" );'."\n";
106  $prefix .= 'my $feature = $feat_adaptor->fetch_by_display_label("COG6");'."\n";
107  }
108  if($code =~ /\$transcript\-\>/ and ! ( $code =~ /\$transcript_adaptor/) ){
109  $prefix .= 'my $transcript_adaptor = $registry->get_adaptor( "Human", "Core", "transcript" );'."\n";
110  $prefix .= 'my $transcript = $transcript_adaptor->fetch_by_stable_id("ENST00000380152");'."\n";
111  }
112  if($code =~ /\$translation\-\>/ and ! ( $code =~ /\$translation_adaptor/) ){
113  $prefix .= 'my $transcript_adaptor = $registry->get_adaptor( "Human", "Core", "transcript" );'."\n";
114  $prefix .= 'my $transcript = $transcript_adaptor->fetch_by_stable_id("ENST00000380152");'."\n";
115  $prefix .= 'my $translation = $transcript->translation;'."\n";
116  }
117  if( $code =~ /\$marker\-\>/ and ! ( $code =~ /\$marker_adaptor/) ){
118  $prefix .= 'my $marker_adaptor = $registry->get_adaptor( "Human", "Core", "marker" );'."\n";
119  $prefix .= 'my $marker = $marker_adaptor->fetch_all_by_synonym("D9S1038E")->[0];'."\n";
120  }
121  }
122  $code = $prefix."####### end of insertion#########\n".$code;
123  print PERL $code."\n";;
124  close PERL;
125  sleep 2;
126 # print "CODE".$code."\n";
127 
128  my $test_val = system("perl $file >& /dev/null");
129 # print "VAL is $test_val\n";
130 
131 
132  # my $test_val = eval {$code};
133 
134  if($test_val){
135  print "file $file FAILED $test_val\n";
136  }
137  else{
138  print "file $file OKAY $test_val\n";
139  }
140 }
141 
142 sub usage {
143  print << "EOF";
144  perl test_code_from_html.pl
145 
146  This script will strip and create seperate perl files for any block in the html
147  that is in surrounded by <pre class="code"> ... </pre>
148  The script adds registry code etc at the start if is not a full code example.
149  These perl scripts are then executed and the status of this run reports if the
150  code as successfully executed.
151 
152  -path The path to the ensembl-webcode directory (Must be set)
153 
154  -user User name to be used for the mysql instance
155 
156  -host Host name of the mysql instance (defualt ens-staging)
157 
158  i.e. perl test_code_from_html -path ~/src
159 
160 EOF
161 }
process_code
public process_code()
Bio::EnsEMBL::Registry
Definition: Registry.pm:113
run
public run()
Bio::EnsEMBL::Registry::load_registry_from_db
public Int load_registry_from_db()
usage
public usage()