Initial Windows agent repository

This commit is contained in:
Frank Harris 2026-06-08 10:45:20 -05:00
commit a0db0c2e5b
10589 changed files with 3844063 additions and 0 deletions

View file

@ -0,0 +1,269 @@
package Clone;
use strict;
require Exporter;
use XSLoader ();
our @ISA = qw(Exporter);
our @EXPORT;
our @EXPORT_OK = qw( clone );
our $VERSION = '0.50';
XSLoader::load('Clone', $VERSION);
1;
__END__
=head1 NAME
Clone - recursively copy Perl datatypes
=for html
<a href="https://github.com/garu/Clone/actions/workflows/test.yml"><img src="https://github.com/garu/Clone/actions/workflows/test.yml/badge.svg" alt="Build Status"></a>
<a href="https://metacpan.org/pod/Clone"><img src="https://badge.fury.io/pl/Clone.svg" alt="CPAN version"></a>
=head1 SYNOPSIS
use Clone 'clone';
my $data = {
set => [ 1 .. 50 ],
foo => {
answer => 42,
object => SomeObject->new,
},
};
my $cloned_data = clone($data);
$cloned_data->{foo}{answer} = 1;
print $cloned_data->{foo}{answer}; # '1'
print $data->{foo}{answer}; # '42'
You can also add it to your class:
package Foo;
use parent 'Clone';
sub new { bless {}, shift }
package main;
my $obj = Foo->new;
my $copy = $obj->clone;
=head1 DESCRIPTION
This module provides a C<clone()> method which makes recursive
copies of nested hash, array, scalar and reference types,
including tied variables and objects.
C<clone()> takes a scalar argument and duplicates it. To duplicate lists,
arrays or hashes, pass them in by reference, e.g.
my $copy = clone (\@array);
# or
my %copy = %{ clone (\%hash) };
=head1 EXAMPLES
=head2 Cloning Blessed Objects
package Person;
sub new {
my ($class, $name) = @_;
bless { name => $name, friends => [] }, $class;
}
package main;
use Clone 'clone';
my $person = Person->new('Alice');
my $clone = clone($person);
# $clone is a separate object with the same data
push @{$person->{friends}}, 'Bob';
print scalar @{$clone->{friends}}; # 0
=head2 Handling Circular References
Clone properly handles circular references, preventing infinite loops:
my $a = { name => 'A' };
my $b = { name => 'B', ref => $a };
$a->{ref} = $b; # circular reference
my $clone = clone($a);
# Circular structure is preserved in the clone
=head2 Cloning Weakened References
use Scalar::Util 'weaken';
my $obj = { data => 'important' };
my $container = { strong => $obj, weak => $obj };
weaken($container->{weak});
my $clone = clone($container);
# Both strong and weak references are preserved correctly
=head2 Cloning Tied Variables
use Tie::Hash;
tie my %hash, 'Tie::StdHash';
%hash = (a => 1, b => 2);
my $clone = clone(\%hash);
# The tied behavior is preserved in the clone
=head1 LIMITATIONS
=over 4
=item * Maximum Recursion Depth
Clone uses a recursion depth counter to prevent stack overflow.
The default limit is 4000 rdepth units on Linux/macOS and 2000 on
Windows/Cygwin. Each nesting level consumes approximately 2 rdepth
units, so the effective limits are roughly 2000 nesting levels on
Linux/macOS and 1000 on Windows/Cygwin.
For arrays, exceeding the limit triggers an iterative fallback that
avoids stack overflow. For other reference types (hashes, scalars),
exceeding the limit produces a warning and a shallow copy.
You can override the depth limit by passing it as the second argument
to C<clone()>:
my $copy = clone($data, 8000); # allow deeper recursion
=item * Filehandles and IO Objects
Filehandles and IO objects are cloned, but the underlying file descriptor
is shared. Both the original and cloned filehandle will refer to the same
file position. For DBI database handles and similar objects, Clone attempts
to handle them safely, but behavior may vary depending on the object type.
=item * Code References
Code references (subroutines) are cloned by reference, not by value.
The cloned coderef points to the same subroutine as the original.
=item * Thread Safety
Clone is not explicitly thread-safe. Use appropriate synchronization
when cloning data structures across threads.
=back
=head1 PERFORMANCE
Clone is implemented in C using Perl's XS interface, making it very fast
for most use cases.
=over 4
=item * When to use Clone
Clone is optimized for speed and works best with:
=over 4
=item * Shallow to medium-depth structures (3 levels or fewer)
=item * Data structures that need fast cloning in hot code paths
=item * Structures containing blessed objects and tied variables
=back
=item * When to use Storable::dclone
L<Storable>'s C<dclone()> may be faster for:
=over 4
=item * Very deep structures (4+ levels)
=item * When you need serialization features
=back
=back
Benchmarking your specific use case is recommended for performance-critical
applications.
=head1 CAVEATS
=over 4
=item * Cloned objects are deep copies
Changes to the clone do not affect the original, and vice versa. This
includes nested references and objects.
=item * Object internals
While Clone handles most blessed objects correctly, objects with XS
components or complex internal state may not clone as expected. Test
thoroughly with your specific object types.
=item * Memory usage
Cloning large data structures creates a complete copy in memory. Ensure
you have sufficient memory available.
=back
=head1 SEE ALSO
L<Storable>'s C<dclone()> is a flexible solution for cloning variables,
albeit slower for average-sized data structures. Simple
and naive benchmarks show that Clone is faster for data structures
with 3 or fewer levels, while C<dclone()> can be faster for structures
4 or more levels deep.
Other modules that may be of interest:
L<Clone::PP> - Pure Perl implementation of Clone
L<Scalar::Util> - For C<weaken()> and other scalar utilities
L<Data::Dumper> - For debugging and inspecting data structures
=head1 SUPPORT
=over 4
=item * Bug Reports and Feature Requests
Please report bugs on GitHub: L<https://github.com/garu/Clone/issues>
=item * Source Code
The source code is available on GitHub: L<https://github.com/garu/Clone>
=back
=head1 COPYRIGHT
Copyright 2001-2026 Ray Finch. All Rights Reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 AUTHOR
Ray Finch C<< <rdf@cpan.org> >>
Breno G. de Oliveira C<< <garu@cpan.org> >>,
Nicolas Rochelemagne C<< <atoomic@cpan.org> >>
and
Florian Ragwitz C<< <rafl@debian.org> >> perform routine maintenance
releases since 2012.
=cut

