#!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 opening $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]}{$name}} || 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__ #### # 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::Exception, 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__]; } #### @seen = (0)x@adj_index; #### @previous = (undef)x@adj_index; #### @queue = (undex)x@adj_index; $queue_head = 0; $queue_tail = 0; #### $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; } } } #### seeword(-1, $start); #### 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); } } #### if ($found_goal) { my $i = $goal; while (-1 != $i) { print $word_string[$i], "\n"; $i = $previous[$i]; } } else { print "no word ladder.\n"; } #### #include #include #include #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 dimensional, 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 FindNearestPoints (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(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(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(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(by, x)) { output = cv::Point(x, by); return true; } } output = cv::Point(0, 0); return false; } #### 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' in call to 'fgets' in function main 203529 <+termbot> -Error vowel.c 9: Too few parameters in call to 'fgets' 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 main 203529 <+termbot> -Error vowel.c 20: Compound statement missing } in function 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 203542 <+termbot> -#include 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': case 'u': 203555 <+termbot> - n++; 203556 <+termbot> - break; 203557 <+termbot> - 203558 <+termbot> - getch(); 203559 <+termbot> - } 203600 <+termbot> - } 203600 <+termbot> - 203601 <+termbot> -C:\MONKPERL>

Let's fix the call to fgets. 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 main 204042 <+termbot> -Error vowel.c 20: Compound statement missing } in function 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 mistake 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 problems: first, you never output anything, secondly, you call 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 204934 <+termbot> - 2: #include 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 vowel*/ 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': case '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, switch(c) doesn't make sense, since you only assign c once and in a wrong way at that time. you need to switch on something 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 version seems to work now. 205646 <@b_jonas> `type vowel.c 205646 <+termbot> +type vowel.c 205646 <+termbot> - #include 205646 <+termbot> -#include 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': case 'u': 205652 <+termbot> - n++; 205652 <+termbot> - break; 205653 <+termbot> - } 205653 <+termbot> - } 205654 <+termbot> -printf("%d",n); 205654 <+termbot> - } 205655 <+termbot> - 205655 <+termbot> -C:\MONKPERL> #### 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 backtrace } 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__ #### creature weight negative #### #include 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; } #### first line second third fourth #### 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 combinations: Number 1, Assignment 2, Vol my $regex4 = qr/(\w+)'(\w){0,2}/; #contractions in English my $regex5 = qr/(\w)(\/|&)(\w)/; #abbreviations with slash: c/o, i/o, etc. my $regex6 = qr/(M).{1,2}\.(\s([A-Z]{1}[a-z]+))?/; #formal titles: 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 abbreviations, using uppercase only, no space, my $regex9 = qr/[a-zA-Z]{3}\.\s?(\d+)/; #3-letter abbreviations containing numbers, mixed case, my $regex10 = qr/\$\d+/; #money expressions $xxxx format my $regex11 = qr/\$\d+(.\d{2})?/; #money expressions $xxxx.xx format my $regex12 = qr/(http:\/\/.*)|(w{3}\.(.)*)/; #websites beginning with www. or http:// my $regex13 = qr/(\(\d{3}\)\s(\d{3})-(\d{4}))/; #phone numbers, no country code (xxx) xxx-xxxx my @regarray = ($regex13, $regex12, $regex11, $regex10, $regex9, $regex8, $regex7, $regex6, $regex5, $regex4, $regex3, $regex2, $regex1); $/ = undef; my $text = ; 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 #### /* 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; border-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 *:visited { 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 } */ #### 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 #### [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-linux 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 kit. 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 Page. [am]king ~/a/tmp$ #### $ 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"suffix1 succ1"} at -e line 1. foo/bar at -e line 1. $ perl -v This is perl, v5.10.1 (*) built for x86_64-linux ... #### perl -le'$==1,(1x$_)=~/(^)(1|11\1)*(?{$=++})^/,print$=for 0..20' #### perl -we 'use warnings; use strict; use 5.010; use IO "Socket"; use Socket; use Fcntl; my($L, $R) = IO::Socket->socketpair(PF_UNIX, SOCK_STREAM, 0) or die; $L->fcntl(F_SETFD, $L->fcntl(F_GETFD, 0) &~ FD_CLOEXEC); defined(my $p = fork) or die "fork"; if (!$p) { exec @ARGV, $L->fileno; die "exec"; } $L->close; print "reading... "; my $x = $R->getline; say "got: $x"; 0 < waitpid $p,0 or die "wait";' perl -we 'use warnings; use strict; use 5.010; use IO::Socket; sleep 1; my $h = shift; say "fileno: $h"; my $O = IO::Socket->new_from_fd($h, ">") or die "fdopen $!"; $O->printflush("hello"); $O->shutdown(SHUT_WR); say "written"; sleep 1; say "done";' #### perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREAM(), 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; }' #### perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREAM(), 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+#cbstream\s+:?(.*)/si and print $1; }' #### 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) her(7+4+17) bukkit(1+20+10+10+8+19) holder(7+14+11+3+4+17), go(6+14) hold(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+17) 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) cockmongle(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+19+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. She(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) naow(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+18), 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 #### /* 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; border-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 *:visited { 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,perlmonks_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="http://perl.com/"], .nodelet#leftovers a[href="http://perl.com/"] + br, a[href="http://www.perlfoundation.org/perl5/index.cgi"], .nodelet#leftovers a[href="http://www.perlfoundation.org/perl5/index.cgi"] + br, a[href="http://jobs.perl.org/"], .nodelet#leftovers a[href="http://jobs.perl.org/"] + br, a[href="http://www.pm.org/"], .nodelet#leftovers 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.org/"] + 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 }*/ #### 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"; while() { 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) { print $a[$y*$w + $x] ? "#" : " "; } print "\n"; } }' #### [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[rand(10)] = int(rand(10)) for 0..99; $"="+"; warn "$::sum = @x[0..2]";' 13 = 2+8+3 at -e line 1. [am]king ~$ #### #!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::ELOOP, 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 file 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__ #### + +++++++++++++++++++ +++++++++++++++++++++ ++++++++++++++++++++++ ++++++++++++++++++++++++ +++++++++ ++++++++++++++++++++++++++++++++++++++++ ++++++++++ +++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++ +++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++ +++++++++++++++++++++++++++++++++++++++++++ +++++ +++++++++++++++++++++++++++++++++++++++++++++ ++++ ++++++++++++++++++++++++++++++++++++++++++++++ ++++ +++++++++++++++++++++++++++++++++++++++++++++ ++ ++++++ ++++++++++++++++++++++++++++++++++++++++++++++ ++ ++++++++++ +++++++++++ ++++++++++ + +++++++ +++++++++++ ++++++++++ + ++++++++++++ ++++++++++ ++++++++++++ ++++++++++ +++++++++++++ ++++++++++ #### sub mask { my($s, $m) = @_; [map { $$s[$_] } grep { 0 != ($m & (1<<$_)) } 0 .. @$s - 1]; } #### 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} #### #!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 called ", $u, " times\n"; } } __END__ #### 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 #### [am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((?{$u++})(?:a|aa))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaaaaaaaa aaaaaaaaab";' aaaaaaaaa: hit, parens called 10 times aaaaaaaaab: miss, parens called 20 times #### [am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((??{$u++;""})(?:a|aa))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaaaaaaaa aaaaaaaaab";' aaaaaaaaa: hit, parens called 10 times aaaaaaaaab: miss, parens called 143 times #### [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 times [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 times #### print {;log=>} "hi"; #### 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; warn "$_ => $n\n"; rename $_, $n or die "error rename $_ $n: $!"; }}, ".";' #### // 323 - Self reproducing program by Ambrus ZSBAN // // This program writes its source code to stdout. // RVLVQRVLVQ #include #include char s1[]= "// 323 - Self reproducing program by Ambrus ZSBAN\n" "//\n" "// This program writes its source code to stdout.\n" "// RVLVQRVLVQ\n" "\n" "#include \n" "#include \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; } #### #!/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 %{

On-the-fly server experiment with ruby