view release on metacpan or  search on metacpan

lib/Class/MethodMaker/OptExt.pm  view on Meta::CPAN

                                      defchk    => '',
                                      reset     => '',
                                      read      => ['__VALUE__', ''],
                                      store     => '',
                                    },

                        static =>  { encode  => 1,
                                     refer   => '$store[0]',
                                     decl    => 'my @store;',
                                    },
                        type   =>  { encode  => 2,
                                     asgnchk => <<'END',
for (__FOO__) {
  croak(sprintf("Incorrect type for attribute __ATTR__: %s\n" .
                "  : should be '%s' (or subclass thereof)\n",
                (defined($_)                                     ?
                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                 '*undef*'
                ), $type))
    unless ! defined $_ or UNIVERSAL::isa($_, $type);
}
END
                                    },
                         default => { encode => 4,
                                      defchk => <<'END',
if ( ! exists %%STORAGE%% ) {
  %%ASGNCHK__SIGIL__($default)%%
  %%STORAGE%% = $default
}
END
                                    },
                         default_ctor => { encode => 8,
                                           defchk => <<'END',
if ( ! exists %%STORAGE%% ) {
  my $default = $dctor->($_[0]);
  %%ASGNCHK__SIGIL__($default)%%
  %%STORAGE%% = $default
}
END
                                         },
                         tie_class => { encode => 16,
                                        postac => <<'END',
tie %%STORAGE(__SIGIL__)%%, $tie_class, @tie_args
  unless exists %%STORAGE%%;
END
                                        predefchk => <<'END',
tie %%STORAGE(__SIGIL__)%%, $tie_class, @tie_args
  unless exists %%STORAGE%%;
END
                                        reset => <<'END',
untie %%STORAGE(__SIGIL__)%%;
END
                                      },
                         v1_compat => { encode => 32,
                                      },
                         read_cb => { encode => 64,
                                      read => [(<<'END') x 2],
{ # Encapsulate scope to avoid redefined $v issues
  my $v = __VALUE__;
  $v = $_->($_[0], $v)
    for @read_callbacks;
  $v;
}
END
                                    },
                         store_cb => { encode => 128,
                                       store =><<'END',
my __NAME__ = __VALUE__;
if ( exists %%STORAGE%% ) {
  my $old = %%STORAGE%%;
  __NAMEREF__ = $_->($_[0], __NAMEREF__, $name, $old)           %%V2ONLY%%
  __NAMEREF__ = $_->($_[0], __NAMEREF__, $name, $old, __ALL__)  %%V1COMPAT%%
    for @store_callbacks;
} else {
  __NAMEREF__ = $_->($_[0], __NAMEREF__, $name)                 %%V2ONLY%%
  __NAMEREF__ = $_->($_[0], __NAMEREF__, $name, undef, __ALL__) %%V1COMPAT%%
    for @store_callbacks;
}
END
                                    },
                        typex   =>  { encode  => 256,
                                     asgnchk => <<'END',
for (__FOO__) {
#   $_ += 0;
#  croak(sprintf("Incorrect type for attribute __ATTR__: %s\n" .
#                "  : should be '%s' (or subclass thereof)\n",
#                (defined($_)                                     ?
#                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
#                 '*undef*'
#                ), $typex))
#    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
}
END
                                    },
                       };

# Single value representing the codepoints defined for each option
sub optdefvalue {
  my $class = shift;
  my ($option) = @_;

  my $code = OPTEXT->{$option};
  croak "Illegal option name: '$option'\n"
    unless defined $code;

  my $value = 0;
  for ( @{codepoints()} ) {
    $value |= codepoint_value->{$_}
      if exists $code->{$_};
  }

#  return split //, unpack "b9", chr($value >> 8) . chr($value & 255);
#print $value;
  return split //, unpack "b16", chr($value >> 8) .  chr($value & 255);
}

BEGIN {
  croak "No encode value found for type $_\n"
    for grep ! OPTEXT->{$_}->{encode}, grep $_ ne 'DEFAULT', keys %{OPTEXT()};
}

# -------------------------------------
# CLASS CONSTRUCTION
# -------------------------------------

# -------------------------------------
# CLASS COMPONENTS
# -------------------------------------

=head1 CLASS COMPONENTS

Z<>

=cut

# -------------------------------------
# CLASS HIGHER-LEVEL FUNCTIONS