View file

@ -0,0 +1,494 @@
# -*- buffer-read-only: t -*-
#
# This file is auto-generated. ***ANY*** changes here will be lost
#
package Term::ReadKey;
use strict;
use warnings;
=head1 NAME
Term::ReadKey - A perl module for simple terminal control
=head1 SYNOPSIS
use Term::ReadKey;
ReadMode 4; # Turn off controls keys
while (not defined ($key = ReadKey(-1))) {
# No key yet
}
print "Get key $key\n";
ReadMode 0; # Reset tty mode before exiting
=head1 DESCRIPTION
Term::ReadKey is a compiled perl module dedicated to providing simple
control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
non-blocking reads, if the architecture allows, and some generalized handy
functions for working with terminals. One of the main goals is to have the
functions as portable as possible, so you can just plug in "use
Term::ReadKey" on any architecture and have a good likelihood of it working.
Version 2.30.01:
Added handling of arrows, page up/down, home/end, insert/delete keys
under Win32. These keys emit xterm-compatible sequences.
Works with Term::ReadLine::Perl.
=over 4
=item ReadMode MODE [, Filehandle]
Takes an integer argument or a string synonym (case insensitive), which
can currently be one of the following values:
INT SYNONYM DESCRIPTION
0 'restore' Restore original settings.
1 'normal' Change to what is commonly the default mode,
echo on, buffered, signals enabled, Xon/Xoff
possibly enabled, and 8-bit mode possibly disabled.
2 'noecho' Same as 1, just with echo off. Nice for
reading passwords.
3 'cbreak' Echo off, unbuffered, signals enabled, Xon/Xoff
possibly enabled, and 8-bit mode possibly enabled.
4 'raw' Echo off, unbuffered, signals disabled, Xon/Xoff
disabled, and 8-bit mode possibly disabled.
5 'ultra-raw' Echo off, unbuffered, signals disabled, Xon/Xoff
disabled, 8-bit mode enabled if parity permits,
and CR to CR/LF translation turned off.
These functions are automatically applied to the STDIN handle if no
other handle is supplied. Modes 0 and 5 have some special properties
worth mentioning: not only will mode 0 restore original settings, but it
cause the next ReadMode call to save a new set of default settings. Mode
5 is similar to mode 4, except no CR/LF translation is performed, and if
possible, parity will be disabled (only if not being used by the terminal,
however. It is no different from mode 4 under Windows.)
If you just need to read a key at a time, then modes 3 or 4 are probably
sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
control. If you use ReadMode 3, then you should install a SIGINT or END
handler to reset the terminal (via ReadMode 0) if the user aborts the
program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
is actually a good idea.)
If you are executing another program that may be changing the terminal mode,
you will either want to say
ReadMode 1; # same as ReadMode 'normal'
system('someprogram');
ReadMode 1;
which resets the settings after the program has run, or:
$somemode=1;
ReadMode 0; # same as ReadMode 'restore'
system('someprogram');
ReadMode 1;
which records any changes the program may have made, before resetting the
mode.
=item ReadKey MODE [, Filehandle]
Takes an integer argument, which can currently be one of the following
values:
0 Perform a normal read using getc
-1 Perform a non-blocked read
>0 Perform a timed read
If the filehandle is not supplied, it will default to STDIN. If there is
nothing waiting in the buffer during a non-blocked read, then undef will be
returned. In most situations, you will probably want to use C<ReadKey -1>.
I<NOTE> that if the OS does not provide any known mechanism for non-blocking
reads, then a C<ReadKey -1> can die with a fatal error. This will hopefully
not be common.
If MODE is greater then zero, then ReadKey will use it as a timeout value in
seconds (fractional seconds are allowed), and won't return C<undef> until
that time expires.
I<NOTE>, again, that some OS's may not support this timeout behaviour.
If MODE is less then zero, then this is treated as a timeout
of zero, and thus will return immediately if no character is waiting. A MODE
of zero, however, will act like a normal getc.
I<NOTE>, there are currently some limitations with this call under Windows.
It may be possible that non-blocking reads will fail when reading repeating
keys from more then one console.
=item ReadLine MODE [, Filehandle]
Takes an integer argument, which can currently be one of the following
values:
0 Perform a normal read using scalar(<FileHandle>)
-1 Perform a non-blocked read
>0 Perform a timed read
If there is nothing waiting in the buffer during a non-blocked read, then
undef will be returned.
I<NOTE>, that if the OS does not provide any known mechanism for
non-blocking reads, then a C<ReadLine 1> can die with a fatal
error. This will hopefully not be common.
I<NOTE> that a non-blocking test is only performed for the first character
in the line, not the entire line. This call will probably B<not> do what
you assume, especially with C<ReadMode> MODE values higher then 1. For
example, pressing Space and then Backspace would appear to leave you
where you started, but any timeouts would now be suspended.
B<This call is currently not available under Windows>.
=item GetTerminalSize [Filehandle]
Returns either an empty array if this operation is unsupported, or a four
element array containing: the width of the terminal in characters, the
height of the terminal in character, the width in pixels, and the height in
pixels. (The pixel size will only be valid in some environments.)
I<NOTE>, under Windows, this function must be called with an B<output>
filehandle, such as C<STDOUT>, or a handle opened to C<CONOUT$>.
=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
Return -1 on failure, 0 otherwise.
I<NOTE> that this terminal size is only for B<informative> value, and
changing the size via this mechanism will B<not> change the size of
the screen. For example, XTerm uses a call like this when
it resizes the screen. If any of the new measurements vary from the old, the
OS will probably send a SIGWINCH signal to anything reading that tty or pty.
B<This call does not work under Windows>.
=item GetSpeed [, Filehandle]
Returns either an empty array if the operation is unsupported, or a two
value array containing the terminal in and out speeds, in B<decimal>. E.g,
an in speed of 9600 baud and an out speed of 4800 baud would be returned as
(9600,4800). Note that currently the in and out speeds will always be
identical in some OS's.
B<No speeds are reported under Windows>.
=item GetControlChars [, Filehandle]
Returns an array containing key/value pairs suitable for a hash. The pairs
consist of a key, the name of the control character/signal, and the value
of that character, as a single character.
B<This call does nothing under Windows>.
Each key will be an entry from the following list:
DISCARD
DSUSPEND
EOF
EOL
EOL2
ERASE
ERASEWORD
INTERRUPT
KILL
MIN
QUIT
QUOTENEXT
REPRINT
START
STATUS
STOP
SUSPEND
SWITCH
TIME
Thus, the following will always return the current interrupt character,
regardless of platform.
%keys = GetControlChars;
$int = $keys{INTERRUPT};
=item SetControlChars [, Filehandle]
Takes an array containing key/value pairs, as a hash will produce. The pairs
should consist of a key that is the name of a legal control
character/signal, and the value should be either a single character, or a
number in the range 0-255. SetControlChars will die with a runtime error if
an invalid character name is passed or there is an error changing the
settings. The list of valid names is easily available via
%cchars = GetControlChars();
@cnames = keys %cchars;
B<This call does nothing under Windows>.
=back
=head1 AUTHOR
Kenneth Albanowski <kjahds@kjahds.com>
Currently maintained by Jonathan Stowe <jns@gellyfish.co.uk>
=head1 SUPPORT
The code is maintained at
https://github.com/jonathanstowe/TermReadKey
Please feel free to fork and suggest patches.
=head1 LICENSE
Prior to the 2.31 release the license statement was:
Copyright (C) 1994-1999 Kenneth Albanowski.
2001-2005 Jonathan Stowe and others
Unlimited distribution and/or modification is allowed as long as this
copyright notice remains intact.
And was only stated in the README file.
Because I believe the original author's intent was to be more open than the
other commonly used licenses I would like to leave that in place. However if
you or your lawyers require something with some more words you can optionally
choose to license this under the standard Perl license:
This module is free software; you can redistribute it and/or modify it
under the terms of the Artistic License. For details, see the full
text of the license in the file "Artistic" that should have been provided
with the version of perl you are using.
This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of merchantability
or fitness for a particular purpose.
=cut
use vars qw($VERSION);
$VERSION = '2.38';
require Exporter;
require DynaLoader;
use vars qw(@ISA @EXPORT_OK @EXPORT);
@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@EXPORT = qw(
ReadKey
ReadMode
ReadLine
GetTerminalSize
SetTerminalSize
GetSpeed
GetControlChars
SetControlChars
);
@EXPORT_OK = qw();
bootstrap Term::ReadKey;
# Should we use LINES and COLUMNS to try and get the terminal size?
# Change this to zero if you have systems where these are commonly
# set to erroneous values. (But if either are near zero, they won't be
# used anyhow.)
use vars qw($UseEnv $CurrentMode %modes);
$UseEnv = 1;
$CurrentMode = 0;
%modes = ( # lowercase is canonical
original => 0,
restore => 0,
normal => 1,
noecho => 2,
cbreak => 3,
raw => 4,
'ultra-raw' => 5
);
# reduce Carp memory footprint, only load when needed
sub croak { require Carp; goto &Carp::croak; }
sub carp { require Carp; goto &Carp::carp; }
sub ReadMode
{
my $mode = $modes{ lc $_[0] }; # lowercase is canonical
my $fh = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
if ( defined($mode) ) { $CurrentMode = $mode }
elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
else { croak("Unknown terminal mode `$_[0]'"); }
SetReadMode($CurrentMode, $fh);
}
sub normalizehandle
{
my ($file) = @_; # allows fake signature optimization
no strict;
# print "Handle = $file\n";
if ( ref($file) ) { return $file; } # Reference is fine
# if ($file =~ /^\*/) { return $file; } # Type glob is good
if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
# print "Caller = ",(caller(1))[0],"\n";
return \*{ ( ( caller(1) )[0] ) . "::$file" };
}
sub GetTerminalSize
{
my $file = normalizehandle( ( @_ > 0 ? $_[0] : \*STDOUT ) );
my (@results, @fail);
if ( &termsizeoptions() & 1 ) # VIO
{
@results = GetTermSizeVIO($file);
push( @fail, "VIOGetMode call" );
}
elsif ( &termsizeoptions() & 2 ) # GWINSZ
{
@results = GetTermSizeGWINSZ($file);
push( @fail, "TIOCGWINSZ ioctl" );
}
elsif ( &termsizeoptions() & 4 ) # GSIZE
{
@results = GetTermSizeGSIZE($file);
push( @fail, "TIOCGSIZE ioctl" );
}
elsif ( &termsizeoptions() & 8 ) # WIN32
{
@results = GetTermSizeWin32($file);
push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
}
else
{
@results = ();
}
if ( @results < 4 and $UseEnv )
{
my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
if ( ( $C >= 2 ) and ( $L >= 2 ) )
{
@results = ( $C + 0, $L + 0, 0, 0 );
}
push( @fail, "COLUMNS and LINES environment variables" );
}
if ( @results < 4 && $^O ne 'MSWin32')
{
my ($prog) = "resize";
# Workaround for Solaris path silliness
if ( -f "/usr/openwin/bin/resize" ) {
$prog = "/usr/openwin/bin/resize";
}
my ($resize) = scalar(`$prog 2>/dev/null`);
if (defined $resize
and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
)
{
$results[0] = $1;
if ( $resize =~ /LINES\s*=\s*(\d+)/
or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
{
$results[1] = $1;
@results[ 2, 3 ] = ( 0, 0 );
}
else
{
@results = ();
}
}
else
{
@results = ();
}
push( @fail, "resize program" );
}
if ( @results < 4 && $^O ne 'MSWin32' )
{
my ($prog) = "stty size";
my ($stty) = scalar(`$prog 2>/dev/null`);
if (defined $stty
and ( $stty =~ /(\d+) (\d+)/ )
)
{
$results[0] = $2;
$results[1] = $1;
@results[ 2, 3 ] = ( 0, 0 );
}
else
{
@results = ();
}
push( @fail, "stty program" );
}
if ( @results != 4 )
{
carp("Unable to get Terminal Size."
. join( "", map( " The $_ didn't work.", @fail ) ));
return undef;
}
@results;
}
# blockoptions:
#nodelay
#select
sub ReadKey {
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
if (defined $_[0] && $_[0] > 0) {
if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
}
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1); }
my $value = getc $File;
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0); }
$value;
}
sub ReadLine {
my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
if (defined $_[0] && $_[0] > 0) {
if ($_[0]) { return undef if &selectfile($File,$_[0]) == 0 }
}
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,1) };
my $value = scalar(<$File>);
if (defined $_[0] && $_[0] < 0) { &setnodelay($File,0) };
$value;
}
1;
# ex: set ro:

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,117 @@
Mapping files for Japanese encodings
1998 12/25
Fuji Xerox Information Systems
MURATA Makoto
1. Overview
This version of XML::Parser and XML::Encoding does not come with map files for
the charset "Shift_JIS" and the charset "euc-jp". Unfortunately, each of these
charsets has more than one mapping. None of these mappings are
considered as authoritative.
Therefore, we have come to believe that it is dangerous to provide map files
for these charsets. Rather, we introduce several private charsets and map
files for these private charsets. If IANA, Unicode Consoritum, and JIS
eventually reach a consensus, we will be able to provide map files for
"Shift_JIS" and "euc-jp".
2. Different mappings from existing charsets to Unicode
1) Different mappings in JIS X0221 and Unicode
The mapping between JIS X0208:1990 and Unicode 1.1 and the mapping
between JIS X0212:1990 and Unicode 1.1 are published from Unicode
consortium. They are available at
ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/JIS0208.TXT and
ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/JIS0212.TXT,
respectively.) These mapping files have a note as below:
# The kanji mappings are a normative part of ISO/IEC 10646. The
# non-kanji mappings are provisional, pending definition of
# official mappings by Japanese standards bodies.
Unfortunately, the non-kanji mappings in the Japanese standard for ISO 10646/1,
namely JIS X 0221:1995, is different from the Unicode Consortium mapping since
0x213D of JIS X 0208 is mapped to U+2014 (em dash) rather than U+2015
(horizontal bar). Furthermore, JIS X 0221 clearly says that the mapping is
informational and non-normative. As a result, some companies (e.g., Microsoft and
Apple) have introduced slightly different mappings. Therefore, neither the
Unicode consortium mapping nor the JIS X 0221 mapping are considered as
authoritative.
2) Shift-JIS
This charset is especially problematic, since its definition has been unclear
since its inception.
The current registration of the charset "Shift_JIS" is as below:
>Name: Shift_JIS (preferred MIME name)
>MIBenum: 17
>Source: A Microsoft code that extends csHalfWidthKatakana to include
> kanji by adding a second byte when the value of the first
> byte is in the ranges 81-9F or E0-EF.
>Alias: MS_Kanji
>Alias: csShiftJIS
First, this does not reference to the mapping "Shift-JIS to Unicode"
published by the Unicode consortium (available at
ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/SHIFTJIS.TXT).
Second, "kanji" in this registration can be interepreted in different ways.
Does this "kanji" reference to JIS X0208:1978, JIS X0208:1983, or JIS
X0208:1990(== JIS X0208:1997)? These three standards are *incompatible* with
each other. Moreover, we can even argue that "kanji" refers to JIS X0212 or
ideographic characters in other countries.
Third, each company has extended Shift JIS. For example, Microsoft introduced
OEM extensions (NEC extensionsand IBM extensions).
Forth, Shift JIS uses JIS X0201, which is almost upper-compatible with US-ASCII
but is not quite. 5C and 7E of JIS X 0201 are different from backslash and
tilde, respectively. However, many programming languages (e.g., Java)
ignore this difference and assumes that 5C and 7E of Shift JIS are backslash
and tilde.
3. Proposed charsets and mappings
As a tentative solution, we introduce two private charsets for EUC-JP and four
priviate charsets for Shift JIS.
1) EUC-JP
We have two charsets, namely "x-eucjp-unicode" and "x-eucjp-jisx0221". Their
difference is only one code point. The mapping for the former is based
on the Unicode Consortium mapping, while the latter is based on the JIS X0221
mapping.
2) Shift JIS
We have four charsets, namely x-sjis-unicode, x-sjis-jisx0221,
x-sjis-jdk117, and x-sjis-cp932.
The mapping for the charset x-sjis-unicode is the one published by the Unicode
consortium. The mapping for x-sjis-jisx0221 is almost equivalent to
x-sjis-unicode, but 0x213D of JIS X 0208 is mapped to U+2014 (em dash) rather
than U+2015. The charset x-sjis-jdk117 is again almost equivalent to
x-sjis-unicode, but 0x5C and 0x7E of JIS X0201 are mapped to backslash and
tilde.
The charset x-sjis-cp932 is used by Microsoft Windows, and its mapping is
published from the Unicode Consortium (available at:
ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP932.txt). The
coded character set for this charset includes NEC-extensions and
IBM-extensions. 0x5C and 0x7E of JIS X0201 are mapped to backslash and tilde;
0x213D is mapped to U+2015; and 0x2140, 0x2141, 0x2142, and 0x215E of JIS X
0208 are mapped to compatibility characters.
Makoto
Fuji Xerox Information Systems
Tel: +81-44-812-7230 Fax: +81-44-812-7231
E-mail: murata@apsdc.ksp.fujixerox.co.jp

