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

Annotation of /FigKernelPackages/NCBI_taxonomy.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download) (as text)

1 : golsen 1.1 package NCBI_taxonomy;
2 :    
3 : golsen 1.2 #
4 :     # This is a SAS Component
5 :     #
6 :    
7 : golsen 1.1 #===============================================================================
8 :     # Get information from the NCBI taxonomy database.
9 :     #
10 :     # \%data = taxonomy( $taxid, { hash => 1 } )
11 :     #
12 :     # @data = taxonomy( $taxid, { key => $key } )
13 :     # \@data = taxonomy( $taxid, { key => $key } )
14 :     #
15 :     # @data = taxonomy( $taxid, { path => \@path } )
16 :     # \@data = taxonomy( $taxid, { path => \@path } )
17 :     #
18 :     # \@xml = taxonomy( $taxid, { xml => 1 } )
19 :     #
20 :     # Keys:
21 :     #
22 : golsen 1.4 # CommonName # Common name (might be a list)
23 :     # Division # GenBank division (not 3-letter abbrev)
24 :     # GeneticCode # Genetic code number
25 :     # Lineage # Full lineage text, semicolon separated
26 :     # LineageAbbrev # Abbreviated lineage text, semicolon sep.
27 :     # LineageAbbrevIds # List of abbreviated lineage ids
28 :     # LineageAbbrevNames # List of abbreviated lineage names
29 :     # LineageAbbrevPlus # Abbreviated lineage with full lineage suffix
30 :     # LineageAbbrevPlusIds # List of LineageAbbrevPlus ids
31 :     # LineageAbbrevPlusNames # List of LineageAbbrevPlus names
32 :     # LineageExIds # See LineageIds
33 :     # LineageIds # List of full lineage taxids
34 :     # LineageExNames # List of full lineage names
35 :     # LineageNames # See LineageNames
36 :     # MitochondrialGeneticCode # Mitochondrial genetic code number
37 :     # Parent # Parent node taxid
38 :     # Rank # Rank
39 :     # ScientificName # Scientific name (binomial for species)
40 : golsen 1.1 #
41 :     # In the first form, a hash reference is returned with the keys listed above.
42 :     # Each associated value is a reference to a list, which usually only includes
43 :     # one item. The LineageEx... keys are lists of the complete lineage.
44 :     #
45 :     # The second form returns the data associated with a given key from the above
46 :     # list.
47 :     #
48 :     # The third form allows access to an anrbrary datum in the XML heirarchy.
49 :     # The following 2 requests are equivalent:
50 :     #
51 :     # taxonomy( $taxid, { key => 'GeneticCode' } )
52 :     # taxonomy( $taxid, { path => [ qw( Taxon GeneticCode GCId ) ] } )
53 :     #
54 :     # The last form returns the XML hierarchy in perl lists of the form:
55 :     #
56 : golsen 1.4 # [ tag, [ enclosed_items, ... ] ]
57 : golsen 1.1 #
58 :     #-------------------------------------------------------------------------------
59 :     # It does not seem to be possible to get the short lineage without loading
60 :     # the taxonmy browser page. Oh bother.
61 :     #
62 : golsen 1.3 # $lineage = lineage_abbreviated( $taxid );
63 : golsen 1.1 #
64 :     #-------------------------------------------------------------------------------
65 :     # Functions for doing the major steps:
66 :     #-------------------------------------------------------------------------------
67 :     # Get and parse the XML for an NCBI taxonomy entry:
68 :     #
69 :     # $xml = taxonomy_xml( $taxid )
70 :     #
71 :     # The XML is composed of items of the form:
72 :     #
73 :     # [ tag, [ content, ... ] ]
74 :     #
75 :     #-------------------------------------------------------------------------------
76 :     # Extract specific items from the NCBI taxonomy by keyword:
77 :     #
78 :     # @key_valuelist = taxonomy_data( $xml, @data_keys );
79 :     #
80 :     #-------------------------------------------------------------------------------
81 :     # Extract a specific item from the NCBI taxonomy by complete path through
82 :     # XML tags.
83 :     #
84 :     # @values = taxonomy_datum( $xml, @path );
85 :     #
86 :     #-------------------------------------------------------------------------------
87 :    
88 :     use strict;
89 :     use SeedAware;
90 :     use Data::Dumper;
91 :    
92 :     #
93 :     # This hash is used to store paths to specific data.
94 :     #
95 :     my %path = (
96 :     CommonName => [ qw( Taxon OtherNames CommonName ) ],
97 :     Division => [ qw( Taxon Division ) ],
98 :     GCId => [ qw( Taxon GeneticCode GCId ) ],
99 :     GeneticCode => [ qw( Taxon GeneticCode GCId ) ],
100 :     Lineage => [ qw( Taxon Lineage ) ],
101 : golsen 1.4 LineageIds => [ qw( Taxon LineageEx Taxon TaxId ) ],
102 :     LineageNames => [ qw( Taxon LineageEx Taxon ScientificName ) ],
103 : golsen 1.1 MGCId => [ qw( Taxon MitoGeneticCode MGCId ) ],
104 :     MitoGeneticCode => [ qw( Taxon MitoGeneticCode MGCId ) ],
105 :     Parent => [ qw( Taxon ParentTaxId ) ],
106 :     ParentTaxId => [ qw( Taxon ParentTaxId ) ],
107 :     Rank => [ qw( Taxon Rank ) ],
108 :     ScientificName => [ qw( Taxon ScientificName ) ],
109 :     TaxId => [ qw( Taxon TaxId ) ],
110 :     Taxonomy => [ qw( Taxon Lineage ) ],
111 :     );
112 :    
113 :    
114 :     sub taxonomy
115 :     {
116 :     my $taxid = shift;
117 : golsen 1.4 return undef unless defined $taxid && $taxid =~ s/^(\d+)/$1/;
118 : golsen 1.1
119 :     my $options = ( ! @_ || ! $_[0] ) ? { key => 'Lineage' }
120 :     : ( ! ref( $_[0] ) ) ? { key => $_[0] }
121 :     : ( ref( $_[0] ) eq 'ARRAY' ) ? { key => $_[0]->[0] }
122 :     : ( ref( $_[0] ) ne 'HASH' ) ? { key => 'Lineage' }
123 :     : $_[0];
124 :    
125 : golsen 1.4 # This is the only instance in which we do not need the XML:
126 :    
127 :     my $ps_key = pseudo_key( $options->{ key } );
128 :     if ( $ps_key eq 'LineageAbbrev' )
129 :     {
130 :     my $datum = lineage_abbreviated( $taxid );
131 :     return wantarray ? ( $datum ) : [ $datum ];
132 :     }
133 :    
134 : golsen 1.1 my $taxon_xml = taxonomy_xml( $taxid );
135 :     return () unless $taxon_xml && ref( $taxon_xml ) eq 'ARRAY' && @$taxon_xml;
136 :    
137 :     # XML
138 :    
139 :     return $taxon_xml if $options->{ xml };
140 :    
141 : golsen 1.4 # Hash of keys and values, or an type that we need to derive
142 : golsen 1.1
143 : golsen 1.4 if ( $options->{ hash } || $ps_key )
144 : golsen 1.1 {
145 :     my %results = ();
146 : golsen 1.4
147 :     # These are the keys for deriving lineages:
148 :    
149 :     foreach my $key ( qw( Lineage LineageNames LineageIds ) )
150 :     {
151 :     my @values = taxonomy_datum( $taxon_xml, @{ $path{ $key } } );
152 :     $results{ $key } = \@values if @values;
153 :     }
154 :    
155 :     # These will probably never happen, but it could be useful:
156 :    
157 :     my $Lineage = $results{ Lineage } && @{ $results{ Lineage } } ? $results{ Lineage }->[0] : '';
158 :     if ( ! $results{ LineageNames } && $Lineage )
159 :     {
160 :     $results{ LineageNames } = text2list( $Lineage );
161 :     }
162 :    
163 :     if ( ! $Lineage && $results{ LineageNames } && @{ $results{ LineageNames } } )
164 :     {
165 :     $results{ Lineage } = list2text( $results{ LineageNames } );
166 :     $Lineage = $results{ Lineage }->[0]
167 :     }
168 :    
169 :     # Get the abbreviated lineage:
170 :    
171 :     my $LineageAbbrev = lineage_abbreviated( $taxid );
172 :     $results{ LineageAbbrev } = [ $LineageAbbrev ];
173 :    
174 :     if ( $LineageAbbrev )
175 :     {
176 :     my $AbbrevNames = text2list( $LineageAbbrev );
177 :     return wantarray ? @$AbbrevNames : $AbbrevNames if $ps_key eq 'LineageAbbrevNames';
178 :    
179 :     my %id;
180 :     my $LineageIds = $results{ LineageIds };
181 :     my $LineageNames = $results{ LineageNames };
182 :     if ( $LineageIds && $LineageNames && @$LineageIds == @$LineageNames )
183 :     {
184 :     for ( my $i = 0; $i < @$LineageIds; $i++ )
185 :     {
186 :     $id{ $LineageNames->[ $i ] } = $LineageIds->[ $i ];
187 :     }
188 :    
189 :     my $AbbrevIds = [ map { $id{ $_ } } @$AbbrevNames ];
190 :     return wantarray ? @$AbbrevIds : $AbbrevIds if $ps_key eq 'LineageAbbrevIds';
191 :    
192 :     $results{ LineageAbbrevIds } = $AbbrevIds;
193 :     }
194 :    
195 :     $results{ LineageAbbrevNames } = $AbbrevNames;
196 :    
197 :     # There is a peculiarity of the abbreviated lineage that it does not
198 :     # include the species binomial. We will add LineageAbbrevPlus, which
199 :     # adds a suffix of categories at the end of the full lineage, but not
200 :     # in the abbreviated lineage.
201 :    
202 :     if ( $LineageNames && @$LineageNames )
203 :     {
204 :     my @suffix = ();
205 :     foreach ( reverse @$LineageNames )
206 :     {
207 :     last if $_ eq $AbbrevNames->[-1];
208 :     push @suffix, $_;
209 :     }
210 :     # die "NCBI_taxonomy::taxonomy: Terminal taxon in abbreviated lineage not found in full lineage.\n $LineageAbbrev\n $Lineage\n" if @suffix == @$LineageNames;
211 :    
212 :     @suffix = () if @suffix == @$LineageNames;
213 :     my $AbbrevPlusNames = [ @$AbbrevNames, @suffix ];
214 :    
215 :     return wantarray ? @$AbbrevPlusNames : $AbbrevPlusNames if $ps_key eq 'LineageAbbrevPlusNames';
216 :    
217 :     my $AbbrevPlusIds = keys %id ? [ map { $id{ $_ } } @$AbbrevPlusNames ] : undef;
218 :    
219 :     return wantarray ? @$AbbrevPlusIds : $AbbrevPlusIds if $ps_key eq 'LineageAbbrevPlusIds';
220 :    
221 :     my $AbbrevPlus = list2text( $AbbrevPlusNames );
222 :     return wantarray ? @$AbbrevPlus : $AbbrevPlus if $ps_key eq 'LineageAbbrevPlus';
223 :    
224 :     $results{ LineageAbbrevPlusNames } = $AbbrevPlusNames;
225 :     $results{ LineageAbbrevPlusIds } = $AbbrevPlusIds if $AbbrevPlusIds;
226 :     $results{ LineageAbbrevPlus } = $AbbrevPlus;
227 :     }
228 :     }
229 :    
230 :     # These are other keys that we can get from the XML:
231 :    
232 :     my @keys = qw( CommonName
233 :     Division
234 :     GeneticCode
235 :     MitochondrialGeneticCode
236 :     Parent
237 :     Rank
238 :     ScientificName
239 :     );
240 : golsen 1.1 foreach my $key ( @keys )
241 :     {
242 :     my @values = taxonomy_datum( $taxon_xml, @{ $path{ $key } } );
243 :     $results{ $key } = \@values if @values;
244 :     }
245 : golsen 1.4
246 : golsen 1.1 return \%results;
247 :     }
248 :    
249 :     my $path = $options->{ path };
250 : golsen 1.4 if ( ! ( $path && ( ref( $path ) eq 'ARRAY' ) && @$path ) )
251 : golsen 1.1 {
252 :     my $key = cannonical_key( $options->{ key } );
253 :     $path = $path{ $key };
254 :     }
255 :    
256 :     my @data = taxonomy_datum( $taxon_xml, @$path );
257 :    
258 :     wantarray ? @data : \@data;
259 :     }
260 :    
261 :    
262 : golsen 1.4 sub text2list { [ split /; +/, $_[0] ] }
263 :    
264 :    
265 :     sub list2text { [ join '; ', @{ $_[0] } ] }
266 :    
267 :    
268 :     # These are not in the XML, but we can build them:
269 :    
270 :     sub pseudo_key
271 :     {
272 :     local $_ = shift || '';
273 :     return m/Abb.*Pl.*Nam/i ? 'LineageAbbrevPlusNames' :
274 :     m/Abb.*Pl.*Id/i ? 'LineageAbbrevPlusIds' :
275 :     m/Abb.*Pl/i ? 'LineageAbbrevPlus' :
276 :     m/Abb.*Nam/i ? 'LineageAbbrevNames' :
277 :     m/Abb.*Id/i ? 'LineageAbbrevIds' :
278 :     m/Abb/i ? 'LineageAbbrev' :
279 :     m/^Lin.*Sh/i ? 'LineageAbbrev' : # LineageShort
280 :     '';
281 :     }
282 :    
283 :    
284 : golsen 1.1 sub cannonical_key
285 :     {
286 :     local $_ = shift || '';
287 : golsen 1.4 return ( ! $_ ) ? 'Lineage' :
288 :     m/^Cod/i ? 'GeneticCode' :
289 :     m/^Com/i ? 'CommonName' :
290 :     m/^Div/i ? 'Division' :
291 :     m/^Gen/i ? 'GeneticCode' :
292 :     m/^Lin.*Id/i ? 'LineageIds' :
293 :     m/^Lin.*Nam/i ? 'LineageNames' :
294 :     m/^Lin/i ? 'Lineage' :
295 :     m/^Mit/i ? 'MitochondrialGeneticCode' :
296 :     m/^Par/i ? 'Parent' :
297 :     m/^Ran/i ? 'Rank' :
298 :     m/^Sci/i ? 'ScientificName' :
299 :     m/^Tax/i ? 'Lineage' :
300 :     'Lineage';
301 : golsen 1.1 }
302 :    
303 :    
304 :     #-------------------------------------------------------------------------------
305 :     # Get and parse the NCBI XML for a taxonomy entry:
306 :     #
307 :     # $xml = taxonomy_xml( $taxid );
308 :     #
309 :     # The XML is composed of items of the form:
310 :     #
311 :     # [ tag, [ content, ... ] ]
312 :     #
313 :     #-------------------------------------------------------------------------------
314 :    
315 :     sub taxonomy_xml
316 :     {
317 :     my $curl = SeedAware::executable_for( 'curl' )
318 :     or die "Could not find executable for 'curl'.\n";
319 :    
320 :     my $url = 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi';
321 :     my $id = shift;
322 :    
323 :     my %request = ( db => 'taxonomy',
324 :     id => $id,
325 :     report => 'xml',
326 :     );
327 :     my $request = join( '&', map { "$_=" . url_encode( $request{$_}||'' ) } qw( db id report ) );
328 :    
329 :     my $pass = 0;
330 :     my @return = # Remove XML header
331 :     grep { /./ && ! /^<[?!]/ && ! /^<\/?pre>/ }
332 :     grep { if ( /^<pre>/ ) { $pass = 1 } elsif ( /^<\/pre>/ ) { $pass = 0 }; $pass }
333 :     map { xml_unescape( $_ ) } # Decode HTML body content
334 :     map { chomp; s/^\s+//; s/\s+$//; $_ }
335 :     SeedAware::run_gathering_output( $curl, '-s', "$url?$request" );
336 :     ( xml_items( \@return, undef ) )[0];
337 :     }
338 :    
339 :    
340 :     # This is a very crude parser that handles NCBI XML:
341 :    
342 :     sub xml_items
343 :     {
344 :     my ( $list, $close ) = @_;
345 :     my @items = defined $close ? ( $close ) : ();
346 :     while ( my $item = xml_item( $list, $close ) ) { push @items, $item }
347 :     @items;
348 :     }
349 :    
350 :    
351 :     sub xml_item
352 :     {
353 :     my ( $list, $close ) = @_;
354 :     local $_ = shift @$list;
355 :     return undef if ! $_ || defined $close && /^<\/$close>/;
356 :     die "Bad closing tag '$_'." if /^<\//;
357 : golsen 1.4 return( [ $1, xml_unescape($2) ] ) if /^<(\S+)>(.*)<\/(\S+)>$/ && $1 eq $3;
358 : golsen 1.1 return( [ $1, $1 ] ) if /^<(\S+)\s*\/>$/;
359 :     die "Bad line '$_'." if ! /^<(\S+)>$/;
360 :     [ xml_items( $list, $1 ) ];
361 :     }
362 :    
363 :    
364 :     #-------------------------------------------------------------------------------
365 :     # Extract items from the taxonomy:
366 :     #-------------------------------------------------------------------------------
367 :    
368 :     #
369 :     # @key_valuelist = taxonomy_data( $xml, @data_keys );
370 :     #
371 :     sub taxonomy_data
372 :     {
373 :     my $xml = shift;
374 :     return () unless $xml && ref $xml eq 'ARRAY' && @$xml > 1;
375 :     map { [ $_, [ taxonomy_datum( $xml, @{$path{$_}} ) ] ] } grep { $path{$_} } @_;
376 :     }
377 :    
378 :    
379 :     #
380 :     # @values = taxonomy_datum( $xml, @path );
381 :     #
382 :     sub taxonomy_datum
383 :     {
384 :     my ( $xml, @path ) = @_;
385 :    
386 :     return () unless $xml && ref $xml eq 'ARRAY' && @$xml > 1 && @path;
387 :    
388 :     my $match = $xml->[0] eq $path[0];
389 :     return () unless $match || ( $xml->[0] eq 'TaxaSet' );
390 :    
391 :     shift @path if $match;
392 :    
393 :     @path ? map { taxonomy_datum( $_, @path ) } @$xml[ 1 .. (@$xml-1) ]
394 :     : grep { defined() && ! ref() } @$xml[ 1 .. (@$xml-1) ];
395 :     }
396 :    
397 :    
398 :     #-------------------------------------------------------------------------------
399 :     # It does not seem to be possible to get the short lineage without loading
400 :     # the taxonmy browser page. Oh bother.
401 :     #
402 : golsen 1.3 # $lineage = lineage_abbreviated( $taxid );
403 : golsen 1.1 #
404 :     #-------------------------------------------------------------------------------
405 : golsen 1.3 sub lineage_abbreviated
406 : golsen 1.1 {
407 :     my $curl = SeedAware::executable_for( 'curl' )
408 :     or die "Could not find executable for 'curl'.\n";
409 :    
410 :     my $id = shift;
411 :     defined $id or return undef;
412 :    
413 :     my $url = 'http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi';
414 :     my %request = ( id => $id, lin => 's', lvl => 1 );
415 :     my $request = join( '&', map { "$_=" . url_encode( $request{$_}||'' ) } qw( id lin lvl ) );
416 :    
417 :     chomp( my @html = SeedAware::run_gathering_output( $curl, '-s', "$url?$request" ) );
418 :    
419 :     local $_;
420 :     while ( defined( $_ = shift @html ) && ! s/^.*Lineage.*abbreviated\s*// ) {}
421 :     return undef if ! defined $_;
422 :    
423 :     my @part = m/<A [^>]*TITLE=[^>]*>([^<]*)<\/A>/gi;
424 :     if ( ! @part )
425 :     {
426 :     $_ = shift @html;
427 :     @part = m/<A [^>]*TITLE=[^>]*>([^<]*)<\/A>/gi if defined $_;
428 :     return undef if ! @part;
429 :     }
430 :    
431 :     join( '; ', grep { $_ ne 'root' }
432 :     map { s/\s+/ /g; s/^ //; s/ $//; xml_unescape( $_ ) }
433 :     @part
434 :     );
435 :     }
436 :    
437 :    
438 :    
439 :     #-------------------------------------------------------------------------------
440 :     # Auxiliary functions:
441 :     #-------------------------------------------------------------------------------
442 :     #
443 :     # Function to escape the called URL:
444 :    
445 :     my %url_esc = ( ( ' ' => '%20',
446 :     '"' => '%22',
447 :     '#' => '%23',
448 :     '$' => '%24',
449 :     ',' => '%2C' ),
450 :     qw( ! %21
451 :     % %25
452 :     + %2B
453 :     & %2D
454 :     / %2F
455 :     : %3A
456 :     ; %3B
457 :     < %3C
458 :     = %3D
459 :     > %3E
460 :     ? %3F
461 :     @ %40
462 :     [ %5B
463 :     \ %5C
464 :     ] %5D
465 :     ` %60
466 :     { %7B
467 :     | %7C
468 :     } %7D
469 :     ~ %7E
470 :     )
471 :     );
472 :    
473 :     sub url_encode { join( '', map { $url_esc{$_}||$_ } split //, $_[0] ) }
474 :    
475 :    
476 :     # http://en.wikipedia.org/wiki/List_of_XML_and_HTML_character_entity_references
477 :    
478 :     my %predef_ent;
479 :     BEGIN {
480 :     %predef_ent =
481 :     ( # XML predefined entities:
482 :     amp => '&',
483 :     apos => "'",
484 :     gt => '>',
485 :     lt => '<',
486 :     quot => '"',
487 :    
488 :     # HTML predefined entities:
489 :     nbsp => ' ',
490 :     iexcl => '¡',
491 :     cent => '¢',
492 :     pound => '£',
493 :     curren => '¤',
494 :     yen => '¥',
495 :     brvbar => '¦',
496 :     sect => '§',
497 :     uml => '¨',
498 :     copy => '©',
499 :     ordf => 'ª',
500 :     laquo => '«',
501 :     not => '¬',
502 :     shy => ' ',
503 :     reg => '®',
504 :     macr => '¯',
505 :     deg => '°',
506 :     plusmn => '±',
507 :     sup2 => '²',
508 :     sup3 => '³',
509 :     acute => '´',
510 :     micro => 'µ',
511 :     para => '¶',
512 :     middot => '·',
513 :     cedil => '¸',
514 :     sup1 => '¹',
515 :     ordm => 'º',
516 :     raquo => '»',
517 :     frac14 => '¼',
518 :     frac12 => '½',
519 :     frac34 => '¾',
520 :     iquest => '¿',
521 :     Agrave => 'À',
522 :     Aacute => 'Á',
523 :     Acirc => 'Â',
524 :     Atilde => 'Ã',
525 :     Auml => 'Ä',
526 :     Aring => 'Å',
527 :     AElig => 'Æ',
528 :     Ccedil => 'Ç',
529 :     Egrave => 'È',
530 :     Eacute => 'É',
531 :     Ecirc => 'Ê',
532 :     Euml => 'Ë',
533 :     Igrave => 'Ì',
534 :     Iacute => 'Í',
535 :     Icirc => 'Î',
536 :     Iuml => 'Ï',
537 :     ETH => 'Ð',
538 :     Ntilde => 'Ñ',
539 :     Ograve => 'Ò',
540 :     Oacute => 'Ó',
541 :     Ocirc => 'Ô',
542 :     Otilde => 'Õ',
543 :     Ouml => 'Ö',
544 :     times => '×',
545 :     Oslash => 'Ø',
546 :     Ugrave => 'Ù',
547 :     Uacute => 'Ú',
548 :     Ucirc => 'Û',
549 :     Uuml => 'Ü',
550 :     Yacute => 'Ý',
551 :     THORN => 'Þ',
552 :     szlig => 'ß',
553 :     agrave => 'à',
554 :     aacute => 'á',
555 :     acirc => 'â',
556 :     atilde => 'ã',
557 :     auml => 'ä',
558 :     aring => 'å',
559 :     aelig => 'æ',
560 :     ccedil => 'ç',
561 :     egrave => 'è',
562 :     eacute => 'é',
563 :     ecirc => 'ê',
564 :     euml => 'ë',
565 :     igrave => 'ì',
566 :     iacute => 'í',
567 :     icirc => 'î',
568 :     iuml => 'ï',
569 :     eth => 'ð',
570 :     ntilde => 'ñ',
571 :     ograve => 'ò',
572 :     oacute => 'ó',
573 :     ocirc => 'ô',
574 :     otilde => 'õ',
575 :     ouml => 'ö',
576 :     divide => '÷',
577 :     oslash => 'ø',
578 :     ugrave => 'ù',
579 :     uacute => 'ú',
580 :     ucirc => 'û',
581 :     uuml => 'ü',
582 :     yacute => 'ý',
583 :     thorn => 'þ',
584 :     yuml => 'ÿ',
585 :     OElig => 'Œ',
586 :     oelig => 'œ',
587 :     Scaron => 'Š',
588 :     scaron => 'š',
589 :     Yuml => 'Ÿ',
590 :     fnof => 'ƒ',
591 :     circ => 'ˆ',
592 :     tilde => '˜',
593 :     Alpha => 'Α',
594 :     Beta => 'Β',
595 :     Gamma => 'Γ',
596 :     Delta => 'Δ',
597 :     Epsilon => 'Ε',
598 :     Zeta => 'Ζ',
599 :     Eta => 'Η',
600 :     Theta => 'Θ',
601 :     Iota => 'Ι',
602 :     Kappa => 'Κ',
603 :     Lambda => 'Λ',
604 :     Mu => 'Μ',
605 :     Nu => 'Ν',
606 :     Xi => 'Ξ',
607 :     Omicron => 'Ο',
608 :     Pi => 'Π',
609 :     Rho => 'Ρ',
610 :     Sigma => 'Σ',
611 :     Tau => 'Τ',
612 :     Upsilon => 'Υ',
613 :     Phi => 'Φ',
614 :     Chi => 'Χ',
615 :     Psi => 'Ψ',
616 :     Omega => 'Ω',
617 :     alpha => 'α',
618 :     beta => 'β',
619 :     gamma => 'γ',
620 :     delta => 'δ',
621 :     epsilon => 'ε',
622 :     zeta => 'ζ',
623 :     eta => 'η',
624 :     theta => 'θ',
625 :     iota => 'ι',
626 :     kappa => 'κ',
627 :     lambda => 'λ',
628 :     mu => 'μ',
629 :     nu => 'ν',
630 :     xi => 'ξ',
631 :     omicron => 'ο',
632 :     pi => 'π',
633 :     rho => 'ρ',
634 :     sigmaf => 'ς',
635 :     sigma => 'σ',
636 :     tau => 'τ',
637 :     upsilon => 'υ',
638 :     phi => 'φ',
639 :     chi => 'χ',
640 :     psi => 'ψ',
641 :     omega => 'ω',
642 :     thetasym => 'ϑ',
643 :     upsih => 'ϒ',
644 :     piv => 'ϖ',
645 :     ensp => ' ',
646 :     emsp => ' ',
647 :     thinsp => ' ',
648 :     zwnj => ' ',
649 :     zwj => ' ',
650 :     lrm => ' ',
651 :     rlm => ' ',
652 :     ndash => '–',
653 :     mdash => '—',
654 :     lsquo => '‘',
655 :     rsquo => '’',
656 :     sbquo => '‚',
657 :     ldquo => '“',
658 :     rdquo => '”',
659 :     bdquo => '„',
660 :     dagger => '†',
661 :     Dagger => '‡',
662 :     bull => '•',
663 :     hellip => '…',
664 :     permil => '‰',
665 :     prime => '′',
666 :     Prime => '″',
667 :     lsaquo => '‹',
668 :     rsaquo => '›',
669 :     oline => '‾',
670 :     frasl => '⁄',
671 :     euro => '€',
672 :     image => 'ℑ',
673 :     weierp => '℘',
674 :     real => 'ℜ',
675 :     trade => '™',
676 :     alefsym => 'ℵ',
677 :     larr => '←',
678 :     uarr => '↑',
679 :     rarr => '→',
680 :     darr => '↓',
681 :     harr => '↔',
682 :     crarr => '↵',
683 :     lArr => '⇐',
684 :     uArr => '⇑',
685 :     rArr => '⇒',
686 :     dArr => '⇓',
687 :     hArr => '⇔',
688 :     forall => '∀',
689 :     part => '∂',
690 :     exist => '∃',
691 :     empty => '∅',
692 :     nabla => '∇',
693 :     isin => '∈',
694 :     notin => '∉',
695 :     ni => '∋',
696 :     prod => '∏',
697 :     sum => '∑',
698 :     minus => '−',
699 :     lowast => '∗',
700 :     radic => '√',
701 :     prop => '∝',
702 :     infin => '∞',
703 :     ang => '∠',
704 :     and => '∧',
705 :     or => '∨',
706 :     cap => '∩',
707 :     cup => '∪',
708 :     int => '∫',
709 :     there4 => '∴',
710 :     sim => '∼',
711 :     cong => '≅',
712 :     asymp => '≈',
713 :     ne => '≠',
714 :     equiv => '≡',
715 :     le => '≤',
716 :     ge => '≥',
717 :     sub => '⊂',
718 :     sup => '⊃',
719 :     nsub => '⊄',
720 :     sube => '⊆',
721 :     supe => '⊇',
722 :     oplus => '⊕',
723 :     otimes => '⊗',
724 :     perp => '⊥',
725 :     sdot => '⋅',
726 :     lceil => '⌈',
727 :     rceil => '⌉',
728 :     lfloor => '⌊',
729 :     rfloor => '⌋',
730 :     lang => '〈',
731 :     rang => '〉',
732 :     loz => '◊',
733 :     spades => '♠',
734 :     clubs => '♣',
735 :     hearts => '♥',
736 :     diams => '♦',
737 :     );
738 :     }
739 :    
740 :    
741 :     sub xml_unescape
742 :     {
743 :     local $_ = shift;
744 :     s/&#(\d+);/chr($1)/eg; # Numeric character (html)
745 :     s/&#x([\dA-Fa-f]+);/chr(hex($1))/eg; # Numeric character (xml)
746 :     s/&(\w+);/$predef_ent{$1}||"&$1;"/eg; # Predefined entity
747 :     $_;
748 :     }
749 :    
750 :    
751 :     1;
752 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3