Result:
found more than 394 distributions - search limited to the first 2001 files matching your query
( run in 6.647 )
AAAA-Crypt-DH
view release on metacpan or search on metacpan
inc/Devel/CheckLib.pm view on Meta::CPAN
a C<ExtUtils::MakeMaker>-style space-separated list of
incpaths, each preceded by '-I'.
This can also be supplied on the command-line.
=item ccflags
Extra flags to pass to the compiler.
=item ldflags
Extra flags to pass to the linker.
=item analyze_binary
a callback function that will be invoked in order to perform custom
analysis of the generated binary. The callback arguments are the
inc/Devel/CheckLib.pm view on Meta::CPAN
die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/);
push @incpaths, substr($arg, 2);
}
}
my ($cc, $ld) = _findcc($args{debug}, $args{ccflags}, $args{ldflags});
my @missing;
my @wrongresult;
my @wronganalysis;
my @use_headers;
inc/Devel/CheckLib.pm view on Meta::CPAN
}
return
}
# return ($cc, $ld)
# where $cc is an array ref of compiler name, compiler flags
# where $ld is an array ref of linker flags
sub _findcc {
my ($debug, $user_ccflags, $user_ldflags) = @_;
# Need to use $keep=1 to work with MSWin32 backslashes and quotes
my $Config_ccflags = $Config{ccflags}; # use copy so ASPerl will compile
my @Config_ldflags = ();
for my $config_val ( @Config{qw(ldflags)} ){
push @Config_ldflags, $config_val if ( $config_val =~ /\S/ );
}
my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||'', $user_ccflags||'');
my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags, $user_ldflags||'');
my @paths = split(/$Config{path_sep}/, $ENV{PATH});
my @cc = split(/\s+/, $Config{cc});
if (check_compiler ($cc[0], $debug)) {
return ( [ @cc, @ccflags ], \@ldflags );
}
# Find the extension for executables.
my $exe = $Config{_exe};
if ($^O eq 'cygwin') {
$exe = '';
}
foreach my $path (@paths) {
# Look for "$path/$cc[0].exe"
my $compiler = File::Spec->catfile($path, $cc[0]) . $exe;
if (check_compiler ($compiler, $debug)) {
return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)
}
next if ! $exe;
# Look for "$path/$cc[0]" without the .exe, if necessary.
$compiler = File::Spec->catfile($path, $cc[0]);
if (check_compiler ($compiler, $debug)) {
return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)
}
}
die("Couldn't find your C compiler.\n");
}
AAC-Pvoice
view release on metacpan or search on metacpan
lib/AAC/Pvoice/Input.pm view on Meta::CPAN
# if we're already running
return if ($self->{monitorrun} ||
(not $self->{input}->{next}) ||
(not $self->{input}->{select}) ||
$self->{pause});
# set the flag that we're checking the port
$self->{monitorrun} = 1;
$self->{pp} = Device::ParallelPort->new() if not $self->{pp};
my $curvalue = $self->{pp}->get_status();
if (not defined $curvalue)
{
# clear the flag that we're checking the port and return
$self->{monitorrun} = 0;
return
}
$self->{lastvalue} = 0 if not exists $self->{lastvalue};
# if we detect a change...
lib/AAC/Pvoice/Input.pm view on Meta::CPAN
}
}
# the current value becomes the last value
$self->{lastvalue} = $curvalue if $curvalue;
# clear the flag that we're checking the port
$self->{monitorrun} = 0;
}
1;
AC-DC
view release on metacpan or search on metacpan
lib/AC/DC/Protocol.pm view on Meta::CPAN
# message type(32)
# auth length(32)
# data length(32)
# content length(32)
# msgidno(32)
# flags(32): is-reply(0), want-reply(1), is-error(2), data-encrypted(3), content-encrypted(4)
#
# followed by:
# Auth PB(auth-length)
# Data PB(data-length)
# Content(content-length)
lib/AC/DC/Protocol.pm view on Meta::CPAN
# is_reply, want_reply, is_error
my $mt = $MSGTYPE{ $p{type} };
confess "unknown message type $p{type}\n" unless defined $mt;
my $flags = ( $p{is_reply} ? 1 : 0 )
| ( $p{want_reply} ? 2 : 0 )
| ( $p{is_error} ? 4 : 0 )
| ( $p{data_encrypted} ? 8 : 0 )
| ( $p{content_encrypted} ? 16 : 0 );
return pack( "NNNNNNN",
$VERSION, $mt->{num}, $p{auth_length}, $p{data_length}, $p{content_length}, $p{msgidno}, $flags );
}
sub decode_header {
my $me = shift;
AC-Yenta
view release on metacpan or search on metacpan
lib/AC/Yenta/Store/BDBI.pm view on Meta::CPAN
if( $recov ){
unlink $_ for glob "$dir/__*";
}
my $flags = $conf->{readonly} ? 0 : (DB_CREATE| DB_INIT_CDB | DB_INIT_MPOOL);
debug("opening Berkeley dir=$dir, file=$file (recov $recov)");
my $env = BerkeleyDB::Env->new(
-Home => $dir,
-Flags => $flags,
);
# microsecs
$env->set_timeout($TIMEOUT * 1_000_000 / 2, DB_SET_LOCK_TIMEOUT) if $env;
ACME-QuoteDB
view release on metacpan or search on metacpan
lib/ACME/QuoteDB.pm view on Meta::CPAN
probably means that you do not have a database created in the correct format.
basically, you need to create the database, usually, on a first run
you need to add the flag (to the loader):
create_db => 1, # first run, create the db
appending to an existing database is the default behaviour
AES128
view release on metacpan or search on metacpan
grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
grok_number() NEED_grok_number NEED_grok_number_GLOBAL
grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
load_module() NEED_load_module NEED_load_module_GLOBAL
mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
vload_module() NEED_vload_module NEED_vload_module_GLOBAL
vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
SvPOK|||
SvPVX_const|5.009003||p
SvPVX_mutable|5.009003||p
SvPVX|||
SvPV_const|5.009003||p
SvPV_flags_const_nolen|5.009003||p
SvPV_flags_const|5.009003||p
SvPV_flags_mutable|5.009003||p
SvPV_flags|5.007002||p
SvPV_force_flags_mutable|5.009003||p
SvPV_force_flags_nolen|5.009003||p
SvPV_force_flags|5.007002||p
SvPV_force_mutable|5.009003||p
SvPV_force_nolen|5.009003||p
SvPV_force_nomg_nolen|5.009003||p
SvPV_force_nomg|5.007002||p
SvPV_force|||p
_setlocale_debug_string|||n
_setup_canned_invlist|||
_swash_inversion_hash|||
_swash_to_invlist|||
_to_fold_latin1|||
_to_uni_fold_flags||5.014000|
_to_upper_title_latin1|||
_to_utf8_case|||
_to_utf8_fold_flags||5.019009|
_to_utf8_lower_flags||5.019009|
_to_utf8_title_flags||5.019009|
_to_utf8_upper_flags||5.019009|
_warn_problematic_locale|||n
aMY_CXT_|5.007003||p
aMY_CXT|5.007003||p
aTHXR_|5.024000||p
aTHXR|5.024000||p
custom_op_desc||5.007003|
custom_op_get_field|||
custom_op_name||5.007003|
custom_op_register||5.013007|
custom_op_xop||5.013007|
cv_ckproto_len_flags|||
cv_clone_into|||
cv_clone|||
cv_const_sv_or_av|||n
cv_const_sv||5.003070|n
cv_dump|||
cv_forget_slab|||
cv_get_call_checker||5.013006|
cv_name||5.021005|
cv_set_call_checker_flags||5.021004|
cv_set_call_checker||5.013006|
cv_undef_flags|||
cv_undef|||
cvgv_from_hek|||
cvgv_set|||
cvstash_set|||
cx_dump||5.005000|
find_uninit_var|||
first_symbol|||n
fixup_errno_string|||
foldEQ_latin1||5.013008|n
foldEQ_locale||5.013002|n
foldEQ_utf8_flags||5.013010|
foldEQ_utf8||5.013002|
foldEQ||5.013002|n
fold_constants|||
forbid_setid|||
force_ident_maybe_lex|||
get_aux_mg|||
get_av|5.006000||p
get_c_backtrace_dump|||
get_c_backtrace|||
get_context||5.006000|n
get_cvn_flags|||
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
grok_bslash_c|||
grok_bslash_o|||
grok_bslash_x|||
grok_hex|5.007003||p
grok_infnan||5.021004|
grok_number_flags||5.021002|
grok_number|5.007002||p
grok_numeric_radix|5.007002||p
grok_oct|5.007003||p
group_end|||
gv_AVadd|||
gv_const_sv||5.009003|
gv_dump||5.006000|
gv_efullname3||5.003070|
gv_efullname4||5.006001|
gv_efullname|||
gv_fetchfile_flags||5.009005|
gv_fetchfile|||
gv_fetchmeth_autoload||5.007003|
gv_fetchmeth_internal|||
gv_fetchmeth_pv_autoload||5.015004|
gv_fetchmeth_pvn_autoload||5.015004|
gv_fetchmeth_pvn||5.015004|
gv_fetchmeth_pv||5.015004|
gv_fetchmeth_sv_autoload||5.015004|
gv_fetchmeth_sv||5.015004|
gv_fetchmethod_autoload||5.004000|
gv_fetchmethod_pv_flags||5.015004|
gv_fetchmethod_pvn_flags||5.015004|
gv_fetchmethod_sv_flags||5.015004|
gv_fetchmethod|||
gv_fetchmeth|||
gv_fetchpvn_flags|5.009002||p
gv_fetchpvs|5.009004||p
gv_fetchpv|||
gv_fetchsv|||
gv_fullname3||5.003070|
gv_fullname4||5.006001|
hv_free_ent_ret|||
hv_free_ent||5.004000|
hv_iterinit|||
hv_iterkeysv||5.003070|
hv_iterkey|||
hv_iternext_flags||5.008000|
hv_iternextsv|||
hv_iternext|||
hv_iterval|||
hv_kill_backrefs|||
hv_ksplit||5.003070|
hv_rand_set||5.018000|
hv_riter_p||5.009003|
hv_riter_set||5.009003|
hv_scalar||5.009001|
hv_store_ent||5.003070|
hv_store_flags||5.008000|
hv_stores|5.009004||p
hv_store|||
hv_undef_flags|||
hv_undef|||
ibcmp_locale||5.004000|
ibcmp_utf8||5.007003|
ibcmp|||
incline|||
my_exit|||
my_failure_exit||5.004000|
my_fflush_all||5.006000|
my_fork||5.007003|n
my_kid|||
my_lstat_flags|||
my_lstat||5.024000|
my_memcmp|||n
my_memset|||n
my_pclose||5.003070|
my_popen_list||5.007001|
my_setenv|||
my_setlocale|||
my_snprintf|5.009004||pvn
my_socketpair||5.007003|n
my_sprintf|5.009003||pvn
my_stat_flags|||
my_stat||5.024000|
my_strerror||5.021001|
my_strftime||5.007002|
my_strlcat|5.009004||pn
my_strlcpy|5.009004||pn
newATTRSUB||5.006000|
newAVREF|||
newAV|||
newBINOP|||
newCONDOP|||
newCONSTSUB_flags||5.015006|
newCONSTSUB|5.004050||p
newCVREF|||
newDEFSVOP||5.021006|
newFORM|||
newFOROP||5.013007|
newGIVENOP||5.009003|
newGIVWHENOP|||
newGP|||
newGVOP|||
newGVREF|||
newGVgen_flags||5.015004|
newGVgen|||
newHVREF|||
newHVhv||5.005000|
newHV|||
newIO|||
newSVnv|||
newSVpadname||5.017004|
newSVpv_share||5.013006|
newSVpvf_nocontext|||vn
newSVpvf||5.004000|v
newSVpvn_flags|5.010001||p
newSVpvn_share|5.007001||p
newSVpvn_utf8|5.010001||p
newSVpvn|5.004050||p
newSVpvs_flags|5.010001||p
newSVpvs_share|5.009003||p
newSVpvs|5.009003||p
newSVpv|||
newSVrv|||
newSVsv|||
newUNOP_AUX||5.021007|
newUNOP|||
newWHENOP||5.009003|
newWHILEOP||5.013007|
newXS_deffile|||
newXS_flags||5.009004|
newXS_len_flags|||
newXSproto||5.006000|
newXS||5.006000|
new_collate||5.006000|
new_constant|||
new_ctype||5.006000|
op_convert_list||5.021006|
op_dump||5.006000|
op_free|||
op_integerize|||
op_linklist||5.013006|
op_lvalue_flags|||
op_lvalue||5.013007|
op_null||5.007002|
op_parent|||n
op_prepend_elem||5.013006|
op_refcnt_dec|||
parse_fullstmt||5.013005|
parse_gv_stash_name|||
parse_ident|||
parse_label||5.013007|
parse_listexpr||5.013008|
parse_lparen_question_flags|||
parse_stmtseq||5.013006|
parse_subsignature|||
parse_termexpr||5.013008|
parse_unicode_opts|||
parser_dup|||
regclass_swash||5.009004|
regclass|||
regcppop|||
regcppush|||
regcurly|||n
regdump_extflags|||
regdump_intflags|||
regdump||5.005000|
regdupe_internal|||
regex_set_precedence|||n
regexec_flags||5.005000|
regfree_internal||5.009005|
reghop3|||n
reghop4|||n
reghopmaybe3|||n
reginclass|||
same_dirent|||
save_I16||5.004000|
save_I32|||
save_I8||5.006000|
save_adelete||5.011000|
save_aelem_flags||5.011000|
save_aelem||5.004050|
save_alloc||5.006000|
save_aptr|||
save_ary|||
save_bool||5.008001|
save_generic_pvref||5.006001|
save_generic_svref||5.005030|
save_gp||5.004000|
save_hash|||
save_hdelete||5.011000|
save_hek_flags|||n
save_helem_flags||5.011000|
save_helem||5.004050|
save_hints||5.010001|
save_hptr|||
save_int|||
save_item|||
save_iv||5.005000|
save_lines|||
save_list|||
save_long|||
save_magic_flags|||
save_mortalizesv||5.007001|
save_nogv|||
save_op||5.005000|
save_padsv_and_mortalize||5.010001|
save_pptr|||
save_pushptrptr||5.010001|
save_pushptr||5.010001|
save_re_context||5.006000|
save_scalar_at|||
save_scalar|||
save_set_svflags||5.009000|
save_shared_pvref||5.007003|
save_sptr|||
save_strlen|||
save_svref|||
save_vptr||5.006000|
set_numeric_local||5.006000|
set_numeric_radix||5.006000|
set_numeric_standard||5.006000|
set_padlist|||n
setdefout|||
share_hek_flags|||
share_hek||5.004000|
should_warn_nl|||n
si_dup|||
sighandler|||n
simplify_sort|||
skip_to_be_ignored_text|||
skipspace_flags|||
softref2xv|||
sortcv_stacked|||
sortcv_xsub|||
sortcv|||
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
ssc_add_range|||
ssc_and|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool_flags||5.013006|
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2num|||
sv_2nv_flags||5.013001|
sv_2pv_flags|5.007002||p
sv_2pv_nolen|5.006000||p
sv_2pvbyte_nolen|5.006000||p
sv_2pvbyte|5.006000||p
sv_2pvutf8_nolen||5.006000|
sv_2pvutf8||5.006000|
sv_2pv|||
sv_2uv_flags||5.009001|
sv_2uv|5.004000||p
sv_add_arena|||
sv_add_backref|||
sv_backoff|||n
sv_bless|||
sv_buf_to_ro|||
sv_buf_to_rw|||
sv_cat_decode||5.008001|
sv_catpv_flags||5.013006|
sv_catpv_mg|5.004050||p
sv_catpv_nomg||5.013006|
sv_catpvf_mg_nocontext|||pvn
sv_catpvf_mg|5.006000|5.004000|pv
sv_catpvf_nocontext|||vn
sv_catpvf||5.004000|v
sv_catpvn_flags||5.007002|
sv_catpvn_mg|5.004050||p
sv_catpvn_nomg|5.007002||p
sv_catpvn|||
sv_catpvs_flags||5.013006|
sv_catpvs_mg||5.013006|
sv_catpvs_nomg||5.013006|
sv_catpvs|5.009003||p
sv_catpv|||
sv_catsv_flags||5.007002|
sv_catsv_mg|5.004050||p
sv_catsv_nomg|5.007002||p
sv_catsv|||
sv_chop|||
sv_clean_all|||
sv_clean_objs|||
sv_clear|||
sv_cmp_flags||5.013006|
sv_cmp_locale_flags||5.013006|
sv_cmp_locale||5.004000|
sv_cmp|||
sv_collxfrm_flags||5.013006|
sv_collxfrm|||
sv_copypv_flags||5.017002|
sv_copypv_nomg||5.017002|
sv_copypv|||
sv_dec_nomg||5.013002|
sv_dec|||
sv_del_backref|||
sv_dump|||
sv_dup_common|||
sv_dup_inc_multiple|||
sv_dup_inc|||
sv_dup|||
sv_eq_flags||5.013006|
sv_eq|||
sv_exp_grow|||
sv_force_normal_flags||5.007001|
sv_force_normal||5.006000|
sv_free2|||
sv_free_arenas|||
sv_free|||
sv_get_backrefs||5.021008|n
sv_gets||5.003070|
sv_grow|||
sv_i_ncmp|||
sv_inc_nomg||5.013002|
sv_inc|||
sv_insert_flags||5.010001|
sv_insert|||
sv_isa|||
sv_isobject|||
sv_iv||5.005000|
sv_kill_backrefs|||
sv_len|||
sv_magic_portable|5.024000|5.004000|p
sv_magicext_mglob|||
sv_magicext||5.007003|
sv_magic|||
sv_mortalcopy_flags|||
sv_mortalcopy|||
sv_ncmp|||
sv_newmortal|||
sv_newref|||
sv_nolocking||5.007003|
sv_nounlocking|||
sv_nv||5.005000|
sv_only_taint_gmagic|||n
sv_or_pv_pos_u2b|||
sv_peek||5.005000|
sv_pos_b2u_flags||5.019003|
sv_pos_b2u_midway|||
sv_pos_b2u||5.006000|
sv_pos_u2b_cached|||
sv_pos_u2b_flags||5.011005|
sv_pos_u2b_forwards|||n
sv_pos_u2b_midway|||n
sv_pos_u2b||5.006000|
sv_pvbyten_force||5.006000|
sv_pvbyten||5.006000|
sv_pvbyte||5.006000|
sv_pvn_force_flags|5.007002||p
sv_pvn_force|||
sv_pvn_nomg|5.007003|5.005000|p
sv_pvn||5.005000|
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_setref_pvn|||
sv_setref_pvs||5.024000|
sv_setref_pv|||
sv_setref_uv||5.007001|
sv_setsv_cow|||
sv_setsv_flags||5.007002|
sv_setsv_mg|5.004050||p
sv_setsv_nomg|5.007002||p
sv_setsv|||
sv_setuv_mg|5.004050||p
sv_setuv|5.004000||p
sv_true||5.005000|
sv_unglob|||
sv_uni_display||5.007003|
sv_unmagicext|5.013008||p
sv_unmagic|||
sv_unref_flags||5.007001|
sv_unref|||
sv_untaint||5.004000|
sv_upgrade|||
sv_usepvn_flags||5.009004|
sv_usepvn_mg|5.004050||p
sv_usepvn|||
sv_utf8_decode||5.006000|
sv_utf8_downgrade||5.006000|
sv_utf8_encode||5.006000|
sv_utf8_upgrade_flags_grow||5.011000|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade_nomg||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.005000||p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn_flags||5.017002|
sv_vcatpvfn||5.004000|
sv_vcatpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
sv_vsetpvf|5.006000|5.004000|p
utf8_to_uvuni_buf||5.015009|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr||5.007001|
utf8n_to_uvuni||5.007001|
utilize|||
uvchr_to_utf8_flags||5.007003|
uvchr_to_utf8||5.007001|
uvoffuni_to_utf8_flags||5.019004|
uvuni_to_utf8_flags||5.007003|
uvuni_to_utf8||5.007001|
valid_utf8_to_uvchr||5.015009|
valid_utf8_to_uvuni||5.015009|
validate_proto|||
validate_suid|||
if (exists $opt{'list-provided'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{provided};
my @flags;
push @flags, 'explicit' if exists $need{$f};
push @flags, 'depend' if exists $depends{$f};
push @flags, 'hint' if exists $hints{$f};
push @flags, 'warning' if exists $warnings{$f};
my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
print "$f$flags\n";
}
exit 0;
}
my @files;
# define G_METHOD 64
# ifdef call_sv
# undef call_sv
# endif
# if (PERL_BCDVERSION < 0x5006000)
# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : perl_call_sv(sv, flags))
# else
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
# endif
#endif
/* Replace perl_eval_pv with eval_pv */
#endif
#endif
#ifndef vload_module
#if defined(NEED_vload_module)
static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
static
#else
extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
#endif
#ifdef vload_module
# undef vload_module
#endif
#define Perl_vload_module DPPP_(my_vload_module)
#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
void
DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
{
dTHR;
dVAR;
OP *veop, *imop;
OP * const modname = newSVOP(OP_CONST, 0, name);
/* 5.005 has a somewhat hacky force_normal that doesn't croak on
SvREADONLY() if PL_compling is true. Current perls take care in
ck_require() to correctly turn off SvREADONLY before calling
force_normal_flags(). This seems a better fix than fudging PL_compling
*/
SvREADONLY_off(((SVOP*)modname)->op_sv);
modname->op_private |= OPpCONST_BARE;
if (ver) {
veop = newSVOP(OP_CONST, 0, ver);
}
else
veop = NULL;
if (flags & PERL_LOADMOD_NOIMPORT) {
imop = sawparens(newNULLLIST());
}
else if (flags & PERL_LOADMOD_IMPORT_OPS) {
imop = va_arg(*args, OP*);
}
else {
SV *sv;
imop = NULL;
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
#if (PERL_BCDVERSION >= 0x5004000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
#elif (PERL_BCDVERSION > 0x5003000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
veop, modname, imop);
#else
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
modname, imop);
#endif
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
#endif
#endif
#ifndef load_module
#if defined(NEED_load_module)
static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
static
#else
extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
#endif
#ifdef load_module
# undef load_module
#endif
#define Perl_load_module DPPP_(my_load_module)
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
#endif
# define newSVpvn(data,len) ((data) \
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
: newSV(0))
#endif
#ifndef newSVpvn_utf8
# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
#endif
#ifndef SVf_UTF8
# define SVf_UTF8 0
#endif
#ifndef newSVpvn_flags
#if defined(NEED_newSVpvn_flags)
static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
static
#else
extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
#endif
#ifdef newSVpvn_flags
# undef newSVpvn_flags
#endif
#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
SV *
DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
{
SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
SvFLAGS(sv) |= (flags & SVf_UTF8);
return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
}
#endif
#endif
/* Backwards compatibility stuff... :-( */
#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
# define NEED_sv_2pv_flags
#endif
#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
# define NEED_sv_2pv_flags_GLOBAL
#endif
/* Hint: sv_2pv_nolen
* Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
*/
# define SV_COW_SHARED_HASH_KEYS 0
#endif
#if (PERL_BCDVERSION < 0x5007002)
#if defined(NEED_sv_2pv_flags)
static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
static
#else
extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
#ifdef sv_2pv_flags
# undef sv_2pv_flags
#endif
#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
char *
DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
STRLEN n_a = (STRLEN) flags;
return sv_2pv(sv, lp ? lp : &n_a);
}
#endif
#if defined(NEED_sv_pvn_force_flags)
static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
static
#else
extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
#ifdef sv_pvn_force_flags
# undef sv_pvn_force_flags
#endif
#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
char *
DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
STRLEN n_a = (STRLEN) flags;
return sv_pvn_force(sv, lp ? lp : &n_a);
}
#endif
# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
#else
# define DPPP_SVPV_NOLEN_LP_ARG 0
#endif
#ifndef SvPV_const
# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_mutable
# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_flags
# define SvPV_flags(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
#endif
#ifndef SvPV_flags_const
# define SvPV_flags_const(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
(const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
#endif
#ifndef SvPV_flags_const_nolen
# define SvPV_flags_const_nolen(sv, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX_const(sv) : \
(const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
#endif
#ifndef SvPV_flags_mutable
# define SvPV_flags_mutable(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#endif
#ifndef SvPV_force
# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_force_nolen
# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
#endif
#ifndef SvPV_force_mutable
# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
#endif
#ifndef SvPV_force_nomg
# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
#endif
#ifndef SvPV_force_nomg_nolen
# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#endif
#ifndef SvPV_force_flags
# define SvPV_force_flags(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
#endif
#ifndef SvPV_force_flags_nolen
# define SvPV_force_flags_nolen(sv, flags) \
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
#endif
#ifndef SvPV_force_flags_mutable
# define SvPV_force_flags_mutable(sv, lp, flags) \
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
: sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#endif
#ifndef SvPV_nolen
# define SvPV_nolen(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
#endif
#ifndef SvPV_nolen_const
# define SvPV_nolen_const(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
#endif
#ifndef SvPV_nomg
# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
#endif
#ifndef SvPV_nomg_const
# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
#endif
#ifndef SvPV_nomg_const_nolen
# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
#endif
#ifndef SvPV_nomg_nolen
# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
#endif
#ifndef SvPV_renew
# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
SvPV_set((sv), (char *) saferealloc( \
(Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
#endif
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
#ifndef gv_fetchpvn_flags
#if defined(NEED_gv_fetchpvn_flags)
static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
static
#else
extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
#endif
#ifdef gv_fetchpvn_flags
# undef gv_fetchpvn_flags
#endif
#define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
#define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
#if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
GV*
DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
char *namepv = savepvn(name, len);
GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
Safefree(namepv);
return stash;
}
#ifndef isGV_with_GP
# define isGV_with_GP(gv) isGV(gv)
#endif
#ifndef gv_fetchsv
# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
#endif
#ifndef get_cvn_flags
# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
#endif
#ifndef gv_init_pvn
# define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
#endif
#ifndef WARN_ALL
# define WARN_ALL 0
#endif
#endif
#ifndef newSVpvs
# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
#endif
#ifndef newSVpvs_flags
# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
#endif
#ifndef newSVpvs_share
# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
#endif
#ifndef hv_stores
# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
#endif
#ifndef gv_fetchpvs
# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
#endif
#ifndef gv_stashpvs
# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
#endif
#ifndef get_cvs
# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
#endif
#ifndef SvGETMAGIC
# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#endif
else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
else if (mg->mg_type == PERL_MAGIC_utf8)
Safefree(mg->mg_ptr);
}
if (mg->mg_flags & MGf_REFCOUNTED)
SvREFCNT_dec(mg->mg_obj);
Safefree(mg);
}
else
mgp = &mg->mg_moremagic;
}
if (SvMAGIC(sv)) {
if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
mg_magical(sv); /* else fix the flags now */
}
else {
SvMAGICAL_off(sv);
SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
}
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
} else if (s < send) {
/* we can have an optional exponent part */
if (*s == 'e' || *s == 'E') {
/* The only flag we keep is sign. Blow away any "it's UV" */
numtype &= IS_NUMBER_NEG;
numtype |= IS_NUMBER_NOT_INT;
s++;
if (s < send && (*s == '-' || *s == '+'))
s++;
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
for compatibility silently suffer "b" and "0b" as valid binary
numbers. */
if (len >= 1) {
if (s[0] == 'b') {
{
--len;
++s;
goto redo;
}
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
warn("Illegal binary digit '%c' ignored", *s);
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading x or 0x.
for compatibility silently suffer "x" and "0x" as valid hex numbers.
*/
if (len >= 1) {
if (s[0] == 'x') {
{
--len;
++s;
goto redo;
}
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
warn("Illegal hexadecimal digit '%c' ignored", *s);
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
for (; len-- && *s; s++) {
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
out front allows slicker code. */
}
/* Allow \octal to work the DWIM way (that is, stop scanning
* as soon as non-octal characters are seen, complain only iff
* someone seems to want to use the digits eight and nine). */
if (digit == 8 || digit == 9) {
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
warn("Illegal octal digit '%c' ignored", *s);
}
break;
}
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#ifdef pv_escape
# undef pv_escape
#endif
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
{
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
char octbuf[32] = "%123456789ABCDF";
STRLEN wrote = 0;
STRLEN chsize = 0;
STRLEN readsize = 1;
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
#endif
const char *pv = str;
const char * const end = pv + count;
octbuf[0] = esc;
if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
sv_setpvs(dsv, "");
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
isuni = 1;
#endif
for (; pv < end && (!max || wrote < max) ; pv += readsize) {
const UV u =
isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
#endif
(U8)*pv;
const U8 c = (U8)u & 0xFF;
if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
chsize = my_snprintf(octbuf, sizeof octbuf,
"%" UVxf, u);
else
chsize = my_snprintf(octbuf, sizeof octbuf,
"%cx{%" UVxf "}", esc, u);
} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
chsize = 1;
} else {
if (c == dq || c == esc || !isPRINT(c)) {
chsize = 2;
switch (c) {
char tmp[2];
my_snprintf(tmp, sizeof tmp, "%c", c);
sv_catpvn(dsv, tmp, 1);
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
sv_catpvs(dsv, "...");
return SvPVX(dsv);
}
AFS-Command
view release on metacpan or search on metacpan
=head1 Changes in 1.8
=head1 Bug Fixes
=head2 vos examine did not pick up the LOCKED flag
The code to parse the VLDB header was missing the LOCKED flag, if it
was present, so this attribute was not being set properly. It is now.
=head2 pts membership error checking was bogus
Well, it still is bogus, actually, since the code has to deal with the
=head1 Changes in 1.7
=head1 Enhancements
=head2 Boolean flags can be turned off, as well as on
If an argument to a method (and its corresponding command line
argument) doesn't take a value, it is treated like a Boolean flag.
However, the code used to assume that the existence of a Boolean key
in the argument list implied the Boolean argument was always true.
Now, the truth of the arguments I<value> is tested to determine if the
flag should be set on or off. This makes it easy to have subroutines
that just blindly pass certain arguments along, without haing to test
them, and allows for much cleaner code.
For example:
AFS-Monitor
view release on metacpan or search on metacpan
examples/afsmonitor view on Meta::CPAN
my @tests; # choose which tests to run
$tests[1] = 1; # test of FS afsmonitor with detailed output file
$tests[2] = 2; # test of CM afsmonitor
$tests[3] = 0; # test of invalid file name
$tests[4] = 0; # test of detailed flag without output flag
$tests[5] = 0; # test of invalid FS host
$tests[6] = 0; # test of invalid CM host
$tests[7] = 0; # test of no flags
$tests[8] = 0; # test of cmhosts and fshosts and config flags all at once
$tests[9] = 0; # test of cmhosts and fshosts
$tests[10] = 0; # test of config file
$tests[11] = 0; # test of invalid config file
$tests[12] = 0; # test of config file with output file
$tests[13] = 0; # test of show and threshold parameters
AFS-PAG
view release on metacpan or search on metacpan
$config->check_type('ssize_t', undef, undef, include('sys/types.h'));
# Checks needed by all libkafs code.
$config->check_header('sys/ioccom.h');
# If the user passed extra flags into Build.PL, use them for probes.
if ($build->extra_linker_flags) {
my $flags = $build->extra_linker_flags;
my @flags = ref($flags) ? @{$flags} : ($flags);
$config->push_link_flags(@flags);
}
# Check if we have a library available to us. If so, check whether it
# provides k_pioctl and k_haspag and then return.
my $lib = $config->search_libs('k_hasafs', ['kafs', 'kopenafs']);
my @files;
if ($lib) {
$config->define_var('HAVE_K_HASAFS', 1,
'Define to 1 if you have the k_hasafs function.');
my $flags = $build->extra_linker_flags;
my @flags = ref($flags) ? @{$flags} : ($flags);
$build->extra_linker_flags(@flags, '-l' . $lib);
if ($lib eq 'kafs') {
$config->check_header('kafs.h');
} elsif ($lib eq 'kopenafs') {
$config->check_header('kopenafs.h');
}
recursive_test_files => 1,
add_to_cleanup => [qw(config.log cover_db glue/*.o)],
# XS configuration.
c_source => 'glue',
extra_compiler_flags => ['-I.'],
# Additional package metadata.
meta_merge => {
resources => {
repository => 'git://git.eyrie.org/afs/afs-pag.git',
AFS
view release on metacpan or search on metacpan
* updated example scripts for all AFS modules
Developer-visible changes:
* rewrite of method AFS::VOS->backupsys
* concatenate compiler flags in Makefile.PL
* cleaned up compiler warnings
* cleaned up memory allocation for the AFS::PTS, AFS::VOS, AFS::VLDB,
and AFS::BOS modules
* closed memory leaks because of multiple calls to "rx_Init" in the
AFS::PTS, AFS::VOS, AFS::VLDB, and AFS::BOS modules
AI-ANN
view release on metacpan or search on metacpan
_Inline/build/AI/ANN/Neuron_6185/Makefile view on Meta::CPAN
# --- MakeMaker depend section:
# --- MakeMaker cflags section:
CCFLAGS = -D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64
OPTIMIZE = -O2 -g
PERLTYPE =
MPOLLUTE =
AI-CRM114
view release on metacpan or search on metacpan
lib/AI/CRM114.pm view on Meta::CPAN
bless $self, $class;
return $self;
}
sub classify {
my ($self, $flags, $files, $text) = @_;
my $code = qq#-{
isolate (:stats:);
classify <@$flags> ( @$files ) (:stats:);
output /:*:stats:/
}#;
my $o = "";
my $h = run [$self->{cmd}, $code], \$text, \$o;
lib/AI/CRM114.pm view on Meta::CPAN
wantarray ? ($file, $prob, $pr) : $file;
}
sub learn {
my ($self, $flags, $file, $text) = @_;
my $code = qq#-{ learn <@$flags> ( $file ) }#;
my $o = "";
my $h = run [$self->{cmd}, $code], \$text, \$o;
}
lib/AI/CRM114.pm view on Meta::CPAN
Specifies the path to the crm executable.
=back
=item $crm->learn(\@flags, $file, $text)
Learn that the text belongs to the file using the specified flags.
Permissable flags are specified in the C<QUICKREF.txt> file that
comes with CRM114. Examples include C<winnow>, C<microgroom>, and
C<osbf>.
=item classify(\@flags, \@files, $text)
Attempt to correlate the text to one of the files using the
specified flags. Permissable flags are specified in the C<QUICKREF.txt>
file that comes with CRM114. Examples include C<unique>, C<fscm>, and
C<svm>.
In scalar context, returns the path of the best matching file.
In list context, returns a list containing the path of the best file,
AI-Categorizer
view release on metacpan or search on metacpan
lib/AI/Categorizer/Document.pm view on Meta::CPAN
my @keys = keys %$s;
%$s = ();
$self->stem_words(\@keys);
$s->{$_} = 1 foreach @keys;
# This flag is attached to the stopword structure itself so that
# other documents will notice it.
$s->{___stemmed} = 1;
}
sub finish {
AI-Classifier
view release on metacpan or search on metacpan
If you have cpanm, you only need one line:
% cpanm AI::Classifier
If you are installing into a system-wide directory, you may need to pass the
"-S" flag to cpanm, which uses sudo to install the module:
% cpanm -S AI::Classifier
## Installing with the CPAN shell
AI-DecisionTree
view release on metacpan or search on metacpan
If you have cpanm, you only need one line:
% cpanm AI::DecisionTree
If you are installing into a system-wide directory, you may need to pass the
"-S" flag to cpanm, which uses sudo to install the module:
% cpanm -S AI::DecisionTree
## Installing with the CPAN shell
AI-FANN
view release on metacpan or search on metacpan
}
Perl_croak(aTHX_ "wrong type for %s argument, array reference expected", name);
}
static fann_type*
_sv2fta(pTHX_ SV *sv, unsigned int len, int flags, char * const name) {
unsigned int i;
fann_type *fta;
AV *av = _srv2av(aTHX_ sv, len, name);
Newx(fta, len, fann_type);
if (flags & WANT_MORTAL) SAVEFREEPV(fta);
for (i = 0; i < len; i++) {
SV ** svp = av_fetch(av, i, 0);
fta[i] = SvNV(svp ? *svp : &PL_sv_undef);
}
AI-Logic-AnswerSet
view release on metacpan or search on metacpan
# --- MakeMaker depend section:
# --- MakeMaker cflags section:
# --- MakeMaker const_loadlibs section:
AI-ML
view release on metacpan or search on metacpan
inc/MyBuilder.pm view on Meta::CPAN
my $object = $file;
$object =~ s/\.c$/.o/;
next if $self->up_to_date($file, $object);
$cbuilder->compile(
object_file => $object,
extra_compiler_flags => $EXTRA_O_FLAGS,
source => $file,
include_dirs => ["."]
);
}
}
inc/MyBuilder.pm view on Meta::CPAN
my $xs_o = path("XS", "ML.o");
if (!$self->up_to_date($xs_c, $xs_o)) {
$cbuilder->compile(
source => $xs_c,
extra_compiler_flags => $EXTRA_O_FLAGS,
include_dirs => ["."],
object_file => $xs_o
);
}
my $bs_file = path( $archdir, "ML.bs");
inc/MyBuilder.pm view on Meta::CPAN
push @$objects, $xs_o;
my $lib_file = path($archdir, "ML.$Config{dlext}");
if (!$self->up_to_date( $objects, $lib_file )) {
$cbuilder->link(
module_name => 'AI::ML',
extra_linker_flags => $EXTRA_FLAGS,
objects => $objects,
lib_file => $lib_file,
);
}
}
AI-MXNet
view release on metacpan or search on metacpan
lib/AI/MXNet/Image.pm view on Meta::CPAN
Parameters
----------
$buf : str, array ref, pdl, ndarray
Binary image data.
:$flag : int
0 for grayscale. 1 for colored.
:$to_rgb : int
0 for BGR format (OpenCV default). 1 for RGB format (MXNet default).
:$out : NDArray
Output buffer. Do not specify for automatic allocation.
=cut
method imdecode(Str|PDL $buf, Int :$flag=1, Int :$to_rgb=1, Maybe[AI::MXNet::NDArray] :$out=)
{
if(not ref $buf)
{
my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{'uint8'});
my $len; { use bytes; $len = length $buf; }
lib/AI/MXNet/Image.pm view on Meta::CPAN
}
if(not (blessed $buf and $buf->isa('AI::MXNet::NDArray')))
{
$buf = AI::MXNet::NDArray->array($buf, dtype=>'uint8');
}
return AI::MXNet::NDArray->_cvimdecode($buf, { flag => $flag, to_rgb => $to_rgb, ($out ? (out => $out) : ()) });
}
=head2 scale_down
Scale down crop size if it's bigger than the image size.
lib/AI/MXNet/Image.pm view on Meta::CPAN
{
$self->imgrec(
AI::MXNet::IndexedRecordIO->new(
idx_path => $self->path_imgidx,
uri => $self->path_imgrec,
flag => 'r'
)
);
$self->imgidx([@{ $self->imgrec->keys }]);
}
else
{
$self->imgrec(AI::MXNet::RecordIO->new(uri => $self->path_imgrec, flag => 'r'));
}
}
my %imglist;
my @imgkeys;
if($self->path_imglist)
AI-MXNetCAPI
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
use DynaLoader;
`swig -noproxy -c++ -perl mxnet.i`;
unlink "MXNetCAPI.pm";
my @tmp = split(/ /, $ExtUtils::MakeMaker::Config{lddlflags});
my @lddlflags;
while(my $flag = shift(@tmp))
{
if($flag eq '-arch')
{
my $arch = shift(@tmp);
if($arch eq 'i386')
{
next;
}
else
{
push @lddlflags, ($flag, $arch);
}
}
else
{
push @lddlflags, $flag;
}
}
WriteMakefile(
NAME => 'AI::MXNetCAPI',
LICENSE => 'apache_2_0',
Makefile.PL view on Meta::CPAN
VERSION_FROM => 'lib/AI/MXNetCAPI.pm',
ABSTRACT_FROM => 'lib/AI/MXNetCAPI.pm',
LIBS => ['-L../../lib -lmxnet'],
INC => '-I../../include/mxnet',
OBJECT => 'mxnet_wrap.o',
LDDLFLAGS => join(' ', @lddlflags),
PREREQ_PM => {
# prereqs
# build/test prereqs
'Test::More' => 0,
},
AI-MaxEntropy
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
my ( $PostambleActions, $PostambleUsed );
# See if it's a testing or non-interactive session
inc/Module/AutoInstall.pm view on Meta::CPAN
],
@Missing,
);
}
# initialize various flags, and/or perform install
sub _init {
foreach my $arg (
@ARGV,
split(
/[\s\t]+/,
inc/Module/AutoInstall.pm view on Meta::CPAN
return unless $conf->can('conf') # 0.05x+ with "sudo" support
or _can_write($conf->_get_build('base')); # 0.04x
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $conf->get_conf('makeflags') || '';
if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
# 0.03+ uses a hashref here
$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
} else {
# 0.02 and below uses a scalar
$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
}
$conf->set_conf( makeflags => $makeflags );
$conf->set_conf( prereqs => 1 );
while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
inc/Module/AutoInstall.pm view on Meta::CPAN
return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
and _can_write( $Config::Config{sitelib} );
}
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
AI-MegaHAL
view release on metacpan or search on metacpan
lib/AI/MegaHAL.pm view on Meta::CPAN
# Set some of the options that may have been passed to us.
megahal_setnobanner() if(! $args{'Banner'});
megahal_setnowrap() if(! $args{'Wrap'});
megahal_setnoprompt() if(! $args{'Prompt'});
# This flag indicates whether or not we should automatically save
# our brain when the object goes out of scope.
$self->{'AutoSave'} = $args{'AutoSave'};
# Initialize ourselves.
$self->_initialize();
lib/AI/MegaHAL.pm view on Meta::CPAN
=over 4
=item B<Path> - The path to MegaHALs brain or training file (megahal.brn and megahal.trn respectively). If 'Path' is not specified the current working directory is assumed.
=item B<Banner> - A flag which enables/disables the banner which is displayed when MegaHAL starts up. The default is to disable the banner.
=item B<Prompt> - A flag which enables/disables the prompt. This flag is only useful when MegaHAL is run interactively and is disabled by default.
=item B<Wrap> - A flag which enables/disables word wrapping of MegaHALs responses when the lines exceed 80 characters in length. The default is to disable word wrapping.
=back
=head1 METHODS
AI-MicroStructure
view release on metacpan or search on metacpan
lib/AI/MicroStructure/WordBlacklist.pm view on Meta::CPAN
my @search = ("a","a's","able","about","above","according","accordingly","across","actually","after","afterwards","again","against","ain't","all","allow","allows","almost","alone","along","already","also","although","always","am","among","amongst","a...
return @search;
}
sub getStopWords {
if ( @_ and $_[0] eq 'UTF-8' ) {
# adding U0 causes the result to be flagged as UTF-8
my %stoplist = map { ( pack("U0a*", $_), 1 ) } qw(
a able about above according accordingly across actually after afterwards again against aint all allow allows almost alone along already also although always am among amongst an and another any anybody anyhow anyone anything anyway anyways anywhere a...
b be became because become becomes becoming been before beforehand behind being believe below beside besides best better between beyond both brief but by
c came can cannot cant cant cause causes certain certainly changes clearly cmon co com come comes concerning consequently consider considering contain containing contains corresponding could couldnt course cs currently
d definitely described despite did didnt different do does doesnt doing done dont down downwards during
AI-NNVMCAPI
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
# under the License.
use ExtUtils::MakeMaker;
`swig -noproxy -c++ -perl nnvm.i`;
unlink "NNVMCAPI.pm";
my @tmp = split(/ /, $ExtUtils::MakeMaker::Config{lddlflags});
my @lddlflags;
while(my $flag = shift(@tmp))
{
if($flag eq '-arch')
{
my $arch = shift(@tmp);
if($arch eq 'i386')
{
next;
}
else
{
push @lddlflags, ($flag, $arch);
}
}
else
{
push @lddlflags, $flag;
}
}
WriteMakefile(
NAME => 'AI::NNVMCAPI',
Makefile.PL view on Meta::CPAN
VERSION_FROM => 'lib/AI/NNVMCAPI.pm',
ABSTRACT_FROM => 'lib/AI/NNVMCAPI.pm',
LIBS => ['-L../../lib -lmxnet'],
INC => '-I../../3rdparty/tvm/nnvm/include/nnvm',
OBJECT => 'nnvm_wrap.o',
LDDLFLAGS => join(' ', @lddlflags),
PREREQ_PM => {
# prereqs
# build/test prereqs
'Test::More' => 0,
},
AI-NaiveBayes1
view release on metacpan or search on metacpan
t/auxfunctions.pl view on Meta::CPAN
my $file = shift;
my $testfile = @_ ? shift @_ : '';
my $testline = @_ ? shift @_ : '';
my $expected = getfile($file);
if ($got eq $expected) { pass; return }
my $flag = '';
while ($got ne '' or $expected ne '') {
my $a=$got; if ($a =~ /\s*\n/) { $a = $`; $got = $'; }
my $b=$expected; if ($b =~ /\s*\n/) { $b = $`; $expected = $'; }
if ($a ne $b) {
if ($flag eq '')
{ print STDERR "\n$testfile:$testline: Failed comparison with $file!\n"; $flag = 1; }
print STDERR " Got: $a\n".
"Expected: $b\n";
}
}
if ($flag eq '') { pass } else { fail }
}
sub shorterdecimals {
local $_ = shift;
s/(\d{4}\.\d{10})\d+/$1/g;
AI-NeuralNet-BackProp
view release on metacpan or search on metacpan
BackProp.pm view on Meta::CPAN
my %args = @_;
my $len = $#{$data}/2-1;
my $inc = $args{inc};
my $max = $args{max};
my $error = $args{error};
my $p = (defined $args{flag}) ?$args{flag} :1;
my $row = (defined $args{pattern})?$args{pattern}*2+1:1;
my ($fa,$fb);
for my $x (0..$len) {
print "\nLearning index $x...\n" if($AI::NeuralNet::BackProp::DEBUG);
my $str = $self->learn( $data->[$x*2], # The list of data to input to the net
BackProp.pm view on Meta::CPAN
my $type = shift;
my $self = {};
my $layers = shift;
my $size = shift;
my $out = shift || $size;
my $flag = shift || 0;
bless $self, $type;
# If $layers is a string, then it will be nummerically equal to 0, so try to load it
# as a network file.
if($layers == 0) {
# We use a "1" flag as the second argument to indicate that we want load()
# to call the new constructor to make a network the same size as in the file
# and return a refrence to the network, instead of just creating the network from
# pre-exisiting refrence
return $self->load($layers,1);
}
BackProp.pm view on Meta::CPAN
$self->{MAP} = new AI::NeuralNet::BackProp::_map($self);
$self->{SIZE} = $size;
$self->{DIV} = $div;
$self->{OUT} = $out;
$self->{FLAG} = $flag;
$self->{col_width}= 5;
$self->{random} = 0.001;
$self->initialize_group();
BackProp.pm view on Meta::CPAN
my $self = shift;
my $file = shift;
my $size = $self->{SIZE};
my $div = $self->{DIV};
my $out = $self->{OUT};
my $flag = $self->{FLAG};
open(FILE,">$file");
print FILE "size=$size\n";
print FILE "div=$div\n";
print FILE "out=$out\n";
print FILE "flag=$flag\n";
print FILE "rand=$self->{random}\n";
print FILE "cw=$self->{col_width}\n";
print FILE "crunch=$self->{_CRUNCHED}->{_LENGTH}\n";
print FILE "rA=$self->{rA}\n";
print FILE "rB=$self->{rB}\n";
BackProp.pm view on Meta::CPAN
# Load entire network state from disk.
sub load {
my $self = shift;
my $file = shift;
my $load_flag = shift || 0;
return undef if(!(-f $file));
open(FILE,"$file");
my @lines=<FILE>;
BackProp.pm view on Meta::CPAN
$db{$a}=$b;
}
return undef if(!$db{"size"});
if($load_flag) {
undef $self;
# Create new network
$self = AI::NeuralNet::BackProp->new(intr($db{"size"}/$db{"div"}),
$db{"div"},
$db{"out"},
$db{"flag"});
} else {
$self->{DIV} = $db{"div"};
$self->{SIZE} = $db{"size"};
$self->{OUT} = $db{"out"};
$self->{FLAG} = $db{"flag"};
}
# Load variables
$self->{col_width} = $db{"cw"};
$self->{random} = $db{"rand"};
BackProp.pm view on Meta::CPAN
sub initialize_group() {
my $self = shift;
my $size = $self->{SIZE};
my $div = $self->{DIV};
my $out = $self->{OUT};
my $flag = $self->{FLAG};
my $x = 0;
my $y = 0;
# Reset map and run synapse counters.
$self->{RUN}->{REGISTRATION} = $self->{MAP}->{REGISTRATION} = 0;
BackProp.pm view on Meta::CPAN
# is an example. 3 and 2 are set by the new() constructor.
# Flag values:
# 0 - (default) -
# My feed-foward style: Each neuron in layer X is connected to one input of every
# neuron in layer Y. The best and most proven flag style.
#
# ^ ^ ^
# O\ O\ /O Layer Y
# ^\\/^/\/^
# | //|\/\|
# |/ \|/ \|
# O O O Layer X
# ^ ^ ^
#
# 1 -
# In addition to flag 0, each neuron in layer X is connected to every input of
# the neurons ahead of itself in layer X.
# 2 - ("L-U Style") -
# No, its not "Learning-Unit" style. It gets its name from this: In a 2 layer, 3
# neuron network, the connections form a L-U pair, or a W, however you want to look
# at it.
BackProp.pm view on Meta::CPAN
#
# As you can see, each neuron is connected to the next one in its layer, as well
# as the neuron directly above itself.
for ($z=0; $z<$div; $z++) {
if((!$flag) || ($flag == 1)) {
for ($aa=0; $aa<$div; $aa++) {
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$div+$aa]);
}
}
if($flag == 1) {
for ($aa=$z+1; $aa<$div; $aa++) {
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$aa]);
}
}
if($flag == 2) {
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$div+$z]);
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$z+1]) if($z<$div-1);
}
AI::NeuralNet::BackProp::out1 "\n";
}
BackProp.pm view on Meta::CPAN
my $error = ($args{error}>-1 && defined $args{error}) ? $args{error} : -1;
my $div = $self->{DIV};
my $size = $self->{SIZE};
my $out = $self->{OUT};
my $divide = AI::NeuralNet::BackProp->intr($div/$out);
my ($a,$b,$y,$flag,$map,$loop,$diff,$pattern,$value);
my ($t0,$it0);
no strict 'refs';
# Take care of crunching strings passed
$omap = $self->crunch($omap) if($omap == 0);
BackProp.pm view on Meta::CPAN
# Debug
AI::NeuralNet::BackProp::out1 "Num output neurons: $out, Input neurons: $size, Division: $divide\n";
# Start benchmark timer and initalize a few variables
$t0 = new Benchmark;
$flag = 0;
$loop = 0;
my $ldiff = 0;
my $dinc = 0.0001;
my $cdiff = 0;
$diff = 100;
$error = ($error>-1)?$error:-1;
# $flag only goes high when all neurons in output map compare exactly with
# desired result map or $max loops is reached
#
while(!$flag && ($max ? $loop<$max : 1)) {
$it0 = new Benchmark;
# Run the map
$self->{RUN}->run($omap);
# Retrieve last mapping and initialize a few variables.
$map = $self->map();
$y = $size-$div;
$flag = 1;
# Compare the result map we just ran with the desired result map.
$diff = pdiff($map,$res);
# This adjusts the increment multiplier to decrease as the loops increase
BackProp.pm view on Meta::CPAN
# Save last $diff
$ldiff = $diff;
# This catches a max error argument and handles it
if(!($error>-1 ? $diff>$error : 1)) {
$flag=1;
last;
}
# Debugging
AI::NeuralNet::BackProp::out4 "Difference: $diff\%\t Increment: $inc\tMax Error: $error\%\n";
BackProp.pm view on Meta::CPAN
for my $j (0..$divide-1) {
if($a!=$b) {
AI::NeuralNet::BackProp::out1 "Punishing $self->{NET}->[($i*$divide)+$j] at ",(($i*$divide)+$j)," ($i with $a) by $inc.\n";
$l->[$y+($i*$divide)+$j]->weight($inc,$b) if($l->[$y+($i*$divide)+$j]);
$flag = 0;
}
}
}
# This counter is just used in the benchmarking operations.
BackProp.pm view on Meta::CPAN
no strict 'refs';
my $self = shift;
my $sid = shift;
my $value = shift;
my $size = $self->{PARENT}->{DIV};
my $flag = 1;
$self->{OUTPUT}->[$sid]->{VALUE} = $self->{PARENT}->intr($value);
$self->{OUTPUT}->[$sid]->{FIRED} = 1;
AI::NeuralNet::BackProp::out1 "Received value $self->{OUTPUT}->[$sid]->{VALUE} and sid $sid, self $self.\n";
}
BackProp.pm view on Meta::CPAN
=head2 METHODS
=over 4
=item new AI::NeuralNet::BackProp($layers, $size [, $outputs, $topology_flag])
Returns a newly created neural network from an C<AI::NeuralNet::BackProp>
object. The network will have C<$layers> number layers in it
and each layer will have C<$size> number of neurons in that layer.
There is an optional parameter of $outputs, which specifies the number
of output neurons to provide. If $outputs is not specified, $outputs
defaults to equal $size. $outputs may not exceed $size. If $outputs
exceeds $size, the new() constructor will return undef.
The optional parameter, $topology_flag, defaults to 0 when not used. There are
three valid topology flag values:
B<0> I<default>
My feed-foward style: Each neuron in layer X is connected to one input of every
neuron in layer Y. The best and most proven flag style.
^ ^ ^
O\ O\ /O Layer Y
^\\/^/\/^
| //|\/\|
BackProp.pm view on Meta::CPAN
(Sorry about the bad art...I am no ASCII artist! :-)
B<1>
In addition to flag 0, each neuron in layer X is connected to every input of
the neurons ahead of itself in layer X.
B<2> I<("L-U Style")>
No, its not "Learning-Unit" style. It gets its name from this: In a 2 layer, 3
neuron network, the connections form a L-U pair, or a W, however you want to look
BackProp.pm view on Meta::CPAN
See the paragraph on measuring forgetfulness, below. There are
two learn_set()-specific option tags available:
flag => $flag
pattern => $row
If "flag" is set to some TRUE value, as in "flag => 1" in the hash of options, or if the option "flag"
is not set, then it will return a percentage represting the amount of forgetfullness. Otherwise,
learn_set() will return an integer specifying the amount of forgetfulness when all the patterns
are learned.
If "pattern" is set, then learn_set() will use that pattern in the data set to measure forgetfulness by.
AI-NeuralNet-Kohonen-Demo-RGB
view release on metacpan or search on metacpan
$self->{mw} = MainWindow->new(
-width => 200+($self->{map_dim_x} * $self->{display_scale}),
-height => 200+($self->{map_dim_y} * $self->{display_scale}),
);
my $quit_flag = 0;
my $quit_code = sub {$quit_flag = 1};
$self->{mw}->protocol('WM_DELETE_WINDOW' => $quit_code);
$self->{c} = $self->{mw}->Canvas(
-width => 50+($self->{map_dim_x} * $self->{display_scale}),
-height => 50+($self->{map_dim_y} * $self->{display_scale}),
my $l = $self->{mw}->Label(-text => ' ',-textvariable=>\$label_txt);
$l->pack(-side=>'left');
# Replaces Tk's MainLoop
for (0..$self->{epochs}) {
if ($quit_flag) {
$self->{mw}->destroy;
return;
}
$self->{t}++; # Measure epoch
my $target = $self->_select_target;
AI-NeuralNet-Kohonen-Visual
view release on metacpan or search on metacpan
lib/AI/NeuralNet/Kohonen/Visual.pm view on Meta::CPAN
$self->prepare_display if not defined $self->{_mw} or ref $self->{_mw} ne 'MainWindow';
# Replaces Tk's MainLoop
for (0..$self->{epochs}) {
if ($self->{_quit_flag}) {
$self->{_mw}->destroy;
$self->{_mw} = undef;
return;
}
$self->{t}++; # Measure epoch
lib/AI/NeuralNet/Kohonen/Visual.pm view on Meta::CPAN
-width => $w + 20,
-height => $h + 20,
);
$self->{_mw}->fontCreate(qw/TAG -family verdana -size 8 -weight bold/);
$self->{_mw}->resizable( 0, 0);
$self->{_quit_flag} = 0;
$self->{_mw}->protocol('WM_DELETE_WINDOW' => sub {$self->{_quit_flag}=1});
$self->{_canvas} = $self->{_mw}->Canvas(
-width => $w,
-height => $h,
-relief => 'raised',
-border => 2,
lib/AI/NeuralNet/Kohonen/Visual.pm view on Meta::CPAN
The values of C<bmu_x> and C<bmu_y> represent The I<x> and I<y>
co-ordinates of unit to highlight using the value in the
C<hicol> to highlight it with colour. If no C<hicolo> is provided,
it default to red.
When called, this method also sets the object field flag C<plotted>:
currently, this prevents C<main_loop> from calling this routine.
See also L<METHOD get_colour_for>.
=cut
AI-NeuralNet-Kohonen
view release on metacpan or search on metacpan
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
Adds to the C<input> field an input vector in SOM_PAK-format
whitespace-delimited ASCII.
Returns C<undef> on failure to add an item (perhaps because
the data passed was a comment, or the C<weight_dim> flag was
not set); a true value on success.
=cut
sub _add_input_from_str { my ($self) = (shift);
AI-NeuralNet-Mesh
view release on metacpan or search on metacpan
bless $self, $type;
# If $layers is a string, then it will be numerically equal to 0, so
# try to load it as a network file.
if($layers == 0) {
# We use a "1" flag as the second argument to indicate that we
# want load() to call the new constructor to make a network the
# same size as in the file and return a refrence to the network,
# instead of just creating the network from pre-exisiting refrence
return $self->load($layers,1);
}
my $dinc = 0.0002; # amount to adjust gradient by
my $diff = 100; # error magin between results
my $start = new Benchmark;
$inputs = $self->crunch($inputs) if($inputs == 0);
$outputs = $self->crunch($outputs) if($outputs == 0);
my ($flag,$ldiff,$cdiff,$_mi,$loop,$y);
while(!$flag && ($max ? $loop<$max : 1)) {
my $b = new Benchmark;
my $got = $self->run($inputs);
$diff = pdiff($got,$outputs);
$flag = 1;
if(($error>-1 ? $diff<$error : 0) || !$diff) {
$flag=1;
last;
}
if($degrade) {
$inc -= ($dinc*$diff);
for my $x (0..$self->{outputs}-1) {
my $a = $got->[$x];
my $b = $outputs->[$x];
d("got: $a, wanted: $b\n",2);
if ($a != $b) {
$flag = 0;
$y = $self->{total_nodes}-$self->{outputs}+$x;
$self->{mesh}->[$y]->adjust_weight(($a<$b?1:-1)*$inc,$b);
}
}
my $len = $#{$data}/2;
my $inc = $args{inc};
my $max = $args{max};
my $error = $args{error};
my $degrade = $args{degrade};
my $p = (defined $args{flag}) ?$args{flag} :1;
my $row = (defined $args{row}) ?$args{row}+1:1;
my $leave = (defined $args{leave})?$args{leave}:0;
for my $x (0..$len-$leave) {
d("Learning set $x...\n",4);
my $str = $self->learn( $data->[$x*2],
# Load entire network state from disk.
sub load {
my $self = shift;
my $file = shift;
my $load_flag = shift;
my @lines;
if(-f $file) {
open(FILE,"$file");
return undef;
}
return $self->load_old($file) if($self->version($db{"header"})<0.21);
if($load_flag) {
undef $self;
$self = AI::NeuralNet::Mesh->new([split(',',$db{layers})]);
} else {
$self->{inputs} = $db{inputs};
$self->{nodes} = $db{nodes};
# Load entire network state from disk.
sub load_old {
my $self = shift;
my $file = shift;
my $load_flag = shift;
if(!(-f $file)) {
$self->{error} = "File \"$file\" does not exist.";
return undef;
}
if(!$db{"header"}) {
$self->{error} = "Invalid format.";
return undef;
}
if($load_flag) {
undef $self;
# Create new network
$self = AI::NeuralNet::Mesh->new($db{"layers"},
$db{"nodes"},
no strict 'refs';
for(0..$layer-1){$n+=$self->{layers}->[$_]}
$self->{mesh}->[$n+$node]->{threshold} = $value;
}
# Set mean (avg.) flag for a layer.
# usage: $net->mean($layer,$flag);
# If $flag is true, it enables finding the mean for that layer,
# If $flag is false, disables mean.
sub mean {
my $self = shift;
my $layer = shift || 0;
my $value = shift || 0;
my $n = 0;
$self->{_inputs}->[$from_id]->{input} = $input;
$self->{_inputs}->[$from_id]->{fired} = 1;
$self->{_parent}->d("got input $input from id $from_id, weighted to $self->{_inputs}->[$from_id]->{value}.\n",1);
my $flag = 1;
for my $x (0..$self->{_inputs_size}-1) { $flag = 0 if(!$self->{_inputs}->[$x]->{fired}) }
if ($flag) {
$self->{_parent}->d("all inputs fired for $self.\n",1);
my $output = 0;
# Sum
for my $i (@{$self->{_inputs}}) {
$output += $i->{value};
}
# Handle activations, thresholds, and means
$output /= $self->{_inputs_size} if($self->{flag_mean});
#$output += (rand()*$self->{_parent}->{random});
$output = ($output>=$self->{threshold})?1:0 if(($self->{activation} eq "sigmoid") || ($self->{activation} eq "sigmoid_1"));
if($self->{activation} eq "sigmoid_2") {
$output = 1 if($output >$self->{threshold});
$output = -1 if($output <$self->{threshold});
=item $net->learn($input_map_ref, $desired_result_ref [, options ]);
NOTE: learn_set() now has increment-degrading turned OFF by default. See note
on the degrade flag, below.
This will 'teach' a network to associate an new input map with a desired
result. It will return a string containg benchmarking information.
You can also specify strings as inputs and ouputs to learn, and they will be
Options should be written on hash form. There are three options:
inc => $learning_gradient
max => $maximum_iterations
error => $maximum_allowable_percentage_of_error
degrade => $degrade_increment_flag
$learning_gradient is an optional value used to adjust the weights of the internal
connections. If $learning_gradient is ommitted, it defaults to 0.002.
actual results and desired results falls below $maximum_allowable_percentage_of_error.
If you do not include 'error', or $maximum_allowable_percentage_of_error is set to -1,
then learn() will not return until it gets an exact match for the desired result OR it
reaches $maximum_iterations.
$degrade_increment_flag is a simple flag used to allow/dissalow increment degrading
during learning based on a product of the error difference with several other factors.
$degrade_increment_flag is off by default. Setting $degrade_increment_flag to a true
value turns increment degrading on.
In previous module releases $degrade_increment_flag was not used, as increment degrading
was always on. In this release I have looked at several other network types as well
as several texts and decided that it would be better to not use increment degrading. The
option is still there for those that feel the inclination to use it. I have found some areas
that do need the degrade flag to work at a faster speed. See test.pl for an example. If
the degrade flag wasn't in test.pl, it would take a very long time to learn.
=item $net->learn_set(\@set, [ options ]);
Inputs and outputs in the dataset can also be strings.
See the paragraph on measuring forgetfulness, below. There are
two learn_set()-specific option tags available:
flag => $flag
pattern => $row
If "flag" is set to some TRUE value, as in "flag => 1" in the hash of options, or if the option "flag"
is not set, then it will return a percentage represting the amount of forgetfullness. Otherwise,
learn_set() will return an integer specifying the amount of forgetfulness when all the patterns
are learned.
If "pattern" is set, then learn_set() will use that pattern in the data set to measure forgetfulness by.
( run in 6.647 seconds using v1.01-cache-2.11-cpan-94b05bcf43c )