destructive grep
grep something off an array, i.e. if something is found, it is weeded out from the array.
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)
python sucks.
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 som
+e 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 grou
+p " + group)
result = con.search_s(group, ldap.SCOPE_SUBTREE, "obje
+ctClass=*", [_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)
a .signature
$::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||ESE
+L}
alarm if$Herl.Pack("\cG"x4 ."Itrs\c_`mnsgdq\c_Gdbj\c_O`qk"),er(qq.dq\t
+.)
pragmatic pragma
Draft of a meditation. Make arbitrary modules pragmatic, i.e. lexically scoped.
Example:
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;
for LanX about internal DSL
Some thoughts, using the very neat tmoertel meditation, and my derived module.
- the DSL should be written and executed as perl code
- the DSL should work fine with any other valid perl code interspersed within it
- the scope of the DSL code should be delimited. In this case, it is included in a block provided to the render() funtion, which is fine
- the functions neccesary for the DSL should not pollute the caller's namespace.
- the DSL should be performant
Point 4 is the biggest thing here. The DSL scope is already confined via the block as argument to render, which happens to be compiled into the scope of the code using it. This call could be wrapped into a package proper, but maybe it is feasible to use lexical subs inside the block render() consumes. I'll give that a try.
Basic steps to make a distribution from a bunch of module files (say, Date/Birth/*.pm):
Done. You will find a Date-Birth-0.01.tar.gz in your current directory.
Why does this yup?
#!/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..21
+4,216,217..221,223..239,241..246,248..253);
my $european_chars_utf8 = encode_utf8(decode('latin1',$european_cha
+rs_iso8859));
my $european_chars = "[$european_chars_iso8859] + [$european_chars_utf
+8]";
my $valid = "[:print:] + $european_chars";
print "yup\n" if chr(0x82) =~ /^(?[$valid])+$/;
__END__
yup
XP in hex, Free Nodelet Settings
<script type="text/javascript">
item = document.evaluate("//center/table/tbody/tr/td`[1]/table`[1]/tbo
+dy/tr/td`[2]/table/tbody/tr`[4]/td`[2]/b",document, null, XPathResult
+.ORDERED_NODE_SNAPSHOT_TYPE,null).snapshotItem(0);
if(item) item.innerHTML = "0x" + parseInt(item.innerHTML).toString(16)
+;
</script>
fusselkerl
#!/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 back
+ref 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;
}
try: perl fusselkerl fusselkerl /usr/share/dict/words
The name attribute is to be used on button, fieldset, form, iframe, input, keygen, map, meta, object, output, param , select, and textarea. Using the name attribute on anything else will lead to poor HTML.
You forgot a which is the most common tag for which the name attribute is valid. <a></a> is anchor and it is used as <a href="$url">link text</a> and <a name="anchor_name">anchor in text</a> to mark an anchor in a page whose href would then be <a href="$url#anchor_name">target text</a>.
So, For Lady_Aleena ([href://?node_id=535366#Lady_Aleena|For Lady_Aleena]) links to the copy of this node marked as <a name="Lady_Aleena">For Lady Aleena</a> on my scratchpad. This is described on What shortcuts can I use for linking to other information?.
You cannot link to a id or to any tag for which the name attribute is valid and set, only to an anchor (<a name="foo">foo</a>).
Sorry for the impromptu lesson on HTML and PerlMonks markup. :-D
perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
|