Alter
view release on metacpan or search on metacpan
corona = newHV();
mg = sv_magicext(self, (SV*)corona, PERL_MAGIC_ext, NULL, NULL, 0);
SvREFCNT_dec(corona); /* must compensate */
mg->mg_private = ALT_EXTMG_CORONA;
} else {
corona = (HV*)mg->mg_obj;
}
return corona;
}
/* Access to the type table (program-wide, i.e. not thread-duplicated)
* This hash holds an SvTYPE (as an integer SV) for every class that
* wants to autovivify the ego
*/
HV *ALT_type_tab() {
static HV *type_tab = NULL;
if (!type_tab)
type_tab = newHV();
return type_tab;
}
to build it. If compilation isn't possible, the XS part is replaced with
a *pure Perl* implementation "Alter::AlterXS_in_perl". That happens
automatically at load time when loading the XS part fails. The boolean
function "Alter::is_xs" tells (in the obvious way) which implementation
is active. If, for some reason, you want to run the Perl fallback when
the XS version is available, set the environment variable
"PERL_ALTER_NO_XS" to a true value before "Alter" is loaded.
This fallback is not a full replacement for the XS implementation.
Besides being markedly slower, it lacks key features in that it is *not*
automatically garbage-collected and *not* thread-safe. Instead,
"Alter::AlterXS_in_perl" provides a "CLONE" method for thread safety and
a universal destructor "Alter::Destructor::DESTROY" for garbage
collection. A class that uses the pure Perl implementation of "Alter"
will obtain this destructor through inheritance (unless "-destroy" is
specified with the "use" statement). So at the surface thread-safety and
garbage-collection are retained. However, if you want to add your own
destructor to a class, you must make sure that both (all) destructors
are called as needed. Perl only calls the first one it meets on the @ISA
tree and that's it.
Otherwise the fallback implementation works like the original. If
compilation has problems, it should allow you to run test cases to help
decide if it's worth trying. To make sure that production code doesn't
inadvertently run with the Perl implementation
"Alter" is thus an alternative to the *inside-out* technique of class
construction. In some respects, "Alter" objects are easier to handle.
Alter objects support the same data model as traditional Perl objects.
To each class, an Alter object presents an arbitrary reference, the
object's *alter ego*. The type of reference and how it is used are the
entirely the class's business. In particular, the common practice of
using a hash whose keys represent object fields still applies, only each
class sees its individual hash.
"Alter" based objects are garbage-collected and thread-safe without
additional measures.
"Alter" also supports "Data::Dumper" and "Storable" in a generic way, so
that "Alter" based objects can be easily be viewed and made persistent
(within the limitations of the respective modules).
"Alter" works by giving every object a class-specific *alter ego*, which
can be any scalar, for its (the classe's) specific needs for data
storage. The alter ego is set by the "alter()" function (or by
autovivification), usually once per class and object at initialization
lib/Alter.pm view on Meta::CPAN
is replaced with a I<pure Perl> implementation C<Alter::AlterXS_in_perl>.
That happens automatically at load time when loading the XS part
fails. The boolean function C<Alter::is_xs> tells (in the obvious
way) which implementation is active. If, for some reason, you want
to run the Perl fallback when the XS version is available, set
the environment variable C<PERL_ALTER_NO_XS> to a true value before
C<Alter> is loaded.
This fallback is not a full replacement for the XS implementation.
Besides being markedly slower, it lacks key features in that it is
I<not> automatically garbage-collected and I<not> thread-safe.
Instead, C<Alter::AlterXS_in_perl> provides a C<CLONE> method
for thread safety and a universal destructor C<Alter::Destructor::DESTROY>
for garbage collection. A class that uses the pure Perl implementation
of C<Alter> will obtain this destructor through inheritance (unless
C<-destroy> is specified with the C<use> statement). So at the surface
thread-safety and garbage-collection are retained. However, if
you want to add your own destructor to a class, you must make sure
that both (all) destructors are called as needed. Perl only calls the
first one it meets on the C<@ISA> tree and that's it.
Otherwise the fallback implementation works like the original. If
compilation has problems, it should allow you to run test cases to
help decide if it's worth trying. To make sure that production code
doesn't inadvertently run with the Perl implementation
Alter::is_xs or die "XS implementation of Alter required";
lib/Alter.pm view on Meta::CPAN
technique of class construction. In some respects, C<Alter> objects
are easier to handle.
Alter objects support the same data model as traditional Perl
objects. To each class, an Alter object presents an arbitrary
reference, the object's I<alter ego>. The type of reference and
how it is used are the entirely the class's business. In particular,
the common practice of using a hash whose keys represent object
fields still applies, only each class sees its individual hash.
C<Alter> based objects are garbage-collected and thread-safe without
additional measures.
C<Alter> also supports C<Data::Dumper> and C<Storable> in
a generic way, so that C<Alter> based objects can be easily be viewed
and made persistent (within the limitations of the respective modules).
C<Alter> works by giving every object a class-specific I<alter ego>,
which can be any scalar, for its (the classe's) specific needs for
data storage. The alter ego is set by the C<alter()> function (or
by autovivification), usually once per class and object at initialization
lib/Alter/AlterXS_in_perl.pm view on Meta::CPAN
ARRAY => sub { [] },
HASH => sub { {} },
);
sub _vivify {
my $class = shift;
return undef unless $type_tab{ $class};
$viv_tab{ ref $type_tab{ $class}}->();
}
### Garbage collection and thread support
sub Alter::Destructor::DESTROY {
my $id = shift() + 0;
delete $corona_tab{ $id};
delete $ob_reg{ $id};
}
sub CLONE {
return unless shift eq __PACKAGE__;
for my $old_id ( keys %ob_reg ) {
new_version||5.009000|
new_warnings_bitfield|||
next_symbol|||
nextargv|||
nextchar|||
ninstr|||
no_bareword_allowed|||
no_fh_allowed|||
no_op|||
not_a_number|||
nothreadhook||5.008000|
nuke_stacks|||
num_overflow|||n
offer_nice_chunk|||
oopsAV|||
oopsCV|||
oopsHV|||
op_clear|||
op_const_sv|||
op_dump||5.006000|
op_free|||
U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
#else
extern U32 DPPP_(my_PL_signals);
#endif
#define PL_signals DPPP_(my_PL_signals)
#endif
/* Hint: PL_ppaddr
* Calling an op via PL_ppaddr requires passing a context argument
* for threaded builds. Since the context argument is different for
* 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
* automatically be defined as the correct argument.
*/
#if ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 4)))
/* Replace: 1 */
# define PL_ppaddr ppaddr
# define PL_no_modify no_modify
/* Replace: 0 */
#endif
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
}
#endif
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
#ifndef START_MY_CXT
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define START_MY_CXT
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 68)))
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#else
/* older perls don't have PL_numeric_radix_sv so the radix
* must manually be requested from locale.h
*/
#include <locale.h>
dTHR; /* needed for older threaded perls */
struct lconv *lc = localeconv();
char *radix = lc->decimal_point;
if (radix && IN_LOCALE) {
STRLEN len = strlen(radix);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#endif
t/03_class.t view on Meta::CPAN
sub init {
my $obj = shift;
my ( $one_A, $two_A, $one_B, $two_B) = @_;
$obj = $obj->Class_A::init() unless ref $obj;
$obj->Class_A::init( $one_A, $two_A);
$obj->Class_B::init( $one_B, $two_B);
}
}
### Basic class functionality, under thread if avalable
{
my $ref = [];
my ( $one_A, $two_A) = ( 'haha', $ref);
my ( $one_B, $two_B) = ( 'hihi', $ref);
my $cc = Class_C->init( $one_A, $two_A, $one_B, $two_B);
is $cc->one_A, $one_A, "Class_C field 'one_A'";
is $cc->two_A, $two_A, "Class_C field 'two_A'";
is $cc->one_B, $one_B, "Class_C field 'one_B'";
is $cc->two_B, $two_B, "Class_C field 'two_B'";
SKIP: {
use Config;
skip "No thread support", 5 + 4 unless $Config{ usethreads};
require threads;
treads->import if threads->can( 'import');
my $ans = threads->create(
sub {
{
one_A => $cc->one_A,
two_A => $cc->two_A,
one_B => $cc->one_B,
two_B => $cc->two_B,
ref_in_thread => $ref,
};
}
)->join;
my $ref_in_thread = $ans->{ ref_in_thread};
# Did object data make it into thread?
isnt $ref_in_thread, $ref, "In thread: ref is different";
is $ans->{ one_A}, $one_A, "In thread: Class_C field 'one_A'";
is $ans->{ two_A}, $ref_in_thread, "In thread: Class_C field 'two_A'";
is $ans->{ one_B}, $one_B, "In thread: Class_C field 'one_B'";
is $ans->{ two_B}, $ref_in_thread, "In thread: Class_C field 'two_B'";
# repeat basic tests after thread has run
is $cc->one_A, $one_A, "After thread: Class_C field 'one_A'";
is $cc->two_A, $two_A, "After thread: Class_C field 'two_A'";
is $cc->one_B, $one_B, "After thread: Class_C field 'one_B'";
is $cc->two_B, $two_B, "After thread: Class_C field 'two_B'";
} # end of SKIP block
BEGIN { $n_tests += 4 + 5 + 4 }
}
### Storable with STORABLE_attach
# ... if available, otherwise STORABLE_thaw is tested (and again below)
{
use Storable;
( run in 0.311 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )