Result:
found more than 457 distributions - search limited to the first 2001 files matching your query
( run in 3.836 )
Acme-WalkMethods
view release on metacpan or search on metacpan
lib/Acme/WalkMethods.pm view on Meta::CPAN
print "Can I create '$name' as a method (y/N)?";
my $input = <STDIN>;
chomp($input);
unless($input eq 'y') {
return undef;
}
}
if($_[1]) {
# set it
$_[0]->{$name} = $_[1];
}
# Return it
return $_[0]->{$name} if defined $_[0]->{$name};
return undef;
}
sub DESTROY {};
1;
Acme-Warn-LOLCAT
view release on metacpan or search on metacpan
lib/Acme/Warn/LOLCAT.pm view on Meta::CPAN
no warnings 'redefine';
*CORE::GLOBAL::warn =
$main::SIG{__WARN__} = sub{
my $message = shift || "Warning: something's wrong";
my (undef, $file, $line) = caller(0);
$message .= " at $file line $line\n" unless ($message =~ /\n$/);
$message = translate($message);
$message =~ s/\n\. KTHXBYE!//g;
$message =~ s/\n\. KTHX.//g;
Acme-Web-PodDisplay
view release on metacpan or search on metacpan
t/000-report-versions-tiny.t view on Meta::CPAN
diag("${module}: $@");
$pmver = 'died during VERSION check.';
} elsif (defined $version) {
$pmver = "$version";
} else {
$pmver = '<undef>';
}
}
# So, we should be good, right?
return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n");
Acme-What
view release on metacpan or search on metacpan
lib/Acme/What.pm view on Meta::CPAN
: sprintf("$caller\::$method");
}
sub unimport
{
$^H{(__PACKAGE__)} = undef;
}
sub _parser
{
my $self = shift;
Acme-Win32-PEPM
view release on metacpan or search on metacpan
lib/Win32/PEPM/Build.pm view on Meta::CPAN
my $oldpm_to_blib;
my $oldconstants;
sub hookMY
{
$oldpostamble = *MY::postamble{CODE};
undef(*MY::postamble);
*MY::postamble = sub {
my $str = '';
$str = &$oldpostamble(@_) if ($oldpostamble);
return $str.'
lib/Win32/PEPM/Build.pm view on Meta::CPAN
-e"Win32::PEPM::Build::makeCOM(\'$(BASEEXT).com\')"
';
};
$oldpm_to_blib = *MY::pm_to_blib{CODE};
undef(*MY::pm_to_blib);
*MY::pm_to_blib = sub {
my $dlib;
if($oldpm_to_blib){
$dlib = &$oldpm_to_blib(@_);
} else {
lib/Win32/PEPM/Build.pm view on Meta::CPAN
');
return $dlib;
};
$oldconstants = *MY::constants{CODE};
undef(*MY::constants);
*MY::constants = sub {
my $dlib;
if($oldconstants){
$dlib = &$oldconstants(@_);
} else {
Acme-YAPC-Asia-2012-LTthon-Hakushu
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.06';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2012 Adam Kennedy.
Acme-YAPC-Okinawa-Bus
view release on metacpan or search on metacpan
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
PL_stack_sp|5.004050||p
PL_statcache|5.005000||p
PL_stdingv|5.004050||p
PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
PL_tainted|5.004050||p
PL_tainting|5.004050||p
PL_tokenbuf|5.021008||p
POP_MULTICALL||5.021008|
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
av_reify|||
av_shift|||
av_store|||
av_tindex||5.017009|
av_top_index||5.017009|
av_undef|||
av_unshift|||
ax|||n
backup_one_SB|||
backup_one_WB|||
bad_type_gv|||
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
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|
cx_dup|||
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
find_hash_subscript|||
find_in_my_stash|||
find_lexical_cv|||
find_runcv_where|||
find_runcv||5.008001|
find_rundefsv2|||
find_rundefsvoffset||5.009002|
find_rundefsv||5.013002|
find_script|||
find_uninit_var|||
first_symbol|||n
fixup_errno_string|||
foldEQ_latin1||5.013008|n
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
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|||
incpush_if_exists|||
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
for (@{$hint->[1]}) {
$h->{$_} ||= ''; # suppress warning with older perls
$h->{$_} .= "$1\n";
}
}
else { undef $hint }
}
$hint = [$1, [split /,?\s+/, $2]]
if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
else {
if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
my @n = find_api($define->[1]);
push @{$depends{$define->[0]}}, @n if @n
}
undef $define;
}
}
$define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
if (/^}/) {
if (exists $API{$function->[0]}) {
my @n = find_api($function->[1]);
push @{$depends{$function->[0]}}, @n if @n
}
undef $function;
}
else {
$function->[1] .= $_;
}
}
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#ifndef PTR2NV
# define PTR2NV(p) NUM2PTR(NV,p)
#endif
#undef START_EXTERN_C
#undef END_EXTERN_C
#undef EXTERN_C
#ifdef __cplusplus
# define START_EXTERN_C extern "C" {
# define END_EXTERN_C }
# define EXTERN_C extern "C"
#else
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
# ifndef PERL_USE_GCC_BRACE_GROUPS
# define PERL_USE_GCC_BRACE_GROUPS
# endif
#endif
#undef STMT_START
#undef STMT_END
#ifdef PERL_USE_GCC_BRACE_GROUPS
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
# define STMT_END )
#else
# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#ifndef XSprePUSH
# define XSprePUSH (sp = PL_stack_base + ax - 1)
#endif
#if (PERL_BCDVERSION < 0x5005000)
# undef XSRETURN
# define XSRETURN(off) \
STMT_START { \
PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
return; \
} STMT_END
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
/* Hint: isPRINT
* The implementation in older perl versions includes all of the
* isSPACE() characters, which is wrong. The version provided by
* Devel::PPPort always overrides a present buggy version.
*/
# undef isPRINT
# endif
#ifdef HAS_QUAD
# ifdef U64TYPE
# define WIDEST_UTYPE U64TYPE
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
# define PL_stack_sp stack_sp
# define PL_statcache statcache
# define PL_stdingv stdingv
# define PL_sv_arenaroot sv_arenaroot
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
# define PL_tainted tainted
# define PL_tainting tainting
# define PL_tokenbuf tokenbuf
/* Replace: 0 */
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#endif
#ifndef G_METHOD
# 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
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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 vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
#define Perl_vload_module DPPP_(my_vload_module)
#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
#endif
#ifdef load_module
# undef load_module
#endif
#define load_module DPPP_(my_load_module)
#define Perl_load_module DPPP_(my_load_module)
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern SV * DPPP_(my_newRV_noinc)(SV *sv);
#endif
#ifdef newRV_noinc
# undef newRV_noinc
#endif
#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
#endif
#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
#endif
#ifdef newSV_type
# undef newSV_type
#endif
#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
#define Perl_newSV_type DPPP_(my_newSV_type)
#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
#endif
#ifdef sv_2pvbyte
# undef sv_2pvbyte
#endif
#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
/* Hint: sv_2pvbyte
* Use the SvPVbyte() macro instead of sv_2pvbyte().
*/
#undef SvPVbyte
#define SvPVbyte(sv, lp) \
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
/* Hint: sv_pvn_force
* Always use the SvPV_force() macro instead of sv_pvn_force().
*/
/* If these are undefined, they're not handled by the core anyway */
#ifndef SV_IMMEDIATE_UNREF
# define SV_IMMEDIATE_UNREF 0
#endif
#ifndef SV_GMAGIC
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
#endif
#ifdef vnewSVpvf
# undef vnewSVpvf
#endif
#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
#endif
#ifdef newSVpvn_share
# undef newSVpvn_share
#endif
#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
#endif
#ifdef sv_unmagicext
# undef sv_unmagicext
#endif
#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
#endif
#ifdef caller_cx
# undef caller_cx
#endif
#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
#define Perl_caller_cx DPPP_(my_caller_cx)
#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
#endif
#ifdef grok_numeric_radix
# undef grok_numeric_radix
#endif
#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
#endif
#ifdef grok_number
# undef grok_number
#endif
#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#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
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
#define Perl_pv_pretty DPPP_(my_pv_pretty)
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
lib/Acme/YAPC/Okinawa/ppport.h view on Meta::CPAN
#else
extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
#endif
#ifdef pv_display
# undef pv_display
#endif
#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
#define Perl_pv_display DPPP_(my_pv_display)
#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
Acme-constant
view release on metacpan or search on metacpan
lib/Acme/constant.pm view on Meta::CPAN
require Acme::constant;
Acme::constant->import(DEBUG => 1) if $ENV{DEBUG};
}
Howver, usually the good idea to declare constant anyway, as using
undefined constants in strict mode causes Perl errors (and sometimes
could be parsed incorrectly).
use Acme::constant DEBUG => $ENV{DEBUG};
Constants belong to the package they were defined in. When you declare
Acme-ful
view release on metacpan or search on metacpan
my $cursor;
my $FS = 'File::Spec';
our $crum = undef;
sub crum { $crum }
sub import {
my $me = shift;
Acme-require-case
view release on metacpan or search on metacpan
lib/Acme/require/case.pm view on Meta::CPAN
croak "$filename has incorrect case (maybe you want $actual instead?)";
}
# Loaded correctly or not?
if ($@) {
$INC{$filename} = undef;
croak $@;
}
elsif ( !$result ) {
delete $INC{$filename};
croak "$filename did not return a true value";
Acme-use-strict-with-pride
view release on metacpan or search on metacpan
package Bad;
BEGIN {$::loaded{+__PACKAGE__}++;}
my ($a);
# It's true, but it's undefined. And it's line 5
$a = 5 + $a;
Acpi
view release on metacpan or search on metacpan
return $self->getBatteryInfo("last full capacity");
}
sub getLastFullTotal{
my($self) = shift;
my($lastfulltotal) = undef;
my($i) = 0;
my($numbatt) = $self->nbBattery;
for($i=1;$i<=$numbatt;$i++){
$lastfulltotal += $rfield->getValueField("/proc/acpi/battery/BAT".$i."/info","last full capacity");
return $self->getBatteryState("remaining capacity");
}
sub getRemainingTotal{
my($self) = shift;
my($remainingtotal) = undef;
my($i) = 0;
my($numbatt) = $self->nbBattery;
for($i=1;$i<=$numbatt;$i++){
$remainingtotal += $rfield->getValueField("/proc/acpi/battery/BAT".$i."/state","remaining capacity");
return $self->getBatteryState("present rate");
}
sub getPresentRateTotal{
my($self) = shift;
my($presentratetotal) = undef;
my($i) = 0;
my($numbatt) = $self->nbBattery;
for($i=1;$i<=$numbatt;$i++){
$presentratetotal += $rfield->getValueField("/proc/acpi/battery/BAT".$i."/state","present rate");
return $self->getBatteryState("present voltage");
}
sub getPresentVoltageTotal{
my($self) = shift;
my($presentvoltagetotal) = undef;
my($i) = 0;
my($numbatt) = $self->nbBattery;
for($i=1;$i<=$numbatt;$i++){
$presentvoltagetotal += $rfield->getValueField("/proc/acpi/battery/BAT".$i."/state","present voltage");
Acrux-DBI
view release on metacpan or search on metacpan
lib/Acrux/DBI.pm view on Meta::CPAN
url => $url,
uri => $uri,
dsn => '',
cachekey=> '',
driver => '',
dbh => undef,
error => "", # Ok
autoclean => $autoclean ? 1 : 0,
opts => {%_opts},
cache => Mojo::Cache->new,
}, $class;
lib/Acrux/DBI.pm view on Meta::CPAN
if ($dbh) {
$self->{dbh} = $dbh;
printf STDERR "Connected to '%s'\n", $self->dsn if DEBUG;
} else {
$self->{error} = $DBI::errstr || "DBI->connect failed";
$self->{dbh} = undef;
}
return $self;
}
sub connect_cached {
my $self = shift;
lib/Acrux/DBI.pm view on Meta::CPAN
if ($dbh) {
$self->{dbh} = $dbh;
printf STDERR "Connected (cached) to '%s'\n", $self->dsn if DEBUG;
} else {
$self->{error} = $DBI::errstr || "DBI->connect failed";
$self->{dbh} = undef;
}
return $self;
}
sub disconnect {
my $self = shift;
lib/Acrux/DBI.pm view on Meta::CPAN
}
my $rv;
my $argb = '';
if (scalar @$bind_values) {
$argb = sprintf(" with bind values: %s",
join(", ", map {defined($_) ? sprintf("'%s\'", $_) : 'undef'} @$bind_values));
$rv = $sth->execute(@$bind_values);
} elsif (my $cb = $args->{bind_callback} || $args->{bind_cb}) {
unless (is_code_ref($cb)) {
$self->error("Invalid binding callback function. Code ref expected");
lib/Acrux/DBI.pm view on Meta::CPAN
return Acrux::DBI::Dump->new(dbi => $self, @_)
}
sub cleanup {
my $self = shift;
undef $self->{dbh};
return $self;
}
sub DESTROY {
my $self = shift;
printf STDERR "DESTROY on phase %s\n", ${^GLOBAL_PHASE} if DEBUG;
Acrux
view release on metacpan or search on metacpan
lib/Acme/Crux.pm view on Meta::CPAN
=head2 lookup_handler
my $handler = $app->lookup_handler($name)
or die "Handler not found";
Lookup handler by name or aliase. Returns handler or undef while error
=head2 option, opt, getopt
my $value = $app->option("key");
lib/Acme/Crux.pm view on Meta::CPAN
$app->plugin(foo => 'MyApp::Plugin::Foo');
$app->plugin(foo);
$app->plugin(foo => 'MyApp::Plugin::Foo', {bar => 123, baz => 'test'});
$app->plugin(foo => 'MyApp::Plugin::Foo', bar => 123, baz => 'test');
$app->plugin(foo, undef, {bar => 123, baz => 'test'});
Load a plugin by name or pair - name and class
=head2 pwd
lib/Acme/Crux.pm view on Meta::CPAN
return $self->{hitime}
}
sub elapsed {
my $self = shift;
my $timing_begin = shift;
return undef unless my $started = $timing_begin || $self->{hitime};
return tv_interval($started, [gettimeofday]);
}
sub exedir { shift->{exedir} }
sub orig { shift->{orig} }
sub option {
my $self = shift;
my $key = shift;
my $opts = $self->{options};
return undef unless $opts;
return $opts unless defined $key;
return $opts->{$key};
}
sub opt { goto &option }
sub getopt { goto &option }
lib/Acme/Crux.pm view on Meta::CPAN
return 1;
}
sub lookup_handler {
my $self = shift;
my $name = trim(shift // '');
return undef unless length $name;
my $invocant = ref($self) || scalar(caller(0));
my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
return undef unless defined($handlers) && is_hash_ref($handlers);
foreach my $n (keys %$handlers) {
my $aliases = as_array_ref($handlers->{$n}->{aliases});
return $handlers->{$n} if grep {defined && $_ eq $name} ($n, @$aliases);
}
return undef;
}
sub handlers {
my $self = shift;
my $all = shift // 0; # returns aliases too
my $invocant = ref($self) || scalar(caller(0));
lib/Acme/Crux.pm view on Meta::CPAN
return [(sort {$a cmp $b} keys %seen)];
}
sub has_handler {
my $self = shift;
my $name = trim(shift // '');
return undef unless length $name;
return !!grep { $_ eq $name } @{ $self->handlers(1) };
}
sub run_handler {
my $self = shift;
my $name = shift // 'default';
Action-CircuitBreaker
view release on metacpan or search on metacpan
lib/Action/CircuitBreaker.pm view on Meta::CPAN
# the current number of retries
has _current_retries_number => (
is => 'rw',
lazy => 1,
default => sub { 0 },
init_arg => undef,
clearer => 1,
);
has open_time => (
lib/Action/CircuitBreaker.pm view on Meta::CPAN
# Timestamp at which the circuit is available again
has _circuit_open_until => (
is => 'rw',
default => sub { 0 },
init_arg => undef,
);
sub run {
my ($self, $attempt_code) = @_;
lib/Action/CircuitBreaker.pm view on Meta::CPAN
=over
=item *
as first argument, a scalar which is the value of any exception that were
raised by the C<$attempt_code>. Otherwise, undef.
=item *
as second argument, a HashRef, which contains these keys:
Action-Retry
view release on metacpan or search on metacpan
lib/Action/Retry.pm view on Meta::CPAN
# For non blocking mode, store the timestamp after which we can retry
has _needs_sleeping_until => (
is => 'rw',
default => sub { 0 },
init_arg => undef,
);
sub run {
my $self = shift;
lib/Action/Retry.pm view on Meta::CPAN
=over
=item *
as first argument, a scalar which is the value of any exception that were
raised by the C<attempt_code>. Otherwise, undef.
=item *
as second argument, a HashRef, which contains these keys:
ActionExporter
view release on metacpan or search on metacpan
ActionExporter.pm view on Meta::CPAN
# variables changed in the caller by export_action
# our @EXPORT_OK;
# our %EXPORT_TAGS;
sub export_action{
my ($caller,undef,undef)=caller;
my $action = shift;
my ($ex_tags,$ex_ok);
{
no strict;
$ex_tags = \%{"${caller}::EXPORT_TAGS"};
Activator
view release on metacpan or search on metacpan
bin/activator.pl view on Meta::CPAN
# $config, $args, $project, $action and the current apache pid are globally interesting
my ( $config, $args, $project, $action, $httpd_pid );
try eval {
# Act::Config requires that project be set via an option or be the
# last arg, hence the flag after undef below
$config = Activator::Config->get_config( \@ARGV, undef, 1 );
};
if ( catch my $e ) {
die( "Error while processing command line options: $e" );
}
ActiveRecord-Simple
view release on metacpan or search on metacpan
lib/ActiveRecord/Simple.pm view on Meta::CPAN
# 0. check the name
my $table_info_sth = $class->dbh->table_info('', '%', $table_name, 'TABLE');
$table_info_sth->fetchrow_hashref or croak "Can't find table '$table_name' in the database";
# 1. columns list
my $column_info_sth = $class->dbh->column_info(undef, undef, $table_name, undef);
my $cols = $column_info_sth->fetchall_arrayref({});
my @columns = ();
push @columns, $_->{COLUMN_NAME} for @$cols;
# 2. Primary key
my $primary_key_sth = $class->dbh->primary_key_info(undef, undef, $table_name);
my $primary_key_data = $primary_key_sth->fetchrow_hashref;
my $primary_key = ($primary_key_data) ? $primary_key_data->{COLUMN_NAME} : undef;
$class->table_name($table_name) if $table_name;
$class->primary_key($primary_key) if $primary_key;
$class->columns(@columns) if @columns;
}
lib/ActiveRecord/Simple.pm view on Meta::CPAN
if exists $self->{read_only} && $self->{read_only} == 1;
my $save_param = {};
my $fields = $self->_get_columns;
my $pkey = ($self->can('_get_primary_key')) ? $self->_get_primary_key : undef;
FIELD:
for my $field (@$fields) {
next FIELD if defined $pkey && $field eq $pkey && !$self->{$pkey};
next FIELD if ref $field && ref $field eq 'HASH';
lib/ActiveRecord/Simple.pm view on Meta::CPAN
$result = $self->_insert($save_param);
}
$self->{need_to_save} = 0 if $result;
delete $self->{SQL} if $result;
return (defined $result) ? $self : undef;
}
sub update {
my ($self, $params) = @_;
lib/ActiveRecord/Simple.pm view on Meta::CPAN
my $sql = qq{
DELETE FROM "$table_name" WHERE $pkey = ?
};
$sql .= ' CASCADE ' if $param && $param->{cascade};
my $res = undef;
$sql = ActiveRecord::Simple::Utils::quote_sql_stmt($sql, $self->dbh->{Driver}{Name});
if ( $self->dbh->do($sql, undef, $self->{$pkey}) ) {
$self->{isin_database} = undef;
delete $self->{$pkey};
$res = 1;
}
lib/ActiveRecord/Simple.pm view on Meta::CPAN
#load $related_class unless is_loaded $related_class;
#mark_as_loaded $related_class;
load_module $related_class;
my $rel_type = undef;
while (my ($rel_key, $rel_opts) = each %{ $related_class->_get_relations }) {
next if $class ne _get_related_class($rel_opts);
$rel_type = $rel_opts->{type};
}
lib/ActiveRecord/Simple.pm view on Meta::CPAN
}
sub _get_related_subclass {
my ($relation) = @_;
return undef if !ref $relation->{class};
my $subclass;
if (ref $relation->{class} eq 'HASH') {
$subclass = (keys %{ $relation->{class} })[0];
}
lib/ActiveRecord/Simple.pm view on Meta::CPAN
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my @field_names = grep { defined $param->{$_} } sort keys %$param;
my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
my $field_names_str = join q/, /, map { q/"/ . $_ . q/"/ } @field_names;
my (@bind, @values_list);
for (@field_names) {
lib/ActiveRecord/Simple.pm view on Meta::CPAN
if ( $self->dbh->{Driver}{Name} eq 'Pg' ) {
if ($primary_key) {
$sql_stm .= ' RETURINIG ' . $primary_key if $primary_key;
$sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name});
$pkey_val = $self->dbh->selectrow_array($sql_stm, undef, @bind);
}
else {
my $sth = $self->dbh->prepare(
ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
);
lib/ActiveRecord/Simple.pm view on Meta::CPAN
}
else {
$pkey_val =
exists $sth->{mysql_insertid} # mysql only
? $sth->{mysql_insertid}
: $self->dbh->last_insert_id(undef, undef, $table_name, undef);
}
}
if (defined $primary_key && $self->can($primary_key) && $pkey_val) {
#$self->$primary_key($pkey_val);
lib/ActiveRecord/Simple.pm view on Meta::CPAN
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my @field_names = sort keys %$param;
my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
my (@set_list, @bind);
for (@field_names) {
if (ref $param->{$_} eq 'SCALAR') {
push @set_list, $_ . ' = ' . ${ $param->{$_} };
lib/ActiveRecord/Simple.pm view on Meta::CPAN
$primary_key = ?
},
$self->dbh->{Driver}{Name}
);
return $self->dbh->do($sql_stm, undef, @bind);
}
sub _mk_rw_accessors {
my ($class, $fields) = @_;
lib/ActiveRecord/Simple.pm view on Meta::CPAN
my $table_name = _what_is_the_table_name($class);
$table_name =~ s/s$// if $what_key eq 'foreign_key';
return ($what_key eq 'foreign_key') ? "$table_name\_id" : undef;
}
sub _delete_keys {
my ($self, $rx) = @_;
lib/ActiveRecord/Simple.pm view on Meta::CPAN
my $relation = $relations->{$relation_name};
my $full_relation_type = _get_relation_type($class, $relation);
my $related_class = _get_related_class($relation);
### TODO: check for error if returns undef
my $pk = $relation->{params}{pk};
my $fk = $relation->{params}{fk};
my $instance_name = "relation_instance_$relation_name";
lib/ActiveRecord/Simple.pm view on Meta::CPAN
my $pk2_name = $object->_get_primary_key;
my $pk2 = $object->{$pk2_name};
my $sql = qq/INSERT INTO "$via_table" ("$fk1", "$fk2") VALUES (?, ?)/;
$self->dbh->do($sql, undef, $pk1, $pk2);
}
}
return $self;
}
ActiveResource
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '0.91';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2009 Adam Kennedy.
Adam
view release on metacpan or search on metacpan
ex/ai-bot.pl view on Meta::CPAN
sub store_conversation {
my ($self, %a) = @_;
$self->_dbh->do(
'INSERT INTO conversations (nick, message, response, channel) VALUES (?,?,?,?)',
undef, @a{qw(nick message response channel)},
);
}
sub recall {
my ($self, $query, $limit) = @_;
ex/ai-bot.pl view on Meta::CPAN
return join("\n---\n", map { "<$_->{nick}> $_->{message}\n$_->{response}" } @$rows);
}
sub save_note {
my ($self, $nick, $content) = @_;
$self->_dbh->do('INSERT INTO notes (nick, content) VALUES (?,?)', undef, $nick, $content);
}
sub recall_notes {
my ($self, $nick, $query, $limit) = @_;
$limit //= 10;
ex/ai-bot.pl view on Meta::CPAN
return join("\n", map { "#$_->{id} [$_->{nick}] $_->{content}" } @$rows);
}
sub update_note {
my ($self, $id, $content) = @_;
my $rows = $self->_dbh->do('UPDATE notes SET content = ? WHERE id = ?', undef, $content, $id);
return $rows > 0;
}
sub delete_note {
my ($self, $id) = @_;
my $rows = $self->_dbh->do('DELETE FROM notes WHERE id = ?', undef, $id);
return $rows > 0;
}
__PACKAGE__->meta->make_immutable;
}
ex/ai-bot.pl view on Meta::CPAN
is => 'rw', traits => ['NoGetopt'],
default => 0,
);
has _pending_raid => (
is => 'rw', traits => ['NoGetopt'],
default => sub { undef },
);
has _rate_limit_wait => (
is => 'rw', traits => ['NoGetopt'],
default => 0,
);
ex/ai-bot.pl view on Meta::CPAN
return;
}
# Reset rate limit state
$self->_rate_limit_wait(0);
$self->_pending_raid(undef);
if ($@) {
$self->error("Raider error: $@");
# Show error only in main channel
$self->_send_to_channel($self->_default_channel,
Adapter-Async
view release on metacpan or search on metacpan
lib/Adapter/Async/OrderedList.pm view on Meta::CPAN
$self->splice($count, 0, $data)->transform(
done => sub {
($count, @_)
}
);
})->on_ready(sub { undef $f });
$f
}
=head2 unshift
lib/Adapter/Async/OrderedList.pm view on Meta::CPAN
sub pop {
my ($self, $data) = @_;
my $f;
$f = $self->count->then(sub {
$self->splice(shift() - 1, 1)
})->on_ready(sub { undef $f });
$f
}
=head2 shift
lib/Adapter/Async/OrderedList.pm view on Meta::CPAN
return Future->wrap([]) unless $count;
$self->get(
%args,
items => [0..$count-1],
)
})->on_ready(sub { undef $f });
$f
}
1;
Address-PostCode-Australia
view release on metacpan or search on metacpan
lib/Address/PostCode/Australia/Params.pm view on Meta::CPAN
unless (exists $FIELDS->{$field});
die "ERROR: Missing mandatory param: $field"
if ($fields->{$field} && !exists $values->{$field});
die "ERROR: Received undefined mandatory param: $field"
if ($fields->{$field} && !defined $values->{$field});
$FIELDS->{$field}->{check}->($values->{$field})
if defined $values->{$field};
}
AddressBook
view release on metacpan or search on metacpan
examples/SyncAbook.pm view on Meta::CPAN
dlp=>$pilot_sock,
);
PilotMgr::status("Starting Synchronization",10);
AddressBook::sync(master=>$self->{ldap},slave=>$self->{pilot},msg_function=>\&PilotMgr::msg);
PilotMgr::status("Synchronization Complete",100);
$self->{ldap} = undef;
$self->{pilot} = undef;
return;
}
sub conduitQuit {
return;
Ado
view release on metacpan or search on metacpan
lib/Ado/Control.pm view on Meta::CPAN
my ($c, $template) = @_;
my $v = $c->validation;
my $errors = {};
foreach my $param (keys %$template) {
my $checks = $template->{$param};
$checks || next; #false or undefined?!?
#field
my $f =
$checks->{required}
? $v->required($param)
Advanced-Config
view release on metacpan or search on metacpan
=over
=item $cfg = Advanced::Config->new( [$filename[, \%read_opts[, \%get_opts[, \%date_var_opts]]]] );
It takes four arguments, any of which can be omitted or B<undef> during object
creation!
F<$filename> is the optional name of the config file to read in. It can be a
relative path. The absolute path to it will be calculated for you if a relative
path was given.
F<\%read_opts> is an optional hash reference that controls the default parsing
of the config file as it's being read into memory. Feel free to leave as
B<undef> if you're satisfied with this module's default behavior.
F<\%get_opts> is an optional hash reference that defines the default behavior
when this module looks something up in the config file. Feel free to leave as
B<undef> if you're satisfied with this module's default behavior.
F<\%date_var_opts> is an optional hash reference that defines the default
formatting of the special predefined date variables. Feel free to leave as
B<undef> if you're satisfied with the default formatting rules.
See the POD under L<Advanced::Config::Options> for more details on what options
these three hash references support! Look under the S<I<The Read Options>>,
S<I<The Get Options>>, and S<I<The Special Date Variable Formatting Options>>
sections of the POD.
$control{read_opts} = get_read_opts ( $read_opts );
$control{get_opts} = get_get_opts ( $get_opts );
$control{date_opts} = get_date_opts ( $date_opts );
$control{read_only} = 0; # not created via newDefineConfigRules().
$control{ConfigRuleObj} = undef; # not set by set_config_rules ().
my ( %dates, %empty, %mods, %ropts, %rec, @lst );
# Special Date Variables ...
set_special_date_vars ($control{date_opts}, \%dates);
# Validate that it built ok.
foreach my $s ( $cfg->find_sections () ) {
my $sect = $cfg->get_section ($s, 1);
my $name = $sect->section_name ();
my @tags = $sect->find_tags ( undef, 0 ); # Search current section only.
foreach my $t ( @tags ) {
my $cnt = (exists $rOpts->{$t} ? 1 : 0) +
(exists $gOpts->{$t} ? 1 : 0) +
(exists $sOpts->{$t} ? 1 : 0);
$cnt = 1 if ( $cnt == 0 && $name eq DEFAULT_SECTION && $extra{$t} );
On success, it returns a reference to itself so that it can be initialized
separately or as a single unit.
Ex: $cfg = Advanced::Config->new(...)->load_config (...);
On failure it returns I<undef> or calls B<die> if option I<croak> is set!
WARNING: If basename(I<$filename>) is a symbolic link and your config file
contains encrypted data, please review the encryption options about special
considerations.
}
$read_opts = get_read_opts ( $read_opts, $self->{CONTROL}->{read_opts} );
unless ( $filename ) {
my $msg = "You must provide a file name to load!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
unless ( -f $filename ) {
my $msg = "No such file or it's unreadable! -- $filename";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_PRINT ("READ", "Reading a config file into memory ... %s", $filename);
unless ( -f $filename && -r _ ) {
my $msg = "Your config file name doesn't exist or isn't readable.";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# Behaves diferently based on who calls us ...
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_config";
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $msg = "Reading the config file had serious issues!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_RETURN ( $self );
}
$read_opts = {@_} if ( ref ($read_opts) ne "HASH" );
$read_opts = get_read_opts ( $read_opts, $self->{CONTROL}->{read_opts} );
unless ( $string ) {
my $msg = "You must provide a string to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# The filename is a reference to the string passed to this method!
my $filename = \$string;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $msg = "Reading the config file had serious issues!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_RETURN ( $self );
}
# Private method ...
# Gets the requested tag from the current section.
# And then apply the required rules against the returned value.
# The {required} option isn't reliable until in this method!
# Returns: The tag hash ... (undef if it doesn't exist)
sub _base_get
{
my $self = shift;
my $tag = shift;
my $opts = shift;
# Check if we're overriding the required flag ...
my $req = $get_opts->{required};
local $get_opts->{required} = $disable_req ? 0 : $req;
# Returns a hash reference to a local copy of the tag's data ... (or undef)
# Handles the inherit option if used.
my $data_ref =apply_get_rules ( $tag, $self->{SECTION_NAME},
$self->{DATA}->{$t}, $pcfg->{DATA}->{$t},
$pcfg->{CONTROL}->{ALLOW_UTF8},
$get_opts );
my ($data, $req) = $self->_base_get ( $tag, $opts, 0 );
if ( defined $data ) {
return ( $data->{VALUE}, $data->{MASK_IN_FISH}, $data->{FILE}, $data->{ENCRYPTED}, $data->{VARIABLE}, $req );
} else {
return ( undef, 0, "", 0, 0, $req ); # No such tag ...
}
}
# Private method ...
my $hyd_flg = shift; # Is it OK to return a HYD as HYD?
my $cvt_hyd_flg = shift; # Is it OK to convert a HYD into a date str?
if ($hyd_flg && $cvt_hyd_flg) {
local $opts->{required} = 1;
croak_helper ($opts, "Programming error! Can't set both hyd flags to true.", undef);
}
my ($data, $req);
{
local $opts->{date_active} = 0;
} elsif ( $cvt_hyd_flg && $tag =~ m/^[-]?\d+$/ ) {
my $dt = convert_hyd_to_date_str ($tag);
return ( $dt, 0, "", 0, 0, $req ); # We have a valid date string!
} else {
local $opts->{required} = $req;
croak_helper ($opts, "No such tag ($tag), nor is it a date string.", undef);
return ( undef, 0, "", 0, 0, $req ); # No such tag/date ...
}
}
# The tag exists, then it must reference a date!
local $opts->{date_active} = 1;
($data, $req) = $self->_base_get ( $tag, $opts, 0 );
if ( defined $data ) {
return ( $data->{VALUE}, $data->{MASK_IN_FISH}, $data->{FILE}, $data->{ENCRYPTED}, $data->{VARIABLE}, $req );
} else {
return ( undef, 0, "", 0, 0, $req ); # Not a date ...
}
}
#######################################
They all look in the current section for the B<tag> and if the B<tag> couldn't
be found in this section and the I<inherit> option was also set, it will then
look in the parent/main section for the B<tag>. But if the I<inherit> option
wasn't set it wouldn't look there.
If the requested B<tag> couldn't be found, they return B<undef>. But if the
I<required> option was used, it may call B<die> instead!
But normally they just return the requested B<tag>'s value.
They all use F<%override_get_opts>, passed by value or by reference, as an
}
#######################################
# A helper function to handle the various ways to find a hash as an argument!
# Handles all 3 cases.
# undef - No arguments
# hash ref - passed by reference
# something else - passed by value. (array)
sub _get_opt_args
{
my $self = shift; # Reference to the current section.
my $opt_ref = $_[0]; # May be undef, a hash ref, or start of a hash ...
# Convert the parameter array into a regular old hash reference ...
my %opts;
unless ( defined $opt_ref ) {
$opt_ref = \%opts;
# Another helper function to help with evaluating which value to use ...
# Does a 4 step check.
# 1) Use the $value if provided.
# 2) If the key exists in the hash returned by _get_opt_args(), use it.
# 3) Look it up in the default "Get Options" set via call to new().
# 4) undef if all the above fail.
sub _evaluate_hash_values
{
my $self = shift; # References the current section.
my $key = shift; # The hash key to look up ...
This function looks up the requested B<tag>'s value and returns it if its an
integer. If the B<tag>'s value is a floating point number (ex 3.6), then the
value is either truncated or rounded up based on the setting of the I<rt_flag>.
If I<rt_flag> is set, it will perform truncation, so 3.6 becomes B<3>. If the
flag is B<undef> or zero, it does rounding, so 3.6 becomes B<4>. Meaning the
default is rounding.
Otherwise if the B<tag> doesn't exist or its value is not numeric it will
return B<undef> unless it's been marked as I<required>. In that case B<die>
may be called instead.
=cut
sub get_integer
=item $value = $cfg->get_numeric ( $tag[, %override_get_opts] );
This function looks up the requested B<tag>'s value and returns it if its
value is numeric. Which means any valid integer or floating point number!
If the B<tag> doesn't exist or its value is not numeric it will return B<undef>
unless it's been marked as I<required>. In that case B<die> may be called
instead.
=cut
#######################################
=item $value = $cfg->get_boolean ( $tag[, %override_get_opts] );
Treats the B<tag>'s value as a boolean value and returns I<undef>,
B<0> or B<1>.
Sometimes you just want to allow for basically a true/false answer
without having to force a particular usage in the config file.
This function converts the B<tag>'s value accordingly.
This function looks up the requested B<tag>'s value and returns it if its
value contains a valid date. The returned value will always be in I<YYYY-MM-DD>
format no matter what format or language was actually used in the config file
for the date.
If the B<tag> doesn't exist or its value is not a date it will return B<undef>
unless it's been marked as I<required>. In that case B<die> may be called
instead.
If I<$language> is undefined, it will use the default language defined in the
call to I<new> for parsing the date. (B<English> if not overridden.) Otherwise
it must be a valid language defined by B<Date::Language>. If it's a wrong or
bad language, your date might not be recognized as valid.
Unlike most other B<get> options, when parsing the B<tag>'s value, it's not
my ( $value, $sensitive, $required ) = ($self->_base_get3_date_str ( $tag, $opt_ref, 0, 0 ))[0,1,5];
if ( $sensitive ) {
DBUG_MASK (0);
DBUG_MASK_NEXT_FUNC_CALL (-1);
}
return DBUG_RETURN (undef) unless (defined $value);
$value = calc_hundred_year_date ( $value );
DBUG_RETURN ( $value );
}
my ( $value, $sensitive, $required ) = ($self->_base_get3_date_str ( $tag, $opt_ref, 1, 0 ))[0,1,5];
if ( $sensitive ) {
DBUG_MASK (0);
DBUG_MASK_NEXT_FUNC_CALL (-1);
}
return DBUG_RETURN (undef) unless (defined $value);
$value = calc_day_of_week ( $value ); # 0 .. 6
if ($mode =~ m/^[12]$/) {
DBUG_MASK_NEXT_FUNC_CALL (-1) if ( $sensitive );
my ( $value, $sensitive, $required ) = ($self->_base_get3_date_str ( $tag, $opt_ref, 0, 0 ))[0,1,5];
if ( $sensitive ) {
DBUG_MASK (0);
DBUG_MASK_NEXT_FUNC_CALL (-1);
}
return DBUG_RETURN (undef) unless (defined $value);
$value = calc_day_of_year ( $value );
DBUG_RETURN ( $value );
}
my ( $value, $sensitive, $required ) = ($self->_base_get3_date_str ( $tag, $opt_ref, 0, 1 ))[0,1,5];
if ( $sensitive ) {
DBUG_MASK (0);
DBUG_MASK_NEXT_FUNC_CALL (-1);
}
return DBUG_RETURN (undef) unless (defined $value);
$value = adjust_date_str ( $value, $adjYrs, $adjMons );
unless (defined $value) {
local $opt_ref->{required} = $required;
croak_helper ($opt_ref, "usage errror", undef);
}
DBUG_RETURN ( $value );
}
#######################################
=item $value = $cfg->get_filename ( $tag[, $access[, %override_get_opts]] );
Treats the B<tag>'s value as a filename. If the referenced file doesn't exist
it returns I<undef> instead, as if the B<tag> didn't exist.
B<access> defines the minimum access required. If that minimum access isn't
met it returns I<undef> instead, as if the B<tag> didn't exist. B<access>
may be I<undef> to just check for existence.
The B<access> levels are B<r> for read, B<w> for write and B<x> for execute.
You may also combine them if you wish in any order.
Ex: B<rw>, B<xwr>, B<rx> ...
sub get_filename
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $access = shift; # undef or contains "r", "w" and/or "x" ...
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Verify that the tag's value points to an existing filename ...
local $opt_ref->{filename} = 1; # Existance ...
if ( defined $access ) {
#######################################
=item $value = $cfg->get_directory ( $tag[, $access[, %override_get_opts]] );
Treats the B<tag>'s value as a directory. If the referenced directory doesn't
exist it returns I<undef> instead, as if the B<tag> didn't exist.
B<access> defines the minimum access required. If that minimum access isn't met
it returns I<undef> instead, as if the B<tag> didn't exist. B<access> may be
I<undef> to just check for existence.
The B<access> levels are B<r> for read and B<w> for write. You may also combine
them if you wish in any order. Ex: B<rw> or B<wr>.
sub get_directory
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $access = shift; # undef or contains "r" and/or "w" ...
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Verify that the tag's value points to an existing directory ...
# Execute permission is always required to reference a directory's contents.
local $opt_ref->{directory} = 1; # Existance ...
These methods allow you to access the data loaded into each B<tag> in list mode.
Splitting the B<tag>'s data up into arrays and hashes. Otherwise these
functions behave similarly to the one's above.
Each function asks for a I<pattern> used to split the B<tag>'s value into an
array of values. If the pattern is B<undef> it will use the default
I<split_pattern> specified during he call to F<new()>. Otherwise it can be
either a string or a RegEx. See Perl's I<split> function for more details.
After the value has been split, it will perform any requested validation and
most functions will return B<undef> if even one element in the list fails it's
edits. It was added as its own argument, instead of just relying on the
override option hash, since this option is probably the one that gets overridden
most often.
They also support the same I<inherit> and I<required> options described for the
$self->_evaluate_hash_values ("sort", $opt_ref, $sort);
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
local $opt_ref->{sort} =
$self->_evaluate_hash_values ("sort", $opt_ref, $sort);
my $value = $self->get_integer ( $tag, $rt_flag, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
local $opt_ref->{sort} =
$self->_evaluate_hash_values ("sort", $opt_ref, $sort);
my $value = $self->get_numeric ( $tag, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
local $opt_ref->{split_pattern} =
$self->_evaluate_hash_values ("split_pattern", $opt_ref, $split_ptrn);
my $value = $self->get_boolean ( $tag, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
local $opt_ref->{split_pattern} = $split_ptrn;
my $value = $self->get_date ( $tag, $language, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
sub get_list_filename
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $access = shift; # undef or contains "r", "w" and/or "x" ...
my $split_ptrn = shift; # The split pattern to use to call to split().
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Tells us to split the tag's value up into an array ...
local $opt_ref->{split} = 1;
local $opt_ref->{split_pattern} =
$self->_evaluate_hash_values ("split_pattern", $opt_ref, $split_ptrn);
my $value = $self->get_filename ( $tag, $access, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
sub get_list_directory
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $access = shift; # undef or contains "r", "w" and/or "x" ...
my $split_ptrn = shift; # The split pattern to use to call to split().
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Tells us to split the tag's value up into an array ...
local $opt_ref->{split} = 1;
local $opt_ref->{split_pattern} =
$self->_evaluate_hash_values ("split_pattern", $opt_ref, $split_ptrn);
my $value = $self->get_directory ( $tag, $access, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
# Private method ...
unless ( $hide ) {
$hide = 1 if ( should_we_hide_sensitive_data ($tag, 1) );
}
}
# The value must never be undefined!
$self->{DATA}->{$tag}->{VALUE} = (defined $value) ? $value : "";
# What file the tag was found in ...
$self->{DATA}->{$tag}->{FILE} = $file;
if ( $self->_chk_if_read_only () ) {
die ("You may not modify a rules config file!\n");
return (0);
}
my ( $worked, $sensitive ) = $self->_base_set ($tag, $value, undef);
DBUG_MASK_NEXT_FUNC_CALL (2) if ( $sensitive );
DBUG_ENTER_FUNC ( $self, $tag, $value, @_ );
unless ( $worked ) {
=over
=item $section = $cfg->get_section ( [$section_name[, $required]] );
Returns the I<Advanced::Config> object for the requested section in your config
file. If the I<$section_name> doesn't exist, it will return I<undef>. If
I<$required> is set, it will call B<die> instead.
If no I<$section_name> was provided, it returns the default I<main> section.
=cut
if ( $required ) {
die ("Section \"$section\" doesn't exist in this ", __PACKAGE__,
" class!\n");
}
DBUG_RETURN (undef);
}
#######################################
=item $name = $cfg->section_name ( );
=item $scfg = $cfg->create_section ( $name );
Creates a new section called I<$name> within the current Advanced::Config object
I<$cfg>. It returns the I<Advanced::Config> object that it created. If a
section of that same name already exists it will return B<undef>.
There is no such thing as sub-sections, so if I<$cfg> is already points to a
section, then it looks up the parent object and associates the new section with
the parent object instead.
}
# This test bypasses all the die logic in the special case constructor!
# That constructor is no longer exposed in the POD.
if ( $self->get_section ( $name ) ) {
return DBUG_RETURN (undef); # Name is already in use ...
}
DBUG_RETURN ( $self->new_section ( $self, $name ) );
}
=item @list = $cfg->find_tags ( $pattern[, $override_inherit] );
It returns a list of all tags whose name contains the passed pattern.
If the pattern is B<undef> or the empty string, it will return all tags in
the current section. Otherwise it does a case insensitive comparison of the
pattern against each tag to see if it should be returned or not.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section.
The returned list of tags will be sorted in alphabetical order.
sub find_tags
{
DBUG_ENTER_FUNC (@_);
my $self = shift;
my $pattern = shift;
my $inherit = shift; # undef, 0, or 1.
my @lst; # The list of tags found ...
my $pcfg = $self->{PARENT} || $self;
=item @list = $cfg->find_values ( $pattern[, $override_inherit] );
It returns a list of all tags whose values contains the passed pattern.
If the pattern is B<undef> or the empty string, it will return all tags in
the current section. Otherwise it does a case insensitive comparison of the
pattern against each tag's value to see if it should be returned or not.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section.
The returned list of tags will be sorted in alphabetical order.
=item @list = $cfg->find_sections ( $pattern );
It returns a list of all section names which match this pattern.
If the pattern is B<undef> or the empty string, it will return all the section
names. Otherwise it does a case insensitive comparison of the pattern against
each section name to see if it should be returned or not.
The returned list of section names will be sorted in alphabetical order.
2) The config file marked the tag in its comment to HIDE it.
3) The config file marked it as being encrypted.
4) It referenced a variable that was marked as sensitive.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section for the tag.
=cut
sub chk_if_sensitive
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $inherit = shift; # undef, 0, or 1.
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
local $pcfg->{CONTROL}->{get_opts}->{inherit} = $inherit;
This module always automatically decrypts everything unless the "Read" option
B<disable_decryption> was used. In that case this method was added to detect
which tags still needed their values decrypted before they were used.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section for the tag.
=cut
sub chk_if_still_encrypted
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $inherit = shift; # undef, 0, or 1.
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
local $pcfg->{CONTROL}->{get_opts}->{inherit} = $inherit;
is when you used the B<disable_variables> option. The second case is if you
used the B<disable_decryption> option and you had a variable that referenced
a tag that is still encrypted. But use of those two options should be rare.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section for the tag.
=cut
sub chk_if_still_uses_variables
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $inherit = shift; # undef, 0, or 1.
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
local $pcfg->{CONTROL}->{get_opts}->{inherit} = $inherit;
$line = format_section_line ($name, $rOpts);
$string .= "\n${line}\n";
++$cnt if ( should_we_hide_sensitive_data ( $name, 1 ) );
foreach my $tag ( $cfg->find_tags (undef, 0) ) {
++$cnt if ( $cfg->chk_if_sensitive ($tag, 0) );
$line = format_tag_value_line ($cfg, $tag, $rOpts);
$string .= " " . ${line} . ${cmt} . "\n";
}
my %section_data;
my $cfg = $self->get_section ($sect, 1);
my $cnt = 0;
foreach my $tag ( $cfg->find_tags (undef, 0) ) {
my ($val, $hide) = $cfg->_base_get2 ($tag);
next if ( $sensitive && $hide );
$section_data{$tag} = $val;
++$cnt;
}
} else {
$rOpts = $pcfg->{CONTROL}->{read_opts};
}
if ( $msg ) {
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, undef ) );
}
my $status = decrypt_config_file_details ($file, $scratch, $rOpts);
# Some type of error ... or nothing was decrypted ...
with the encryption. And since it's required its passed as a separate argument
instead of being buried in the optional I<%rOpts> hash.
It takes the I<$string> and encrypts all tag/value pairs per the rules defined
by C<encrypt_config_file>. Once the contents of I$<string> has been encrypted,
the encrypted string is returned as I<$out_str>. It will return B<undef> on
failure.
You can tell if something was encrypted by comparing I<$string> to I<$out_str>.
=cut
my $alias = shift; # The alias to use during encryption ...
my $read_opts = $self->_get_opt_args ( @_ ); # The override options ...
unless ( $string ) {
my $msg = "You must provide a string to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
unless ( $alias ) {
my $msg = "You must provide an alias to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# The filename is a reference to the string passed to this method!
my $scratch;
my $src_file = \$string;
my $pcfg = $self->{PARENT} || $self;
my $rOpts = get_read_opts ($read_opts, $pcfg->{CONTROL}->{read_opts});
my $status = encrypt_config_file_details ($src_file, $dst_file, $rOpts);
$scratch = undef if ( $status == 0 );
DBUG_RETURN ( $scratch );
}
with the decryption. And since it's required its passed as a separate argument
instead of being buried in the optional I<%rOpts> hash.
It takes the I<$string> and decrypts all tag/value pairs per the rules defined
by C<decrypt_config_file>. Once the contents of I$<string> has been decrypted,
the decrypted string is returned as I<$out_str>. It will return B<undef> on
failure.
You can tell if something was decrypted by comparing I<$string> to I<$out_str>.
=cut
my $alias = shift; # The alias to use during encryption ...
my $read_opts = $self->_get_opt_args ( @_ ); # The override options ...
unless ( $string ) {
my $msg = "You must provide a string to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
unless ( $alias ) {
my $msg = "You must provide an alias to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# The filename is a reference to the string passed to this method!
my $scratch;
my $src_file = \$string;
my $pcfg = $self->{PARENT} || $self;
my $rOpts = get_read_opts ($read_opts, $pcfg->{CONTROL}->{read_opts});
my $status = decrypt_config_file_details ($src_file, $dst_file, $rOpts);
$scratch = undef if ( $status == 0 );
DBUG_RETURN ( $scratch );
}
=item ($value, $status) = $cfg->lookup_one_variable ( $variable_name );
This method takes the given I<$variable_name> and returns its value.
It returns I<undef> if the given variable doesn't exist. And the optional 2nd
return value tells us about the B<status> of the 1st return value.
If the B<status> is B<-1>, the returned value is still encrypted. If set to
B<1>, the value is considered sensitive. In all other cases this B<status> flag
is set to B<0>.
3. Special Case, see note below about periods in the variable name.
4. If not defined there, look for a value in the %ENV hash.
5. If not defined there, does it represent a special Perl variable?
6. If not defined there, is it a predefined Advanced::Config variable?
7. If not defined there, is it some predefined special date variable?
8. If not defined there, the result is undef.
If a variable was defined in the config file, it uses the tag's value when the
line gets parsed. But when you call this method in your code after the config
file has been loaded into memory, it uses the final value for that tag.
# Did we earlier request case insensitive tag lookups?
$var = lc ($var) if ( $opts->{tag_case} );
# The default return values ...
my ( $val, $mask_flag, $file, $encrypt_flag ) = ( undef, 0, "", 0 );
if ( $var =~ m/^shft(3+)$/i ) {
# 0. The special comment variable ... (Can't override)
$val = $1;
my $c = $opts->{comment}; # Usually a "#".
}
}
}
}
# 8. Then it must be undefined ... (IE: an unknown variable)
}
# Mask the return value in fish ???
DBUG_MASK ( 0 ) if ( $mask_flag);
Here's another example with multiple B<.>'s in its name this time. It would
look up variable B<${>one.two.threeB<}> in Section "one.two" for tag "three".
And if it didn't find it, it would next try Section "one" for tag "two.three".
If it found such a variable, it returns it's value. If it didn't find anything
it returns B<undef>. The optional 2nd and 3rd values tells you more about the
returned value.
I<$sens> is a flag that tells if the data value should be considered sensitive
or not.
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $var_name = shift; # EX: abc.efg.xyz ...
my ( $val, $fish_mask, $f, $encrypted ) = ( undef, 0, "", 0 );
# If the variable name isn't named correctly ...
if ( $var_name !~ m/\./ ) {
return DBUG_RETURN ($val, $fish_mask, $encrypted);
}
# -------------------------------------------------------------
# Start of real work ...
# -------------------------------------------------------------
my ($pcfg, $cmt, $la, $ra, $asgn) = (undef, '#', '${', '}', '=');
if ( $is_obj ) {
# Get the main/parent section to work against!
$pcfg = $self->{PARENT} || $self;
# Look in the Read Options hash for current settings ...
Affix-Infix2Postfix
view release on metacpan or search on metacpan
Infix2Postfix.pm view on Meta::CPAN
@matches=$self->tokenize($str);
@errors=$self->verify(@matches);
if (@errors) {
$self->{ERRSTR}='Bad tokens: '.join(' ',@matches[@errors]);
return undef;
}
@res=$self->elist(@matches);
return @res;
}
Affix
view release on metacpan or search on metacpan
lib/Affix/Build.pm view on Meta::CPAN
my ( @files, @libs );
foreach my $src (@sources) {
my $handler = $self->_resolve_handler( $src->{lang} );
# Request 'static' output from the handler
my $res = $self->$handler( $src, undef, 'static' );
push @files, $res->{file};
push @libs, @{ $res->{libs} } if $res->{libs};
}
# Link step
lib/Affix/Build.pm view on Meta::CPAN
for my $dir ( File::Spec->path ) {
my $abs = File::Spec->catfile( $dir, $c );
return $abs if MM->maybe_command($abs);
}
}
return undef;
}
method _base ($file) { return $file->basename(qr/\.[^.]+$/); }
#
method _build_c ( $src, $out, $mode ) {
my $file = $src->{path};
lib/Affix/Build.pm view on Meta::CPAN
return $out;
}
else {
my $c_file = $build_dir->child( $self->_base($file) . '.c' );
$self->_run( $v, '-o', "$c_file", "$file" );
return $self->_build_c( { path => $c_file }, undef, 'static' );
}
}
#~ swiftc point.swift -emit-module -emit-library
#~ https://forums.swift.org/t/creating-a-c-accessible-shared-library-in-swift/45329/5
Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Base.pm view on Meta::CPAN
sub _set_err {
my ($self, $args) = @_;
$self->set(\@err, $args);
$self->Verbose("Err called");
return undef;
}
=back
=head2 METHODS
lib/Agent/TCLI/Base.pm view on Meta::CPAN
{
$handler = sub {
my $self = shift;
return ( pop( @{ $self->$accessor } ) )
if defined($self->$accessor);
return undef;
};
}
elsif ( $action eq 'shift' )
{
$handler = sub {
my $self = shift;
return ( shift (@{ $self->$accessor } ) )
if defined($self->$accessor);
return undef;
};
}
elsif ( $action eq 'unshift' )
{
$handler = sub {
Agent
view release on metacpan or search on metacpan
if ($fh) {
unless ($fh->isa('IO::Handle')) {
warn "File argument was not of IO::Handle!";
return;
}
local $/ = undef;
$code = <$fh>;
} elsif ($name) {
$code = _find_agent($name);
} elsif ($code) {
if (ref($stored) eq 'ARRAY') {
print "Agent: Found $name!\n" if $Debug;
unless ( open(PAFILE, "$_/$name") ) {
warn "Agent: could not open $_/$name!";
return;
}
local $/ = undef;
my $code = <PAFILE>;
close PAFILE;
return $code;
}
}
Is any chunk of Perl code that can accomplish some user-defined objective
by communicating with other agents, and manipulating any data it obtains.
A Perl Agent consists of a knowledge base (variables), a reasoning
procedure (code), and access to one or more languages coupled with
methods of communication. These languages remain largely undefined, or
rather, user-defined; support for KQML/KIF is under development.
=item Developing An Agent
Note that the developer must devise the reasoning procedure and knowledge
( run in 3.836 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )