<p>
#!perl
use warnings; use strict;
my(@tagsi_fname);
$tagsi_fname[0] = ...; # some hard-coded filenames encoded here
$tagsi_fname[1] = ...;
binmode STDOUT, ":encoding(utf-8)" or die "binmode STDOUT: $!";
my(@tagit, @tagil);
for my$v (0,1) {
my$dbgname = "tags$v";
my$fname = $tagsi_fname[$v];
open my$tabfh, "<:encoding(utf-16)", $fname or die qq(error openin
+g $dbgname file: $!);
my$enable;
my$prevempty = 1;
my@r;
while (my$l = <$tabfh>) {
$l =~ s/\r?\n?\z//;
my$empty = $l!~/\S/;
my@l = split /\t/, $l;
if (!$enable && $l[0] && "DmTag" eq $l[0] && $prevempty) {
$enable = 1;
}
if ($enable && !$empty) {
push @r, \@l;
}
$prevempty = $empty;
}
eof($tabfh) or die;
!$enable and die;
my($_hdr0, $_hdr1, $tags_hdr, @tags_tab) = @r;
...
printf "%s %s\n", ($v ? "+++" : "---"), $fname;
$tagit[$v] = \@tags_tab;
};
for my$v (0,1) {
for my$i (keys @{$tagit[$v]}) {
my$l = ${$tagit[$v]}[$i];
my$name = $$l[0];
push @{${$tagil[$v]}{$name}}, $i;
}
}
sub fmttag {
my($prefix, $l) = @_;
... printf(...)
}
for my$v (0,1) {
print "@@ tags ", ($v ? "added" : "deleted"), "\n";
my$prefix = $v ? "+" : "-";
for my$l (@{$tagit[$v]}) {
my$name = $$l[0];
if (!${$tagil[1-$v]}{$name}) {
fmttag $prefix, $l;
}
}
if (0 == $v) {
my%u;
print "@@ tags changed\n";
for my$l (@{$tagit[0]}) {
my$name = $$l[0];
if (${$tagil[1]}{$name} && !$u{$name}++ &&
(1 < @{${$tagil[1]}{$name}} || 1 < @{${$tagil[0]}{$nam
+e}} ||
pack("(j/a)*", @{${$tagit[0]}[${${$tagil[0]}{$name
+}}[0]]}) ne
pack("(j/a)*", @{${$tagit[1]}[${${$tagil[1]}{$name
+}}[0]]})))
{
for my$vv (0,1) {
for my$i (@{${$tagil[$vv]}{$name}}) {
fmttag+($vv ? "+" : "-"), ${$tagit[$vv]}[$i];
}
}
}
}
}
}
print "@@ end of diff\n"
__END__
CS words for describing two endpoints of a connection. Are there any more good ones?
- host / guest
- master / slave
- server / client
- remote / local
- passive / active
- Alice / Bob
- backend / frontend
- engine / ?
- ? / user
- attacker / defender
- request / response
- produce / consume
- implement / specify
- provide / require
- sock / peer (as in getsockname / getpeername)
- source / destination (for direction of flow)
- send / receive (for direction of flow)
- female / male (for hardware plugs)
# warning: completely untested
{ package AnyEvent::Impl::Prima;
sub io {
my($s, %r) = @_;
Prima::File->new(file => $r{fh},
mask => ("w" eq $r{poll} ? fe::Write() : fe::Read()) | fe::Exc
+eption,
onRead=>$r{cb},onWrite=>$r{cb},onException=>$r{cb})
}
sub timer {
my($s ,%r) = @_; my($c,$g) = $r{cb}; $r{interval} and die "error:
+repeated timers not supported in AnyEvent::Impl::Prima";
Prima::Timer->new(timeout=>$r{after},
onTick => sub{ my($i)=@_; $i->stop; $g++ or &$c() })
}
push @AnyEvent::REGISTRY,["Prima",__PACKAGE__];
}
Note that the unix impl of the prima event loop is a simple hand-rolled select loop, but it's rigged to wake up every 0.2 seconds even when idle.
Update: see https://github.com/Corion/AnyEvent-Impl-Prima/blob/master/lib/AnyEvent/Impl/Prima.pm
doc XML::Twig XML-Twig mirod perlmodlib
cpan XML::Twig XML-Twig mirod perlmodlib
searchcpan XML::Twig XML-Twig mirod perlmodlib
metacpan XML::Twig XML-Twig mirod perlmodlib
mod XML::Twig XML-Twig mirod perlmodlib
searchmod XML::Twig XML-Twig mirod perlmodlib
metamod XML::Twig XML-Twig mirod perlmodlib
dist XML::Twig XML-Twig mirod perlmodlib
searchdist XML::Twig XML-Twig mirod perlmodlib
metadist XML::Twig XML-Twig mirod perlmodlib
Word ladder one-way breadth-first search pseudocode stuff for Limbic~Region.
Assume you have read in three pre-computed arrays of integers
@adj_edge, @adj_index, @adj_length
such that the neigbours of the word of index $i are given by @adj_edge[$adj_index[$i] .. $adj_index[$i] + $adj_length[$i] - 1]
You have found the two words you want to bridge: $start, $goal.
You will need three temporary arrays, each the size of your word list.
@seen = (0)x@adj_index;
This tells what words you have already met.
@previous = (undef)x@adj_index;
This tells the previous word from which we have first met this word. (You could have @seen and @previous in the same array.)
@queue = (undex)x@adj_index;
$queue_head = 0;
$queue_tail = 0;
This is the queue of words you have to process. Only the portion @queue[$queue_head .. $queue_tail - 1] section is meaningful, the section @queue[0 .. $queue_head] contains used up old items, and @queue[$queue_tail .. @queue] is space for future items.
When you see a word $j on the other side of an edge starting from $i, you mark it to be processed in the future if you haven't yet met it.
$found_goal = 0;
sub visit {
my($i, $j) = @_;
if (!$seen[$j]) {
$seen[$j] = 1;
$previous[$j] = $i;
$queue[$queue_tail++] = $j;
if ($goal == $j) {
$found_goal = 1;
}
}
}
You start by putting the starting word to the word queue, from a fake starting point.
seeword(-1, $start);
Now in the main loop, you shift a word to be processed from the queue and visit all its neigbours.
while ($queue_head < $queue_tail && !$found_goal) {
my $i = $queue[$queue_head++];
for $e (0 .. $adj_length[$i]) {
my $j = $adj_edge[$adj_index[$i] + $e];
visit($i, $j);
}
}
Finally, you must print the word ladder by following the edges backwards.
if ($found_goal) {
my $i = $goal;
while (-1 != $i) {
print $word_string[$i], "\n";
$i = $previous[$i];
}
} else {
print "no word ladder.\n";
}
(This would be a little bit longer if you wanted to print the words from start to goal, but instead just swap start with goal at program start.)
Sorry for errors in above code, it's untested.
#include <cstdlib>
#include <iostream>
#include <algorithm>
#include "opencv2/core/core.hpp"
using std::cerr; using std::abort;
using std::min; using std::max;
/*! Find a point set in a mask that is nearest (in l^\infty metric) to
+ a given point. */
/*!
\arg `image` is a boolean mask, must be of type `CV_8C` and 2 dime
+nsional,
nonzero value means true.
\arg `center` is the point.
\arg `output` becomes the nearest point found.
\returns true iff a point is found, false if `image` is all false.
*/
bool
FindNearestPoint(cv::Mat image, cv::Point center, cv::Point &output) {
if (CV_8U != image.type() || 2 != image.dims) {
cerr << "error: wrong type of matrix passed to FindNearestPoin
+ts (type=" << image.type() << ", dims=" << image.dims << ").\n";
abort();
}
int sy = image.rows, sx = image.cols;
int cy = center.y, cx = center.x;
int ldx = cx < 0 ? -cx : sx <= cx ? cx - sx : 0;
int ldy = cy < 0 ? -cy : sy <= cy ? cy - sy : 0;
int ld = max(ldx, ldy);
int hdx = cx < 0 ? sx - cx : sx <= cx ? cx : max(cx, sx - cx);
int hdy = cy < 0 ? sy - cy : sy <= cy ? cy : max(cy, sy - cy);
int hd = max(hdx, hdy);
for (int d = ld; d <= hd; d++) {
int ay = cy - d;
int ly = max(0, ay);
int by = cy + d;
int hy = min(sy - 1, by);
int ax = cx - d;
int lx = max(0, ax);
int bx = cx + d;
int hx = min(sx - 1, bx);
if (0 <= ax && ax < sx)
for (int y = ly; y <= hy; y++)
if (0 != image.at<unsigned char>(y, ax))
{ output = cv::Point(ax, y); return true; }
if (0 <= bx && bx < sx)
for (int y = ly; y <= hy; y++)
if (0 != image.at<unsigned char>(y, bx))
{ output = cv::Point(bx, y); return true; }
if (0 <= ay && ay < sy)
for (int x = lx; x <= hx; x++)
if (0 != image.at<unsigned char>(ay, x))
{ output = cv::Point(x, ay); return true; }
if (0 <= by && by < sy)
for (int x = lx; x <= hx; x++)
if (0 != image.at<unsigned char>(by, x))
{ output = cv::Point(x, by); return true; }
}
output = cv::Point(0, 0);
return false;
}
For obfu. The following magic variables intify automatically: $- $= $% $? $! $^E $^F $^T $^D $^H $^P. The following stringify: $0 $^I $^O $\ $^A $:. This boolify: $| $^W $^C.
To Monk_perl:
203527 <+termbot> +bcc vowel.c
203529 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
+
International
203529 <+termbot> -vowel.c:
203529 <+termbot> -Error vowel.c 9: Type mismatch in parameter '__s' i
+n call to
'fgets' in function main
203529 <+termbot> -Error vowel.c 9: Too few parameters in call to 'fge
+ts' in
function main
203529 <+termbot> -Error vowel.c 9: Nonportable pointer conversion in
+function
main
203529 <+termbot> -Warning vowel.c 18: Unreachable code in function ma
+in
203529 <+termbot> -Error vowel.c 20: Compound statement missing } in f
+unction
main
203531 <+termbot> -Warning vowel.c 20: Function should return a value
+in
function main
203534 <+termbot> -*** 4 errors in Compile ***
203534 <+termbot> -*** 4 errors in Compile ***
203534 <+termbot> -
203535 <+termbot> - Available memory 4081880
203536 <+termbot> -
203537 <+termbot> -C:\MONKPERL>
203542 <@b_jonas> `type vowel.c
203542 <+termbot> +type vowel.c
203542 <+termbot> - #include<stdio.h>
203542 <+termbot> -#include<conio.h>
203542 <+termbot> - main()
203542 <+termbot> - {
203543 <+termbot> - char c;
203545 <+termbot> - int i,n=0; /* n stands for no. of vowel*/
203547 <+termbot> - clrscr();
203548 <+termbot> - c=fgets(a[i]);
203549 <+termbot> - for(i=0;i<=a[i];i++)
203550 <+termbot> - {
203551 <+termbot> - switch(c)
203552 <+termbot> - {
203554 <+termbot> - case 'a': case 'e': case 'i': case 'o': c
+ase 'u':
203555 <+termbot> - n++;
203556 <+termbot> - break;
203557 <+termbot> -
203558 <+termbot> - getch();
203559 <+termbot> - }
203600 <+termbot> - }
203600 <+termbot> -
203601 <+termbot> -C:\MONKPERL>
</c>
<p>
Let's fix the call to fgets.
<c>
203945 <@b_jonas> `edlin vowel.c
203945 <+termbot> +edlin vowel.c
203946 <+termbot> -End of input file
203946 <+termbot> -*
204002 <@b_jonas> 9
204005 <@b_jonas> `9
204005 <+termbot> +9
204006 <+termbot> - 9:* c=fgets(a[i]);
204006 <+termbot> - 9:*
204017 <@b_jonas> ` fgets(a, 9, stdin);
204017 <+termbot> + fgets(a, 9, stdin);
204017 <+termbot> -*
204023 <@b_jonas> `8,10p
204023 <+termbot> +8,10p
204023 <+termbot> - 8: clrscr();
204023 <+termbot> - 9: fgets(a, 9, stdin);
204023 <+termbot> - 10:* for(i=0;i<=a[i];i++)
204023 <+termbot> -*
204030 <@b_jonas> `e
204031 <+termbot> +e
204031 <+termbot> -
204031 <+termbot> -C:\MONKPERL>
204039 <@b_jonas> `bcc vowel.c
204039 <+termbot> +bcc vowel.c
204041 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
+
International
204041 <+termbot> -vowel.c:
204042 <+termbot> -Warning vowel.c 18: Unreachable code in function ma
+in
204042 <+termbot> -Error vowel.c 20: Compound statement missing } in f
+unction
main
204042 <+termbot> -Warning vowel.c 20: Function should return a value
+in
function main
204042 <+termbot> -*** 1 errors in Compile ***
204042 <+termbot> -
204042 <+termbot> - Available memory 4081880
204044 <+termbot> -
204044 <+termbot> -C:\MONKPERL>
204406 <@cbstream> [ambrus] ah, that one error I got seems to be a mis
+take when
I copied the program. I skipped a line. So what did
+ you get?
What does the program do for you?
204132 <@b_jonas> `edlin vowel.c
204132 <+termbot> +edlin vowel.c
204132 <+termbot> -End of input file
204132 <+termbot> -*
204405 <@b_jonas> `17
204406 <+termbot> +17
204406 <+termbot> - 17:*
204406 <+termbot> - 17:*
204407 <@b_jonas> ` }
204407 <+termbot> + }
204407 <+termbot> -*
204409 <@b_jonas> `e
204410 <+termbot> +e
204410 <+termbot> -
204410 <+termbot> -C:\MONKPERL>
204412 <@b_jonas> `bcc vowel.c
204412 <+termbot> +bcc vowel.c
204415 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
+
International
204415 <+termbot> -vowel.c:
204415 <+termbot> -Warning vowel.c 20: Function should return a value
+in
function main
204415 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland
International
204415 <+termbot> -
204415 <+termbot> - Available memory 4075304
204418 <+termbot> -
204418 <+termbot> -C:\MONKPERL>
204640 <@cbstream> [ambrus] Monk_perl: apart from the wrong condition
+in the
for loop, I think there are at least two smaller pr
+oblems:
first, you never output anything, secondly, you cal
+l getch()
too many times (once for each iteration in the for
+loop)
204645 <+termbot> -C:\MONKPERL>
204656 <@b_jonas> `edlin vowel.c
204657 <+termbot> +edlin vowel.c
204657 <+termbot> -End of input file
204657 <+termbot> -*
204704 <@b_jonas> `18d
204704 <+termbot> +18d
204704 <+termbot> -*
204724 <+termbot> -*
204815 <@b_jonas> `19i
204815 <+termbot> +19i
204815 <+termbot> - 19:*
204841 <@b_jonas> `printf("%d",n);
204841 <+termbot> +printf("%d",n);
204841 <+termbot> - 20:*
204844 <@b_jonas> ``o
204844 <+termbot> +^Z
204845 <+termbot> -*
204849 <@b_jonas> `17p
204849 <+termbot> +17p
204849 <+termbot> - 17: }
204849 <+termbot> - 18: }
204849 <+termbot> - 19: printf("%d",n);
204849 <+termbot> - 20:* }
204850 <+termbot> -*
204853 <@b_jonas> `10
204854 <+termbot> +10
204854 <+termbot> - 10:* for(i=0;i<=a[i];i++)
204854 <+termbot> - 10:*
204926 <@b_jonas> ` for (i = 0; 0 != a[i]; i++)
204926 <+termbot> + for (i = 0; 0 != a[i]; i++)
204926 <+termbot> -*
204933 <@b_jonas> `1p
204934 <+termbot> +1p
204934 <+termbot> - 1: #include<stdio.h>
204934 <+termbot> - 2: #include<conio.h>
204934 <+termbot> - 3: main()
204934 <+termbot> - 4: {
204934 <+termbot> - 5: char c;
204934 <+termbot> - 6: char a[9];
204935 <+termbot> - 7: int i,n=0; /* n stands for no. of vow
+el*/
204935 <+termbot> - 8: clrscr();
204936 <+termbot> - 9: fgets(a, 9, stdin);
204936 <+termbot> - 10: for (i = 0; 0 != a[i]; i++)
204937 <+termbot> - 11: {
204937 <+termbot> - 12: switch(c)
204938 <+termbot> - 13: {
204938 <+termbot> - 14: case 'a': case 'e': case 'i': c
+ase 'o':
case 'u':
204939 <+termbot> - 15: n++;
204939 <+termbot> - 16: break;
204940 <+termbot> - 17: }
204940 <+termbot> - 18: }
204942 <+termbot> - 19: printf("%d",n);
204943 <+termbot> - 20:* }
204943 <+termbot> -*
205017 <@b_jonas> `e
205017 <+termbot> +e
205017 <+termbot> -
205018 <+termbot> -C:\MONKPERL>
205025 <@b_jonas> `bcc vowel.c
205025 <+termbot> +bcc vowel.c
205028 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
+
International
205028 <+termbot> -vowel.c:
205028 <+termbot> -Warning vowel.c 20: Function should return a value
+in
function main
205028 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland
International
205028 <+termbot> -
205028 <+termbot> - Available memory 4074540
205031 <+termbot> -
205031 <+termbot> -C:\MONKPERL>
205320 <@cbstream> [ambrus] right, the problem is, <c>switch(c)</c> do
+esn't
make sense, since you only assign <c>c</c> once and
+ in a
wrong way at that time. you need to switch on somet
+hing
that's set to the next character each time.
205319 <@b_jonas> `edlin vowel.c
205320 <+termbot> +edlin vowel.c
205320 <+termbot> -End of input file
205320 <+termbot> -*
205352 <@b_jonas> `12
205352 <+termbot> +12
205352 <+termbot> - 12:* switch(c)
205352 <+termbot> - 12:*
205401 <@b_jonas> ` switch(a[i])
205401 <+termbot> + switch(a[i])
205401 <+termbot> -*
205403 <@b_jonas> `e
205403 <+termbot> +e
205403 <+termbot> -
205403 <+termbot> -C:\MONKPERL>
205406 <@b_jonas> `bcc vowel.c
205406 <+termbot> +bcc vowel.c
205408 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland
+
International
205408 <+termbot> -vowel.c:
205408 <+termbot> -Warning vowel.c 20: Function should return a value
+in
function main
205408 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland
International
205409 <+termbot> -
205409 <+termbot> - Available memory 4074540
205411 <+termbot> -
205411 <+termbot> -C:\MONKPERL>
205417 <@b_jonas> `vowel
205418 <+termbot> +vowel
205420 <@b_jonas> `semi
205420 <+termbot> -semi
205420 <+termbot> -2
205420 <+termbot> -C:\MONKPERL>
205422 <@b_jonas> `vowel
205422 <+termbot> +vowel
205427 <@b_jonas> eieio
205431 <@b_jonas> `eieio
205432 <+termbot> -eieio
205432 <+termbot> -5
205432 <+termbot> -C:\MONKPERL>
205433 <@b_jonas> `vowel
205433 <+termbot> +vowel
205447 <@b_jonas> strmpf
205453 <@b_jonas> `strmpf
205454 <+termbot> -strmpf
205454 <+termbot> -0
205454 <+termbot> -C:\MONKPERL>
205523 <@cbstream> [ambrus] ah, after all the modifications, my versio
+n seems
to work now.
205646 <@b_jonas> `type vowel.c
205646 <+termbot> +type vowel.c
205646 <+termbot> - #include<stdio.h>
205646 <+termbot> -#include<conio.h>
205646 <+termbot> - main()
205646 <+termbot> - {
205647 <+termbot> - char c;
205647 <+termbot> - char a[9];
205648 <+termbot> - int i,n=0; /* n stands for no. of vowel*/
205648 <+termbot> - clrscr();
205649 <+termbot> - fgets(a, 9, stdin);
205649 <+termbot> - for (i = 0; 0 != a[i]; i++)
205650 <+termbot> - {
205650 <+termbot> - switch(a[i])
205651 <+termbot> - {
205651 <+termbot> - case 'a': case 'e': case 'i': case 'o': c
+ase 'u':
205652 <+termbot> - n++;
205652 <+termbot> - break;
205653 <+termbot> - }
205653 <+termbot> - }
205654 <+termbot> -printf("%d",n);
205654 <+termbot> - }
205655 <+termbot> -
205655 <+termbot> -C:\MONKPERL>
To Xiong:
use warnings;
use Scalar::Util "blessed";
{
package Error::Base;
sub new {
my($class, $str, @rest) = @_;
my %o = (str => $str, @rest); # you may store backtrace info too
bless \%o, $class;
}
use overload q/""/ => "strify";
sub strify {
my($self) = @_;
$$self{str} . "\n"; # you may append a user-readable form of the b
+acktrace
}
sub crash {
my($self, @rest) = @_;
die $self->new(@rest);
}
}
my $wt = -140;
if ($wt < 0) {
Error::Base->crash("creature weight negative",
negative_creature_weight => 1,
creature_name => "dragon",
creature_weight => -140,
);
}
__END__
Output:
creature weight negative
To Monk_perl:
-
Solve Write any natural number as sum of three triangular numbers.
-
Write a C program that inputs a list of fourteen integers separated by whitespace, then prints their alternating sign sum.
Example input: 44 57 31 29 51 29 59 48 82 18 95 11 45 64. Output for this input: 151
-
Without running it on a computer, determine what this program would print if ran.
#include <stdio.h>
int main(void) {
int n = 0;
while (n < 10) {
if (n < 5) {
n = n + 3;
} else {
n = n + 2;
printf("%d\n", n);
}
}
return 0;
}
List of perl modules I have, for Xiong. This is inclusive like your list, there are some modules in here that I haven't really tried.
Some dependencies are not listed, even if I've used them directly. Also, assume that I mean the latest stable versions of each of these modules and of the perl core.
-
Mark Lehmann's modules: AnyEvent, EV, AnyEvent::HTTP, Coro, Compress::LZF, EV::Loop::Async, JSON::XS, EV::ADNS, IO::Socket::SSL, AnyEvent::HTTP. (If you want to be inclusive, just install all his modules :)
-
Email parsing and creation: Mime::Tools, Email::Mime.
-
Internationalization stuff: Unicode::Collate.
-
modules whose functions have been integrated to core lately but you can still use them if you want your code to run on older perls unchanged: Socket::GetAddrInfo, MRO::Compat, Hash::Util::FieldHash::Compat, WWW::Curl.
-
OS interface: BSD::Resource, Socket::MsgHdr.
-
Date module: Date::Manip.
-
Toolkit stuff: Glib, Gtk2, Wx, Tk.
-
web and XML and related stuff: CGI, HTML::Tree, XML::Twig, XML::LibXML, XML::XSH2, XML::XPath, LWP, URI, Net::Curl::Simple, Mozilla::CA.
-
Perl data structures stuff: Data::Diver, Data::Dump::Streamer.
-
Perl internals magic stuff: Sub::Name.
-
Regexp::Common.
-
Numeric: Math::BigInt::GMP, Math::Int64, Math::Libm, PDL.
-
Serialization: YAML (I don't recommend this one, but it's popular), YAML::Syck, JSON.
-
Various other modules I have downloaded to look at their docs but have never used them and possibly never even installed them (this is true to some of the previous modules too): Astro::MoonPhase, B::Keywords, File::HomeDir, File::ShareDir, Sane.
-
Paul Evan's modules (I haven't really tried any of these): Async-MergePoint, IO::Async, AnyEvent::IRC, Term::TermKey.
-
(Update:) This one I install only because I'm the maintainer: Object::Import.
Code in pre tags around code tags
first line
second
third
fourth
To cythin, based on cythin's scratchpad and The story of a strange line of code: pos($_) = pos($_);:
use warnings; use strict;
my $regex1 = qr/([a-zA-Z]+(\d*)+)|((\d*)+[a-zA-Z]+)/; #default
+words, and words with numbers
my $regex2 = qr/(\w|\d|\.)+@(\w|\d|\.)+/; #email addresses
my $regex3 = qr/(\w+)\s?(\d)+/; #word and number co
+mbinations: Number 1, Assignment 2, Vol
my $regex4 = qr/(\w+)'(\w){0,2}/; #contractions in Engl
+ish
my $regex5 = qr/(\w)(\/|&)(\w)/; #abbreviations with sl
+ash: c/o, i/o, etc.
my $regex6 = qr/(M).{1,2}\.(\s([A-Z]{1}[a-z]+))?/; #formal titl
+es: Dr., Mr., Mrs. Agenstein, etc.
my $regex7 = qr/(\w+)-(\w+)(-\w+)?/; #hyphenated words:
+ cat-like, face-to-face, etc.
my $regex8 = qr/([A-Z]\.?){3}/; #3-letter abbreviat
+ions, using uppercase only, no space,
my $regex9 = qr/[a-zA-Z]{3}\.\s?(\d+)/; #3-letter abbre
+viations containing numbers, mixed case,
my $regex10 = qr/\$\d+/; #money expressions $xxxx f
+ormat
my $regex11 = qr/\$\d+(.\d{2})?/; #money expressions $x
+xxx.xx format
my $regex12 = qr/(http:\/\/.*)|(w{3}\.(.)*)/; #websites beg
+inning with www. or http://
my $regex13 = qr/(\(\d{3}\)\s(\d{3})-(\d{4}))/; #phone numb
+ers, no country code (xxx) xxx-xxxx
my @regarray = ($regex13, $regex12, $regex11, $regex10, $regex9, $rege
+x8, $regex7, $regex6, $regex5, $regex4, $regex3, $regex2, $regex1);
$/ = undef;
my $text = <DATA>;
TOK: while(1) {
for my $i (0 .. @regarray-1) {
my $re = $regarray[$i];
if ($text =~ /\G($re)/gc) {
my $word = $1;
if (12 != $i) {
printf "%02d (%s)\n", $i, $word;
}
next TOK;
}
}
if ($text =~ /\G./gcs) {
1;
} elsif ($text =~ /\G\z/gc) {
print "end of text\n";
last;
} else {
die;
}
}
__DATA__
Some text here
Custom CSS I use with the Dark theme. This is grey on black text. One problem with it is that I can't change the colors of the checkboxes and option buttons, so they look ugly. (I'm using various versions of Firefox mostly.)
/* css for ambrus in perlmonks.com */
/* color, supplementing the Dark theme */
input, textarea, select { background-color: #000000; color: #cccccc }
input[type="submit"] { background-color: #000000; color: #ffffff }
a:link { color: #8080ff }
a:visited { color: #a060d0 }
/* posts */
div.notetext { font-size: 100% }
tr.reply-body ul.indent font[size="2"] { font-size: 100% }
div.readmore { background-color: transparent; padding-left: 2px; borde
+r-left-width: 2px; border-left-color: #080; border-left-style: solid
+}
/* nodelets */
tbody.nodelet td { font-size: 100%; background-color: #000000 }
#XP_Nodelet sup { vertical-align: text-top }
tbody.nodelet .inline-list > li:before { content: " "; }
tbody.nodelet#Find_Nodes .inline-list > li { display: block; }
.nodelet#Leftovers ul#external { display: none; }
/* cb messages */
tbody.nodelet td.highlight { /* background-color: transparent */ }
tr.cb_msg td, tr.cb_me td { padding: 0px; text-indent: -0.6em; padding
+-left: 0.6em; }
/* cb speakers: */
span.chat span.cb_author *:link, span.chat span.cb_author *:visited {
+font-size: 111% }
span.chat i > span.cb_author *:link , span.chat i > span.cb_author *:v
+isited { font-size: 111%; font-style: italic }
/* cb separators
span.chat span.cb_author:before { content: "\3d" }
span.chat i > span.cb_author:before { content: "\3d" }
span.chat span.cb_author:after { content: "\3d" }
span.chat i > span.cb_author:after { content: "" }
*/
span.chat span.cb_sq_br:first-child , span.chat span.cb_sq_br , span.
+chat span.cb_me_bullet { display: none }
/* span.chat span.cb_sep { } */
/* cb sidebar */
body#id-481185 input[name="message"] { width: 100%; }
body#id-481181 table.cb_table td { font-size: 17px }
/* increase some text areas */
*.user-settings textarea[name="setstyle"] { width: 80ex; height: 20em
+}
/* show levels next to attributions */
/*.attribution-title { display: inline; }*/
/* misc */
div.ss-criteria-summary { display: none }
/* TEMP */
/*"http://cruft.de/lr.css"*/
/*tbody[id="XP_Nodelet"] { display: none; color: lime }*/
/*.nnt-line-incidental .nnt-link { background-color: orange; }*/
/*ul ul ul { padding-left: 0px }*/
/* body#id-11911 .nodelets { display: none } */
Rat gradient is 80ff80;8080ff.
Testing: ea ια ou őű low control space control
del cp1252 –… invalid byte ‘€ end.
Languages in order of portability on unix systems, for when I want to write a cross-language obfu. (These are off the top of my head, check package lists of distros if you want to be sure.)
-
Almost all unixen: bash or ksh, sed or awk, gcc.
-
Almost all linuxen: bash, gsed, gawk, perl.
-
Linuxen where you build: g++, gmake.
-
Linuxen where you develop: m4 (autotools uses it), lex, yacc, makeinfo, some C libraries.
-
Traditional unices (but not some modern linux desktops): make, dc, bc, ex.
-
Many unices where you typeset: metafont, tex, latex, gs (ghostscript).
-
Many linuxes: python2, ruby1.8, firefox or konqueror.
Funny warning syntax that inlines to nothing:
use warnings; use strict;
+
no warnings qw"void";
+
sub DEBUG () {}
{ package Dbglt; use overload "<", sub {}; }
*< = sub { bless {}, Dbglt::; };
# for not debugging, uncomment:
sub dbg () { "" }
# for debugging, uncomment:
#sub dbg { "" }
dbg & <<'DEBUG;';
warn "debugging message";
DEBUG;
warn "normal message";
__END__
# bash functions for manipulating the path
shopt -s extglob
# addpath appends a directory to the path unless it is already there
# eg: addpath ~/bin
addpath(){
local a p=":$PATH:"; for a;
do case "$p" in (*:"${a%/}"?(/):*);; (*) p="$p$a:";; esac;
done; p="${p#:}"; PATH="${p%:}";
}
# delpath deletes a dir from the path
delpath(){
local a p=":$PATH:"; for a;
do a="${a%/}"; p=${p/:"${a}"?(\/):/:};
done; p="${p#:}"; PATH="${p%:}";
}
#END
To Xiong: removing filter by calling unimport works as expected:
[am]king ~/a/tmp$ cat a.pl
{
package Filter::Transcript;
use Filter::Util::Call;
sub filter {
my $s = filter_read;
warn "TRANSCRIPT: $_";
$s;
}
sub import {
filter_add(\&filter);
}
sub unimport {
filter_del()
}
BEGIN { $INC{"Filter/Transcript.pm"}++; }
}
print "hello, world\n";
use Filter::Transcript;
for (0, 1) {
print "this part of the code is transscribed\n";
}
no Filter::Transcript;
print "good bye\n";
__END__
[am]king ~/a/tmp$ perl a.pl
TRANSCRIPT:
TRANSCRIPT: for (0, 1) {
TRANSCRIPT: print "this part of the code is transscribed\n";
TRANSCRIPT: }
TRANSCRIPT:
TRANSCRIPT: no Filter::Transcript;
hello, world
this part of the code is transscribed
this part of the code is transscribed
good bye
[am]king ~/a/tmp$ perl -v
This is perl 5, version 12, subversion 1 (v5.12.1) built for x86_64-li
+nux
Copyright 1987-2010, Larry Wall
Perl may be copied only under the terms of either the Artistic License
+ or the
GNU General Public License, which may be found in the Perl 5 source ki
+t.
Complete documentation for Perl, including FAQ lists, should be found
+on
this system using "man perl" or "perldoc perl". If you have access to
+ the
Internet, point your browser at http://www.perl.org/, the Perl Home Pa
+ge.
[am]king ~/a/tmp$
The link from the internationalized About Google page
http://www.google.hu/intl/hu/about.html to the Google Blog is
broken. It says "Google Blog" but actually points to the google
search main page http://www.google.com/.
I can't figure out where to send a report about this.
I looked at the Google Help Center at first,
but in http://www.google.com/support/bin/static.py?page=portal_more.cs
I couldn't find a category that matched the about page. Then I tried
the "Contacting Us" page, but it seems there's no general contact
page, only ones tied to each google product like Web search
(http://www.google.com/support/websearch/bin/request.py?contact_type=contact_policy),
which sent me to the Help forum. However, the Help forum
http://www.google.com/support/forum?hl=en is also separated to pages
for each google product, and it seems there's no generic forum about
topics that don't fit elsewhere, nor a forum about the Help Center or
the Help forum itself (nor a Help Center category about the forum
etc), so now I completely don't have any idea on who to ask.
On the
Google Blog page itself they say "We Love Feedback" with an email addres, and they're probably interested in the link pointing to them (so readers can find the blog), so finally I sent a mail to that address in case they can help, but I still don't think that's the right place.
So, dear monks, help me figure out who I should ask about this thing.
Why am I getting this warning?
$ perl -we 'my %rule = ("suffix1", "foo", "succ1", "bar"); warn join("
+/", @rule{qw"suffix1 succ1"})'
Scalar value @rule{qw"suffix1 succ1"} better written as $rule{qw"suffi
+x1 succ1"} at -e line 1.
foo/bar at -e line 1.
$ perl -v
This is perl, v5.10.1 (*) built for x86_64-linux
...
Word ladder, perl quiz of the week expert edition week 22. See
report of solutions and task specification, my submission,
and other mails in these two mailing lists.
RE The Oldest Plays the Piano
There's
Re: Simple primality testing which links to an older node prime factorization using base 1.
Then there's the amazing dc.sed script which implements arbitrary precision numeric calculations in decimal base in sed – you can find its source here or inside the tarball of gnu sed as a test. I don't really understand how it does the multiplication and division, but I could do the addittion on my own in a slightly more complicated way in Re^2: --- adding a column of integers (it's a loop of four substitutions, dc.sed has two and the teasing comment "could be done in one s/// if we could have >9 back-refs..." which I don't really believe).
How about fibonacci numbers? Some snipets like Re: Fibonacci golf with one state variable use regex substitutions but then they're not really using the power of the regex engine. There must be some way to actually use the regular expression engine to generate fibonacci numbers though. Searching yields fibonacci regex and Fibonacci Regex. These test for fibonacci numbers rather than generating them but there's probably some way to convert them. Another idea is to use something like this but probably there's some nicer way to phrase it:
perl -le'$==1,(1x$_)=~/(^)(1|11\1)*(?{$=++})^/,print$=for 0..20'
good localtime
Here's some code to show that IO::Socket inherits the creation methods (new, new_from_fd, fdopen) from IO::Handle.
perl -we 'use warnings; use strict; use 5.010; use IO "Socket"; use So
+cket; use Fcntl; my($L, $R) = IO::Socket->socketpair(PF_UNIX, SOCK_ST
+REAM, 0) or die; $L->fcntl(F_SETFD, $L->fcntl(F_GETFD, 0) &~ FD_CLOEX
+EC); defined(my $p = fork) or die "fork"; if (!$p) { exec @ARGV, $L->
+fileno; die "exec"; } $L->close; print "reading... "; my $x = $R->get
+line; say "got: $x"; 0 < waitpid $p,0 or die "wait";' perl -we 'use w
+arnings; use strict; use 5.010; use IO::Socket; sleep 1; my $h = shif
+t; say "fileno: $h"; my $O = IO::Socket->new_from_fd($h, ">") or die
+"fdopen $!"; $O->printflush("hello"); $O->shutdown(SHUT_WR); say "wri
+tten"; sleep 1; say "done";'
To Tanktalus, who is lazy to read the irc RFCs.
perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREA
+M(), 0 or die; connect $C, sockaddr_in(6667, inet_aton("irc.freenode.
+net")) or die; printf $C "user 0 0 0 x\nnick cbu%04x\njoin #cbstream\
+n", rand(2**16) or die; flush $C; while (<$C>) { y/\r//; /\A(?::\S+)?
+\s+(?:4|ERROR)/ and die $_; /\A:cbstream!\S+\s+PRIVMSG\s+#cbstream\s+
+:?(.*)/si and print $1; }'
New, corrected version:
perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREA
+M(), 0 or die; connect $C, sockaddr_in(6667, inet_aton("irc.freenode.
+net")) or die; printf $C "user 0 0 0 x\nnick cbu%04x\njoin #cbstream\
+n", rand(2**16) or die; flush $C; while (<$C>) { y/\r//; /\A(?::\S+)?
+\s+(?:4(?!77)|ERROR)/ and die $_; /\A:cbstream!\S+\s+PRIVMSG\s+#cbstr
+eam\s+:?(.*)/si and print $1; }'
Numerology. If you don't cheat by using random operations and only add the letters of each verse then 442 is the most frequent sum in the bible.
442 thorns(19+7+14+17+13+18) also(0+11+18+14) An(0+13) thistlez(19
++7+8+18+19+11+4+25) gun(6+20+13) it(8+19) brin(1+17+8+13) forth(5+14+
+17+19+7) 2 u(20); -- Genesis 3:18
442 Ceiling(2+4+8+11+8+13+6) Cat(2+0+19) sed(18+4+3), "yr(24+17) h
+er(7+4+17) bukkit(1+20+10+10+8+19) holder(7+14+11+3+4+17), go(6+14) h
+old(7+14+11+3) her(7+4+17) bukkit(1+20+10+10+8+19)." -- Genesis 16:9
442 An(0+13) he(7+4) sed(18+4+3) "Abraham(0+1+17+0+7+0+12) ur(20+1
+7) gud(6+20+3) kitteh(10+8+19+19+4+7). U(20) wud(22+20+3) givd(6+8+21
++3) me(12+4) ur(20+17) kitteh(10+8+19+19+4+7). -- Genesis 22:16
442 Dad(3+0+3) may(12+0+24) feels(5+4+4+11+18) my(12+24) no(13+14)
+ furz(5+20+17+25), then(19+7+4+13) he(7+4) would(22+14+20+11+3) cockm
+ongle(2+14+2+10+12+14+13+6+11+4) me(12+4)." -- Genesis 27:12
442 Da(3+0) maidz(12+0+8+3+25) n(13) dere(3+4+17+4) kittehs(10+8+1
+9+19+4+7+18) come(2+14+12+4) up(20+15) and(0+13+3) smelled(18+12+4+11
++11+4+3) Esau's(4+18+0+20+18) butt(1+20+19+19), -- Genesis 33:6
442 newai(13+4+22+0+8) u(20) can(2+0+13) lookz(11+14+14+10+25) at(
+0+19) me(12+4) An(0+13) seez(18+4+4+25) taht(19+0+7+19) i(8) iz(8+25)
+ ur(20+17) bro(1+17+14). 4 rael(17+0+4+11). -- Genesis 45:12
442 See(18+4+4)? U(20) has(7+0+18) stopped(18+19+14+15+15+4+3) all
+(0+11+11) teh(19+4+7) Israelite(8+18+17+0+4+11+8+19+4) d(3)00dz(3+25)
+ from(5+17+14+12) work(22+14+17+10)." -- Exodus 5:5
442 Eech(4+4+2+7) yr(24+17), U(20) eet(4+4+19) bred(1+17+4+3) wid(
+22+8+3) no(13+14) yeest(24+4+4+18+19), or(14+17) I(8) pwn(15+22+13) U
+(20). Big(1+8+6) tyme(19+24+12+4). -- Exodus 12:15
442 pwn(15+22+13) teh(19+4+7) Midianites(12+8+3+8+0+13+8+19+4+18)
+for(5+14+17) teh(19+4+7) j(9)00s(18) so(18+14) tehy(19+4+7+24) wil(22
++8+11) laik(11+0+8+10) u(20). -- Numbers 31:2
442 Ruth(17+20+19+7) goes(6+14+4+18) home(7+14+12+4) at(0+19) 5. S
+he(18+7+4) has(7+0+18) got(6+14+19) good(6+14+14+3) amount(0+12+14+20
++13+19) of(14+5) foods(5+14+14+3+18). -- Ruth 2:17
442 "when(22+7+4+13) tehy(19+4+7+24) iz(8+25) liek(11+8+4+10) 'we(
+22+4) can(2+0+13) haz(7+0+25) cheezburgr(2+7+4+4+25+1+20+17+6+17) nao
+w(13+0+14+22) plz(15+11+25)?'() -- Job 38:40
442 Oh(14+7) hai(7+0+8). Dude(3+20+3+4) called(2+0+11+11+4+3) Job(
+9+14+1) replied(17+4+15+11+8+4+3) on(14+13) chat(2+7+0+19) and(0+13+3
+) sed(18+4+3) back(1+0+2+10) to(19+14) Invisible(8+13+21+8+18+8+1+11+
+4) Man(12+0+13): -- Job 42:1
442 u(20) is(8+18) on(14+13) teh(19+4+7) thrones(19+7+17+14+13+4+1
+8), gettin(6+4+19+19+8+13) praised(15+17+0+8+18+4+3) by(1+24) teh(19+
+4+7) Israel(8+18+17+0+4+11). -- Psalm 22:3
442 Ceiling(2+4+8+11+8+13+6) cat(2+0+19) are(0+17+4) serious(18+4+
+17+8+14+20+18) cat(2+0+19). This(19+7+8+18) are(0+17+4) serious(18+4+
+17+8+14+20+18) psalm(15+18+0+11+12). -- Psalm 24:8
The numerology guys are: Zombie timeless 1 tess e:v Zombie yeshfriend TRUTH.
New fav pentomino pattern testing here.
This is a test to see if we can still make a homenode button with html filtering, using javascript.
Go0
Alert1
Golf
More
Ofill
Smile
<a href="r=javascript:r='replace';eval(s='\';d=document;d.write(\'\\x3cform method=postImessage name=opI\\\'H\\\' name=message \'.replace(/I/g,\' \\x3cinput value=\'));d.close();d.forms[0].stubmit();'r(/^/,'r=\''+r))">X
My perlmonks user CSS (I use the default theme, updated 2008 August 1st):
/* css for ambrus in perlmonks.com */
/* general */
/* posts */
div.notetext { font-size: 100% }
tr.reply-body ul.indent font[size="2"] { font-size: 100% }
div.readmore { background-color: transparent; padding-left: 2px; borde
+r-left-width: 2px; border-left-color: #080; border-left-style: solid
+}
/* nodelets */
#nodelet_body_row_XP_Nodelet sup { vertical-align: text-top }
tbody.nodelet td { font-size: 100% }
/* cb messages */
tbody.nodelet td.highlight { /* background-color: transparent */ }
tr.cb_msg td, tr.cb_me td { padding: 0px; text-indent: -0.6em; padding
+-left: 0.6em; }
/* cb speakers: */
span.chat span.cb_author *:link, span.chat span.cb_author *:visited {
+font-size: 111% }
span.chat i > span.cb_author *:link , span.chat i > span.cb_author *:v
+isited { font-size: 111%; font-style: italic }
/* cb separators
span.chat span.cb_author:before { content: "\3d" }
span.chat i > span.cb_author:before { content: "\3d" }
span.chat span.cb_author:after { content: "\3d" }
span.chat i > span.cb_author:after { content: "" }
*/
span.chat span.cb_sq_br:first-child , span.chat span.cb_sq_br , span.
+chat span.cb_me_bullet { display: none }
/* span.chat span.cb_sep { } */
/* cb sidebar */
body#id-481185 input[name="message"] { width: 100%; }
body#id-481181 table.cb_table td { font-size: 17px }
/* increase some text areas */
*.user-settings textarea[name="setstyle"] { width: 80ex; height: 20em
+}
/* hide levels next to attributions */
span.attribution-title { display: none }
/* misc */
div.ss-criteria-summary { background-color: lime }
/* hide some links from the nodelets */
.nodelet#leftovers a[href="http://www.cafepress.com/perlmonks,perlmonk
+s_too,pm_more"], .nodelet#leftovers a[href="http://www.cafepress.com/
+perlmonks,perlmonks_too,pm_more"] + br, a[href="http://perlbuzz.com/"
+], .nodelet#leftovers a[href="http://perlbuzz.com/"] + br, a[href="ht
+tp://perl.com/"], .nodelet#leftovers a[href="http://perl.com/"] + br,
+ a[href="http://www.perlfoundation.org/perl5/index.cgi"], .nodelet#le
+ftovers a[href="http://www.perlfoundation.org/perl5/index.cgi"] + br,
+ a[href="http://jobs.perl.org/"], .nodelet#leftovers a[href="http://j
+obs.perl.org/"] + br, a[href="http://www.pm.org/"], .nodelet#leftover
+s a[href="http://www.pm.org/"] + br, a[href="http://planet.perl.org/"
+], .nodelet#leftovers a[href="http://planet.perl.org/"] + br, a[href=
+"http://use.perl.org/"], .nodelet#leftovers a[href="http://use.perl.o
+rg/"] + br, a[href="http://www.perl.org/"], .nodelet#leftovers a[href
+="http://www.perl.org/"] + br { display: none }
/* TEMP */
/*"http://cruft.de/lr.css"*/
/*tbody[id="XP_Nodelet"] { display: none; color: lime }*/
Variant of patchy patterns
perl -we '($H,$W)=`stty size`=~/^(\d+) (\d+)/?($1-1,$2):(24,80);$w=$W+
+20; @a = map { rand() < 1/5 } 0 .. ($H+20)*$w; print "\e[H\e[J"; whil
+e() { print "\e[H"; for (1..5) { rand(40)<1 and @a[rand(@a)] = 1; @a
+= map { $c = $_; $s = 0; $s += $a[($c + $_) % @a] for -$w-1, -$w, -$w
++1, -1, 1, $w-1, $w, $w+1; $p = $a[$_]; ($p?2:4) <= $s && $s < ($p?6:
+9) } 0 .. @a - 1; } for $y (10 .. $H + 9) { for $x (10 .. $W + 9) { p
+rint $a[$y*$w + $x] ? "#" : " "; } print "\n"; } }'
List of candidates for irc/pm questions that could be auto-replied to.
- duping filehandles
- system versus qx, especially `mkdir` and `cp`
- replace between
- fork, esp 0==$pid
- \Q
- dereferencing deep datastructures (hard)
- symbolic references
- status gauge in a CGI
- anything with xp in pmdiscuss
-
Proof-of-concept example for array automatically computing the sum of its first few elements. On Limbic~Region's question. Warning: splicing, shifting etc the element will mess this up.
[am]king ~$ perl -we 'use strict; { package S; use Tie::Scalar; @{*ISA
+} = "Tie::StdScalar"; sub STORE { $::sum -= ${$_[0]}||0; $::sum += ${
+$_[0]} = $_[1] } } my @x; tie $x[$_], "S" for 0..2; $::sum = 0; $x[ra
+nd(10)] = int(rand(10)) for 0..99; $"="+"; warn "$::sum = @x[0..2]";'
13 = 2+8+3 at -e line 1.
[am]king ~$
Here's a simple vector paint program.
It requires a terminal that can do xterm-like mouse reporting. It allows to draw colored polygons.
Left button adds a new node after the last one, right button removes the last node, middle button moves last node. The dot and comma keys cycle the nodes of the polygon, so you can change the nodes at any place. Backspace scrapes the whole polygon. The digits 0-7 set the color of the polygon. The lc letters a-z select another polygon: you have 26 of these, you can edit and color each of them independently, at startup the "a" polygon is selected, and the polygons with later letters are above the earlier ones.
The program can now save drawings. If you give a filename as a command-line argument, the drawing from that file will be loaded (if the file exists) and control-D will quit from the program saving to that file.
You figure out the rest from the code.
#!ruby -w
# simple vector-based paint program -- by ambrus
#
def mainloop;
at_exit do
print "\e[?9l\e[m";
system(*%w"stty sane");
end;
system(*%w"stty -icanon -echo -echonl");
puts "\e[?9h";
render;
while c = STDIN.getc;
if ?\e != c;
gotkey c;
elsif ?[ != STDIN.getc || ?M != STDIN.getc;
else
b = STDIN.getc - ?\ ;
x = STDIN.getc - ?!;
y = STDIN.getc - ?!;
gotmouse b, x, y;
end;
end;
end;
def render;
print "\e[H";
@SCRHEI.times do |y|
b = [[1e6]];
(0 ... @x.size).each do |obj|
px = @x[obj];
py = @y[obj];
b.concat((0 ... px.size).map do |k|
m = if py[k-1] <= y && y < py[k]; 1;
elsif py[k] <= y && y < py[k-1]; -1; end;
if m;
if xdet = py[k] - py[k - 1];
x = (px[k-1] * (py[k] - y) - px[k] * (py[k - 1
+] - y)) / xdet;
[x, m, obj];
end;
end;
end.compact);
end;
b.sort!;
c = @x.map { 0 };
@SCRWID.times do |x|
while b[0][0] < x;
c[b[0][2]] += b[0][1];
b.shift;
end;
fobj = (0 ... c.size).map.reverse!.find {|o| 0 != c[o] };
colr = if fobj; @colr[fobj] else "7" end;
print "\e[4#{colr}m ";
end;
y < @SCRHEI - 1 and print "\e[K\n";
end;
print "\e[J";
STDOUT.flush;
end;
def fsave fname;
File.open(fname, "w") do |file|
file.puts "DRAWIMAGE 0 1";
(0 ... 26).each do |n|
@x[n].empty? and next;
file.print "OBJECT ", n, " ", @colr[n];
(0 ... @x[n].size).each do |k|
file.print " ", @x[n][k], " ", @y[n][k];
end;
file.print "\n";
end;
end;
end;
def fload fname;
file = ();
begin
file = File.open(fname);
rescue Errno::ENOENT, Errno::ENAMETOOLONG, Errno::EISDIR, Errno::E
+LOOP, Errno::ENOTDIR,
Errno::EACCES, Errno::EROFS;
return;
end;
version = false;
file.each do |l|
l =~ /\A\s*(?:#|\z)/ and next;
f = l.scan(/\S+/);
case f[0].upcase;
when "DRAWIMAGE";
"0" == f[1] or fail "wrong major verson loading image
+file";
version = true;
when "OBJECT";
(0 ... 26) === (n = Integer(f[1])) or fail "wrong file
+ format: invalid obj nr";
(0 ... 7) === (colr = Integer(f[2])) or fail "wrong fi
+le format: invalid colr";
@colr[n] = colr.to_s;
s = (f.size - 3)/2;
(0 ... s).each do |k|
(-32768 .. 32767) === (@x[n][k] = Integer(f[3 + k
+* 2])) or fail "wrong file format: invalid coordinate";
(-32768 .. 32767) === (@y[n][k] = Integer(f[3 + k
+* 2 + 1])) or fail "wrong file format: invalid coordinate";
end;
when "QC";
# noop
else
fail "wrong file format: invalid decl";
end;
end;
version or fail "wrong draw file format: no header";
file.close;
true;
end;
TIOCGWINSZ = 0x00005413;
def getwinsz;
#@SCRHEI, @SCRWID = 24, 80;
STDOUT.ioctl(TIOCGWINSZ, (buf = [].pack("x99")));
@SCRHEI, @SCRWID = buf.unpack("s!s!");
end;
getwinsz;
@x = (0 ... 26).map { [] };
@y = @x.map { [] };
@colr = @x.map { "0" };
def selobj n;
@s = n;
@xs = @x[n];
@ys = @y[n];
end;
selobj 0;
$*.empty? or fload($*[0]);
def gotmouse b, x, y;
if 0 == b; # left button appends point
@xs.push x;
@ys.push y;
elsif 2 === b; # right button removes point
@xs.pop;
@ys.pop;
elsif 1 === b; # middle button moves last point
@xs.empty? and return;
@xs[@xs.size - 1] = x;
@ys[@xs.size - 1] = y;
end;
render;
end;
def gotkey c;
case c;
when ?a .. ?z;
selobj c - ?a;
when ?0 .. ?7;
@colr[@s] = c.chr;
when ?\b, ?\x7f;
@xs.replace [];
@ys.replace [];
when ?,;
@xs.empty? and return;
@xs.unshift @xs.pop;
@ys.unshift @ys.pop;
when ?.;
@xs.empty? and return;
@xs.push @xs.shift;
@ys.push @ys.shift;
when ?/;
@xs.pop;
@ys.pop;
when ?\cd;
$*.empty? or fsave($*[0]);
exit;
end;
render;
end;
mainloop();
__END__
Here's an elephant I've made with a previous version.
+
+
+++++++++++++++++++
+
+++++++++++++++++++++
+
++++++++++++++++++++++
+
++++++++++++++++++++++++
+
+++++++++ ++++++++++++++++++++++++++++++++++++++++
+
++++++++++ +++++++++++++++++++++++++++++++++++++++
+
++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+++++++ ++++++++++++++++++++++++++++++++++++++++++++
++
+++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++
++++++ +++++++++++++++++++++++++++++++++++++++++
+++
+++++ ++++++++++++++++++++++++++++++++++++++++++
++++
++++ +++++++++++++++++++++++++++++++++++++++++++
++++
++++ ++++++++++++++++++++++++++++++++++++++++++++
++ ++
++++++ +++++++++++++++++++++++++++++++++++++++++++++
++ ++
++++++++++ +++++++++++ +++++++++
++ +
+++++++ +++++++++++ +++++++++
++ +
++++++++++++ +++++++++
++
++++++++++++ +++++++++
++
+++++++++++++ +++++++++
++
cbstream FAQ
To Corion.
sub mask {
my($s, $m) = @_;
[map { $$s[$_] } grep { 0 != ($m & (1<<$_)) } 0 .. @$s - 1];
}
A lua japh.
a="for b=2,26 do c=0;for d,e in ipairs({a:byte(1,-1)})do c=(b*c+e)%127
+\
end;io.write(string.char(c))end--$S`U$-}OPX41,@aYH\3\26Q2\23*|>";
loadstring(a) {ambrus}
Question about the regexp engine.
Suppose I want to do this: "aaaaaaaaab" =~ /(a(?:|(?1)|a(?1 )))/
Which one of the below two behaiviours would it do:
#!perl
# simulate the regexp /(a(?:|(?1)|a(?1)))/
use warnings;
use strict;
for my $MEM (0, 1) {
print $MEM ? "with" : "without", " memoization\n";
my $u;
my %c = ();
my $f; $f = sub {
$u++;
my $a = join(",", @_);
$MEM and exists($c{$a}) and
return $c{$a};
$c{$a} = (
1 <= @_ and
$_[0] eq "a" and (
1 == @_ or
&$f(@_[1 .. @_ - 1]) or
$_[1] eq "a" and
&$f(@_[1 .. @_ - 1])
)
);
};
for my $s ("aaaaaaaa", "aaaaaaaab") {
$u = 0;
print " ", $s, ": ",
&$f($s =~ /(.)/g) ? "hit" : "miss", ", sub cal
+led ", $u,
" times\n";
}
}
__END__
Output:
without memoization
aaaaaaaa: hit, sub called 8 times
aaaaaaaab: miss, sub called 383 times
with memoization
aaaaaaaa: hit, sub called 8 times
aaaaaaaab: miss, sub called 16 times
Here's a somewhat similar re that would blow up but perl optimizes it.
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((?{$u++})(?:a|aa
+))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaaaaaa
+aa aaaaaaaaab";'
aaaaaaaaa: hit, parens called 10 times
aaaaaaaaab: miss, parens called 20 times
However, you can force it to blow up if you make the optimization impossible with a (??{ -- which incidentally shows that "have I recursed" conditionals are not the only thing why these kinds of optimizations are difficult.
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((??{$u++;""})(?:
+a|aa))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaa
+aaaaaa aaaaaaaaab";'
aaaaaaaaa: hit, parens called 10 times
aaaaaaaaab: miss, parens called 143 times
Backreferences can also inhibit this optimization:
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /j(.)rd((?{$u++})(?
+:\1|\1\1))+j/ ? "hit" : "miss", ", parens called $u times\n" } for qw
+"jard"."a"x16 ."bjord"."o"x16 ."j";'
jardaaaaaaaaaaaaaaaabjordooooooooooooooooj: hit, parens called 4197 ti
+mes
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /j(.)rd((?{$u++})(?
+:[ao]|[ao][ao]))+j/ ? "hit" : "miss", ", parens called $u times\n" }
+for qw"jard"."a"x16 ."bjord"."o"x16 ."j";'
jardaaaaaaaaaaaaaaaabjordooooooooooooooooj: hit, parens called 76 time
+s
This means that if you want to implement this memoization thing in the perl RE engine, you'll have to work with finding out when you can correctly apply it and when you can't.
I'm starting to really admire the engine (and those who wrote it) that it can work all this out.
I guess might make all this a meditation. As a reference to myself: palindrome using regular expressions.
print {;log=>} "hi";
For tye.
A command to rename some files, answer for a question on irc. Note how I avoid elseifs with next.
perl -we 'use File::Find; finddepth sub {{ /\A(\d{5}-p)(\d+)(\.tif)\z/
+ or next; my $n = sprintf("%s%04d%s", $1, $2, $3); -e $n and next; wa
+rn "$_ => $n\n"; rename $_, $n or die "error rename $_ $n: $!"; }}, "
+.";'
For creamygoodness, on embedding C snippets into C as data, here's a quine I wrote ages ago.
// 323 - Self reproducing program by Ambrus ZSBAN
//
// This program writes its source code to stdout.
// RVLVQRVLVQ
#include <stdio.h>
#include <string.h>
char s1[]=
"// 323 - Self reproducing program by Ambrus ZSBAN\n"
"//\n"
"// This program writes its source code to stdout.\n"
"// RVLVQRVLVQ\n"
"\n"
"#include <stdio.h>\n"
"#include <string.h>\n"
"char s1[]=\n"
"\"";
char s2[]=
"\";\n"
"\n"
"int main (void) {\n"
" char *p;\n"
" int x;\n"
" printf (\"%s\", s1);\n"
" p= s1;\n"
" while (*p) {\n"
" switch (*p) {\n"
" case '\\n':\n"
" printf (\"\\\\n\\\"\\n\\\"\");\n"
" break;\n"
" case '\\\\':\n"
" printf (\"\\\\\\\\\");\n"
" break;\n"
" case '\\\"':\n"
" printf (\"\\\\\\\"\");\n"
" break;\n"
" default:\n"
" x= strcspn (p, \"\\n\\\\\\\"\");\n"
" printf (\"%.*s\", x, p);\n"
" p+= x -1;\n"
" }\n"
" p++;\n"
" }\n"
" printf (\"\\\";\\nchar s2[]=\\n\\\"\");\n"
" p= s2;\n"
" while (*p) {\n"
" switch (*p) {\n"
" case '\\n':\n"
" printf (\"\\\\n\\\"\\n\\\"\");\n"
" break;\n"
" case '\\\\':\n"
" printf (\"\\\\\\\\\");\n"
" break;\n"
" case '\\\"':\n"
" printf (\"\\\\\\\"\");\n"
" break;\n"
" default:\n"
" x= strcspn (p, \"\\n\\\\\\\"\");\n"
" printf (\"%.*s\", x, p);\n"
" p+= x -1;\n"
" }\n"
" p++;\n"
" }\n"
" printf (\"%s\", s2);\n"
" return;\n"
" }\n"
"\n"
"\n"
"";
int main (void) {
char *p;
int x;
printf ("%s", s1);
p= s1;
while (*p) {
switch (*p) {
case '\n':
printf ("\\n\"\n\"");
break;
case '\\':
printf ("\\\\");
break;
case '\"':
printf ("\\\"");
break;
default:
x= strcspn (p, "\n\\\"");
printf ("%.*s", x, p);
p+= x -1;
}
p++;
}
printf ("\";\nchar s2[]=\n\"");
p= s2;
while (*p) {
switch (*p) {
case '\n':
printf ("\\n\"\n\"");
break;
case '\\':
printf ("\\\\");
break;
case '\"':
printf ("\\\"");
break;
default:
x= strcspn (p, "\n\\\"");
printf ("%.*s", x, p);
p+= x -1;
}
p++;
}
printf ("%s", s2);
return;
}
Here's the ruby version of the CGI script I tried to make work below. This one seems to work, but I can't make a demonstration that can be viewed from outside because the firewalls on webservers block that.
#!/usr/local/bin/ruby -w
IMAGE_NAME = "/home/ambrus/a/flycgi/leer.jpg";
require "socket";
require "timeout";
print "Content-Type: text/html; charset=ISO-8859-2\n\n";
print %{<html>
<head>
<title>On-the-fly server experiment</title>
</head><body>
<h1>On-the-fly server experiment with ruby</h1>
<p>This CGI script experiments with starting a TCP server connection
on the fly to serve an image embedded in the page.
I do not recommend this technique for production.
<p>
So, here's an image:
};
lsock = Socket.new(Socket::PF_INET, Socket::SOCK_STREAM, 0);
lsock.listen 1;
port = Socket.unpack_sockaddr_in(lsock.getsockname)[0];
imgthread = Thread.new {
begin
asock = ();
timeout(60) {
asock, * = lsock.accept;
};
imgfile = File.open IMAGE_NAME;
imgsize = imgfile.stat.size;
asock.print "HTTP/1.1 200 Ok\nContent-type: image/jpeg
+\n" +
"Content-length: " + imgsize.to_s + "\n\n";
while b = imgfile.read(16*1024);
asock.print b;
end;
asock.close;
rescue Timeout::Error;
end;
};
server_name = ENV["SERVER_NAME"] || "localhost";
print %{<img src="http://} + server_name + ":" + port.to_s + %{/" alt=
+"some dynamic image">};
print %{<p>Goodbye for now.
</body></html>
};
$>.flush;
imgthread.join;
__END__
This is the CGI script I'm trying to write as an experiment to serve an image in a strange way. It segfaults on the webserver at the point when it first wants to start the coroutine. I'm trying though on another machine that doesn't have a webserver it seems to work fine. You may have to change some pathnames in it, like the path to the error log (take care, it's overwritten every time) and the path to the image to be served.
<c>
#!/usr/bin/perl -T
use warnings; use strict;
BEGIN {
use IO::Handle;
open our $LOG, ">", "/home/student/ambrus/a/html/.fly.log" or die "cannot write error log";
sub tolog {
chomp(my $s = join("", @_));
warn "logged: " . $s;
print $LOG "fly " . localtime() . ": " . $s . "\n" or die "cannot write error log";
flush $LOG;
}
tolog "starting";
$SIG{__WARN__} = \&tolog;
our $OLDSIGDIE = $SIG{__DIE__}; $SIG{__DIE__} = \&tolog;
} CHECK {
#$SIG{__DIE__} = our $OLDSIGDIE;
tolog "checking";
} END {
tolog "ending";
}
eval {
use lib "/home/student/ambrus/local/perl/lib/perl/5.8.4";
use Coro; use Coro::Handle; use Coro::Timer; use Coro::Socket;
use Socket;
print qq{Content-Type: text/html; charset=ISO-8859-2\n\n};
my @jobs;
push @jobs, async {
tolog "D10";
select unblock *STDOUT;
print qq{<html>
<head>
<title>On-the-fly server experiment</title>
</head><body>
On-the-fly server experiment
This CGI script experiments with starting a TCP server connection
on the fly to serve an image embedded in the page.
I do not recommend this technique for production.
So, here's an image:
};
socket my $S, PF_INET(), SOCK_STREAM(), 0 or die "socket $!";
listen $S, 1 or die "listen $!";
my($p, undef) = sockaddr_in(getsockname $S);
push @jobs, async {
eval {
my $Su = Coro::Socket->new_from_fh($S);
my $A = $Su->accept or die "accept: $!";
open my $I, "<", "/home/student/ambrus/a/html/pu/egyetem.jpg" or die "open image: $!";
print $A "HTTP/1.1 200 Ok\nContent-type: image/jpeg\n" .
"Content-length: " . (-s $I) . "\n\n" or
die "print image header: $!";
while (read $I, my $b, 4*1024) {
print $A $b;
#Coro::Timer::sleep 0.1;
}
close $A;
};
$@ and warn($@), die($@);
};
my $sn = $ENV{"SERVER_NAME"} || "
|
