Initial Commit

This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions

337
database/perl/vendor/lib/JSON/MaybeXS.pm vendored Normal file
View File

@@ -0,0 +1,337 @@
package JSON::MaybeXS;
use strict;
use warnings FATAL => 'all';
use base qw(Exporter);
our $VERSION = '1.004003';
$VERSION =~ tr/_//d;
sub _choose_json_module {
return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'};
return 'JSON::XS' if $INC{'JSON/XS.pm'} && eval { JSON::XS->VERSION(3.0); 1 };
my @err;
return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; };
push @err, "Error loading Cpanel::JSON::XS: $@";
return 'JSON::XS' if eval { require JSON::XS; JSON::XS->VERSION(3.0); 1; };
push @err, "Error loading JSON::XS: $@";
return 'JSON::PP' if eval { require JSON::PP; 1 };
push @err, "Error loading JSON::PP: $@";
die join( "\n", "Couldn't load a JSON module:", @err );
}
BEGIN {
our $JSON_Class = _choose_json_module();
$JSON_Class->import(qw(encode_json decode_json));
no strict 'refs';
*$_ = $JSON_Class->can($_)
for qw(true false);
}
our @EXPORT = qw(encode_json decode_json JSON);
my @EXPORT_ALL = qw(is_bool);
our @EXPORT_OK = qw(is_bool to_json from_json);
our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ],
legacy => [ @EXPORT, @EXPORT_OK ],
);
sub JSON () { our $JSON_Class }
sub new {
shift;
my %args = @_ == 1 ? %{$_[0]} : @_;
my $new = (our $JSON_Class)->new;
$new->$_($args{$_}) for keys %args;
return $new;
}
use Scalar::Util ();
sub is_bool {
die 'is_bool is not a method' if $_[1];
Scalar::Util::blessed($_[0])
and ($_[0]->isa('JSON::XS::Boolean')
or $_[0]->isa('Cpanel::JSON::XS::Boolean')
or $_[0]->isa('JSON::PP::Boolean'));
}
# (mostly) CopyPasta from JSON.pm version 2.90
use Carp ();
sub from_json ($@) {
if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
Carp::croak "from_json should not be called as a method.";
}
my $json = JSON()->new;
if (@_ == 2 and ref $_[1] eq 'HASH') {
my $opt = $_[1];
for my $method (keys %$opt) {
$json->$method( $opt->{$method} );
}
}
return $json->decode( $_[0] );
}
sub to_json ($@) {
if (
ref($_[0]) =~ /^JSON/
or (@_ > 2 and $_[0] =~ /^JSON/)
) {
Carp::croak "to_json should not be called as a method.";
}
my $json = JSON()->new;
if (@_ == 2 and ref $_[1] eq 'HASH') {
my $opt = $_[1];
for my $method (keys %$opt) {
$json->$method( $opt->{$method} );
}
}
$json->encode($_[0]);
}
1;
=head1 NAME
JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
=head1 SYNOPSIS
use JSON::MaybeXS;
my $data_structure = decode_json($json_input);
my $json_output = encode_json($data_structure);
my $json = JSON()->new;
my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
=head1 DESCRIPTION
This module first checks to see if either L<Cpanel::JSON::XS> or
L<JSON::XS> (at at least version 3.0)
is already loaded, in which case it uses that module. Otherwise
it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP>
in order, and either uses the first module it finds or throws an error.
It then exports the C<encode_json> and C<decode_json> functions from the
loaded module, along with a C<JSON> constant that returns the class name
for calling C<new> on.
If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
want to pass options as constructor args rather than calling mutators, so
we provide our own C<new> method that supports that.
=head1 EXPORTS
C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
is exported on request.
To import only some symbols, specify them on the C<use> line:
use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
use JSON::MaybeXS qw(JSON); # JSON constant only
To import all available sensible symbols (C<encode_json>, C<decode_json>, and
C<is_bool>), use C<:all>:
use JSON::MaybeXS ':all';
To import all symbols including those needed by legacy apps that use L<JSON::PP>:
use JSON::MaybeXS ':legacy';
This imports the C<to_json> and C<from_json> symbols as well as everything in
C<:all>. NOTE: This is to support legacy code that makes extensive
use of C<to_json> and C<from_json> which you are not yet in a position to
refactor. DO NOT use this import tag in new code, in order to avoid
the crawling horrors of getting UTF-8 support subtly wrong. See the
documentation for L<JSON> for further details.
=head2 encode_json
This is the C<encode_json> function provided by the selected implementation
module, and takes a perl data structure which is serialised to JSON text.
my $json_text = encode_json($data_structure);
=head2 decode_json
This is the C<decode_json> function provided by the selected implementation
module, and takes a string of JSON text to deserialise to a perl data structure.
my $data_structure = decode_json($json_text);
=head2 to_json, from_json
See L<JSON> for details. These are included to support legacy code
B<only>.
=head2 JSON
The C<JSON> constant returns the selected implementation module's name for
use as a class name - so:
my $json_obj = JSON()->new; # returns a Cpanel::JSON::XS or JSON::PP object
and that object can then be used normally:
my $data_structure = $json_obj->decode($json_text); # etc.
The use of parentheses here is optional, and only used as a hint to the reader
that this use of C<JSON> is a I<subroutine> call, I<not> a class name.
=head2 is_bool
$is_boolean = is_bool($scalar)
Returns true if the passed scalar represents either C<true> or
C<false>, two constants that act like C<1> and C<0>, respectively
and are used to represent JSON C<true> and C<false> values in Perl.
Since this is a bare sub in the various backend classes, it cannot be called as
a class method like the other interfaces; it must be called as a function, with
no invocant. It supports the representation used in all JSON backends.
Available since version 1.002004.
=head1 CONSTRUCTOR
=head2 new
With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call
mutators to set options, such as:
my $json = $class->new->utf8(1)->pretty(1);
Since this is a trifle irritating and noticeably un-perlish, we also offer:
my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
which works equivalently to the above (and in the usual tradition will accept
a hashref instead of a hash, should you so desire).
The resulting object is blessed into the underlying backend, which offers (at
least) the methods C<encode> and C<decode>.
=head1 BOOLEANS
To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
use JSON::MaybeXS;
my $true = JSON()->true;
my $false = JSON()->false;
The booleans are also available as subs or methods on JSON::MaybeXS.
use JSON::MaybeXS ();
my $true = JSON::MaybeXS::true;
my $true = JSON::MaybeXS->true;
my $false = JSON::MaybeXS::false;
my $false = JSON::MaybeXS->false;
=head1 CONVERTING FROM JSON::Any
L<JSON::Any> used to be the favoured compatibility layer above the various
JSON backends, but over time has grown a lot of extra code to deal with legacy
backends (e.g. L<JSON::Syck>) that are no longer needed. This is a rough guide of translating such code:
Change code from:
use JSON::Any;
my $json = JSON::Any->new->objToJson($data); # or to_json($data), or Dump($data)
to:
use JSON::MaybeXS;
my $json = encode_json($data);
Change code from:
use JSON::Any;
my $data = JSON::Any->new->jsonToObj($json); # or from_json($json), or Load($json)
to:
use JSON::MaybeXS;
my $json = decode_json($data);
=head1 CAVEATS
The C<new()> method in this module is technically a factory, not a
constructor, because the objects it returns will I<NOT> be blessed into the
C<JSON::MaybeXS> class.
If you are using an object returned by this module as a Moo(se) attribute,
this type constraint code:
is 'json' => ( isa => 'JSON::MaybeXS' );
will I<NOT> do what you expect. Instead, either rely on the C<JSON> class
constant described above, as so:
is 'json' => ( isa => JSON::MaybeXS::JSON() );
Alternatively, you can use duck typing:
use Moose::Util::TypeConstraints 'duck_type';
is 'json' => ( isa => Object , duck_type([qw/ encode decode /]));
=head1 INSTALLATION
At installation time, F<Makefile.PL> will attempt to determine if you have a
working compiler available, and therefore whether you are able to run XS code.
If so, L<Cpanel::JSON::XS> will be added to the prerequisite list, unless
L<JSON::XS> is already installed at a high enough version. L<JSON::XS> may
also be upgraded to fix any incompatibility issues.
Because running XS code is not mandatory and L<JSON::PP> (which is in perl
core) is used as a fallback backend, this module is safe to be used in a suite
of code that is fatpacked or installed into a restricted-resource environment.
You can also prevent any XS dependencies from being installed by setting
C<PUREPERL_ONLY=1> in F<Makefile.PL> options (or in the C<PERL_MM_OPT>
environment variable), or using the C<--pp> or C<--pureperl> flags with the
L<cpanminus client|cpanm>.
=head1 AUTHOR
mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
=head1 CONTRIBUTORS
=over 4
=item * Clinton Gormley <drtech@cpan.org>
=item * Karen Etheridge <ether@cpan.org>
=item * Kieren Diment <diment@gmail.com>
=back
=head1 COPYRIGHT
Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
as listed above.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself.
=cut

1835
database/perl/vendor/lib/JSON/XS.pm vendored Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,31 @@
=head1 NAME
JSON::XS::Boolean - dummy module providing JSON::XS::Boolean
=head1 SYNOPSIS
# do not "use" yourself
=head1 DESCRIPTION
This module exists only to provide overload resolution for Storable and
similar modules. It's only needed for compatibility with data serialised
(by other modules such as Storable) that was decoded by JSON::XS versions
before 3.0.
Since 3.0, JSON::PP::Boolean has replaced it. Support for
JSON::XS::Boolean will be removed in a future release.
=cut
use JSON::XS ();
1;
=head1 AUTHOR
Marc Lehmann <schmorp@schmorp.de>
http://home.schmorp.de/
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,43 @@
package # This is JSON::backportPP
JSON::PP::Boolean;
use strict;
require overload;
local $^W;
overload::import('overload',
"0+" => sub { ${$_[0]} },
"++" => sub { $_[0] = ${$_[0]} + 1 },
"--" => sub { $_[0] = ${$_[0]} - 1 },
fallback => 1,
);
$JSON::backportPP::Boolean::VERSION = '4.06';
1;
__END__
=head1 NAME
JSON::PP::Boolean - dummy module providing JSON::PP::Boolean
=head1 SYNOPSIS
# do not "use" yourself
=head1 DESCRIPTION
This module exists only to provide overload resolution for Storable and similar modules. See
L<JSON::PP> for more info about this class.
=head1 AUTHOR
This idea is from L<JSON::XS::Boolean> written by Marc Lehmann <schmorp[at]schmorp.de>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

View File

@@ -0,0 +1,131 @@
package # This is JSON::backportPP
JSON::backportPP5005;
use 5.005;
use strict;
my @properties;
$JSON::PP5005::VERSION = '1.10';
BEGIN {
sub utf8::is_utf8 {
0; # It is considered that UTF8 flag off for Perl 5.005.
}
sub utf8::upgrade {
}
sub utf8::downgrade {
1; # must always return true.
}
sub utf8::encode {
}
sub utf8::decode {
}
*JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii;
*JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1;
*JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
*JSON::PP::JSON_PP_decode_unicode = \&_decode_unicode;
# missing in B module.
sub B::SVp_IOK () { 0x01000000; }
sub B::SVp_NOK () { 0x02000000; }
sub B::SVp_POK () { 0x04000000; }
$INC{'bytes.pm'} = 1; # dummy
}
sub _encode_ascii {
join('', map { $_ <= 127 ? chr($_) : sprintf('\u%04x', $_) } unpack('C*', $_[0]) );
}
sub _encode_latin1 {
join('', map { chr($_) } unpack('C*', $_[0]) );
}
sub _decode_surrogates { # from http://homepage1.nifty.com/nomenclator/unicode/ucs_utf.htm
my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00); # from perlunicode
my $bit = unpack('B32', pack('N', $uni));
if ( $bit =~ /^00000000000(...)(......)(......)(......)$/ ) {
my ($w, $x, $y, $z) = ($1, $2, $3, $4);
return pack('B*', sprintf('11110%s10%s10%s10%s', $w, $x, $y, $z));
}
else {
Carp::croak("Invalid surrogate pair");
}
}
sub _decode_unicode {
my ($u) = @_;
my ($utf8bit);
if ( $u =~ /^00([89a-f][0-9a-f])$/i ) { # 0x80-0xff
return pack( 'H2', $1 );
}
my $bit = unpack("B*", pack("H*", $u));
if ( $bit =~ /^00000(.....)(......)$/ ) {
$utf8bit = sprintf('110%s10%s', $1, $2);
}
elsif ( $bit =~ /^(....)(......)(......)$/ ) {
$utf8bit = sprintf('1110%s10%s10%s', $1, $2, $3);
}
else {
Carp::croak("Invalid escaped unicode");
}
return pack('B*', $utf8bit);
}
sub JSON::PP::incr_text {
$_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
Carp::croak("incr_text can not be called when the incremental parser already started parsing");
}
$_[0]->{_incr_parser}->{incr_text} = $_[1] if ( @_ > 1 );
$_[0]->{_incr_parser}->{incr_text};
}
1;
__END__
=pod
=head1 NAME
JSON::PP5005 - Helper module in using JSON::PP in Perl 5.005
=head1 DESCRIPTION
JSON::PP calls internally.
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2012 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

View File

@@ -0,0 +1,173 @@
package # This is JSON::backportPP
JSON::backportPP56;
use 5.006;
use strict;
my @properties;
$JSON::PP56::VERSION = '1.08';
BEGIN {
sub utf8::is_utf8 {
my $len = length $_[0]; # char length
{
use bytes; # byte length;
return $len != length $_[0]; # if !=, UTF8-flagged on.
}
}
sub utf8::upgrade {
; # noop;
}
sub utf8::downgrade ($;$) {
return 1 unless ( utf8::is_utf8( $_[0] ) );
if ( _is_valid_utf8( $_[0] ) ) {
my $downgrade;
for my $c ( unpack( "U*", $_[0] ) ) {
if ( $c < 256 ) {
$downgrade .= pack("C", $c);
}
else {
$downgrade .= pack("U", $c);
}
}
$_[0] = $downgrade;
return 1;
}
else {
Carp::croak("Wide character in subroutine entry") unless ( $_[1] );
0;
}
}
sub utf8::encode ($) { # UTF8 flag off
if ( utf8::is_utf8( $_[0] ) ) {
$_[0] = pack( "C*", unpack( "C*", $_[0] ) );
}
else {
$_[0] = pack( "U*", unpack( "C*", $_[0] ) );
$_[0] = pack( "C*", unpack( "C*", $_[0] ) );
}
}
sub utf8::decode ($) { # UTF8 flag on
if ( _is_valid_utf8( $_[0] ) ) {
utf8::downgrade( $_[0] );
$_[0] = pack( "U*", unpack( "U*", $_[0] ) );
}
}
*JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii;
*JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1;
*JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates;
*JSON::PP::JSON_PP_decode_unicode = \&JSON::PP::_decode_unicode;
unless ( defined &B::SVp_NOK ) { # missing in B module.
eval q{ sub B::SVp_NOK () { 0x02000000; } };
}
}
sub _encode_ascii {
join('',
map {
$_ <= 127 ?
chr($_) :
$_ <= 65535 ?
sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_));
} _unpack_emu($_[0])
);
}
sub _encode_latin1 {
join('',
map {
$_ <= 255 ?
chr($_) :
$_ <= 65535 ?
sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_));
} _unpack_emu($_[0])
);
}
sub _unpack_emu { # for Perl 5.6 unpack warnings
return !utf8::is_utf8($_[0]) ? unpack('C*', $_[0])
: _is_valid_utf8($_[0]) ? unpack('U*', $_[0])
: unpack('C*', $_[0]);
}
sub _is_valid_utf8 {
my $str = $_[0];
my $is_utf8;
while ($str =~ /(?:
(
[\x00-\x7F]
|[\xC2-\xDF][\x80-\xBF]
|[\xE0][\xA0-\xBF][\x80-\xBF]
|[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
|[\xED][\x80-\x9F][\x80-\xBF]
|[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
|[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
|[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
|[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
)
| (.)
)/xg)
{
if (defined $1) {
$is_utf8 = 1 if (!defined $is_utf8);
}
else {
$is_utf8 = 0 if (!defined $is_utf8);
if ($is_utf8) { # eventually, not utf8
return;
}
}
}
return $is_utf8;
}
1;
__END__
=pod
=head1 NAME
JSON::PP56 - Helper module in using JSON::PP in Perl 5.6
=head1 DESCRIPTION
JSON::PP calls internally.
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2012 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut