view release on metacpan or  search on metacpan

ApacheFormat.pm  view on Meta::CPAN

=cut

use File::Spec;
use Carp           qw(croak);
use Text::Balanced qw(extract_delimited extract_variable);
use Scalar::Util qw(weaken);

# this "placeholder" is used to handle escaped variables (\$)
# if it conflicts with a define in your config file somehow, simply
# override it with "$Config::ApacheFormat::PLACEHOLDER = 'whatever';"
our $PLACEHOLDER = "~PLaCE_h0LDeR_$$~";  

ApacheFormat.pm  view on Meta::CPAN

            my $val = [];
            $val = _parse_value_list($values) if $values;

            # create new object for block, inheriting options from
            # this object, with this object set as parent (using
            # weaken() to avoid creating a circular reference that
            # would leak memory)
            my $parent = $self;
            weaken($parent);
            my $block = ref($self)->new(
                  inheritance_support => $self->{inheritance_support},
                  include_support     => $self->{include_support},
                  autoload_support    => $self->{autoload_support},
                  case_sensitive      => $case_sensitive,

 view release on metacpan or  search on metacpan

lib/Config/ppport.h  view on Meta::CPAN

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

 view release on metacpan or  search on metacpan

lib/Config/General/Hierarchical.pm  view on Meta::CPAN

use Carp;
use Clone::PP qw( clone );
use Config::General;
use Config::General::Hierarchical::ExcludeWeaken;
use Cwd qw( abs_path );
use Scalar::Util qw( weaken );

use base 'Class::Accessor::Fast';

my @properties = qw( constraint name opt value );
my %properties = map( ( $_ => 1 ), @properties );

lib/Config/General/Hierarchical.pm  view on Meta::CPAN

                    %options
                }
            )
        );

        weaken( $self->opt->{root} )
          unless $Config::General::Hierarchical::ExcludeWeaken::exclude;

        $self->read($file) if $file;

        $self->check if $args{check};

 view release on metacpan or  search on metacpan

lib/Config/Model/Itself.pm  view on Meta::CPAN

use Config::Model 2.163;
use IO::File ;
use Log::Log4perl 1.11;
use Carp ;
use Data::Dumper ;
use Scalar::Util qw/weaken/;
use Data::Compare ;
use Path::Tiny 0.125; # for mkdir

my $logger = Log::Log4perl::get_logger("Backend::Itself");

lib/Config/Model/Itself.pm  view on Meta::CPAN

