[Bps-public-commit] rt-extension-rest2 branch, master, updated. 64ca458fc72c68ff08805fd5910976eabc087f58
Jim Brandt
jbrandt at bestpractical.com
Mon Nov 20 16:58:23 EST 2017
The branch, master has been updated
via 64ca458fc72c68ff08805fd5910976eabc087f58 (commit)
via 39beaf2c56605868dd3f7896f3a7fa7362ba90e2 (commit)
via 8f2e846c7a809b0ef8519c9855d8e709d99fc617 (commit)
via 6e9bc32ab98623159e5a8344003a5bb0ade157ce (commit)
via c3610c1a6a2460be4fd0c7044c40137e588fec7a (commit)
via 059ab1c61b19980694f8fd2191b28447e288f15a (commit)
from 41c27e38e5d77db2974b1cc0bbaaeed4aaa01386 (commit)
Summary of changes:
Changes | 9 +
MANIFEST | 2 +-
META.yml | 7 +-
README | 4 +
inc/YAML/Tiny.pm | 694 ++++++++++++++++++++----------
inc/unicore/Name.pm | 416 ------------------
lib/RT/Extension/REST2.pm | 32 +-
lib/RT/Extension/REST2/Dispatcher.pm | 2 +
lib/RT/Extension/REST2/Middleware/Auth.pm | 1 +
9 files changed, 507 insertions(+), 660 deletions(-)
create mode 100644 Changes
delete mode 100644 inc/unicore/Name.pm
- Log -----------------------------------------------------------------
commit c3610c1a6a2460be4fd0c7044c40137e588fec7a
Author: Alex Vandiver <alex at chmrr.net>
Date: Tue Nov 7 22:13:23 2017 -0500
Connect to the database at request start, not app init
rt-server takes pains to close down the database connection before
handing off control to the PSGI server, such that the database
connection is not preserved across the `fork`. DB connections which
are so shared result in undefined behavior -- postgres, for instance,
will reuse the same statement ids on the handle in different
processes, resulting in errors of the form:
DBD::Pg::st execute failed: ERROR: prepared statement "dbdpg_p4068_1" already exists
Unfortunately, `to_app` is called _after_ that preventative
disconnection has happened, so opening the database connection there
_does_ cause it to be shared -- with the aforementioned disasterous
results.
_Some_ call to `ConnectToDatabase` is required, because (at the time
of this commit, in <= 4.4) the only other explicit call to it is done
inside the Mason handler. Thus, without an explicit connect in this
extension, REST requests which happen to have not served a Mason page
will fail, due to lack of a database connection.
Move database connections to inside the PSGI handlers themselves, such
that the connection is opened inside the forked child, not the parent.
Just the addition in Auth is technically sufficient, since it
currently always runs before the main dispatcher -- however, we
include the connection there as a preventative measure. This is safe
because DBIx::SearchBuilder::Handle's Connect (and thus
RT::ConnectToDatabase) is a no-op if the connection is already live.
diff --git a/lib/RT/Extension/REST2.pm b/lib/RT/Extension/REST2.pm
index fdecd03..ad88726 100644
--- a/lib/RT/Extension/REST2.pm
+++ b/lib/RT/Extension/REST2.pm
@@ -566,8 +566,6 @@ sub to_psgi_app { shift->to_app(@_) }
sub to_app {
my $class = shift;
- RT::ConnectToDatabase();
-
return builder {
enable '+RT::Extension::REST2::Middleware::ErrorAsJSON';
enable '+RT::Extension::REST2::Middleware::Log';
diff --git a/lib/RT/Extension/REST2/Dispatcher.pm b/lib/RT/Extension/REST2/Dispatcher.pm
index 1c7f780..166492e 100644
--- a/lib/RT/Extension/REST2/Dispatcher.pm
+++ b/lib/RT/Extension/REST2/Dispatcher.pm
@@ -43,6 +43,8 @@ sub to_psgi_app {
return sub {
my $env = shift;
+
+ RT::ConnectToDatabase();
my $dispatch = $self->_dispatcher->dispatch($env->{PATH_INFO});
return [404, ['Content-Type' => 'text/plain'], 'Not Found']
diff --git a/lib/RT/Extension/REST2/Middleware/Auth.pm b/lib/RT/Extension/REST2/Middleware/Auth.pm
index 875ebcf..7e33738 100644
--- a/lib/RT/Extension/REST2/Middleware/Auth.pm
+++ b/lib/RT/Extension/REST2/Middleware/Auth.pm
@@ -14,6 +14,7 @@ our @auth_priority = qw(
sub call {
my ($self, $env) = @_;
+ RT::ConnectToDatabase();
for my $method (@auth_priority) {
last if $env->{'rt.current_user'} = $self->$method($env);
}
commit 6e9bc32ab98623159e5a8344003a5bb0ade157ce
Merge: 41c27e3 c3610c1
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 20 16:28:21 2017 -0500
Merge branch 'no-shared-connections'
commit 8f2e846c7a809b0ef8519c9855d8e709d99fc617
Merge: 6e9bc32 059ab1c
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 20 16:32:10 2017 -0500
Merge branch 'add-cleanup-callback'
commit 39beaf2c56605868dd3f7896f3a7fa7362ba90e2
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 20 16:52:43 2017 -0500
Module::Install updates
diff --git a/inc/YAML/Tiny.pm b/inc/YAML/Tiny.pm
index 9a4e291..4fd023d 100644
--- a/inc/YAML/Tiny.pm
+++ b/inc/YAML/Tiny.pm
@@ -1,105 +1,217 @@
#line 1
-package YAML::Tiny;
-BEGIN {
- $YAML::Tiny::AUTHORITY = 'cpan:ADAMK';
+use 5.008001; # sane UTF-8 support
+use strict;
+use warnings;
+package YAML::Tiny; # git description: v1.69-8-g2c1e266
+# XXX-INGY is 5.8.1 too old/broken for utf8?
+# XXX-XDG Lancaster consensus was that it was sufficient until
+# proven otherwise
+
+our $VERSION = '1.70';
+
+#####################################################################
+# The YAML::Tiny API.
+#
+# These are the currently documented API functions/methods and
+# exports:
+
+use Exporter;
+our @ISA = qw{ Exporter };
+our @EXPORT = qw{ Load Dump };
+our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
+
+###
+# Functional/Export API:
+
+sub Dump {
+ return YAML::Tiny->new(@_)->_dump_string;
}
-{
- $YAML::Tiny::VERSION = '1.56';
+
+# XXX-INGY Returning last document seems a bad behavior.
+# XXX-XDG I think first would seem more natural, but I don't know
+# that it's worth changing now
+sub Load {
+ my $self = YAML::Tiny->_load_string(@_);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # To match YAML.pm, return the last document
+ return $self->[-1];
+ }
}
-# git description: v1.55-3-gc945058
+# XXX-INGY Do we really need freeze and thaw?
+# XXX-XDG I don't think so. I'd support deprecating them.
+BEGIN {
+ *freeze = \&Dump;
+ *thaw = \&Load;
+}
-use strict;
-use warnings;
+sub DumpFile {
+ my $file = shift;
+ return YAML::Tiny->new(@_)->_dump_file($file);
+}
-# UTF Support?
-sub HAVE_UTF8 () { $] >= 5.007003 }
-BEGIN {
- if ( HAVE_UTF8 ) {
- # The string eval helps hide this from Test::MinimumVersion
- eval "require utf8;";
- die "Failed to load UTF-8 support" if $@;
+sub LoadFile {
+ my $file = shift;
+ my $self = YAML::Tiny->_load_file($file);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # Return only the last document to match YAML.pm,
+ return $self->[-1];
}
+}
- # Class structure
- require 5.004;
- require Exporter;
- require Carp;
- @YAML::Tiny::ISA = qw{ Exporter };
- @YAML::Tiny::EXPORT = qw{ Load Dump };
- @YAML::Tiny::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
- # Error storage
- $YAML::Tiny::errstr = '';
+###
+# Object Oriented API:
+
+# Create an empty YAML::Tiny object
+# XXX-INGY Why do we use ARRAY object?
+# NOTE: I get it now, but I think it's confusing and not needed.
+# Will change it on a branch later, for review.
+#
+# XXX-XDG I don't support changing it yet. It's a very well-documented
+# "API" of YAML::Tiny. I'd support deprecating it, but Adam suggested
+# we not change it until YAML.pm's own OO API is established so that
+# users only have one API change to digest, not two
+sub new {
+ my $class = shift;
+ bless [ @_ ], $class;
+}
+
+# XXX-INGY It probably doesn't matter, and it's probably too late to
+# change, but 'read/write' are the wrong names. Read and Write
+# are actions that take data from storage to memory
+# characters/strings. These take the data to/from storage to native
+# Perl objects, which the terms dump and load are meant. As long as
+# this is a legacy quirk to YAML::Tiny it's ok, but I'd prefer not
+# to add new {read,write}_* methods to this API.
+
+sub read_string {
+ my $self = shift;
+ $self->_load_string(@_);
}
-# The character class of all characters we need to escape
-# NOTE: Inlined, since it's only used once
-# my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
+sub write_string {
+ my $self = shift;
+ $self->_dump_string(@_);
+}
+
+sub read {
+ my $self = shift;
+ $self->_load_file(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->_dump_file(@_);
+}
+
+
+
+
+#####################################################################
+# Constants
# Printed form of the unprintable characters in the lowest range
# of ASCII characters, listed by ASCII ordinal position.
my @UNPRINTABLE = qw(
- z x01 x02 x03 x04 x05 x06 a
- x08 t n v f r x0e x0f
+ 0 x01 x02 x03 x04 x05 x06 a
+ b t n v f r x0E x0F
x10 x11 x12 x13 x14 x15 x16 x17
- x18 x19 x1a e x1c x1d x1e x1f
+ x18 x19 x1A e x1C x1D x1E x1F
);
# Printable characters for escapes
my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
+ 0 => "\x00", z => "\x00", N => "\x85",
+ a => "\x07", b => "\x08", t => "\x09",
n => "\x0a", v => "\x0b", f => "\x0c",
r => "\x0d", e => "\x1b", '\\' => '\\',
);
-# Special magic boolean words
+# XXX-INGY
+# I(ngy) need to decide if these values should be quoted in
+# YAML::Tiny or not. Probably yes.
+
+# These 3 values have special meaning when unquoted and using the
+# default YAML schema. They need quotes if they are strings.
my %QUOTE = map { $_ => 1 } qw{
- null Null NULL
- y Y yes Yes YES n N no No NO
- true True TRUE false False FALSE
- on On ON off Off OFF
+ null true false
};
+# The commented out form is simpler, but overloaded the Perl regex
+# engine due to recursion and backtracking problems on strings
+# larger than 32,000ish characters. Keep it for reference purposes.
+# qr/\"((?:\\.|[^\"])*)\"/
+my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
+my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
+# unquoted re gets trailing space that needs to be stripped
+my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;
+my $re_trailing_comment = qr/(?:\s+\#.*)?/;
+my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
+
#####################################################################
-# Implementation
+# YAML::Tiny Implementation.
+#
+# These are the private methods that do all the work. They may change
+# at any time.
-# Create an empty YAML::Tiny object
-sub new {
- my $class = shift;
- bless [ @_ ], $class;
-}
+
+###
+# Loader functions:
# Create an object from a file
-sub read {
+sub _load_file {
my $class = ref $_[0] ? ref shift : shift;
# Check the file
- my $file = shift or return $class->_error( 'You did not specify a file name' );
- return $class->_error( "File '$file' does not exist" ) unless -e $file;
- return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
- return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
-
- # Slurp in the file
- local $/ = undef;
- local *CFG;
- unless ( open(CFG, $file) ) {
- return $class->_error("Failed to open file '$file': $!");
+ my $file = shift or $class->_error( 'You did not specify a file name' );
+ $class->_error( "File '$file' does not exist" )
+ unless -e $file;
+ $class->_error( "'$file' is a directory, not a file" )
+ unless -f _;
+ $class->_error( "Insufficient permissions to read '$file'" )
+ unless -r _;
+
+ # Open unbuffered with strict UTF-8 decoding and no translation layers
+ open( my $fh, "<:unix:encoding(UTF-8)", $file );
+ unless ( $fh ) {
+ $class->_error("Failed to open file '$file': $!");
+ }
+
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ flock( $fh, Fcntl::LOCK_SH() )
+ or warn "Couldn't lock '$file' for reading: $!";
+ }
+
+ # slurp the contents
+ my $contents = eval {
+ use warnings FATAL => 'utf8';
+ local $/;
+ <$fh>
+ };
+ if ( my $err = $@ ) {
+ $class->_error("Error reading from file '$file': $err");
}
- my $contents = <CFG>;
- unless ( close(CFG) ) {
- return $class->_error("Failed to close file '$file': $!");
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $class->_error("Failed to close file '$file': $!");
}
- $class->read_string( $contents );
+ $class->_load_string( $contents );
}
# Create an object from a string
-sub read_string {
+sub _load_string {
my $class = ref $_[0] ? ref shift : shift;
my $self = bless [], $class;
my $string = $_[0];
@@ -108,30 +220,23 @@ sub read_string {
die \"Did not provide a string to load";
}
- # Byte order marks
- # NOTE: Keeping this here to educate maintainers
- # my %BOM = (
- # "\357\273\277" => 'UTF-8',
- # "\376\377" => 'UTF-16BE',
- # "\377\376" => 'UTF-16LE',
- # "\377\376\0\0" => 'UTF-32LE'
- # "\0\0\376\377" => 'UTF-32BE',
- # );
- if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
- die \"Stream has a non UTF-8 BOM";
- } else {
- # Strip UTF-8 bom if found, we'll just ignore it
- $string =~ s/^\357\273\277//;
+ # Check if Perl has it marked as characters, but it's internally
+ # inconsistent. E.g. maybe latin1 got read on a :utf8 layer
+ if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
+ die \<<'...';
+Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
+Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
+...
}
- # Try to decode as utf8
- utf8::decode($string) if HAVE_UTF8;
+ # Ensure Unicode character semantics, even for 0x80-0xff
+ utf8::upgrade($string);
+
+ # Check for and strip any leading UTF-8 BOM
+ $string =~ s/^\x{FEFF}//;
# Check for some special cases
return $self unless length $string;
- unless ( $string =~ /[\012\015]+\z/ ) {
- die \"Stream does not end with newline character";
- }
# Split the file into lines
my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
@@ -141,15 +246,18 @@ sub read_string {
@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
# A nibbling parser
+ my $in_document = 0;
while ( @lines ) {
# Do we have a document header?
if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
# Handle scalar documents
shift @lines;
if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
- push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
+ push @$self,
+ $self->_load_scalar( "$1", [ undef ], \@lines );
next;
}
+ $in_document = 1;
}
if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
@@ -158,36 +266,65 @@ sub read_string {
while ( @lines and $lines[0] !~ /^---/ ) {
shift @lines;
}
+ $in_document = 0;
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
+ # XXX The final '-+$' is to look for -- which ends up being an
+ # error later.
+ } elsif ( ! $in_document && @$self ) {
+ # only the first document can be explicit
+ die \"YAML::Tiny failed to classify the line '$lines[0]'";
+ } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
# An array at the root
my $document = [ ];
push @$self, $document;
- $self->_read_array( $document, [ 0 ], \@lines );
+ $self->_load_array( $document, [ 0 ], \@lines );
} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
# A hash at the root
my $document = { };
push @$self, $document;
- $self->_read_hash( $document, [ length($1) ], \@lines );
+ $self->_load_hash( $document, [ length($1) ], \@lines );
} else {
+ # Shouldn't get here. @lines have whitespace-only lines
+ # stripped, and previous match is a line with any
+ # non-whitespace. So this clause should only be reachable via
+ # a perlbug where \s is not symmetric with \S
+
+ # uncoverable statement
die \"YAML::Tiny failed to classify the line '$lines[0]'";
}
}
};
- if ( ref $@ eq 'SCALAR' ) {
- return $self->_error(${$@});
- } elsif ( $@ ) {
- require Carp;
- Carp::croak($@);
+ my $err = $@;
+ if ( ref $err eq 'SCALAR' ) {
+ $self->_error(${$err});
+ } elsif ( $err ) {
+ $self->_error($err);
}
return $self;
}
-# Deparse a scalar string to the actual scalar
-sub _read_scalar {
+sub _unquote_single {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+}
+
+sub _unquote_double {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\\"/"/g;
+ $string =~
+ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
+ {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
+ return $string;
+}
+
+# Load a YAML scalar string to the actual Perl scalar
+sub _load_scalar {
my ($self, $string, $indent, $lines) = @_;
# Trim trailing whitespace
@@ -197,25 +334,13 @@ sub _read_scalar {
return undef if $string eq '~';
# Single quote
- if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
- return '' unless defined $1;
- $string = $1;
- $string =~ s/\'\'/\'/g;
- return $string;
+ if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_single($1);
}
# Double quote.
- # The commented out form is simpler, but overloaded the Perl regex
- # engine due to recursion and backtracking problems on strings
- # larger than 32,000ish characters. Keep it for reference purposes.
- # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
- if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) {
- # Reusing the variable is a little ugly,
- # but avoids a new variable and a string copy.
- $string = $1;
- $string =~ s/\\"/"/g;
- $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
- return $string;
+ if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_double($1);
}
# Special cases
@@ -227,13 +352,9 @@ sub _read_scalar {
# Regular unquoted string
if ( $string !~ /^[>|]/ ) {
- if (
- $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
- or
- $string =~ /:(?:\s|$)/
- ) {
- die \"YAML::Tiny found illegal characters in plain scalar: '$string'";
- }
+ die \"YAML::Tiny found illegal characters in plain scalar: '$string'"
+ if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
+ $string =~ /:(?:\s|$)/;
$string =~ s/\s+#.*\z//;
return $string;
}
@@ -261,8 +382,8 @@ sub _read_scalar {
return join( $j, @multiline ) . $t;
}
-# Parse an array
-sub _read_array {
+# Load an array
+sub _load_array {
my ($self, $array, $indent, $lines) = @_;
while ( @$lines ) {
@@ -287,12 +408,7 @@ sub _read_array {
my $indent2 = length("$1");
$lines->[0] =~ s/-/ /;
push @$array, { };
- $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
- # Array entry with a value
- shift @$lines;
- push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
+ $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
shift @$lines;
@@ -308,17 +424,28 @@ sub _read_array {
} else {
# Naked indenter
push @$array, [ ];
- $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
+ $self->_load_array(
+ $array->[-1], [ @$indent, $indent2 ], $lines
+ );
}
} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
push @$array, { };
- $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
+ $self->_load_hash(
+ $array->[-1], [ @$indent, length("$1") ], $lines
+ );
} else {
die \"YAML::Tiny failed to classify line '$lines->[0]'";
}
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+ # Array entry with a value
+ shift @$lines;
+ push @$array, $self->_load_scalar(
+ "$2", [ @$indent, undef ], $lines
+ );
+
} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
# This is probably a structure like the following...
# ---
@@ -337,8 +464,8 @@ sub _read_array {
return 1;
}
-# Parse an array
-sub _read_hash {
+# Load a hash
+sub _load_hash {
my ($self, $hash, $indent, $lines) = @_;
while ( @$lines ) {
@@ -358,19 +485,43 @@ sub _read_hash {
die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
}
- # Get the key
- unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
- if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
- die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
- }
+ # Find the key
+ my $key;
+
+ # Quoted keys
+ if ( $lines->[0] =~
+ s/^\s*$re_capture_single_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_single($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_double_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_double($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_unquoted_key$re_key_value_separator//
+ ) {
+ $key = $1;
+ $key =~ s/\s+$//;
+ }
+ elsif ( $lines->[0] =~ /^\s*\?/ ) {
+ die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
+ }
+ else {
die \"YAML::Tiny failed to classify line '$lines->[0]'";
}
- my $key = $1;
+
+ if ( exists $hash->{$key} ) {
+ warn "YAML::Tiny found a duplicate key '$key' in line '$lines->[0]'";
+ }
# Do we have a value?
if ( length $lines->[0] ) {
# Yes
- $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
+ $hash->{$key} = $self->_load_scalar(
+ shift(@$lines), [ @$indent, undef ], $lines
+ );
} else {
# An indent
shift @$lines;
@@ -380,7 +531,9 @@ sub _read_hash {
}
if ( $lines->[0] =~ /^(\s*)-/ ) {
$hash->{$key} = [];
- $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ $self->_load_array(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
} elsif ( $lines->[0] =~ /^(\s*)./ ) {
my $indent2 = length("$1");
if ( $indent->[-1] >= $indent2 ) {
@@ -388,7 +541,9 @@ sub _read_hash {
$hash->{$key} = undef;
} else {
$hash->{$key} = {};
- $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ $self->_load_hash(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
}
}
}
@@ -397,98 +552,159 @@ sub _read_hash {
return 1;
}
+
+###
+# Dumper functions:
+
# Save an object to a file
-sub write {
+sub _dump_file {
my $self = shift;
- my $file = shift or return $self->_error('No file name provided');
- # Write it to the file
- open( CFG, '>' . $file ) or return $self->_error(
- "Failed to open file '$file' for writing: $!"
- );
- print CFG $self->write_string;
- close CFG;
+ require Fcntl;
+
+ # Check the file
+ my $file = shift or $self->_error( 'You did not specify a file name' );
+
+ my $fh;
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ # Open without truncation (truncate comes after lock)
+ my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
+ sysopen( $fh, $file, $flags )
+ or $self->_error("Failed to open file '$file' for writing: $!");
+
+ # Use no translation and strict UTF-8
+ binmode( $fh, ":raw:encoding(UTF-8)");
+
+ flock( $fh, Fcntl::LOCK_EX() )
+ or warn "Couldn't lock '$file' for reading: $!";
+
+ # truncate and spew contents
+ truncate $fh, 0;
+ seek $fh, 0, 0;
+ }
+ else {
+ open $fh, ">:unix:encoding(UTF-8)", $file;
+ }
+
+ # serialize and spew to the handle
+ print {$fh} $self->_dump_string;
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $self->_error("Failed to close file '$file': $!");
+ }
return 1;
}
# Save an object to a string
-sub write_string {
+sub _dump_string {
my $self = shift;
- return '' unless @$self;
+ return '' unless ref $self && @$self;
# Iterate over the documents
my $indent = 0;
my @lines = ();
- foreach my $cursor ( @$self ) {
- push @lines, '---';
-
- # An empty document
- if ( ! defined $cursor ) {
- # Do nothing
-
- # A scalar document
- } elsif ( ! ref $cursor ) {
- $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
-
- # A list at the root
- } elsif ( ref $cursor eq 'ARRAY' ) {
- unless ( @$cursor ) {
- $lines[-1] .= ' []';
- next;
- }
- push @lines, $self->_write_array( $cursor, $indent, {} );
- # A hash at the root
- } elsif ( ref $cursor eq 'HASH' ) {
- unless ( %$cursor ) {
- $lines[-1] .= ' {}';
- next;
- }
- push @lines, $self->_write_hash( $cursor, $indent, {} );
+ eval {
+ foreach my $cursor ( @$self ) {
+ push @lines, '---';
- } else {
- Carp::croak("Cannot serialize " . ref($cursor));
+ # An empty document
+ if ( ! defined $cursor ) {
+ # Do nothing
+
+ # A scalar document
+ } elsif ( ! ref $cursor ) {
+ $lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
+
+ # A list at the root
+ } elsif ( ref $cursor eq 'ARRAY' ) {
+ unless ( @$cursor ) {
+ $lines[-1] .= ' []';
+ next;
+ }
+ push @lines, $self->_dump_array( $cursor, $indent, {} );
+
+ # A hash at the root
+ } elsif ( ref $cursor eq 'HASH' ) {
+ unless ( %$cursor ) {
+ $lines[-1] .= ' {}';
+ next;
+ }
+ push @lines, $self->_dump_hash( $cursor, $indent, {} );
+
+ } else {
+ die \("Cannot serialize " . ref($cursor));
+ }
}
+ };
+ if ( ref $@ eq 'SCALAR' ) {
+ $self->_error(${$@});
+ } elsif ( $@ ) {
+ $self->_error($@);
}
join '', map { "$_\n" } @lines;
}
-sub _write_scalar {
+sub _has_internal_string_value {
+ my $value = shift;
+ my $b_obj = B::svref_2object(\$value); # for round trip problem
+ return $b_obj->FLAGS & B::SVf_POK();
+}
+
+sub _dump_scalar {
my $string = $_[1];
+ my $is_key = $_[2];
+ # Check this before checking length or it winds up looking like a string!
+ my $has_string_flag = _has_internal_string_value($string);
return '~' unless defined $string;
return "''" unless length $string;
- if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
+ if (Scalar::Util::looks_like_number($string)) {
+ # keys and values that have been used as strings get quoted
+ if ( $is_key || $has_string_flag ) {
+ return qq['$string'];
+ }
+ else {
+ return $string;
+ }
+ }
+ if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
$string =~ s/\\/\\\\/g;
$string =~ s/"/\\"/g;
$string =~ s/\n/\\n/g;
+ $string =~ s/[\x85]/\\N/g;
$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
+ $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
return qq|"$string"|;
}
- if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
+ if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
+ $QUOTE{$string}
+ ) {
return "'$string'";
}
return $string;
}
-sub _write_array {
+sub _dump_array {
my ($self, $array, $indent, $seen) = @_;
if ( $seen->{refaddr($array)}++ ) {
- die "YAML::Tiny does not support circular references";
+ die \"YAML::Tiny does not support circular references";
}
my @lines = ();
foreach my $el ( @$array ) {
my $line = (' ' x $indent) . '-';
my $type = ref $el;
if ( ! $type ) {
- $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
+ $line .= ' ' . $self->_dump_scalar( $el );
push @lines, $line;
} elsif ( $type eq 'ARRAY' ) {
if ( @$el ) {
push @lines, $line;
- push @lines, $self->_write_array( $el, $indent + 1, $seen );
+ push @lines, $self->_dump_array( $el, $indent + 1, $seen );
} else {
$line .= ' []';
push @lines, $line;
@@ -497,38 +713,38 @@ sub _write_array {
} elsif ( $type eq 'HASH' ) {
if ( keys %$el ) {
push @lines, $line;
- push @lines, $self->_write_hash( $el, $indent + 1, $seen );
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
} else {
$line .= ' {}';
push @lines, $line;
}
} else {
- die "YAML::Tiny does not support $type references";
+ die \"YAML::Tiny does not support $type references";
}
}
@lines;
}
-sub _write_hash {
+sub _dump_hash {
my ($self, $hash, $indent, $seen) = @_;
if ( $seen->{refaddr($hash)}++ ) {
- die "YAML::Tiny does not support circular references";
+ die \"YAML::Tiny does not support circular references";
}
my @lines = ();
foreach my $name ( sort keys %$hash ) {
my $el = $hash->{$name};
- my $line = (' ' x $indent) . "$name:";
+ my $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":";
my $type = ref $el;
if ( ! $type ) {
- $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
+ $line .= ' ' . $self->_dump_scalar( $el );
push @lines, $line;
} elsif ( $type eq 'ARRAY' ) {
if ( @$el ) {
push @lines, $line;
- push @lines, $self->_write_array( $el, $indent + 1, $seen );
+ push @lines, $self->_dump_array( $el, $indent + 1, $seen );
} else {
$line .= ' []';
push @lines, $line;
@@ -537,92 +753,87 @@ sub _write_hash {
} elsif ( $type eq 'HASH' ) {
if ( keys %$el ) {
push @lines, $line;
- push @lines, $self->_write_hash( $el, $indent + 1, $seen );
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
} else {
$line .= ' {}';
push @lines, $line;
}
} else {
- die "YAML::Tiny does not support $type references";
+ die \"YAML::Tiny does not support $type references";
}
}
@lines;
}
+
+
+#####################################################################
+# DEPRECATED API methods:
+
+# Error storage (DEPRECATED as of 1.57)
+our $errstr = '';
+
# Set error
sub _error {
- $YAML::Tiny::errstr = $_[1];
- undef;
+ require Carp;
+ $errstr = $_[1];
+ $errstr =~ s/ at \S+ line \d+.*//;
+ Carp::croak( $errstr );
}
# Retrieve error
+my $errstr_warned;
sub errstr {
- $YAML::Tiny::errstr;
+ require Carp;
+ Carp::carp( "YAML::Tiny->errstr and \$YAML::Tiny::errstr is deprecated" )
+ unless $errstr_warned++;
+ $errstr;
}
-
#####################################################################
-# YAML Compatibility
-
-sub Dump {
- YAML::Tiny->new(@_)->write_string;
-}
-
-sub Load {
- my $self = YAML::Tiny->read_string(@_);
- unless ( $self ) {
- Carp::croak("Failed to load YAML document from string");
- }
- if ( wantarray ) {
- return @$self;
- } else {
- # To match YAML.pm, return the last document
- return $self->[-1];
- }
-}
+# Helper functions. Possibly not needed.
-BEGIN {
- *freeze = *Dump;
- *thaw = *Load;
-}
-sub DumpFile {
- my $file = shift;
- YAML::Tiny->new(@_)->write($file);
-}
+# Use to detect nv or iv
+use B;
-sub LoadFile {
- my $self = YAML::Tiny->read($_[0]);
- unless ( $self ) {
- Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
+# XXX-INGY Is flock YAML::Tiny's responsibility?
+# Some platforms can't flock :-(
+# XXX-XDG I think it is. When reading and writing files, we ought
+# to be locking whenever possible. People (foolishly) use YAML
+# files for things like session storage, which has race issues.
+my $HAS_FLOCK;
+sub _can_flock {
+ if ( defined $HAS_FLOCK ) {
+ return $HAS_FLOCK;
}
- if ( wantarray ) {
- return @$self;
- } else {
- # Return only the last document to match YAML.pm,
- return $self->[-1];
+ else {
+ require Config;
+ my $c = \%Config::Config;
+ $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/;
+ require Fcntl if $HAS_FLOCK;
+ return $HAS_FLOCK;
}
}
-
-
-
+# XXX-INGY Is this core in 5.8.1? Can we remove this?
+# XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this
#####################################################################
# Use Scalar::Util if possible, otherwise emulate it
+use Scalar::Util ();
BEGIN {
local $@;
- eval {
- require Scalar::Util;
- };
- my $v = eval("$Scalar::Util::VERSION") || 0;
- if ( $@ or $v < 1.18 ) {
+ if ( eval { Scalar::Util->VERSION(1.18); } ) {
+ *refaddr = *Scalar::Util::refaddr;
+ }
+ else {
eval <<'END_PERL';
# Scalar::Util failed to load or too old
sub refaddr {
@@ -633,18 +844,29 @@ sub refaddr {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
- my $i = do { local $^W; hex $1 };
+ my $i = do { no warnings 'portable'; hex $1 };
bless $_[0], $pkg if defined $pkg;
$i;
}
END_PERL
- } else {
- *refaddr = *Scalar::Util::refaddr;
}
}
+delete $YAML::Tiny::{refaddr};
+
1;
+# XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong
+# but leaving grey area stuff up here.
+#
+# I would like to change Read/Write to Load/Dump below without
+# changing the actual API names.
+#
+# It might be better to put Load/Dump API in the SYNOPSIS instead of the
+# dubious OO API.
+#
+# null and bool explanations may be outdated.
+
__END__
-#line 1223
+#line 1487
diff --git a/inc/unicore/Name.pm b/inc/unicore/Name.pm
deleted file mode 100644
index 15e729b..0000000
--- a/inc/unicore/Name.pm
+++ /dev/null
@@ -1,416 +0,0 @@
-#line 1
-# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
-# This file is machine-generated by lib/unicore/mktables from the Unicode
-# database, Version 6.2.0. Any changes made here will be lost!
-
-
-# !!!!!!! INTERNAL PERL USE ONLY !!!!!!!
-# This file is for internal use by core Perl only. The format and even the
-# name or existence of this file are subject to change without notice. Don't
-# use it directly.
-
-
-package charnames;
-
-# This module contains machine-generated tables and code for the
-# algorithmically-determinable Unicode character names. The following
-# routines can be used to translate between name and code point and vice versa
-
-{ # Closure
-
- # Matches legal code point. 4-6 hex numbers, If there are 6, the first
- # two must be 10; if there are 5, the first must not be a 0. Written this
- # way to decrease backtracking. The first regex allows the code point to
- # be at the end of a word, but to work properly, the word shouldn't end
- # with a valid hex character. The second one won't match a code point at
- # the end of a word, and doesn't have the run-on issue
- my $run_on_code_point_re = qr/(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b)/;
- my $code_point_re = qr/(?^aa:\b(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b))/;
-
- # In the following hash, the keys are the bases of names which include
- # the code point in the name, like CJK UNIFIED IDEOGRAPH-4E01. The value
- # of each key is another hash which is used to get the low and high ends
- # for each range of code points that apply to the name.
- my %names_ending_in_code_point = (
-'CJK COMPATIBILITY IDEOGRAPH' =>
-{
-'high' =>
-[
-64109,
-64217,
-195101,
-],
-'low' =>
-[
-63744,
-64112,
-194560,
-],
-},
-'CJK UNIFIED IDEOGRAPH' =>
-{
-'high' =>
-[
-19893,
-40908,
-173782,
-177972,
-178205,
-],
-'low' =>
-[
-13312,
-19968,
-131072,
-173824,
-177984,
-],
-},
-
- );
-
- # The following hash is a copy of the previous one, except is for loose
- # matching, so each name has blanks and dashes squeezed out
- my %loose_names_ending_in_code_point = (
-'CJKCOMPATIBILITYIDEOGRAPH' =>
-{
-'high' =>
-[
-64109,
-64217,
-195101,
-],
-'low' =>
-[
-63744,
-64112,
-194560,
-],
-},
-'CJKUNIFIEDIDEOGRAPH' =>
-{
-'high' =>
-[
-19893,
-40908,
-173782,
-177972,
-178205,
-],
-'low' =>
-[
-13312,
-19968,
-131072,
-173824,
-177984,
-],
-},
-
- );
-
- # And the following array gives the inverse mapping from code points to
- # names. Lowest code points are first
- my @code_points_ending_in_code_point = (
-
-{
-'high' => 19893,
-'low' => 13312,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 40908,
-'low' => 19968,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 64109,
-'low' => 63744,
-'name' => 'CJK COMPATIBILITY IDEOGRAPH',
-},
-{
-'high' => 64217,
-'low' => 64112,
-'name' => 'CJK COMPATIBILITY IDEOGRAPH',
-},
-{
-'high' => 173782,
-'low' => 131072,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 177972,
-'low' => 173824,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 178205,
-'low' => 177984,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 195101,
-'low' => 194560,
-'name' => 'CJK COMPATIBILITY IDEOGRAPH',
-},
-,
-
- );
-
- # Convert from code point to Jamo short name for use in composing Hangul
- # syllable names
- my %Jamo = (
-4352 => 'G',
-4353 => 'GG',
-4354 => 'N',
-4355 => 'D',
-4356 => 'DD',
-4357 => 'R',
-4358 => 'M',
-4359 => 'B',
-4360 => 'BB',
-4361 => 'S',
-4362 => 'SS',
-4363 => '',
-4364 => 'J',
-4365 => 'JJ',
-4366 => 'C',
-4367 => 'K',
-4368 => 'T',
-4369 => 'P',
-4370 => 'H',
-4449 => 'A',
-4450 => 'AE',
-4451 => 'YA',
-4452 => 'YAE',
-4453 => 'EO',
-4454 => 'E',
-4455 => 'YEO',
-4456 => 'YE',
-4457 => 'O',
-4458 => 'WA',
-4459 => 'WAE',
-4460 => 'OE',
-4461 => 'YO',
-4462 => 'U',
-4463 => 'WEO',
-4464 => 'WE',
-4465 => 'WI',
-4466 => 'YU',
-4467 => 'EU',
-4468 => 'YI',
-4469 => 'I',
-4520 => 'G',
-4521 => 'GG',
-4522 => 'GS',
-4523 => 'N',
-4524 => 'NJ',
-4525 => 'NH',
-4526 => 'D',
-4527 => 'L',
-4528 => 'LG',
-4529 => 'LM',
-4530 => 'LB',
-4531 => 'LS',
-4532 => 'LT',
-4533 => 'LP',
-4534 => 'LH',
-4535 => 'M',
-4536 => 'B',
-4537 => 'BS',
-4538 => 'S',
-4539 => 'SS',
-4540 => 'NG',
-4541 => 'J',
-4542 => 'C',
-4543 => 'K',
-4544 => 'T',
-4545 => 'P',
-4546 => 'H',
-
- );
-
- # Leading consonant (can be null)
- my %Jamo_L = (
-'' => 11,
-'B' => 7,
-'BB' => 8,
-'C' => 14,
-'D' => 3,
-'DD' => 4,
-'G' => 0,
-'GG' => 1,
-'H' => 18,
-'J' => 12,
-'JJ' => 13,
-'K' => 15,
-'M' => 6,
-'N' => 2,
-'P' => 17,
-'R' => 5,
-'S' => 9,
-'SS' => 10,
-'T' => 16,
-
- );
-
- # Vowel
- my %Jamo_V = (
-'A' => 0,
-'AE' => 1,
-'E' => 5,
-'EO' => 4,
-'EU' => 18,
-'I' => 20,
-'O' => 8,
-'OE' => 11,
-'U' => 13,
-'WA' => 9,
-'WAE' => 10,
-'WE' => 15,
-'WEO' => 14,
-'WI' => 16,
-'YA' => 2,
-'YAE' => 3,
-'YE' => 7,
-'YEO' => 6,
-'YI' => 19,
-'YO' => 12,
-'YU' => 17,
-
- );
-
- # Optional trailing consonant
- my %Jamo_T = (
-'B' => 17,
-'BS' => 18,
-'C' => 23,
-'D' => 7,
-'G' => 1,
-'GG' => 2,
-'GS' => 3,
-'H' => 27,
-'J' => 22,
-'K' => 24,
-'L' => 8,
-'LB' => 11,
-'LG' => 9,
-'LH' => 15,
-'LM' => 10,
-'LP' => 14,
-'LS' => 12,
-'LT' => 13,
-'M' => 16,
-'N' => 4,
-'NG' => 21,
-'NH' => 6,
-'NJ' => 5,
-'P' => 26,
-'S' => 19,
-'SS' => 20,
-'T' => 25,
-
- );
-
- # Computed re that splits up a Hangul name into LVT or LV syllables
- my $syllable_re = qr/(|B|BB|C|D|DD|G|GG|H|J|JJ|K|M|N|P|R|S|SS|T)(A|AE|E|EO|EU|I|O|OE|U|WA|WAE|WE|WEO|WI|YA|YAE|YE|YEO|YI|YO|YU)(B|BS|C|D|G|GG|GS|H|J|K|L|LB|LG|LH|LM|LP|LS|LT|M|N|NG|NH|NJ|P|S|SS|T)?/;
-
- my $HANGUL_SYLLABLE = "HANGUL SYLLABLE ";
- my $loose_HANGUL_SYLLABLE = "HANGULSYLLABLE";
-
- # These constants names and values were taken from the Unicode standard,
- # version 5.1, section 3.12. They are used in conjunction with Hangul
- # syllables
- my $SBase = 0xAC00;
- my $LBase = 0x1100;
- my $VBase = 0x1161;
- my $TBase = 0x11A7;
- my $SCount = 11172;
- my $LCount = 19;
- my $VCount = 21;
- my $TCount = 28;
- my $NCount = $VCount * $TCount;
-
- sub name_to_code_point_special {
- my ($name, $loose) = @_;
-
- # Returns undef if not one of the specially handled names; otherwise
- # returns the code point equivalent to the input name
- # $loose is non-zero if to use loose matching, 'name' in that case
- # must be input as upper case with all blanks and dashes squeezed out.
-
- if ((! $loose && $name =~ s/$HANGUL_SYLLABLE//)
- || ($loose && $name =~ s/$loose_HANGUL_SYLLABLE//))
- {
- return if $name !~ qr/^$syllable_re$/;
- my $L = $Jamo_L{$1};
- my $V = $Jamo_V{$2};
- my $T = (defined $3) ? $Jamo_T{$3} : 0;
- return ($L * $VCount + $V) * $TCount + $T + $SBase;
- }
-
- # Name must end in 'code_point' for this to handle.
- return if (($loose && $name !~ /^ (.*?) ($run_on_code_point_re) $/x)
- || (! $loose && $name !~ /^ (.*) ($code_point_re) $/x));
-
- my $base = $1;
- my $code_point = CORE::hex $2;
- my $names_ref;
-
- if ($loose) {
- $names_ref = \%loose_names_ending_in_code_point;
- }
- else {
- return if $base !~ s/-$//;
- $names_ref = \%names_ending_in_code_point;
- }
-
- # Name must be one of the ones which has the code point in it.
- return if ! $names_ref->{$base};
-
- # Look through the list of ranges that apply to this name to see if
- # the code point is in one of them.
- for (my $i = 0; $i < scalar @{$names_ref->{$base}{'low'}}; $i++) {
- return if $names_ref->{$base}{'low'}->[$i] > $code_point;
- next if $names_ref->{$base}{'high'}->[$i] < $code_point;
-
- # Here, the code point is in the range.
- return $code_point;
- }
-
- # Here, looked like the name had a code point number in it, but
- # did not match one of the valid ones.
- return;
- }
-
- sub code_point_to_name_special {
- my $code_point = shift;
-
- # Returns the name of a code point if algorithmically determinable;
- # undef if not
-
- # If in the Hangul range, calculate the name based on Unicode's
- # algorithm
- if ($code_point >= $SBase && $code_point <= $SBase + $SCount -1) {
- use integer;
- my $SIndex = $code_point - $SBase;
- my $L = $LBase + $SIndex / $NCount;
- my $V = $VBase + ($SIndex % $NCount) / $TCount;
- my $T = $TBase + $SIndex % $TCount;
- $name = "$HANGUL_SYLLABLE$Jamo{$L}$Jamo{$V}";
- $name .= $Jamo{$T} if $T != $TBase;
- return $name;
- }
-
- # Look through list of these code points for one in range.
- foreach my $hash (@code_points_ending_in_code_point) {
- return if $code_point < $hash->{'low'};
- if ($code_point <= $hash->{'high'}) {
- return sprintf("%s-%04X", $hash->{'name'}, $code_point);
- }
- }
- return; # None found
- }
-} # End closure
-
-1;
commit 64ca458fc72c68ff08805fd5910976eabc087f58
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 20 16:56:47 2017 -0500
Prep for 1.01 release
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..58f0ca6
--- /dev/null
+++ b/Changes
@@ -0,0 +1,9 @@
+Revision history for RT-Extension-REST2
+
+1.01 2017-11-20
+ - Relocate REST2 DB connect to occur after PSGI forks
+ - Add cleanup method to resolve DBIx::SearchBuilder processing at request end
+
+1.00 2017-07-20
+ - Initial release
+
diff --git a/MANIFEST b/MANIFEST
index 345098c..c85b73e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,4 @@
+Changes
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
@@ -12,7 +13,6 @@ inc/Module/Install/RTx/Runtime.pm
inc/Module/Install/Substitute.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
-inc/unicore/Name.pm
inc/YAML/Tiny.pm
lib/RT/Extension/REST2.pm
lib/RT/Extension/REST2/Dispatcher.pm
diff --git a/META.yml b/META.yml
index 834efba..6e364f4 100644
--- a/META.yml
+++ b/META.yml
@@ -5,6 +5,7 @@ author:
build_requires:
ExtUtils::MakeMaker: 6.59
Test::Deep: 0
+ Test::WWW::Mechanize::PSGI: 0
Try::Tiny: 0
configure_requires:
ExtUtils::MakeMaker: 6.59
@@ -37,11 +38,11 @@ requires:
Pod::POM: 0
Scalar::Util: 0
Sub::Exporter: 0
- Web::Machine: 0.12
+ Web::Machine: '0.12'
namespace::autoclean: 0
perl: 5.10.1
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 1.00
-x_module_install_rtx_version: 0.39
+version: '1.01'
+x_module_install_rtx_version: '0.39'
x_requires_rt: 4.2.4
diff --git a/README b/README
index 5b90a4b..aa3466a 100644
--- a/README
+++ b/README
@@ -207,6 +207,10 @@ USAGE
Additionally, this system lets you be informed of new capabilities in
the form of additional hyperlinks.
+ Using these tools and principles, REST2 will help you build rich,
+ robust, and powerful integrations with the other applications and
+ services that your team uses.
+
Endpoints
Currently provided endpoints under /REST/2.0/ are described below.
Wherever possible please consider using _hyperlinks hypermedia controls
diff --git a/lib/RT/Extension/REST2.pm b/lib/RT/Extension/REST2.pm
index dd140bf..b7e2a7b 100644
--- a/lib/RT/Extension/REST2.pm
+++ b/lib/RT/Extension/REST2.pm
@@ -4,7 +4,7 @@ use 5.010001;
package RT::Extension::REST2;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
our $REST_PATH = '/REST/2.0';
use Plack::Builder;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list