View file

@ -0,0 +1,51 @@
This directory contains binary encoding maps for some selected encodings.
If they are placed in a directory listed in @XML::Parser::Expat::Encoding_Path,
then they are automatically loaded by the XML::Parser::Expat::load_encoding
function as needed. Otherwise you may load what you need directly by
explicitly calling this function.
These maps were generated by a perl script that comes with the module
XML::Encoding, compile_encoding, from XML formatted encoding maps that
are distributed with that module. These XML encoding maps were generated
in turn with a different script, domap, from mapping information contained
on the Unicode version 2.0 CD-ROM. This CD-ROM comes with the Unicode
Standard reference manual and can be ordered from the Unicode Consortium
at http://www.unicode.org. The identical information is available on the
internet at ftp://ftp.unicode.org/Public/MAPPINGS.
See the encoding.h header in the Expat sub-directory for a description of
the structure of these files.
Clark Cooper
December 12, 1998
================================================================
Contributed maps
This distribution contains four contributed encodings from MURATA Makoto
<murata@apsdc.ksp.fujixerox.co.jp> that are variations on the encoding
commonly called Shift_JIS:
x-sjis-cp932.enc
x-sjis-jdk117.enc
x-sjis-jisx0221.enc
x-sjis-unicode.enc (This is the same encoding as the shift_jis.enc that
was distributed with this module in version 2.17)
Please read his message (Japanese_Encodings.msg) about why these are here
and why I've removed the shift_jis.enc encoding.
We also have two contributed encodings that are variations of the EUC-JP
encoding from Yoshida Masato <yoshidam@inse.co.jp>:
x-euc-jp-jisx0221.enc
x-euc-jp-unicode.enc
The comments that MURATA Makoto made in his message apply to these
encodings too.
KangChan Lee <dolphin@comeng.chungnam.ac.kr> supplied the euc-kr encoding.
Clark Cooper
December 26, 1998

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,73 @@
# LWPExternEnt.pl
#
# Copyright (c) 2000 Clark Cooper
# All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package XML::Parser;
use strict;
use URI;
use URI::file;
use LWP::UserAgent;
##
## Note that this external entity handler reads the entire entity into
## memory, so it will choke on huge ones. It would be really nice if
## LWP::UserAgent optionally returned us an IO::Handle.
##
sub lwp_ext_ent_handler {
my ($xp, $base, $sys) = @_; # We don't use public id
my $uri;
if (defined $base) {
# Base may have been set by parsefile, which is agnostic about
# whether its a file or URI.
my $base_uri = URI->new($base);
unless (defined $base_uri->scheme) {
$base_uri = URI->new_abs($base_uri, URI::file->cwd);
}
$uri = URI->new_abs($sys, $base_uri);
}
else {
$uri = URI->new($sys);
unless (defined $uri->scheme) {
$uri = URI->new_abs($uri, URI::file->cwd);
}
}
my $ua = $xp->{_lwpagent};
unless (defined $ua) {
$ua = $xp->{_lwpagent} = LWP::UserAgent->new();
$ua->env_proxy();
}
my $req = HTTP::Request->new('GET', $uri);
my $res = $ua->request($req);
if ($res->is_error) {
$xp->{ErrorMessage} .= "\n" . $res->status_line . " $uri";
return undef;
}
$xp->{_BaseStack} ||= [];
push(@{$xp->{_BaseStack}}, $base);
$xp->base($uri);
return $res->content;
} # End lwp_ext_ent_handler
sub lwp_ext_ent_cleanup {
my ($xp) = @_;
$xp->base(pop(@{$xp->{_BaseStack}}));
} # End lwp_ext_ent_cleanup
1;

