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; } ####