sub BUILD {
    my $self = shift;

    # avoid memory cycle
    weaken($self);

    my $cb = sub {
        my %args = @_ ;
        my $p = $args{path} || '' ;
        return unless $p =~ /^class/ ;

 view release on metacpan or  search on metacpan

lib/Config/Model/TkUI.pm  view on Meta::CPAN

no warnings qw/experimental::postderef experimental::signatures/;

use base qw/Tk::Toplevel/;
use vars qw/$icon_path $error_img $warn_img/;
use subs qw/menu_struct/;
use Scalar::Util qw/weaken/;
use Log::Log4perl 1.11;
use Path::Tiny;
use YAML::PP;
use File::HomeDir;

lib/Config/Model/TkUI.pm  view on Meta::CPAN

        -label => 'Auto save',
        -variable => \$cw->{auto_save_mode},
    );

    my $weak_cw = $cw;
    weaken($weak_cw);
    $cw->{instance}->on_change_cb( sub {
        $weak_cw->save if $weak_cw->{auto_save_mode};;
    });

    # create frame for location entry

lib/Config/Model/TkUI.pm  view on Meta::CPAN

        my $scan_sub = sub {
            $scanner->scan_element( [ $newpath, $cw,  $opening, $actions, $force_display_path ], $node, $elt );
        };
        my @data = ( $scan_sub, $node->fetch_element($elt) );

        # It's necessary to store a weakened reference of a tree
        # object as these ones tend to disappear when warped out. In
        # this case, the object must be destroyed. This does not
        # happen if a non-weakened reference is kept in Tk Tree.
        weaken( $data[1] );

        my $elt_type = $node->element_type($elt);
        my $eltmode  = $elt_mode{$elt_type};
        if ( $tkt->infoExists($newpath) ) {
            $eltmode = $tkt->getmode($newpath);    # will reuse mode below

lib/Config/Model/TkUI.pm  view on Meta::CPAN

        if ( not $tkt->infoExists($newpath) ) {
            my @opt = $prevpath ? ( -after => $prevpath ) : ( -at => 0 );
            $logger->trace(
                "disp_hash add $newpath mode $eltmode cargo_type $elt_type" . " elt $sub_elt" );
            my @data = ( $scan_sub, $sub_elt );
            weaken( $data[1] );
            $tkt->add( $newpath, -data => \@data, @opt );
            $tkt->itemCreate( $newpath, 0, -text => $node->shorten_idx($idx) );
            $tkt->setmode( $newpath => $eltmode );
        }

lib/Config/Model/TkUI.pm  view on Meta::CPAN

        unless ( defined $data_ref->[1] ) {
            $cw->reload;
            return;
        }
        $obj = $data_ref->[1];
        weaken($obj);
    }

    my $loc  = $obj->location;
    my $type = $obj->get_type;
    $logger->trace("item $loc to $mode (type $type)");

lib/Config/Model/TkUI.pm  view on Meta::CPAN

    map { $_->destroy if Tk::Exists($_) } $e_frame->children;

    my $widget = $widget_table{$mode}{$type}
        || die "Cannot find $mode widget for type $type";
    my $weak_cw = $cw;
    weaken($weak_cw);
    my @store = $mode eq 'edit' ? ( -store_cb => sub { $weak_cw->reload(@_) } ) : ();
    $cw->{current_mode} = $mode;

    my $tk_font = $cw->cget('-font');
    $cw->{editor} = $e_frame->$widget(

 view release on metacpan or  search on metacpan

lib/Config/Model/AnyId.pm  view on Meta::CPAN

use Config::Model::Warper;
use Carp qw/cluck croak carp/;
use Log::Log4perl qw(get_logger :levels);
use Storable qw/dclone/;
use Mouse::Util::TypeConstraints;
use Scalar::Util qw/weaken/;

extends qw/Config::Model::AnyThing/;

use feature qw/signatures postderef/;
no warnings qw/experimental::signatures experimental::postderef/;

lib/Config/Model/AnyId.pm  view on Meta::CPAN

        $self-> add_warpable_check_content($_);
    }
    for ( qw/duplicates/ ) {
        my $method = "check_$_";
        my $weak_self = $self;
        weaken($weak_self); # weaken reference loop ($self - check_content - closure - self)
        $self-> add_check_content( sub { $weak_self->$method(@_);} ) if  $self->{$_};
    }

    Config::Model::Exception::Model->throw(
        object => $self,

lib/Config/Model/AnyId.pm  view on Meta::CPAN

This method expects a sub ref with signature C<( $self, $error, $warn,
$apply_fix )>.  Where C<$error> and C<$warn> are array ref. You can
push error or warning messages there.  C<$apply_fix> is a
boolean. When set to 1, the passed method can fix the warning or the
error. Please make sure to weaken C<$self> to avoid memory cycles.

Example:

 package MyId;
 use Mouse;
 extends qw/Config::Model::HashId/;
 use Scalar::Util qw/weaken/;

 sub setup {
    my $self = shift;
    weaken($self);
    $self-> add_check_content( sub { $self->check_usused_licenses(@_);} )
}

=head1 Introspection methods

 view release on metacpan or  search on metacpan

inc/Spiffy.pm  view on Meta::CPAN

      "  return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
      "    unless \$#_ > 0 or defined \$_[0]->{%s};\n",
    weak_init =>
      "  return do {\n" .
      "    \$_[0]->{%s} = do { my \$self = \$_[0]; %s };\n" .
      "    Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n" .
      "    \$_[0]->{%s};\n" .
      "  } unless \$#_ > 0 or defined \$_[0]->{%s};\n",
    return_if_get => 
      "  return \$_[0]->{%s} unless \$#_ > 0;\n",
    set => 
      "  \$_[0]->{%s} = \$_[1];\n",
    weaken => 
      "  Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n",
    sub_end => 
      "  return \$_[0]->{%s};\n}\n",
);

sub field {

inc/Spiffy.pm  view on Meta::CPAN

        local *paired_arguments = sub { (qw(-package -init)) };
        Spiffy->parse_arguments(@_);
    };
    my ($field, $default) = @values;
    $package = $args->{-package} if defined $args->{-package};
    die "Cannot have a default for a weakened field ($field)"
        if defined $default && $args->{-weak};
    return if defined &{"${package}::$field"};
    require Scalar::Util if $args->{-weak};
    my $default_string =
        ( ref($default) eq 'ARRAY' and not @$default )

inc/Spiffy.pm  view on Meta::CPAN

    }
    $code .= sprintf $code{set_default}, $field, $default_string, $field
      if defined $default;
    $code .= sprintf $code{return_if_get}, $field;
    $code .= sprintf $code{set}, $field;
    $code .= sprintf $code{weaken}, $field, $field 
      if $args->{-weak};
    $code .= sprintf $code{sub_end}, $field;

    my $sub = eval $code;
    die $@ if $@;

 view release on metacpan or  search on metacpan

lib/Config/Strict.pm  view on Meta::CPAN

package Config::Strict;
use warnings;
use strict;
use Data::Dumper;
use Scalar::Util qw(blessed weaken);
$Data::Dumper::Indent = 0;
use Carp qw(confess croak);

our $VERSION = '0.07';

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||

 view release on metacpan or  search on metacpan

lib/Config/XPath.pm  view on Meta::CPAN

use XML::XPath;

use Carp;

use Scalar::Util qw( weaken );

=head1 NAME

C<Config::XPath> - retrieve configuration data from XML files by using XPath

lib/Config/XPath.pm  view on Meta::CPAN

   my $self = {
      parent   => $parent,
      context  => $context
   };

   weaken( $self->{parent} );

   return bless $self, $class;
}

sub find

 view release on metacpan or  search on metacpan

lib/Config/Yak/NamedPlugins.pm  view on Meta::CPAN

        }
        my $arg_ref = $self->config()->get($plugin_name);
        $arg_ref->{'logger'} = $self->logger();
        $arg_ref->{'config'} = $self->config();
        $arg_ref->{'parent'} = $self;
        Scalar::Util::weaken( $arg_ref->{'parent'} );
        if ( $arg_ref->{'disabled'} ) {
            $self->logger()->log( message => 'Skipping disabled plugin: ' . $plugin_name, level => 'debug', );
            next PLUGIN;
        }
        try {

 view release on metacpan or  search on metacpan

lib/Consumer/NonBlock.pm  view on Meta::CPAN

    +batch
    +batch_item
    +buffer
};

sub weaken { $_[0]->{+IS_WEAK} = 1 };