View file

@ -0,0 +1,53 @@
# $Id: Debug.pm,v 1.1 2003-07-27 16:07:49 matt Exp $
package XML::Parser::Style::Debug;
use strict;
use warnings;
sub Start {
my $expat = shift;
my $tag = shift;
print STDERR "@{$expat->{Context}} \\\\ (@_)\n";
}
sub End {
my $expat = shift;
my $tag = shift;
print STDERR "@{$expat->{Context}} //\n";
}
sub Char {
my $expat = shift;
my $text = shift;
$text =~ s/([^\x00-\x7f])/sprintf "#x%X;", ord $1/eg;
$text =~ s/([\t\n])/sprintf "#%d;", ord $1/eg;
print STDERR "@{$expat->{Context}} || $text\n";
}
sub Proc {
my $expat = shift;
my $target = shift;
my $text = shift;
my @foo = @{ $expat->{Context} };
print STDERR "@foo $target($text)\n";
}
1;
__END__
=head1 NAME
XML::Parser::Style::Debug - Debug style for XML::Parser
=head1 SYNOPSIS
use XML::Parser;
my $p = XML::Parser->new(Style => 'Debug');
$p->parsefile('foo.xml');
=head1 DESCRIPTION
This just prints out the document in outline form to STDERR. Nothing special is
returned by parse.
=cut

View file

@ -0,0 +1,80 @@
# $Id: Objects.pm,v 1.1 2003-08-18 20:20:51 matt Exp $
package XML::Parser::Style::Objects;
use strict;
use warnings;
sub Init {
my $expat = shift;
$expat->{Lists} = [];
$expat->{Curlist} = $expat->{Tree} = [];
}
sub Start {
my $expat = shift;
my $tag = shift;
my $newlist = [];
my $class = "${$expat}{Pkg}::$tag";
my $newobj = bless { @_, Kids => $newlist }, $class;
push @{ $expat->{Lists} }, $expat->{Curlist};
push @{ $expat->{Curlist} }, $newobj;
$expat->{Curlist} = $newlist;
}
sub End {
my $expat = shift;
my $tag = shift;
$expat->{Curlist} = pop @{ $expat->{Lists} };
}
sub Char {
my $expat = shift;
my $text = shift;
my $class = "${$expat}{Pkg}::Characters";
my $clist = $expat->{Curlist};
my $pos = $#$clist;
if ( $pos >= 0 and ref( $clist->[$pos] ) eq $class ) {
$clist->[$pos]->{Text} .= $text;
}
else {
push @$clist, bless { Text => $text }, $class;
}
}
sub Final {
my $expat = shift;
delete $expat->{Curlist};
delete $expat->{Lists};
$expat->{Tree};
}
1;
__END__
=head1 NAME
XML::Parser::Style::Objects - Objects styler parser
=head1 SYNOPSIS
use XML::Parser;
my $p = XML::Parser->new(Style => 'Objects', Pkg => 'MyNode');
my $tree = $p->parsefile('foo.xml');
=head1 DESCRIPTION
This module implements XML::Parser's Objects style parser.
This is similar to the Tree style, except that a hash object is created for
each element. The corresponding object will be in the class whose name
is created by appending "::" and the element name to the package set with
the Pkg option. Non-markup text will be in the ::Characters class. The
contents of the corresponding object will be in an anonymous array that
is the value of the Kids property for that object.
=head1 SEE ALSO
L<XML::Parser::Style::Tree>
=cut

View file

@ -0,0 +1,199 @@
# $Id: Stream.pm,v 1.1 2003-07-27 16:07:49 matt Exp $
package XML::Parser::Style::Stream;
use strict;
use warnings;
# This style invented by Tim Bray <tbray@textuality.com>
sub Init {
no strict 'refs';
my $expat = shift;
$expat->{Text} = '';
my $sub = $expat->{Pkg} . "::StartDocument";
&$sub($expat)
if defined(&$sub);
}
sub Start {
no strict 'refs';
my $expat = shift;
my $type = shift;
local $_;
doText($expat);
$_ = "<$type";
%_ = @_;
while (@_) {
my $attr = shift;
my $val = shift;
$val =~ s/&/&amp;/g;
$val =~ s/</&lt;/g;
$val =~ s/>/&gt;/g;
$val =~ s/"/&quot;/g;
$_ .= ' ' . $attr . '="' . $val . '"';
}
$_ .= '>';
my $sub = $expat->{Pkg} . "::StartTag";
if ( defined(&$sub) ) {
&$sub( $expat, $type );
}
else {
print;
}
}
sub End {
no strict 'refs';
my $expat = shift;
my $type = shift;
local $_;
# Set right context for Text handler
push( @{ $expat->{Context} }, $type );
doText($expat);
pop( @{ $expat->{Context} } );
$_ = "</$type>";
my $sub = $expat->{Pkg} . "::EndTag";
if ( defined(&$sub) ) {
&$sub( $expat, $type );
}
else {
print;
}
}
sub Char {
my $expat = shift;
$expat->{Text} .= shift;
}
sub Proc {
no strict 'refs';
my $expat = shift;
my $target = shift;
my $text = shift;
local $_;
doText($expat);
$_ = "<?$target $text?>";
my $sub = $expat->{Pkg} . "::PI";
if ( defined(&$sub) ) {
&$sub( $expat, $target, $text );
}
else {
print;
}
}
sub Final {
no strict 'refs';
my $expat = shift;
my $sub = $expat->{Pkg} . "::EndDocument";
&$sub($expat)
if defined(&$sub);
}
sub doText {
no strict 'refs';
my $expat = shift;
local $_ = $expat->{Text};
if ( length($_) ) {
my $sub = $expat->{Pkg} . "::Text";
if ( defined(&$sub) ) {
&$sub($expat);
}
else {
print;
}
$expat->{Text} = '';
}
}
1;
__END__
=head1 NAME
XML::Parser::Style::Stream - Stream style for XML::Parser
=head1 SYNOPSIS
use XML::Parser;
my $p = XML::Parser->new(Style => 'Stream', Pkg => 'MySubs');
$p->parsefile('foo.xml');
{
package MySubs;
sub StartTag {
my ($e, $name) = @_;
# do something with start tags
}
sub EndTag {
my ($e, $name) = @_;
# do something with end tags
}
sub Text {
my ($e) = @_;
# $_ contains accumulated text
# do something with text nodes
}
}
=head1 DESCRIPTION
This style uses the Pkg option to find subs in a given package to call for each event.
If none of the subs that this
style looks for is there, then the effect of parsing with this style is
to print a canonical copy of the document without comments or declarations.
All the subs receive as their 1st parameter the Expat instance for the
document they're parsing.
It looks for the following routines:
=over 4
=item * StartDocument
Called at the start of the parse .
=item * StartTag
Called for every start tag with a second parameter of the element type. The $_
variable will contain a copy of the tag and the %_ variable will contain
attribute values supplied for that element.
=item * EndTag
Called for every end tag with a second parameter of the element type. The $_
variable will contain a copy of the end tag.
=item * Text
Called just before start or end tags with accumulated non-markup text in
the $_ variable.
=item * PI
Called for processing instructions. The $_ variable will contain a copy of
the PI and the target and data are sent as 2nd and 3rd parameters
respectively.
=item * EndDocument
Called at conclusion of the parse.
=back
=cut

View file

@ -0,0 +1,64 @@
# $Id: Subs.pm,v 1.1 2003-07-27 16:07:49 matt Exp $
package XML::Parser::Style::Subs;
use strict;
use warnings;
sub Start {
no strict 'refs';
my $expat = shift;
my $tag = shift;
my $fname = $expat->{Pkg} . "::$tag";
if ( defined &$fname ) {
( \&$fname )->( $expat, $tag, @_ );
}
}
sub End {
no strict 'refs';
my $expat = shift;
my $tag = shift;
my $fname = $expat->{Pkg} . "::${tag}_";
if ( defined &$fname ) {
( \&$fname )->( $expat, $tag );
}
}
1;
__END__
=head1 NAME
XML::Parser::Style::Subs - glue for handling element callbacks
=head1 SYNOPSIS
use XML::Parser;
my $p = XML::Parser->new(Style => 'Subs', Pkg => 'MySubs');
$p->parsefile('foo.xml');
{
package MySubs;
sub foo {
# start of foo tag
}
sub foo_ {
# end of foo tag
}
}
=head1 DESCRIPTION
Each time an element starts, a sub by that name in the package specified
by the Pkg option is called with the same parameters that the Start
handler gets called with.
Each time an element ends, a sub with that name appended with an underscore
("_"), is called with the same parameters that the End handler gets called
with.
Nothing special is returned by parse.
=cut

