Result:
found 674 distributions and 1899 files matching your query !
( run in 0.465 )
Config-UCL
view release on metacpan or search on metacpan
libucl-0.8.1/include/lua_ucl.h view on Meta::CPAN
#include "ucl.h"
/**
* Closure structure for lua function storing inside UCL
*/
struct ucl_lua_funcdata {
lua_State *L;
int idx;
char *ret;
};
libucl-0.8.1/include/lua_ucl.h view on Meta::CPAN
* @param allow_array traverse over implicit arrays
*/
UCL_EXTERN int ucl_object_push_lua (lua_State *L,
const ucl_object_t *obj, bool allow_array);
UCL_EXTERN struct ucl_lua_funcdata* ucl_object_toclosure (
const ucl_object_t *obj);
#endif /* LUA_UCL_H_ */
Convos
view release on metacpan or search on metacpan
lib/Convos/public/js/jquery.js view on Meta::CPAN
},
// Contents
"empty": function( elem ) {
// http://www.w3.org/TR/selectors/#empty-pseudo
// :empty is negated by element (1) or content nodes (text: 3; cdata: 4; entity ref: 5),
// but not by others (comment: 8; processing instruction: 7; etc.)
// nodeType < 6 works because attributes (2) do not appear as children
for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) {
if ( elem.nodeType < 6 ) {
return false;
Couch-DB
view release on metacpan or search on metacpan
lib/Couch/DB/Database.pm view on Meta::CPAN
my $answer = $result->answer->{rows}[$index] or return;
my $values = $result->values->{rows}[$index];
( answer => $answer,
values => $values,
ddocdata => $values->{doc},
docparams => { db => $self },
);
}
sub designs(;$%)
lib/Couch/DB/Database.pm view on Meta::CPAN
my $answer = $result->answer->{rows}[$index] or return ();
my $values = $result->values->{rows}[$index];
( answer => $answer,
values => $values,
docdata => $values->{doc},
docparams => { local => $args{local}, db => $self },
);
}
sub allDocs(;$%)
lib/Couch/DB/Database.pm view on Meta::CPAN
my $answer = $result->answer->{docs}[$index] or return ();
my $values = $result->values->{docs}[$index];
( answer => $answer,
values => $values,
docdata => $values,
docparams => { local => $args{local}, db => $self },
);
}
sub find($%)
Crypt-HSXKPasswd
view release on metacpan or search on metacpan
bin/hsxkpasswd view on Meta::CPAN
byeee("file $val does not exist");
}
open my $RCFILE_FH, '<', $val or byee("failed to read file $val with error:\n* $OS_ERROR");
my $json_string = do{local $/ = undef; <$RCFILE_FH>};
close $RCFILE_FH;
my $rcdata;
eval{
$rcdata = decode_json($json_string);
1; # explicit evaluation
}or do{
byeee("failed to parse the hsxkpasswdrc file's content as JSON:\n* source file: $val\n* parse error: $EVAL_ERROR");
};
say 'Validing the converted datatsructure from the hsxkpasswdrc file ...';
my $is_valid = RCFileData->check($rcdata);
if($is_valid){
say '** hsxkpasswdrc data OK **';
}else{
say '** hsxkpasswdrc data INVALID **';
say RCFileData->get_message($rcdata);
exit 1;
}
exit 0;
},
#
bin/hsxkpasswd view on Meta::CPAN
$cmd_args{'rng-pkg-args'} = $args;
},
'rcfile=s' => sub{
my ($opt_name, $val) = @_;
if($val eq 'NONE'){
$cmd_args{no_rcdata} = 1;
}else{
$cmd_args{rcdata} = load_rcfile($val);
}
},
'verbose' => \$verbose,
'warn|w=s' => sub{
my ($opt_name, $val) = @_;
bin/hsxkpasswd view on Meta::CPAN
# try determine the user's home dir and .hsxkpasswdrc file path
my @home_dir = File::Spec->splitdir(File::HomeDir->my_home());
my $dot_hsxkpasswdrc_path = File::Spec->catfile(@home_dir, '.hsxkpasswdrc');
# start with blank rcdata
my $rcdata = {};
# unless we're skipping rcdata completely, try from the args, then from ~/hsxkpasswdrc
if($cmd_args{no_rcdata}){
note('loading of hsxkpasswdrc files disabled with --rcfile=NONE');
}else{
if($cmd_args{rcdata}){
$rcdata = $cmd_args{rcdata};
note('using hsxkpasswdrc file from --rcfile option');
}elsif(-f $dot_hsxkpasswdrc_path){
$rcdata = load_rcfile($dot_hsxkpasswdrc_path);
note("using hsxkpasswdrc file $dot_hsxkpasswdrc_path");
}else{
note('no hsxkpasswdrc file loaded');
}
}
bin/hsxkpasswd view on Meta::CPAN
my %custom_preset_lookup = ();
foreach my $preset (Crypt::HSXKPasswd->defined_presets()){
$preset_lookup{$preset} = 1;
$standard_preset_lookup{$preset} = 1;
}
if($rcdata->{custom_presets}){
foreach my $preset (keys %{$rcdata->{custom_presets}}){
$preset_lookup{$preset} = 1;
$custom_preset_lookup{$preset} = 1;
}
}
# if there are custom presets, print out the detail if in verbose mode
if($verbose && $rcdata->{custom_presets}){
note('custom presets (from hsxkpasswdrc file): '.(join q{, }, keys %custom_preset_lookup));
my @unoverriden_standard_presets = ();
my @overridden_standard_presets = ();
foreach my $preset (sort keys %standard_preset_lookup){
if($custom_preset_lookup{$preset}){
bin/hsxkpasswd view on Meta::CPAN
# === Set the Warning Level (if specified) ====================================#
#
if($cmd_args{warn}){
Crypt::HSXKPasswd->module_config('ENTROPY_WARNINGS', $cmd_args{warn});
note('using entropy warning level specified with --warn option');
}elsif($rcdata->{default_entropy_warnings}){
Crypt::HSXKPasswd->module_config('ENTROPY_WARNINGS', $rcdata->{default_entropy_warnings});
note('using entropy warning level specified in hsxkpasswdrc file');
}else{
note('no custom entropy warning level set');
}
bin/hsxkpasswd view on Meta::CPAN
$hsxkpwd_args{config} = $cmd_args{config};
note('using config from file specified with --config-file option');
}elsif($cmd_args{preset}){
# if there is a matching custom preset, use it to generate a config,
# otherwise treat the config as a standard config
if($rcdata->{custom_presets} && $rcdata->{custom_presets}->{$cmd_args{preset}}){
# we are a custom preset
my $config = $rcdata->{custom_presets}->{$cmd_args{preset}}->{config};
# apply any overrides if needed
if($cmd_args{preset_overrides}){
# save the keys into the config
foreach my $key (keys %{$cmd_args{preset_overrides}}){
bin/hsxkpasswd view on Meta::CPAN
$hsxkpwd_args{preset_overrides} = $cmd_args{preset_overrides};
}
note(qq{using standard preset '$cmd_args{preset}'});
}
}else{
# if the preset DEFUALT is ovrridden by the rcdata, us it
if($rcdata->{custom_presets} && $rcdata->{custom_presets}->{'DEFAULT'}){
$hsxkpwd_args{config} = $rcdata->{custom_presets}->{'DEFAULT'}->{config};
note('using custom default config from hsxkpasswdrc file');
}else{
note('using standard default config');
}
}
bin/hsxkpasswd view on Meta::CPAN
$hsxkpwd_args{dictionary} = load_dictionary(
$cmd_args{'dict-pkg'},
$cmd_args{'dict-pkg-args'} || [],
);
note('using dictionary package from --dict-pkg option');
}elsif($rcdata->{default_dictionary}){
if($rcdata->{default_dictionary}->{file}){
$hsxkpwd_args{dictionary_file} = $rcdata->{default_dictionary}->{file};
note('using dictionary file from hsxkpasswdrc file');
}elsif($rcdata->{default_dictionary}->{package}){
$hsxkpwd_args{dictionary} = load_dictionary(
$rcdata->{default_dictionary}->{package},
$rcdata->{default_dictionary}->{package_constructor_args} || [],
);
note('using dictionary package from hsxkpasswdrc file');
}else{
# this should be impossible if the rcfile validation is working!
note('using default word source');
bin/hsxkpasswd view on Meta::CPAN
$hsxkpwd_args{rng} = load_rng(
$cmd_args{'rng-pkg'},
$cmd_args{'rng-pkg-args'} || [],
);
note('using rng package from --rng-pkg option');
}elsif($rcdata->{default_rng}){
$hsxkpwd_args{rng} = load_rng(
$rcdata->{default_rng}->{package},
$rcdata->{default_rng}->{package_constructor_args} || [],
);
note('using rng package from hsxkpasswdrc file');
}else{
note('using default rng');
}
bin/hsxkpasswd view on Meta::CPAN
open my $RCFILE_FH, '<', $rcfile_path or byee("failed to read file $rcfile_path with error:\n* $OS_ERROR");
my $json_string = do{local $/ = undef; <$RCFILE_FH>};
close $RCFILE_FH;
# try parse the file to JSON
my $loaded_rcdata = {};
eval{
$loaded_rcdata = decode_json($json_string);
1; # explicit evaluation
}or do{
byeee("failed to parse JSON string from file $rcfile_path with error:\n* $EVAL_ERROR");
};
# validate the data structure represnted by the JSON
unless(RCFileData->check($loaded_rcdata)){
byeee("invalid hsxkpasswdrc data from file $rcfile_path:\n* ".RCFileData->get_message($loaded_rcdata));
}
# return the data
return $loaded_rcdata;
}
#####-SUB-######################################################################
# Type : SUBROUTINE
# Purpose : Load a dictionary object form a package name
Crypt-OpenBSD-Blowfish
view release on metacpan or search on metacpan
Blowfish.xs view on Meta::CPAN
unsigned char *data = (unsigned char *) SvPVbyte(sv_mortalcopy(sv_data),datalen);
if (datalen % 8)
croak("data must be in 8-byte chunks");
uint16_t words = datalen / 4;
uint32_t cdata[words];
uint16_t j = 0;
int i;
int rounds = SvIVx(sv_rounds);
for (i=0; i<words; i++)
cdata[i] = Blowfish_stream2word(data, datalen, &j);
for (i=0; i<rounds; i++)
blf_enc(self, cdata, sizeof(cdata) / sizeof(uint64_t));
for (i=0; i<words; i++) {
data[4 * i + 3] = (cdata[i] >> 24) & 0xff;
data[4 * i + 2] = (cdata[i] >> 16) & 0xff;
data[4 * i + 1] = (cdata[i] >> 8) & 0xff;
data[4 * i ] = cdata[i] & 0xff;
}
RETVAL = newSVpvn ((char *) data, datalen);
}
OUTPUT:
RETVAL
Crypt-OpenPGP
view release on metacpan or search on metacpan
lib/Crypt/OpenPGP.pm view on Meta::CPAN
$ptdata = Crypt::OpenPGP::PacketFactory->save($pt);
}
if (my $alg = $param{Compress}) {
require Crypt::OpenPGP::Compressed;
$alg = Crypt::OpenPGP::Compressed->alg_id($alg);
my $cdata = Crypt::OpenPGP::Compressed->new( Data => $ptdata,
Alg => $alg ) or return $pgp->error("Compression error: " .
Crypt::OpenPGP::Compressed->errstr);
$ptdata = Crypt::OpenPGP::PacketFactory->save($cdata);
}
my $key_data = Crypt::OpenPGP::Util::get_random_bytes(32);
my $sym_alg = $param{Cipher} ?
Crypt::OpenPGP::Cipher->alg_id($param{Cipher}) : DEFAULT_CIPHER;
my(@sym_keys);
Crypt-OpenSSL-Base-Func
view release on metacpan or search on metacpan
see also openssl/crypto/pkcs12/p12_key.c
pkcs12_key_gen($password, $salt, $id, $iteration, $digest_name)
my $macdata_key = pkcs12_key_gen('123456', pack("H*", 'e241f01650dbeae4'), 3, 2048, 'sha256');
print unpack("H*", $macdata_key), "\n";
=head3 pkcs5_pbkdf2_hmac
RFC2898 : PBKDF2
Crypt-OpenSSL-PKCS-Func
view release on metacpan or search on metacpan
=head1 SYNOPSIS
use Crypt::OpenSSL::PKCS::Func qw/PKCS12_key_gen PKCS5_PBKDF2_HMAC/;
my $macdata_key = PKCS12_key_gen('123456', 'e241f01650dbeae4', 3, 2048, 32, 'sha256');
print $macdata_key, "\n";
#72:12:59:F1:4A:AD:70:B5:88:39:F7:15:66:B4:33:DA:1B:8A:D0:8F:65:0F:4D:02:FA:AA:0B:9B:09:5B:B5:1D
my $pbkdf2_key = PKCS5_PBKDF2_HMAC('123456', 'b698314b0d68bcbd', 2048, 'sha256', 32);
print $pbkdf2_key, "\n";
#F6:8B:53:86:DE:3A:8D:63:35:84:69:50:54:4D:29:A5:5A:D3:32:8D:EA:17:68:53:04:D7:82:28:48:AE:C5:34
Crypt-OpenSSL-PKCS12
view release on metacpan or search on metacpan
} else {
alg_print(aTHX_ bio, p7->d.encrypted->enc_data->algorithm, NULL);
}
}
}
bags = PKCS12_unpack_p7encdata(p7, pass, passlen);
} else {
continue;
}
Crypt-Perl
view release on metacpan or search on metacpan
util/extract_openssl_curves.pl view on Meta::CPAN
my $esc_cname = $cname =~ tr<-><_>r;
$perl .= "use constant OID_$esc_cname => '$oid';$/$/";
next if $oid_seen{$oid}++;
my $cdata = OpenSSL_Control::curve_data($cname);
try {
my $template_data = Crypt::Perl::ECDSA::ECParameters::normalize($cdata);
$_ = substr($_->as_hex(), 2) for values %$template_data;
$template_data->{'oid'} = $oid_;
$template_data->{'seed'} ||= q<>;
Crypt-ZCert
view release on metacpan or search on metacpan
lib/Crypt/ZCert.pm view on Meta::CPAN
if (!$self->public_file) {
warn "No 'public_file' specified; commit() will fail!"
}
my $secdata = decode_zpl( $self->secret_file->slurp );
$secdata->{curve} ||= +{};
my $pubkey = $secdata->{curve}->{'public-key'};
my $seckey = $secdata->{curve}->{'secret-key'};
unless ($pubkey && $seckey) {
confess "Invalid ZCert; ".
"expected 'curve' section containing 'public-key' & 'secret-key'"
}
$self->_set_public_key_z85($pubkey);
$self->_set_secret_key_z85($seckey);
$self->metadata->set(%{ $secdata->{metadata} })
if $secdata->{metadata} and keys %{ $secdata->{metadata} };
}
sub generate_keypair {
my ($self) = blessed $_[0] ? $_[0] : $_[0]->new;
lib/Crypt/ZCert.pm view on Meta::CPAN
$zcert->commit;
# Retrieve a public/secret ZCert file pair (as ZPL) without writing:
my $certdata = $zcert->export_zcert;
my $pubdata = $certdata->public;
my $secdata = $certdata->secret;
# Retrieve a newly-generated key pair (no certificate):
my $keypair = Crypt::ZCert->new->generate_keypair;
my $pub_z85 = $keypair->public;
my $sec_z85 = $keypair->secret;
CryptX
view release on metacpan or search on metacpan
src/ltc/misc/ssh/ssh_decode_sequence_multi.c view on Meta::CPAN
{
int err;
va_list args;
ssh_data_type type;
void *vdata;
unsigned char *cdata;
char *sdata;
ulong32 *u32data;
ulong64 *u64data;
unsigned long *bufsize;
ulong32 size;
src/ltc/misc/ssh/ssh_decode_sequence_multi.c view on Meta::CPAN
}
/* Read data */
switch (type) {
case LTC_SSHDATA_BYTE:
cdata = vdata;
*cdata = *in++;
break;
case LTC_SSHDATA_BOOLEAN:
cdata = vdata;
/*
The value 0 represents FALSE, and the value 1 represents TRUE. All non-zero values MUST be
interpreted as TRUE; however, applications MUST NOT store values other than 0 and 1.
*/
*cdata = (*in++)?1:0;
break;
case LTC_SSHDATA_UINT32:
u32data = vdata;
LOAD32H(*u32data, in);
in += 4;
Cvs-Trigger
view release on metacpan or search on metacpan
lib/Cvs/Trigger.pm view on Meta::CPAN
###########################################
my($self, $repo_dir, @files) = @_;
my $ppid = getppid();
my $cdata = $self->_cache_get();
for my $file (@files) {
DEBUG "Caching $repo_dir/$file under ppid=$ppid";
push @{ $cdata->{$repo_dir} }, $file;
}
$cdata->{_ttl} += 1;
DEBUG "Setting $ppid cache to ", Dumper($cdata);
$self->{file_cache}->set($ppid, freeze $cdata);
}
###########################################
sub _cache_ttl_dec {
###########################################
my($self) = @_;
my $ppid = getppid();
my $cdata = $self->_cache_get();
$cdata->{_ttl}--;
$self->{file_cache}->set($ppid, freeze $cdata);
return $cdata->{_ttl};
}
###########################################
sub _cache_get {
###########################################
my($self) = @_;
my $ppid = getppid();
my $cdata;
if(my $c = $self->{file_cache}->get($ppid)) {
DEBUG "Cache hit on ppid=$ppid";
$cdata = thaw $c;
} else {
DEBUG "Cache miss on ppid=$ppid";
$cdata = { _ttl => 0 };
}
return $cdata;
}
###########################################
package Cvs::Temp;
###########################################
DBD-SQLite-Amalgamation
view release on metacpan or search on metacpan
sqlite-amalgamation.c view on Meta::CPAN
MemPage *pChild; /* Pointer to a new child page */
Pgno pgnoChild; /* Page number of the new child page */
BtShared *pBt; /* The BTree */
int usableSize; /* Total usable size of a page */
u8 *data; /* Content of the parent page */
u8 *cdata; /* Content of the child page */
int hdr; /* Offset to page header in parent */
int brk; /* Offset to content of first cell in parent */
assert( pPage->pParent==0 );
assert( pPage->nOverflow>0 );
sqlite-amalgamation.c view on Meta::CPAN
assert( sqlite3PagerIswriteable(pChild->pDbPage) );
usableSize = pBt->usableSize;
data = pPage->aData;
hdr = pPage->hdrOffset;
brk = get2byte(&data[hdr+5]);
cdata = pChild->aData;
memcpy(cdata, &data[hdr], pPage->cellOffset+2*pPage->nCell-hdr);
memcpy(&cdata[brk], &data[brk], usableSize-brk);
if( pChild->isInit ) return SQLITE_CORRUPT;
rc = sqlite3BtreeInitPage(pChild, pPage);
if( rc ) goto balancedeeper_out;
memcpy(pChild->aOvfl, pPage->aOvfl, pPage->nOverflow*sizeof(pPage->aOvfl[0]));
pChild->nOverflow = pPage->nOverflow;
DBD-Teradata
view release on metacpan or search on metacpan
lib/DBD/Teradata.pm view on Meta::CPAN
if (ref $$params[$_] eq 'ARRAY') &&
(scalar(@{$$params[$_]}) > $maxparmlen);
}
}
my $fldcnt = $numParam;
my ($tuples, $datainfo, $indicdata) = (0, '', '');
my $pos = 0;
if (($params && scalar @$params) || $attrs->{_fetch_sub}) {
($tuples, $datainfo, $indicdata) =
$usephs ? _process_ph_params($sth, $fldcnt, $params, $attrs) :
_process_using_params($sth, $fldcnt, $rawmode, $modepcl, $params, $attrs);
return undef
unless $tuples;
}
lib/DBD/Teradata.pm view on Meta::CPAN
($dbh->{tdat_mode} ne 'ANSI') && ($iobj->[11] == 0);
$iobj->[11] = 1
if ($partition == 1) && ($dbh->{tdat_mode} eq 'ANSI');
return $tuples
if $attrs->{_fetch_sub};
my $rowcnt = $iobj->io_execute($sth, $datainfo, $indicdata,
($use_cursor ? $cursth->{_p}[6] : undef));
$sthp->[13] = $rowcnt;
return $sth->DBI::set_err($iobj->io_get_error())
unless defined($rowcnt);
$sth->{Active} = ($sth->{NUM_OF_FIELDS} != 0);
lib/DBD/Teradata.pm view on Meta::CPAN
}
return ($datainfo, $packstr);
}
sub _process_ph_params {
my ($sth, $fldcnt, $params, $attrs) = @_;
my $indicdata;
my $pos = 0;
my $maxsz = 100;
my ($i, $p);
my $sthp = $sth->{_p};
my $iobj = $sthp->[11];
lib/DBD/Teradata.pm view on Meta::CPAN
if (($ttype == 12) || ($ttype == -3)) &&
($maxszs[$_] < length($p) + 2);
}
map { $maxsz += $_; } @maxszs;
$maxsz += scalar @indicvec;
$indicdata = "\0" x $maxsz;
substr($indicdata, 0, scalar(@indicvec), pack('C*', @indicvec));
substr($indicdata, scalar(@indicvec), $pos, pack($packstr, @tmpary));
$pos += scalar(@indicvec);
return (++$tuples, $datainfo, substr($indicdata, 0, $pos))
;
}
substr($iobj->[16], $attrs->{_datainfop}, length($datainfo), $datainfo);
return ($tuples, undef, undef);
}
sub _process_using_params {
my ($sth, $fldcnt, $rawmode, $modepcl, $params, $attrs) = @_;
my $indicdata;
my $pos = 0;
my $maxsz = (($fldcnt & 7) ? ($fldcnt>>3) + 1 : $fldcnt>>3);
my ($i, $k, $p);
my $sthp = $sth->{_p};
my $iobj = $sthp->[11];
lib/DBD/Teradata.pm view on Meta::CPAN
$ttype = $ptypes->[$i];
$p = $params->[$i];
$p = $$p
if defined($p) && (ref $p);
}
$indicdata = "\0" x $maxsz;
substr($indicdata, 0, scalar(@indicvec), pack('C*', @indicvec));
substr($indicdata, scalar(@indicvec), $pos, pack($packstr, @tmpary));
$pos += scalar(@indicvec);
}
else {
$p = $params->[0];
$p = (ref $p eq 'ARRAY') ? $p->[0] : $$p
if defined($p) && (ref $p);
$pos = length($p) - 3;
$indicdata = substr($p, 2, $pos);
}
return (++$tuples, undef, substr($indicdata, 0, $pos))
;
}
return ($tuples, undef, undef);
}
sub Realize {
lib/DBD/Teradata.pm view on Meta::CPAN
$sumcnt--;
}
return $nextcol;
}
sub io_execute {
my ($obj, $sth, $datainfo, $indicdata, $rowid) = @_;
$obj->[18] = 0;
$obj->[24] = '00000';
$obj->[17] = '';
my $stmtinfo = $sth->{tdat_stmt_info};
my $stmtno = $sth->{tdat_stmtno};
lib/DBD/Teradata.pm view on Meta::CPAN
my $forCursor = ($stmt=~/\s+WHERE\s+CURRENT$/i) && $rowid;
if (($partition == 1) ||
(($partition == 6) && ($stmt ne ';'))) {
$reqlen = 4 + length($stmt) + 6 +
((defined($datainfo) && length($datainfo)) ? 4 + length($datainfo) : 0) +
((defined($indicdata) && length($indicdata)) ? 4 + length($indicdata) : 0) +
($forCursor ? 4 + length($rowid) : 0) +
($sth->{tdat_mload} ? 14 : 0);
if ($reqlen > 65535) {
$reqlen += 4 + 4 + (length($datainfo) ? 4 : 0) +
(length($indicdata) ? 4 : 0) + (($forCursor && $rowid) ? 4 : 0);
$obj->[26] = 1;
}
else {
$obj->[26] = undef;
}
lib/DBD/Teradata.pm view on Meta::CPAN
}
return $obj->io_set_error('Maximum request size exceeded.')
if ($obj->[40] < 5000000) && ($reqlen > 65535);
if ($partition == 1) {
$reqmsg = $reqfac->sqlRequest($obj, $sth, $forCursor, $rowid, $modepcl, $keepresp,
$obj->[3], $stmt, $datainfo, $indicdata);
}
delete $obj->[1]{$_}
foreach (keys %{$obj->[1]});
my $treqno = $obj->[2];
if (($partition == 5) || ($partition == 4)) {
DBIx-BulkUtil
view release on metacpan or search on metacpan
lib/DBIx/BulkUtil.pm view on Meta::CPAN
my @col_list;
for my $col (@{$cols->{LIST}}) {
my $col_str = $col;
my $cdata = $cmap->{$col};
my $type = $cdata->{TYPE_NAME};
my $dec = $cdata->{DECIMAL_DIGITS};
$col_str .= " $type";
my $size = $cdata->{COLUMN_SIZE};
for ($type) {
$col_str .=
/CHAR/ ? "($size)"
: /NUMBER/ ? (defined $dec) ? "($size,$dec)" : ''
: '';
}
#$col_str .= " DEFAULT $cdata->{COLUMN_DEF}" if defined $cdata->{COLUMN_DEF};
#$col_str =~ s/\s+$//;
#$col_str .= " NOT NULL" unless $cdata->{NULLABLE};
push @col_list, $col_str;
}
my $create_sql = sprintf($sql,
DBIx-Web
view release on metacpan or search on metacpan
# from: my ($s, $tm, $df); local (*FG, *FL); ($s, *FG, *FL, $tm, $df) =@_; print FL...
# to: my ($s, $FG, $FL, $tm, $df) =@_; print $FL...
# 2007-06-25 for perl58/CGI: $CGI::Q =$_[0]->{-cgi} - default CGI object
# 2007-06-25 for perl58: using CGI 3.29
# 2007-06-25 CGI 3.20 - 3.29 bug traced:
# sub _style { ... push(@result,style({'type'=>$type},"$cdata_start\n$_\n$cdata_end")) foreach @c;
# autoloads new CGI - damages existed CGI / ?PerlIS / ?PerlEx
# may be something like:
# push(@result,style($self,{'type'=>$type},"$cdata_start\n$_\n$cdata_end")) foreach @c;
# 2007-06-25 for perl58: cgiFooter trace using CGI->{'dbix_web'}
# 2007-06-25 for perl58: "400 Bad request (malformed multipart POST)" traced within 'sub read_multipart'
# 2007-06-25 new {-c}->{-startitit} for initialize()/start() transition
# 2007-06-25 for perl58: deleted 'site/lib/CGI.pm' & 'site/lib/CGI/...' parts
# 2007-06-22 for perl58: use CGI qw(-nph); start_html(-style=>{-code=>...};
DBIx-XHTML_Table
view release on metacpan or search on metacpan
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
$head = $self->_build_head;
$body = $self->{'rows'} ? $self->_build_body : '';
$foot = $self->{'totals'} ? $self->_build_foot : '';
# w3c says tfoot comes before tbody ...
my $cdata = $head . $foot . $body;
return _tag_it('table', $attribs, $cdata) . $N;
}
sub _build_head {
my ($self) = @_;
my ($attribs,$cdata,$caption);
my $output = '';
# build the <caption> tag if applicable
if ($caption = $self->{'global'}->{'caption'}) {
$attribs = $self->{'global'}->{'caption_attribs'};
$cdata = $self->{'encode_cells'} ? $self->_xml_encode($caption) : $caption;
$output .= $N.$T . _tag_it('caption', $attribs, $cdata);
}
# build the <colgroup> tags if applicable
if ($attribs = $self->{'global'}->{'colgroup'}) {
$cdata = $self->_build_head_colgroups();
$output .= $N.$T . _tag_it('colgroup', $attribs, $cdata);
}
# go ahead and stop if they don't want the head
return "$output\n" if $self->{'no_head'};
# prepare <tr> tag info
my $tr_attribs = _merge_attribs(
$self->{'head'}->{'tr'}, $self->{'global'}->{'tr'}
);
my $tr_cdata = $self->_build_head_row();
# prepare the <thead> tag info
$attribs = $self->{'head'}->{'thead'} || $self->{'global'}->{'thead'};
$cdata = $N.$T . _tag_it('tr', $tr_attribs, $tr_cdata) . $N.$T;
# add the <thead> tag to the output
$output .= $N.$T . _tag_it('thead', $attribs, $cdata) . $N;
}
sub _build_head_colgroups {
my ($self) = @_;
my (@cols,$output);
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
# the skinny here is to grab a slice of the rows, one for each group
foreach my $end (@indicies) {
my $body_group = $self->_build_body_group([@{$self->{'rows'}}[$beg..$end]]) || '';
my $attribs = $self->{'global'}->{'tbody'} || $self->{'body'}->{'tbody'};
my $cdata = $N . $body_group . $T;
$output .= $T . _tag_it('tbody',$attribs,$cdata) . $N;
$beg = $end + 1;
}
return $output;
}
sub _build_body_group {
my ($self,$chunk) = @_;
my ($output,$cdata);
my $attribs = _merge_attribs(
$self->{'body'}->{'tr'}, $self->{'global'}->{'tr'}
);
my $pk_col = '';
# build the rows
for my $i (0..$#$chunk) {
my @row = @{$chunk->[$i]};
$pk_col = splice(@row,$self->{'pk_index'},1) if defined $self->{'pk_index'};
$cdata = $self->_build_body_row(\@row, ($i and $self->{'nodup'} or 0), $pk_col);
$output .= $T . _tag_it('tr',$attribs,$cdata) . $N;
}
# build the subtotal row if applicable
if (my $subtotals = shift @{$self->{'sub_totals'}}) {
$cdata = $self->_build_body_subtotal($subtotals);
$output .= $T . _tag_it('tr',$attribs,$cdata) . $N;
}
return $output;
}
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
$row->[$_] = '' unless defined($row->[$_]);
# bug 21761 "Special XML characters should be expressed as entities"
$row->[$_] = $self->_xml_encode( $row->[$_] ) if $self->{'encode_cells'};
my $cdata = ($row->[$_] =~ /^\s+$/)
? $self->{'null_value'}
: $row->[$_]
;
$self->{'current_col'} = $name;
$cdata = ($nodup and $index == $_)
? $self->{'nodup'}
: _map_it($self->{'map_cell'}->{$name},$cdata)
;
$output .= $T.$T . _tag_it('td', $attribs, $cdata) . $N;
}
return $output . $T;
}
sub _build_body_subtotal {
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
my $tr_attribs = _merge_attribs(
# notice that foot is 1st and global 2nd - different than rest
$self->{'foot'}->{'tr'}, $self->{'global'}->{'tr'}
);
my $tr_cdata = $self->_build_foot_row();
my $attribs = $self->{'foot'}->{'tfoot'} || $self->{'global'}->{'tfoot'};
my $cdata = $N.$T . _tag_it('tr', $tr_attribs, $tr_cdata) . $N.$T;
return $T . _tag_it('tfoot',$attribs,$cdata) . $N;
}
sub _build_foot_row {
my ($self) = @_;
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
return $output . $T;
}
# builds a tag and it's enclosed data
sub _tag_it {
my ($name,$attribs,$cdata) = @_;
my $text = "<\L$name\E";
# build the attributes if any - skip blank vals
for my $k (sort keys %{$attribs}) {
my $v = $attribs->{$k};
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
} sort keys %$v) . ';';
}
$v = _rotate($v) if (ref $v eq 'ARRAY');
$text .= qq| \L$k\E="$v"| unless $v =~ /^$/;
}
$text .= (defined $cdata) ? ">$cdata</\L$name\E>" : '/>';
}
# used by map_cell() and map_head()
sub _map_it {
my ($sub,$datum) = @_;
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
=item B<map_cell>
$table->map_cell($subroutine[,$cols])
Map a supplied subroutine to all the <td> tag's cdata for
the specified columns. The first argument is a reference to a
subroutine. This subroutine should shift off a single scalar at
the beginning, munge it in some fasion, and then return it.
The second argument is the column (scalar) or columns (reference
to a list of scalars) to apply this subroutine to. Example:
lib/DBIx/XHTML_Table.pm view on Meta::CPAN
# uppercase the data in the fifth column
$table->map_cell( sub { return uc shift }, 4);
One temptation that needs to be addressed is using this method to
color the cdata inside a <td> tag pair. For example:
# don't be tempted to do this
$table->map_cell(sub {
return qq|<font color="red">| . shift . qq|</font>|;
}, [qw(first_name last_name)]);
DDC-Concordance
view release on metacpan or search on metacpan
lib/DDC/Filter.pm view on Meta::CPAN
my $chost = $ns->{sock}->peerhost.':'.$ns->{sock}->peerport;
my $shost = $sclient->{sock}->peerhost.':'.$sclient->{sock}->peerport;
$filter->logmsg('info', "connect from client $chost --> server $shost");
my $cdata = $filter->readData($ns->{sock});
my $fcdata = $filter->filterInput($cdata);
$filter->logmsg('debug', "got query=($cdata)->($fcdata) from client $chost");
$filter->logmsg('trace', "got query from client $chost");
$sclient->send($fcdata);
$filter->logmsg('trace', "passed on query from client $chost to upstream server $shost");
my $sdata = $sclient->readData();
$filter->logmsg('trace', "got response from upstream server $shost");
DPKG-Log
view release on metacpan or search on metacpan
test_data/big.log view on Meta::CPAN
2010-06-23 09:59:03 status unpacked libgme0 0.5.5-2
2010-06-23 09:59:03 install libgsm1 <none> 1.0.13-3
2010-06-23 09:59:03 status half-installed libgsm1 1.0.13-3
2010-06-23 09:59:03 status unpacked libgsm1 1.0.13-3
2010-06-23 09:59:03 status unpacked libgsm1 1.0.13-3
2010-06-23 09:59:03 install libiptcdata0 <none> 1.0.4-1+b1
2010-06-23 09:59:03 status half-installed libiptcdata0 1.0.4-1+b1
2010-06-23 09:59:03 status unpacked libiptcdata0 1.0.4-1+b1
2010-06-23 09:59:03 status unpacked libiptcdata0 1.0.4-1+b1
2010-06-23 09:59:03 install libsamplerate0 <none> 0.1.7-3
2010-06-23 09:59:03 status half-installed libsamplerate0 0.1.7-3
2010-06-23 09:59:03 status unpacked libsamplerate0 0.1.7-3
2010-06-23 09:59:03 status unpacked libsamplerate0 0.1.7-3
2010-06-23 09:59:03 install libjack0 <none> 1.9.5~dfsg-13
test_data/big.log view on Meta::CPAN
2010-06-23 10:18:49 status installed libdc1394-22 2.1.2-2
2010-06-23 10:18:49 configure libdatrie1 0.2.3-1 0.2.3-1
2010-06-23 10:18:49 status unpacked libdatrie1 0.2.3-1
2010-06-23 10:18:49 status half-configured libdatrie1 0.2.3-1
2010-06-23 10:18:49 status installed libdatrie1 0.2.3-1
2010-06-23 10:18:49 configure libiptcdata0 1.0.4-1+b1 1.0.4-1+b1
2010-06-23 10:18:49 status unpacked libiptcdata0 1.0.4-1+b1
2010-06-23 10:18:49 status half-configured libiptcdata0 1.0.4-1+b1
2010-06-23 10:18:49 status installed libiptcdata0 1.0.4-1+b1
2010-06-23 10:18:49 configure libavahi-common-data 0.6.25-3 0.6.25-3
2010-06-23 10:18:49 status unpacked libavahi-common-data 0.6.25-3
2010-06-23 10:18:49 status half-configured libavahi-common-data 0.6.25-3
2010-06-23 10:18:49 status installed libavahi-common-data 0.6.25-3
2010-06-23 10:18:49 configure libgnomecanvas2-common 2.30.1-1 2.30.1-1
DTA-CAB
view release on metacpan or search on metacpan
CAB/Format/XmlPerl.pm view on Meta::CPAN
foreach ($nod->childNodes) {
push(@$val, $fmt->parseNode($_));
}
}
elsif ($nodname =~ /^\#/) {
;##-- special node, e.g. #cdata-section, #comment, etc.: skip
}
else {
$fmt->logwarn("cannot handle node with name=$nodname - skipping");
}
return $val;
Dash
view release on metacpan or search on metacpan
share/assets/dash_core_components/async~markdown.js.map view on Meta::CPAN
{"version":3,"sources":["webpack:///./node_modules/is-whitespace-character/index.js","webpack:///./node_modules/xtend/immutable.js","webpack:///./node_modules/trim/index.js","webpack:///./node_modules/is-decimal/index.js","webpack:///./node_modules/u...
Data-Checker
view release on metacpan or search on metacpan
lib/Data/Checker.pm view on Meta::CPAN
my $manager = Parallel::ForkManager->new($max_proc);
$manager->run_on_finish
(
sub {
my($pid,$exit_code,$id,$signal,$core_dump,$funcdata) = @_;
my($ele,$err,$warn,$info) = @$funcdata;
if (defined($err) && @$err) {
$fail{$ele} = $err;
} else {
$pass{$ele} = $$data{$ele};
Data-Clean-ForJSON-Pregen
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
unless (defined &Data::Clean::ForJSON::Pregen::clean_for_json_in_place) {
plan skip_all => 'clean_for_json_in_place() not yet generated';
}
my $data;
my $cdata;
$cdata = clean_for_json_in_place({
code => sub{} ,
#date => DateTime->from_epoch(epoch=>1001),
scalar => \1,
version => version->parse('1.2'),
obj => bless({},"Foo"),
});
is_deeply($cdata, {
code => "CODE",
#date => 1001,
scalar => 1 ,
version => '1.2',
obj => {},
}, "cleaning up");
{
my $ref = [];
$data = {a=>$ref, b=>$ref};
$cdata = clone_and_clean_for_json($data);
#use Data::Dump; dd $data; dd $cdata;
is_deeply($cdata, {a=>[], b=>[]}, "circular")
or diag explain $cdata;
}
subtest "unbless does not modify original object when using clone_and_clean()" => sub {
my $data = bless({},"Foo");
my $cdata = clone_and_clean_for_json($data);
is_deeply($cdata, {}, "cleaned data");
is_deeply($data , bless({},"Foo"), "original data");
# is_deeply doesn't differentiate blessed and unblessed, so we test it here
ok(blessed($data), "original data blessed");
};
Data-Clean-ForJSON
view release on metacpan or search on metacpan
t/for_json.t view on Meta::CPAN
use JSON::PP;
use Scalar::Util qw(blessed);
my $c = Data::Clean::ForJSON->get_cleanser;
my $data;
my $cdata;
$cdata = $c->clean_in_place({
code => sub{} ,
date => DateTime->from_epoch(epoch=>1001),
scalar => \1,
version => version->parse('1.2'),
obj => bless({},"Foo"),
});
is_deeply($cdata, {
code => "CODE",
date => 1001,
scalar => 1 ,
version => '1.2',
obj => {},
}, "cleaning up");
{
my $ref = [];
$data = {a=>$ref, b=>$ref};
$cdata = $c->clone_and_clean($data);
#use Data::Dump; dd $data; dd $cdata;
is_deeply($cdata, {a=>[], b=>[]}, "circular")
or diag explain $cdata;
}
subtest "unbless does not modify original object when using clone_and_clean()" => sub {
my $data = bless({},"Foo");
my $cdata = $c->clone_and_clean($data);
is_deeply($cdata, {}, "cleaned data");
is_deeply($data , bless({},"Foo"), "original data");
# is_deeply doesn't differentiate blessed and unblessed, so we test it here
ok(blessed($data), "original data blessed");
};
Data-Clean-FromJSON-Pregen
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
unless (defined &Data::Clean::FromJSON::Pregen::clean_from_json_in_place) {
plan skip_all => 'clean_from_json_in_place() not yet generated';
}
my $data;
my $cdata;
subtest clean_from_json_in_place => sub {
my $cdata = clean_from_json_in_place([bless(do{\(my $o=0)},"JSON::PP::Boolean"), bless(do{\(my $o=1)},"JSON::PP::Boolean")]);
is_deeply($cdata, [0, 1]);
};
done_testing;
Data-Clean-JSON
view release on metacpan or search on metacpan
use JSON::PP;
use Scalar::Util qw(blessed);
my $c = Data::Clean::JSON->get_cleanser;
my $data;
my $cdata;
$cdata = $c->clean_in_place({
code => sub{} ,
date => DateTime->from_epoch(epoch=>1001),
scalar => \1,
version => version->parse('1.2'),
obj => bless({},"Foo"),
});
is_deeply($cdata, {
code => "CODE",
date => 1001,
scalar => 1 ,
version => '1.2',
obj => {},
}, "cleaning up");
{
my $ref = [];
$data = {a=>$ref, b=>$ref};
$cdata = $c->clone_and_clean($data);
#use Data::Dump; dd $data; dd $cdata;
is_deeply($cdata, {a=>[], b=>[]}, "circular")
or diag explain $cdata;
}
subtest "unbless does not modify original object when using clone_and_clean()" => sub {
my $data = bless({},"Foo");
my $cdata = $c->clone_and_clean($data);
is_deeply($cdata, {}, "cleaned data");
is_deeply($data , bless({},"Foo"), "original data");
# is_deeply doesn't differentiate blessed and unblessed, so we test it here
ok(blessed($data), "original data blessed");
};
Data-Clean
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
subtest "command: call_func" => sub {
require DateTime;
my $c = Data::Clean->new(
-obj => ['call_func', 'main::f1'],
);
my $cdata = $c->clean_in_place({a=>bless({}, "foo")});
is_deeply($cdata, {a=>"foofoo"});
};
subtest "security: check call_func argument" => sub {
dies_ok {
Data::Clean->new(
t/01-basic.t view on Meta::CPAN
my $data = bless({foo=>1}, "Foo");
my $c = Data::Clean->new(
-obj => ['unbless_ffc_inlined'],
);
my $cdata = $c->clone_and_clean($data);
is_deeply($cdata, {foo=>1})
or diag explain $cdata;
};
subtest "command: replace_with_str" => sub {
my $c = Data::Clean->new(
-obj => ['replace_with_str', "JINNY'S TAIL"],
);
my $cdata = $c->clean_in_place({a=>bless({}, "foo")});
is_deeply($cdata, {a=>"JINNY'S TAIL"});
};
subtest "selector: -circular, command: clone" => sub {
my ($c, $data, $cdata);
$data = [1]; push @$data, $data;
$c = Data::Clean->new(-circular => ['clone', 1]);
$cdata = $c->clone_and_clean($data);
is_deeply($cdata, [1, [1, 'CIRCULAR']], 'limit 1');
$c = Data::Clean->new(-circular => ['clone', 2]);
$cdata = $c->clone_and_clean($data);
is_deeply($cdata, [1, [1, [1, 'CIRCULAR']]], 'limit 2');
};
subtest "selector: ''" => sub {
my $c = Data::Clean->new(
'' => ['replace_with_str', "X"],
);
my $cdata = $c->clean_in_place({a=>[], b=>1, c=>"x", d=>undef});
is_deeply($cdata, {a=>[], b=>"X", c=>"X", d=>"X"});
};
subtest "option: !recurse_obj" => sub {
my $c;
my $cdata;
$c = Data::Clean->new(
CODE => ["replace_with_ref"],
);
$cdata = $c->clean_in_place({a=>sub{}});
is_deeply($cdata, {a=>"CODE"});
$cdata = $c->clean_in_place(bless({a=>sub{}}, "Foo"));
is(ref($cdata->{a}), "CODE");
$c = Data::Clean->new(
CODE => ["replace_with_ref"],
'!recurse_obj' => 1,
);
$cdata = $c->clean_in_place({a=>sub{}});
is_deeply($cdata, {a=>"CODE"});
$cdata = $c->clean_in_place(bless({a=>sub{}}, "Foo"));
is_deeply($cdata, bless({a=>"CODE"}, "Foo"));
};
# make sure we can catch circular references
subtest "circular: -obj=>unbless + !recurse_obj & no Acme::Damn" => sub {
t/01-basic.t view on Meta::CPAN
my $c = Data::Clean->new(
-circular => ['replace_with_str', 'CIRCULAR'],
-obj => ['unbless'],
'!recurse_obj' => 1,
);
my $cdata = $c->clone_and_clean($tree);
is_deeply($cdata, {
id => 'n0',
parent => undef,
children => [{id=>'n1', parent=>"CIRCULAR"}, {id=>'n2', parent=>"CIRCULAR"}],
}) or diag explain $cdata;
};
# command: call_method is tested via json
# command: one_or_zero is tested via json
# command: deref_scalar is tested via json
Data-CleanJSON
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
unless (defined &Data::CleanJSON::clean_json_in_place) {
plan skip_all => 'clean_json_in_place() not yet generated';
}
my $data;
my $cdata;
$cdata = clean_json_in_place({
code => sub{} ,
#date => DateTime->from_epoch(epoch=>1001),
scalar => \1,
version => version->parse('1.2'),
obj => bless({},"Foo"),
});
is_deeply($cdata, {
code => "CODE",
#date => 1001,
scalar => 1 ,
version => '1.2',
obj => {},
}, "cleaning up");
{
my $ref = [];
$data = {a=>$ref, b=>$ref};
$cdata = clone_and_clean_json($data);
#use Data::Dump; dd $data; dd $cdata;
is_deeply($cdata, {a=>[], b=>[]}, "circular")
or diag explain $cdata;
}
subtest "unbless does not modify original object when using clone_and_clean()" => sub {
my $data = bless({},"Foo");
my $cdata = clone_and_clean_json($data);
is_deeply($cdata, {}, "cleaned data");
is_deeply($data , bless({},"Foo"), "original data");
# is_deeply doesn't differentiate blessed and unblessed, so we test it here
ok(blessed($data), "original data blessed");
};
Data-Dump-XML
view release on metacpan or search on metacpan
lib/Data/Dump/XML/Parser.pm view on Meta::CPAN
if defined $parent_class;
} else {
warn "found unknown element $tag";
}
# mix of pcdata and elements not allowed, ignore chars
$p->{char} = '';
$p->{id}->[$parent_id] = $ref
if ($parent_id);
}
( run in 0.465 second using v1.01-cache-2.11-cpan-454fe037f31 )