sub init {
    my $self = shift;

    croak "Must be either a reader or a writer" unless $self->{+IS_READER} || $self->{+IS_WRITER};

lib/Consumer/NonBlock.pm  view on Meta::CPAN

Normally when the reader is closed it will delete the data. Normally when the
writer is closed it will mark the data stream as complete. If you fork then
either of these actions can happen in either process.

The weaken() method can be used to prevent a reader or writer from taking these
actions. So in the producer process you want to weaken the reader object, and
in the consumer process you want to weaken the writer object.

    use Consumer::NonBlock;

    my ($reader, $writer) = Consumer::NonBlock->pair(batch_size => 100);

    my $pid = fork // die "Could not fork: $!";

    if ($pid) { # Parent
        # Make sure this process does not delete the temp data
        $reader->weaken;
        $reader->close;

        $writer->write_line("Line from the parent");
    }
    else { # Child
        # Make sure this process does not mark the IO as complete
        $writer->weaken;
        $writer->close;

        my $line = $reader->read_line;
        print "Got line: $line\n";
    }

lib/Consumer/NonBlock.pm  view on Meta::CPAN

Check if handle is a writer.

=item $bool = $handle->is_weak()

Check if the handle has been weakened.

=item $handle->weaken()

Weaken the handle so it will not delete the data dir or close the IO.

=item $handle->set_env_var()

 view release on metacpan or  search on metacpan

examples/fatpacked.plackup  view on Meta::CPAN

  use strict;
  no warnings;
  use Carp;
  use Plack::Util;
  use Plack::Util::Accessor qw(force);
  use Scalar::Util qw(weaken);
  use parent qw(Plack::Middleware);
  
  sub call {
      my ( $self, $env ) = @_;
  

examples/fatpacked.plackup  view on Meta::CPAN

  
      return sub {
          my $new_path_info = shift;
          my($path, $query) = split /\?/, $new_path_info, 2;
  
          Scalar::Util::weaken($env);
  
          $env->{PATH_INFO}      = $path;
          $env->{QUERY_STRING}   = $query;
          $env->{REQUEST_METHOD} = 'GET';
          $env->{CONTENT_LENGTH} = 0;

examples/fatpacked.plackup  view on Meta::CPAN

      my($self, $env) = @_;
  
      my $min = $level_numbers{ $self->level || "debug" };
  
      my $env_ref = $env;
      Scalar::Util::weaken($env_ref);
  
      $env->{'psgix.logger'} = sub {
          my $args = shift;
  
          if ($level_numbers{$args->{level}} >= $min) {

 view release on metacpan or  search on metacpan

lib/Context/Singleton/Frame.pm  view on Meta::CPAN

		$class = ref $class;
	}

	unless ($self->{root}) {
		$self->{root} = $self;
		Scalar::Util::weaken $self->{root};
	}

	$self = bless $self, $class;

	$self->proclaim (%proclaim);

 view release on metacpan or  search on metacpan

inc/Test/Deep/Cache/Simple.pm  view on Meta::CPAN

use Scalar::Util qw( refaddr );

BEGIN
{
  if (grep /^weaken$/, @Scalar::Util::EXPORT_FAIL)
  {
    # we're running on a version of perl that has no weak refs, so we
    # just install a no-op sub for weaken instead of importing it
    *weaken = sub {};
  }
  else
  {
    Scalar::Util->import('weaken');
  }
}

sub new
{

inc/Test/Deep/Cache/Simple.pm  view on Meta::CPAN

	my ($d1, $d2) = @_;
	{
		local $SIG{__DIE__};

		# cannot weaken read only refs, no harm if we can't as they never
		# disappear
		eval{weaken($d1)};
		eval{weaken($d2)};
	}

	$self->{fn_get_key(@_)} = [$d1, $d2];
}

inc/Test/Deep/Cache/Simple.pm  view on Meta::CPAN

	my $self = shift;

	my $key = fn_get_key(@_);
	my $pair = $self->{$key};

	# are both weakened refs still valid, if not delete this entry
	if (ref($pair->[0]) and ref($pair->[1]))
	{
		return 1;
	}
	else

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

SvROK_off|5.003007|5.003007|
SvROK_on|5.003007|5.003007|
SvRV|5.003007|5.003007|
SvRV_const|5.010001||Viu
SvRV_set|5.009003|5.003007|p
sv_rvunweaken|5.027004|5.027004|
sv_rvweaken|5.006000|5.006000|
SvRVx|5.003007||Viu
SvRX|5.009005|5.003007|p
SvRXOK|5.009005|5.003007|p
SV_SAVED_COPY|5.009005||Viu
SvSCREAM|5.003007||Viu

 view release on metacpan or  search on metacpan

t/Test/More.pm  view on Meta::CPAN

  use Test::More tests => $Num_Tests;

There are rare cases when you will not know beforehand how many tests
your script is going to run.  In this case, you can declare that you
have no plan.  (Try to avoid using this as it weakens your test.)

  use Test::More qw(no_plan);

B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
think everything has failed.  See L<CAVEATS and NOTES>).

 view release on metacpan or  search on metacpan

Scalar.pm  view on Meta::CPAN

package Convert::Scalar;

BEGIN {
   $VERSION = 1.12;
   @ISA = qw(Exporter);
   @EXPORT_OK = qw(readonly readonly_on readonly_off weaken unmagic len grow extend extend_read readall writeall);
   %EXPORT_TAGS = (
      taint  => [qw(taint untaint tainted)],
      utf8   => [qw(utf8 utf8_on utf8_off utf8_valid utf8_upgrade utf8_downgrade utf8_encode utf8_decode utf8_length)],
      refcnt => [qw(refcnt refcnt_inc refcnt_dec refcnt_rv refcnt_inc_rv refcnt_dec_rv)],
      ok     => [qw(ok uok rok pok nok niok)],

Scalar.pm  view on Meta::CPAN

=item unmagic scalar, type

Remove the specified magic from the scalar (DANGEROUS!).

=item weaken scalar

Weaken a reference. (See also L<WeakRef>).

=item taint scalar

Scalar.pm  view on Meta::CPAN

Increments the reference count of the given scalar inplace.

=item refcnt_dec scalar

Decrements the reference count of the given scalar inplace. Use C<weaken>
instead if you understand what this function is fore. Better yet: don't
use this module in this case.

=item refcnt_rv scalar[, newrefcnt]

 view release on metacpan or  search on metacpan

lib/Convos.pm  view on Meta::CPAN

  $self->defaults(full_page => 1, organization_name => $self->config('name'));
  $self->hook(before_dispatch => \&_before_dispatch);
  $self->_embed_backend if $ENV{CONVOS_BACKEND_EMBEDDED};

  Scalar::Util::weaken($self);
  Mojo::IOLoop->timer(0 => sub { $self->_set_secrets });
}

sub _assets {
  my $self = shift;

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||

 view release on metacpan or  search on metacpan

LocalScalar.pm  view on Meta::CPAN

package Coro::LocalScalar;
use strict;
no strict 'refs';
use Guard;
use Carp;
use Scalar::Util qw/weaken/;
our $VERSION = '0.21';

=head1 NAME

Coro::LocalScalar - local() for Coro

LocalScalar.pm  view on Meta::CPAN

sub localize { # tie scalar to container
	my $self = shift;
	
	$self->{scalar} = \$_[0];
	weaken $self->{scalar}; # no circular
	
	tie($_[0], __PACKAGE__, $self );
	$self;
}

 view release on metacpan or  search on metacpan

lib/Coro/PrioChannel/Multi.pm  view on Meta::CPAN

# ABSTRACT: Multiple-listener priority message queues for Coro


use Coro::PrioChannel;
use Scalar::Util qw(weaken);


sub LIM()  { 0 }
sub CHAN() { 1 }

lib/Coro/PrioChannel/Multi.pm  view on Meta::CPAN

{
    my $self = shift;
    @{$self->[CHAN]} = grep { defined } @{$self->[CHAN]};

    # when we pull out the refs this way, they're
    # no longer weakened, so re-weaking everything.
    # (easier than using splice to pull undef items out -
    #  if we get too many readers, we'll re-evaluate if this
    #  is slow.)
    weaken($_) for @{$self->[CHAN]};
}


sub number_of_listeners
{

lib/Coro/PrioChannel/Multi.pm  view on Meta::CPAN

    $self->clean();
    'Channel=size :: ' . join ":", map { $_ . "=" . $self->[CHAN][$_]->size() } 0..$#$self;
}


# create new channel, add it to $self, ensure it's weakened, and return
# the non-weak version.
sub listen
{
    my $self = shift;
    my $channel = Coro::PrioChannel->new($self->[LIM]);

 view release on metacpan or  search on metacpan

lib/Coro/Twiggy.pm  view on Meta::CPAN

use 5.008008;
use strict;
use warnings;

use Twiggy::Server;
use Scalar::Util 'weaken';
use Coro;
use Data::Dumper;

our $VERSION = '0.03';

lib/Coro/Twiggy.pm  view on Meta::CPAN

    $self->{app} = $cb || DEFAULT_SERVICE;
}

sub _app {
    my ($self) = @_;
    weaken $self;
    sub {
        my ($env) = @_;
        sub {
            my ($cb) = @_;
            async {

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

          which can dramatically improve performance, but people
          using windows-process-emulation perls do not care much about
          performance.

3.51  Sun Mar  4 14:18:04 CET 2007
	- fixed a problem when you weakened references to Coro::State's
          (patch by Yuval Kogman).

3.501 Wed Feb 28 12:44:07 CET 2007
	- rename some global symbols as macosx from hell redefines
          them without asking.

 view release on metacpan or  search on metacpan

lib/Couch/DB/Client.pm  view on Meta::CPAN

use Couch::DB::Util   qw/flat/;
use Couch::DB::Result ();

use Log::Report     'couch-db';

use Scalar::Util    qw/weaken blessed/;
use List::Util      qw/first/;
use MIME::Base64    qw/encode_base64/;
use Storable        qw/dclone/;
use URI::Escape     qw/uri_escape/;

lib/Couch/DB/Client.pm  view on Meta::CPAN

	$self->{CDC_ua}     = delete $args->{user_agent} or panic "Requires 'user_agent'";
	$self->{CDC_uuids}  = [];
	$self->{CDC_seqnr}  = ++$seqnr;

	$self->{CDC_couch}  = delete $args->{couch} or panic "Requires 'couch'";
	weaken $self->{CDC_couch};

	$self->{CDC_hdrs}   = my $headers = delete $args->{headers} || {};

	my $username        = delete $args->{username} // '';
	$self->login(

 view release on metacpan or  search on metacpan

xs/async.c  view on Meta::CPAN

    async->refcount = 1;
    async->iops_ptr = cbcio;
    cbcio->v.v0.cookie = async;

    async->selfrv = newRV_inc(ptriv); sv_rvweaken(async->selfrv);
    async->action_sv = newSViv(0); SvREADONLY_on(async->action_sv);
    async->flags_sv = newSViv(0); SvREADONLY_on(async->flags_sv);
    async->usec_sv = newSVnv(0); SvREADONLY_on(async->usec_sv);
    async->sched_r_sv = newSViv(0); SvREADONLY_on(async->sched_r_sv);
    async->sched_w_sv = newSViv(0); SvREADONLY_on(async->sched_w_sv);

 view release on metacpan or  search on metacpan

XS/Type.pm  view on Meta::CPAN

=head2 Recursive specifications

=over 4

=item json_type_weaken

This function can be used as an argument for L</json_type_arrayof>,
L</json_type_hashof> or L</json_type_anyof> functions to create weak
references suitable for complicated recursive structures. It depends
on L<the weaken function from Scalar::Util|Scalar::Util/weaken> module.
See following example:

  my $struct = {
      type => JSON_TYPE_STRING,
      array => json_type_arrayof(JSON_TYPE_INT),
  };
  $struct->{recursive} = json_type_anyof(
      json_type_weaken($struct),
      json_type_arrayof(JSON_TYPE_STRING),
  );

If you want to encode all perl scalars to JSON string types despite
how complicated is input perl structure you can define JSON type
specification for alternatives recursively. It could be defined as:

  my $type = json_type_anyof();
  $type->[0] = JSON_TYPE_STRING_OR_NULL;
  $type->[1] = json_type_arrayof(json_type_weaken($type));
  $type->[2] = json_type_hashof(json_type_weaken($type));

  print encode_json([ 10, "10", { key => 10 } ], $type);
  # ["10","10",{"key":"10"}]

An alternative solution for encoding all scalars to JSON strings is to

XS/Type.pm  view on Meta::CPAN

use strict;
use warnings;

BEGIN {
  if (eval { require Scalar::Util }) {
    Scalar::Util->import('weaken');
  } else {
    *weaken = sub($) { die 'Scalar::Util is required for weaken' };
  }
}

# This exports needed XS constants to perl
use Cpanel::JSON::XS ();

XS/Type.pm  view on Meta::CPAN

our @EXPORT = our @EXPORT_OK = qw(
  json_type_arrayof
  json_type_hashof
  json_type_anyof
  json_type_null_or_anyof
  json_type_weaken
  JSON_TYPE_NULL
  JSON_TYPE_BOOL
  JSON_TYPE_INT
  JSON_TYPE_FLOAT
  JSON_TYPE_STRING

XS/Type.pm  view on Meta::CPAN

use constant JSON_TYPE_WEAKEN_CLASS => 'Cpanel::JSON::XS::Type::Weaken';

sub json_type_anyof {
  my ($scalar, $array, $hash);
  my ($scalar_weaken, $array_weaken, $hash_weaken);
  foreach (@_) {
    my $type = $_;
    my $ref = ref($_);
    my $weaken;
    if ($ref eq JSON_TYPE_WEAKEN_CLASS) {
      $type = ${$type};
      $ref = ref($type);
      $weaken = 1;
    }
    if ($ref eq '') {
      die 'Only one scalar type can be specified in anyof' if defined $scalar;
      $scalar = $type;
      $scalar_weaken = $weaken;
    } elsif ($ref eq 'ARRAY' or $ref eq JSON_TYPE_ARRAYOF_CLASS) {
      die 'Only one array type can be specified in anyof' if defined $array;
      $array = $type;
      $array_weaken = $weaken;
    } elsif ($ref eq 'HASH' or $ref eq JSON_TYPE_HASHOF_CLASS) {
      die 'Only one hash type can be specified in anyof' if defined $hash;
      $hash = $type;
      $hash_weaken = $weaken;
    } else {
      die 'Only scalar, array or hash can be specified in anyof';
    }
  }
  my $type = [$scalar, $array, $hash];
  weaken $type->[0] if $scalar_weaken;
  weaken $type->[1] if $array_weaken;
  weaken $type->[2] if $hash_weaken;
  return bless $type, JSON_TYPE_ANYOF_CLASS;
}

sub json_type_null_or_anyof {
  foreach (@_) {

XS/Type.pm  view on Meta::CPAN

sub json_type_arrayof {
  die 'Exactly one type must be specified in arrayof' if scalar @_ != 1;
  my $type = $_[0];
  if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
    $type = ${$type};
    weaken $type;
  }
  return bless \$type, JSON_TYPE_ARRAYOF_CLASS;
}

sub json_type_hashof {
  die 'Exactly one type must be specified in hashof' if scalar @_ != 1;
  my $type = $_[0];
  if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
    $type = ${$type};
    weaken $type;
  }
  return bless \$type, JSON_TYPE_HASHOF_CLASS;
}

sub json_type_weaken {
  die 'Exactly one type must be specified in weaken' if scalar @_ != 1;
  die 'Scalar cannot be specfied in weaken' if ref($_[0]) eq '';
  return bless \(my $type = $_[0]), JSON_TYPE_WEAKEN_CLASS;
}

1;

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

sv_release_COW|||
sv_release_IVX|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.006000||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p