Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

add deprecation feature for JSON::Syck to close the Test::JSON bug

  • Loading branch information...
commit 4060539a57e44109f64208b6f69e7224b0e9df8f 1 parent e9b163e
Chris Prather authored
Showing with 121 additions and 81 deletions.
  1. +5 −1 Changes
  2. +116 −80 lib/JSON/Any.pm
View
6 Changes
@@ -1,5 +1,9 @@
Revision history for JSON-Any
-1.19 2009-01-??
+1.20 2009-07-02
+ * Re-work things so that deprecated modules just warn but aren't actually excluded (perigrin)
+ * Improve the warnings when things go awry (semifor)
+
+1.19 2009-01-15
* Make JSON::Syck optional and deprecated. (perigrin)
* Added tests for string escapes. (semifor)
View
196 lib/JSON/Any.pm
@@ -2,7 +2,7 @@ package JSON::Any;
use warnings;
use strict;
-use Carp;
+use Carp qw(croak carp);
=head1 NAME
@@ -37,31 +37,31 @@ BEGIN {
JSON->import( '-support_by_pp', '-no_export' );
my ( $self, $conf ) = @_;
my @params = qw(
- ascii
- latin1
- utf8
- pretty
- indent
- space_before
- space_after
- relaxed
- canonical
- allow_nonref
- allow_blessed
- convert_blessed
- filter_json_object
- shrink
- max_depth
- max_size
- loose
- allow_bignum
- allow_barekey
- allow_singlequote
- escape_slash
- indent_length
- sort_by
+ ascii
+ latin1
+ utf8
+ pretty
+ indent
+ space_before
+ space_after
+ relaxed
+ canonical
+ allow_nonref
+ allow_blessed
+ convert_blessed
+ filter_json_object
+ shrink
+ max_depth
+ max_size
+ loose
+ allow_bignum
+ allow_barekey
+ allow_singlequote
+ escape_slash
+ indent_length
+ sort_by
);
- local $conf->{utf8} = !$conf->{utf8}; # it means the opposite
+ local $conf->{utf8} = !$conf->{utf8}; # it means the opposite
my $obj = $handler->new;
for my $mutator (@params) {
@@ -85,8 +85,8 @@ BEGIN {
croak "JSON::DWIW does not support utf8" if $conf->{utf8};
$self->[ENCODER] = 'to_json';
$self->[DECODER] = 'from_json';
- $self->[HANDLER] =
- $handler->new( { map { $_ => $conf->{$_} } @params } );
+ $self->[HANDLER]
+ = $handler->new( { map { $_ => $conf->{$_} } @params } );
},
},
json_xs_1 => {
@@ -98,16 +98,16 @@ BEGIN {
my ( $self, $conf ) = @_;
my @params = qw(
- ascii
- utf8
- pretty
- indent
- space_before
- space_after
- canonical
- allow_nonref
- shrink
- max_depth
+ ascii
+ utf8
+ pretty
+ indent
+ space_before
+ space_after
+ canonical
+ allow_nonref
+ shrink
+ max_depth
);
my $obj = $handler->new;
@@ -131,25 +131,25 @@ BEGIN {
my ( $self, $conf ) = @_;
my @params = qw(
- ascii
- latin1
- utf8
- pretty
- indent
- space_before
- space_after
- relaxed
- canonical
- allow_nonref
- allow_blessed
- convert_blessed
- filter_json_object
- shrink
- max_depth
- max_size
+ ascii
+ latin1
+ utf8
+ pretty
+ indent
+ space_before
+ space_after
+ relaxed
+ canonical
+ allow_nonref
+ allow_blessed
+ convert_blessed
+ filter_json_object
+ shrink
+ max_depth
+ max_size
);
- local $conf->{utf8} = !$conf->{utf8}; # it means the opposite
+ local $conf->{utf8} = !$conf->{utf8}; # it means the opposite
my $obj = $handler->new;
for my $mutator (@params) {
@@ -162,17 +162,21 @@ BEGIN {
},
},
json_syck => {
- encoder => 'Dump',
- decoder => 'Load',
- get_true => sub { croak "JSON::Syck does not support special boolean values"; },
- get_false => sub { croak "JSON::Syck does not support special boolean values"; },
+ encoder => 'Dump',
+ decoder => 'Load',
+ get_true => sub {
+ croak "JSON::Syck does not support special boolean values";
+ },
+ get_false => sub {
+ croak "JSON::Syck does not support special boolean values";
+ },
create_object => sub {
my ( $self, $conf ) = @_;
croak "JSON::Syck does not support utf8" if $conf->{utf8};
$self->[ENCODER] = sub { Dump(@_) };
$self->[DECODER] = sub { Load(@_) };
$self->[HANDLER] = 'JSON::Syck';
- }
+ }
},
);
}
@@ -187,16 +191,12 @@ sub _make_key {
return $key;
}
-sub import {
- my $class = shift;
- my @order = @_;
+my @default = qw(XS JSON DWIW);
+my @deprecated = qw(Syck);
+sub _try_loading {
+ my @order = @_;
( $handler, $encoder, $decoder ) = ();
-
- @order = split /\s/, $ENV{JSON_ANY_ORDER}
- if !@order and $ENV{JSON_ANY_ORDER};
- @order = qw(XS JSON DWIW) unless @order;
-
foreach my $testmod (@order) {
$testmod = "JSON::$testmod" unless $testmod eq "JSON";
eval "require $testmod";
@@ -208,10 +208,42 @@ sub import {
last;
}
}
+ return ( $handler, $encoder, $decoder );
+}
- unless ( $handler ) {
- my $last = pop @order;
- croak "Couldn't find a JSON package. Need ", join ', ' => @order, "or $last";
+sub import {
+ my $class = shift;
+ my @order = @_;
+
+ ( $handler, $encoder, $decoder ) = ();
+
+ @order = split /\s/, $ENV{JSON_ANY_ORDER}
+ if !@order and $ENV{JSON_ANY_ORDER};
+
+ if (@order) {
+ ( $handler, $encoder, $decoder ) = _try_loading(@order);
+ if ( $handler && grep { "JSON::$_" eq $handler } @deprecated ) {
+ my $last = pop @default;
+ carp "Found deprecated package $handler. Please upgrade to ",
+ join ', ' => @default, "or $last";
+ }
+ }
+ unless ($handler) {
+ ( $handler, $encoder, $decoder ) = _try_loading(@default);
+ }
+ unless ($handler) {
+ ( $handler, $encoder, $decoder ) = _try_loading(@deprecated);
+ if ($handler) {
+ my $last = pop @default;
+ carp "Found deprecated package $handler. Please upgrade to ",
+ join ', ' => @default, "or $last";
+ }
+ }
+
+ unless ($handler) {
+ my $last = pop @default;
+ croak "Couldn't find a JSON package. Need ", join ', ' => @default,
+ "or $last";
}
croak "Couldn't find a decoder method." unless $decoder;
croak "Couldn't find a encoder method." unless $encoder;
@@ -273,9 +305,10 @@ can also be set via the $ENV{JSON_ANY_ORDER} environment variable.
JSON::Syck has been deprecated by it's author, but in the attempt to still
stay relevant as a "Compat Layer" JSON::Any still supports it. This support
-however has been made optional, and disabled by default. If you would like to
-use JSON::Any with version 1.19 and above you'll need to explicitly add it to
-the import list.
+however has been made optional starting with JSON::Any 1.19. In deference to a
+bug request starting with JSON 1.20 JSON::Syck and other deprecated modules
+will still be installed, but only as a last resort and will now include a
+warning.
use JSON::Any qw(Syck XS JSON);
@@ -328,7 +361,7 @@ sub new {
my @config = @_;
if ( $ENV{JSON_ANY_CONFIG} ) {
push @config, map { split /=/, $_ } split /,\s*/,
- $ENV{JSON_ANY_CONFIG};
+ $ENV{JSON_ANY_CONFIG};
}
$creator->( $self, my $conf = {@config} );
$self->[UTF8] = $conf->{utf8};
@@ -424,7 +457,8 @@ sub objToJson {
if ( ref $self ) {
my $method;
unless ( ref $self->[ENCODER] ) {
- croak "No $handler Object created!" unless exists $self->[HANDLER];
+ croak "No $handler Object created!"
+ unless exists $self->[HANDLER];
$method = $self->[HANDLER]->can( $self->[ENCODER] );
croak "$handler can't execute $self->[ENCODER]" unless $method;
}
@@ -438,9 +472,9 @@ sub objToJson {
}
utf8::decode($json)
- if ( ref $self ? $self->[UTF8] : $UTF8 )
- and !utf8::is_utf8($json)
- and utf8::valid($json);
+ if ( ref $self ? $self->[UTF8] : $UTF8 )
+ and !utf8::is_utf8($json)
+ and utf8::valid($json);
return $json;
}
@@ -482,7 +516,8 @@ sub jsonToObj {
if ( ref $self ) {
my $method;
unless ( ref $self->[DECODER] ) {
- croak "No $handler Object created!" unless exists $self->[HANDLER];
+ croak "No $handler Object created!"
+ unless exists $self->[HANDLER];
$method = $self->[HANDLER]->can( $self->[DECODER] );
croak "$handler can't execute $self->[DECODER]" unless $method;
}
@@ -522,6 +557,7 @@ __END__
Chris Thompson, C<< <cthom at cpan.org> >>
Chris Prather, C<< <chris at prather.org> >>
Robin Berjon, C<< robin at berjon.com >>
+Marc Mims C<<marc@questright.com>>
=head1 BUGS
@@ -551,4 +587,4 @@ Copyright 2007-2009 Chris Thompson, some rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
-=cut
+=cut
Please sign in to comment.
Something went wrong with that request. Please try again.