sub dgrep (&+) {
my $code = shift;
my $array = shift;
my @return;
for my $i ( -$#$array .. 0 ){
local $_ = $array->[-$i];
if(&$code){
unshift @return, $array->[-$i];
splice @$array, -$i, 1;
}
}
@return;
}
my @array = qw(moon fruit address buddy geese join say gone);
my @goners = dgrep { /(.)\1/ } @array;
warn "goners: (@goners)\n";
warn "array: (@array)\n";
__END__
goners: (moon address buddy geese)
array: (fruit join say gone)
####
for server in serverList:
# Required parameters
try:
ldapConnection = server['connection']
ldapVersion = server['version']
ldapUseTls = server['tls']
ldapBindDn = server['binddn']
ldapBindPassword = server['bindpassword']
groupList = server['groups']
if 'memberAttr' in config:
_memberAttr = config['memberAttr']
except Exception as error:
print("[LdapUserList::Run] Module LastLogin misses some parameters: " + str(error.message))
exit()
#
# LDAP connection
#
con = ldap.initialize(ldapConnection);
con.set_option(ldap.OPT_PROTOCOL_VERSION, ldapVersion)
con.set_option(ldap.OPT_DEREF, ldap.DEREF_ALWAYS)
if ldapUseTls:
con.set_option(ldap.OPT_X_TLS_DEMAND, True)
try:
con.simple_bind_s(ldapBindDn, ldapBindPassword)
except Exception as error:
print("[LdapUserList::Run] LDAP connection failed: " + str(error.message))
exit()
if (verbose): print "[LdapUserList::Run] LDAP connected to " + ldapConnection + " as: " + con.whoami_s()
#
# Query for entries
#
userDict = {} # <========== this
for group in groupList:
if(verbose): print("[LdapUserList::Run] Searching group " + group)
result = con.search_s(group, ldap.SCOPE_SUBTREE, "objectClass=*", [_memberAttr])
for g in result:
groupname = g[0]
# Check if we have some members
if not _memberAttr in g[1]: continue
userlist = g[1][_memberAttr]
userDict[groupname] = userlist
#
# Print entries
#
_result.append("groupdn;userdn")
for (k,v) in userDict.iteritems(): # <========= this
for user in v:
_result.append(k + ";" + user)
##
##
$::Given.Surname (m?!\)Oo. M z ___ cel +49.123.456.7890::$
$::Street #11 G°\ \ / / mail ----> me@foo.tld::$
$::12345 Some Town /\_¯/(q / / ^[ - immer weg vom Haufen::$
$::--------------------- \__(m.===·==· -)--])?);sub AUTOLOAD{map{print&&
select($,,$,,$,,$|/++$-)}map{pack c,($|++?1:13)+ord}split//,shift||ESEL}
alarm if$Herl.Pack("\cG"x4 ."Itrs\c_`mnsgdq\c_Gdbj\c_O`qk"),er(qq.dq\t.)
##
##
package Foo;
require Exporter;
@Foo::ISA = qw(Exporter);
our @EXPORT = qw(foo);
sub foo { print "Foo::foo\n" }
1;
##
##
#!/usr/bin/perl
#
sub foo {
print "main::foo\n";
}
use pragmatic Foo;
foo;
no pragmatic Foo;
foo;
use pragmatic Foo;
foo;
no pragmatic;
foo;
use pragmatic Foo;
foo;
##
##
package pragmatic;
our $VERSION = 0.01;
our %pragmas; # pragmas currently in effect
our %masked; # masked symbols while pragma on
our %symbols; #
our $AUTOLOAD;
sub import {
shift; # discard package
return unless @_; # nothing to do
my ($mod,@args) = split " ", shift;
my @caller = caller(1);
# see if $mod is defined in $caller
my $callpkg = $caller[0];
unless (exists $symbols{$callpkg} && exists $symbols{$callpkg}->{$mod}) {
package pragmatic::import {
die $@ unless eval "use $mod @args;1";
my $stash = "$callpkg\::";
for my $symbol (keys %pragmatic::import::) {
if (my $code = *{$pragmatic::import::{$symbol}}{CODE}){
next unless *{${$stash}{$symbol}};
if (*{${$stash}{$symbol}}{CODE}) {
$masked{$callpkg}->{$symbol}
= *{${$stash}{$symbol}}{CODE};
}
$symbols{$callpkg}->{$mod}->{$symbol} = $code;
*{"$caller\::$symbol"} = \&{"pragmatic::$symbol"};
}
delete $pragmatic::import::{$symbol};
}
}
}
push @{$pragmas{$callpkg}}, $mod
unless grep {/^$mod$/} @{$pragmas{$callpkg}};
$^H{"$callpkg/pragma/in_effect"} = 1;
$^H{"$callpkg/$mod/in_effect"} = 1;
}
sub unimport {
shift;
my $mod = shift;
my $callpkg = (caller)[0];
if($mod) {
$^H{"$callpkg/$mod/in_effect"} = 0;
} else {
$^H{"$callpkg/pragma/in_effect"} = 0;
}
}
sub AUTOLOAD {
$AUTOLOAD =~ s/.*:://;
my ($callpkg,$file,$line,$hinthash) = (caller(0))[0..2,10];
if ($hinthash->{"$callpkg/pragma/in_effect"}) {
# look up symbol in reverse pragma chain for this package
for my $mod ( reverse @{$pragmas{$callpkg}} ) {
if (exists $symbols{$callpkg}->{$mod}) {
if (exists $symbols{$callpkg}->{$mod}->{$AUTOLOAD}) {
if ($hinthash->{"$callpkg/$mod/in_effect"}) {
goto &{$symbols{$callpkg}->{$mod}->{$AUTOLOAD}};
} else {
goto &{$masked{$callpkg}->{$AUTOLOAD}};
}
}
}
}
die "Undefined subroutine &$callpkg::$AUTOLOAD called at $file line $line\n";
} else {
goto &{$masked{$callpkg}->{$AUTOLOAD}};
}
}
1;
##
##
use Date::Birth::Stone;
use Date::Birth::Flower;
use Date::Birth::DayStone;
use Date::Birth::ZodiacStone;
##
##
#!/usr/bin/perl
use Encode;
use strict; use warnings; # avoid being beaten to death
no warnings "experimental::regex_sets";
my $european_chars_iso8859 = join '', map { chr $_ } (191..207,209..214,216,217..221,223..239,241..246,248..253);
my $european_chars_utf8 = encode_utf8(decode('latin1',$european_chars_iso8859));
my $european_chars = "[$european_chars_iso8859] + [$european_chars_utf8]";
my $valid = "[:print:] + $european_chars";
print "yup\n" if chr(0x82) =~ /^(?[$valid])+$/;
__END__
yup
##
##
##
##
#!/usr/bin/perl
# file fusselkerl
use strict;
my $pat = shift;
my $p;
{
my (%s, %i);
my $d = my $c = 1; # our regexp will be inside parens, so first backref is 2
$p = join (
"",
map {
if($s{$_}++){
"\\".$i{$_}
}
else{
$i{$_}=++$c;
$c>$d+1 ? '(?!'.join('|',map{"\\".abs}-$c+1..-$d-1).")(\\w)" : "(\\w)";
}
} split//,$pat
);
}
print '(',$p,")\n";
open my $fh, '<', shift;
my %s;
while (<$fh>) {
my @l = ();
while (/\b($p)\b/g) {
push @l, $1 unless $s{$1}++;
}
print join (", ",@l), $/ if @l;
}
##
##