/usr/share/perl5/MKDoc/XML/Decode.pm is in libmkdoc-xml-perl 0.75-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | # -------------------------------------------------------------------------------------
# MKDoc::XML::Decode
# -------------------------------------------------------------------------------------
# Author : Jean-Michel Hiver
# Copyright : (c) MKDoc Holdings Ltd, 2003
#
# This modules expands XML entities & > < " and '.
#
# This module is distributed under the same license as Perl itself.
# -------------------------------------------------------------------------------------
package MKDoc::XML::Decode;
use warnings;
use strict;
our %Modules = ();
our $WARN = 0;
# import all plugins once
foreach my $include_dir (@INC)
{
my $dir = "$include_dir/MKDoc/XML/Decode";
if (-e $dir and -d $dir)
{
opendir DD, $dir or do {
warn "Cannot open directory $dir. Reason: $!";
next;
};
my @modules = map { s/\.pm$//; $_ }
grep /\.pm$/,
grep !/^\./,
readdir (DD);
closedir DD;
foreach my $module (@modules)
{
$module =~ /^(\w+)$/;
$module = $1;
eval "use MKDoc::XML::Decode::$module";
$@ and warn "Cannot import module $module. Reason: $@";
my $name = "MKDoc::XML::Decode::$module"->can ('module_name') ?
"MKDoc::XML::Decode::$module"->module_name() :
lc ($module);
$Modules{$name} = "MKDoc::XML::Decode::$module";
}
}
}
sub new
{
my $class = shift;
@_ = sort keys %Modules unless (scalar @_);
my $self = bless [ map {
$Modules{$_} ? $Modules{$_} : do {
warn "Module $_ not found - Ignoring";
();
} } @_ ], $class;
return $self;
}
sub entity_to_char
{
my $self = shift;
my $char = shift;
for (@{$self}) {
my $res = $_->process ($char);
return $res if (defined $res);
};
warn "Could not expand &$char;" if ($WARN);
return "&$char;";
}
sub process
{
(@_ == 2) or warn "MKDoc::XML::Encode::process() should be called with two arguments";
my $self = shift;
my $data = join '', map { defined $_ ? $_ : () } @_;
$data =~ s/&(#?[0-9A-Za-z]+);/$self->entity_to_char ($1)/eg;
return $data;
}
1;
__END__
=head1 NAME
MKDoc::XML::Decode - Expands XML entities
=head1 SYNOPSIS
use MKDoc::XML::Decode;
my $decode = new MKDoc::XML::Decode qw/xml xhtml numeric/;
# $xml is now "Chris' Baloon"
my $xml = MKDoc::XML::Decode->process ("Chris' Baloon");
=head1 SUMMARY
MKDoc::XML::Decode is a very simple module with pluggable entity decoding mechanism.
At the moment there are three modules:
xml - Decodes ' " > < and &
xhtml - Decodes XHTML entities such as é
numeric - Decodes numeric entities such as A
That's it.
This module and its counterpart L<MKDoc::XML::Encode> are used by L<MKDoc::XML::Dumper>
to XML-encode and XML-decode litterals.
=head1 API
=head2 my $decode_object = new MKDoc::XML::Decode (@modules);
Constructs a new decode object using the modules specified in @modules.
=head2 my $decoded = $decode_object->decode ($stuff);
Decodes $stuff and returns it into $decoded.
Any entity which is not recognized will be returned as is but will trigger a warning.
=head1 AUTHOR
Copyright 2003 - MKDoc Holdings Ltd.
Author: Jean-Michel Hiver
This module is free software and is distributed under the same license as Perl
itself. Use it at your own risk.
=head1 SEE ALSO
L<MKDoc::XML::Encode>
=cut
|