View file

@ -0,0 +1,106 @@
# $Id: Tree.pm,v 1.2 2003-07-31 07:54:51 matt Exp $
package XML::Parser::Style::Tree;
use strict;
use warnings;
sub Init {
my $expat = shift;
$expat->{Lists} = [];
$expat->{Curlist} = $expat->{Tree} = [];
}
sub Start {
my $expat = shift;
my $tag = shift;
my $newlist = [ {@_} ];
push @{ $expat->{Lists} }, $expat->{Curlist};
push @{ $expat->{Curlist} }, $tag => $newlist;
$expat->{Curlist} = $newlist;
}
sub End {
my $expat = shift;
my $tag = shift;
$expat->{Curlist} = pop @{ $expat->{Lists} };
}
sub Char {
my $expat = shift;
my $text = shift;
my $clist = $expat->{Curlist};
my $pos = $#$clist;
if ( $pos > 0 and $clist->[ $pos - 1 ] eq '0' ) {
$clist->[$pos] .= $text;
}
else {
push @$clist, 0 => $text;
}
}
sub Final {
my $expat = shift;
delete $expat->{Curlist};
delete $expat->{Lists};
$expat->{Tree};
}
1;
__END__
=head1 NAME
XML::Parser::Style::Tree - Tree style parser
=head1 SYNOPSIS
use XML::Parser;
my $p = XML::Parser->new(Style => 'Tree');
my $tree = $p->parsefile('foo.xml');
=head1 DESCRIPTION
This module implements XML::Parser's Tree style parser.
When parsing a document, C<parse()> will return a parse tree for the
document. Each node in the tree
takes the form of a tag, content pair. Text nodes are represented with
a pseudo-tag of "0" and the string that is their content. For elements,
the content is an array reference. The first item in the array is a
(possibly empty) hash reference containing attributes. The remainder of
the array is a sequence of tag-content pairs representing the content
of the element.
So for example the result of parsing:
<foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
would be:
Tag Content
==================================================================
[foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]],
bar, [ {}, 0, "Howdy", ref, [{}]],
0, "do"
]
]
The root document "foo", has 3 children: a "head" element, a "bar"
element and the text "do". After the empty attribute hash, these are
represented in it's contents by 3 tag-content pairs.
=head2 Entity Expansion
The underlying Expat parser always expands predefined XML entity
references (C<&lt;>, C<&gt;>, C<&amp;>, C<&quot;>, C<&apos;>) in both
text content and attribute values before they reach the Tree style
handlers. This is required by the XML specification and cannot be
prevented. For example, C<&lt;> in the source XML will appear as C<< < >>
in the resulting tree structure.
If you need access to the original unexpanded text, consider using the
handler-based API with the C<original_string> method on the Expat object
instead of the Tree style.
=cut