Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

Donations gladly accepted

  • (Sep 10, 2018 at 22:53 UTC) Welcome new users!
If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Killer byte tripping up Perl?
4 direct replies — Read more / Contribute
by echo5
on Dec 12, 2018 at 17:22

    I have a simple script that appears to show that some byte in the output is causing Perl to behave strangely.

    The script calls a command that coughs up 150 bytes or so of binary data. One stream of returned data behaves as expected. Another stream causes chaos.

    The script: $cmd = "/usr/local/bin/mycmd"; print "The cmd to be run is: $cmd \n"; open(CMD, "$cmd |" ) or die "Can't run '$cmd'\n$!\n"; while (<CMD>) { chomp; print "My raw output is: $_ \n"; $dataout = $_; print "My DATAOUT is: $dataout \n"; }

    When I run the above script in a "good" scenario I get the below output:

    The cmd to be run is: /usr/local/bin/mycmd My raw output is: &#65533; ` /11&#65533;%_$&#65533;%f$&#65533;&c$&#65 +533;%a$&#65533;%\$&c$&^$&#65533;&i$ My DATAOUT is: &#65533; ` /11&#65533;%_$&#65533;%f$&#65533;&c$&#65533; +%a$&#65533;%\$&c$&^$&#65533;&i$

    When I run the above script in a "bad" scenario I get the below output:

    The cmd to be run is: /usr/local/bin/mycmd My raw output is: My DATAOUT is: My raw output is: &#65533;0]&#65533;c &#65533;&#65533; My DATAOUT is: &#65533;0]&#65533;c &#65533;&#65533;

    Ultimately the goal is to ingest the data and process it using unpack but that was failing as $_ didn't contain data is should contain to process. The "bad" behavior above seems to show that there is some sort of "killer byte" being output from mycmd that throws a wrench into things. Below is the good and bad output in hex form via xxd. Is there a byte in there tripping up Perl?

    Good data stream: 0000000: 0202 00d0 0000 0000 0000 0000 0100 0000 ................ 0000010: 0100 0000 0100 0000 0100 0000 0100 0000 ................ 0000020: 0100 0000 0100 0000 0500 0000 0500 0000 ................ 0000030: 0500 0000 0500 0000 0500 0020 0100 0000 ........... .... 0000040: 0100 0000 0100 0000 0100 0000 0100 0000 ................ 0000050: 0100 0000 0100 0000 0500 0000 0500 0000 ................ 0000060: 0500 0000 0100 0000 0100 0000 0000 0000 ................ 0000070: 0200 0060 0100 0020 0000 0000 0100 2d00 ...`... ......-. 0000080: 0100 2f00 0100 3000 0000 0000 0100 0000 ../...0......... 0000090: 0000 0000 0102 ca25 0102 4a24 0102 bd25 .......%..J$...% 00000a0: 0102 5024 0102 da25 0102 4c24 0102 d525 ..P$...%..L$...% 00000b0: 0102 4c24 0102 c325 0102 4624 0102 e025 ..L$...%..F$...% 00000c0: 0102 4e24 0102 e225 0102 4824 0102 dd25 ..N$...%..H$...% 00000d0: 0102 5224 ..R$
    Bad data stream: 0000000: 020a 009c 0000 0000 0000 0000 0100 0000 ................ 0000010: 0100 0000 0100 0000 0100 0000 0100 0000 ................ 0000020: 0100 0000 0100 0000 0100 0000 0500 0000 ................ 0000030: 0500 0000 0500 0000 0500 0000 0500 0000 ................ 0000040: 0500 0000 0500 0000 0500 0000 0500 0000 ................ 0000050: 0500 0000 0500 0000 0500 0000 0500 0000 ................ 0000060: 0500 0000 0500 0000 0100 0000 0000 0000 ................ 0000070: 0100 3000 0000 0000 0100 005c 0100 00b4 ..0........\.... 0000080: 0000 0000 0100 0000 0000 0000 0200 0063 ...............c 0000090: 0100 0020 0000 0000 0103 9206 0103 8506 ... ............
Grep Pattern
3 direct replies — Read more / Contribute
by GotToBTru
on Dec 12, 2018 at 09:29

    I want to apply a F T T F repeating pattern as a filter to an array or list. Here is what I came up with:

    $i = 0; @result = grep { $i = 0 unless ($i<4); $i++%3 ? 1 : 0; } 0..12

    @result = 1,2,5,6,9,10

    It works but looks clunky. Any more elegant options?

    But God demonstrates His own love toward us, in that while we were yet sinners, Christ died for us. Romans 5:8 (NASB)

Calling a variable value as a variable
4 direct replies — Read more / Contribute
by echo5
on Dec 11, 2018 at 19:42

    Greetings Monks, long time listener.....first time caller

    I am attempting to accomplish something that I'm sure is probably dumb but I'm a hack (I admit it freely) and trying to deal with some ingested binary data in a way that makes sense in my brain (likely root of problem). I am ingesting binary output to stdout from a command run previous to the below code. Everything works as expected in the below code EXCEPT when I need to compare the value of previously defined variable (eg: $blu) by calling it in a foreach later where the string "blu" is an element and I try to call $blu by calling its element value in the foreach loop ${"index"} when $index equals blu, red, etc.

    No matter what I try...${index}, ${'index'}, ${"index"} I can never draw in the value of $blu, $red, $grn or $ylw to evaluate whether or not it equals the value 01.

    Thanks to all who take a moment to consider my quandary. Like I said I'm a hack and I'm beating my head against the desk.

    { chomp; my $dataout = $_; my @bytes = unpack( 'x252' . 'H2' x200, $dataout); my ($blu, $red, $grn, $ylw) = (@bytes[0], @bytes[12], @by +tes[56], @bytes[120]); my %humanize = ( 'blu' => 'Blue', 'red' => 'Red', 'grn' => 'Green', 'ylw' => 'Yellow' ); foreach my $index (blu, red, grn, ylw) { if (${"index"} != 01) { syslog('warning', "Color val +ue bad $humanize{$index}"); $status_code = 1; } } }
EXTERN.h missing when compiling on OpenWrt
3 direct replies — Read more / Contribute
by morgon
on Dec 11, 2018 at 18:37
    Hi

    I would like to run a bot on my OpenWrt-device where I do not have a full perl-installation (there is no working working CPAN-client).
    I have copied over all pure-perl modules I need but for the xs-modules I had hoped that I could make do with what I can get via package-manager.

    Alas there is one vital ingredient missing, and that is Net::SSLeay that is not available (as an aside - ssl modules for python are packaged...).
    So I installed gcc and tried to compile it on the box, but it fails like this:

    $ make Running Mkbootstrap for Net::SSLeay () chmod 644 SSLeay.bs mips-openwrt-linux-uclibc-gcc -c -D_REENTRANT -D_GNU_SOURCE -Os -pip +e -mno-branch-likely -mips32r2 -mtune=34kc -fno-caller-saves -fhonour +-copts -Wno-error=unused-but-set-variable -Wno-error=unused-result -m +soft-float -I/data3/openwrt-cc-ar71xx/staging_dir/target-mips_34kc_uC +libc-0.9.33.2/usr/include -I/data3/openwrt-cc-ar71xx/staging_dir/targ +et-mips_34kc_uClibc-0.9.33.2/include -I/data3/openwrt-cc-ar71xx/stagi +ng_dir/toolchain-mips_34kc_gcc-4.8-linaro_uClibc-0.9.33.2/usr/include + -I/data3/openwrt-cc-ar71xx/staging_dir/toolchain-mips_34kc_gcc-4.8-l +inaro_uClibc-0.9.33.2/include -O2 -DVERSION=\"1.84\" -DXS_VERSION=\ +"1.84\" -fPIC "-I/usr/lib/perl5/5.20/CORE" SSLeay.c SSLeay.xs:140:20: fatal error: EXTERN.h: No such file or directory #include "EXTERN.h" ^ compilation terminated. make: *** [SSLeay.o] Error 1
    Any ideas on how to proceed?

    My system is an OpenWrt Chaos Calmer 15.05, the perl is a 5.20.2.

    Many thanks!

replace characters in link
2 direct replies — Read more / Contribute
by ytjPerl
on Dec 11, 2018 at 10:28
    Hi Monks,

    I basically know how to replace partial of string with designated characters. But I have trouble with the string containing special characters which pass to perl variable and which I only keep it as it is in perl. For instance, I have a web link as https://abc.abc:8080/abc?abcdef&abc=&egh?, I am intending to replace abc.abc:8080 as def.def and keep the rest of it as it is, so the link would be https://def.def/abc?abcdef&abc=&egh?

    Is there a way to do it ?

    Thanks!

How does rename() work on read-only files?
4 direct replies — Read more / Contribute
by j41r
on Dec 10, 2018 at 19:56

    Dear monks,

    I'm one of the weird people that hates to ask questions but instead loves to RTFM. This time I'm really stuck with this subject that I'm pretty sure is trivial for all of you but, for me, it's so important that I didn't hesitate to raise my hand to ask about it, so here you go:

    I was reading about Why does Perl let me delete read only files? Why does i clobber protected files? Isn't this a bug in Perl?, and while the executive summary was pretty much understandable, that wasn't enough for me and I went the extra mile by reading the elaborately and painstakingly explanation available in the file file-dir-perms

    That's an amazing explanation, however how rename() actually works on read-only files just went over my head. Could anyone please help me out understand these two cases?

    1. When running perl -i.bak -pe 1 alpha/foo, foo's inode is preserved and foo.bak gets a new inode.
    2. When running perl -i.bak -pe 1 alpha/bar, bar gets a new inode and bar.bak gets the previous bar's inode.

    I also read How can I reliably rename a file?, which says (emphasis mine):

    It may be more portable to use the File::Copy module instead. You just copy to the new file to the new name (checking return values), then delete the old one. This isn't really the same semantically as a rename(), which preserves meta-information like permissions, timestamps, inode info, etc.

    but it seams to just add insult to injury, so any help would be appreciated.

multiple hash compare, find, create
9 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 10, 2018 at 12:12

    Hello Perl Monks. First time post, long time gleaner of information which is and has been very appreciated. Anyway I have an issue that I truly need some assistance with. I am fairly new to hash tables. What I need to do is compare three hash tables each containing between 14 million and 28 million keys with associated values. Sure, I could nest some loops and let it rip and come back in a year or so to see if it worked and hoping that no server crashes occurred.

    Optimally, I'd like to find the common keys between each of the three hash tables and gather the values from each of the three hash tables and create a new, forth hash table that contains  key => [value_hash_1, value_hash_2, value_hash_3] And for a key that does not exist in all three hashes, do nothing; the resulting forth hash table will have somewhat less than 14 million k/v pairs.

    Do I make sense? And the solution is most likely posted, but I had difficulty finding it.

    Thank you very much for your assistance!

File::Temp survival and scope created by "do"
1 direct reply — Read more / Contribute
by vr
on Dec 10, 2018 at 05:40

    In Spreadsheet::Read Win32::LongPath::openL, I wrote something like:

    my $tmp = File::Temp-> new( SUFFIX => '.ods' )-> filename; copyL 'whatever.ods', $tmp; say 'ok' if defined ReadData( $tmp );

    which I later realized didn't work exactly as intended. Temp file (and object) no longer existed after 1st statement, copyL simply "hijacked" file name, and temp file wasn't cleaned-up at program end.

    Initially I wanted it shorter as

    copyL 'whatever.ods', my $tmp = File::Temp-> new( SUFFIX => '.ods' )-> + filename; say 'ok' if defined ReadData( $tmp );

    it wasn't "ok" for reason stated above. Instead, in retrospect, this would work:

    copyL 'whatever.ods', my $tmp = File::Temp-> new( SUFFIX => '.ods' ); say 'ok' if defined ReadData( $tmp-> filename );

    Then object stringifies itself in 1st statement, and survives because bound to a variable. From practical point, that's about it all. However, during investigation I was puzzled by unexpected (though maybe not practically useful) behaviour:

    use 5.014; use warnings; package Temp; use parent 'File::Temp'; sub new { my $self = shift; $self-> SUPER::new( DIR => '.' ) } sub DESTROY { my $self = shift; say 'global' if ${^GLOBAL_PHASE} eq 'DESTRUCT'; $self-> SUPER::DESTROY } package main; use File::Copy; sub foo { my $h = Temp-> new } die unless -f 'x'; # this file must exist copy 'x', my $fn1 = Temp-> new-> filename or die; copy 'x', my $fn2 = do { Temp-> new }-> filename or die; copy 'x', my $fn3 = do { my $h = Temp-> new }-> filename or die; copy 'x', my $fn4 = foo-> filename or die; say 1 if -f $fn1; say 2 if -f $fn2; say 3 if -f $fn3; say 4 if -f $fn4;

    which says "3". All copying completes successfully, and I'd expect objects destroyed and temp files deleted by end of each of 4 statements. But, somehow, object survives if bound to lexical variable in "do" block, but not in case of subroutine call. Why?

    Auxiliary question: object was not destroyed during global destruction at program end, but when?

Example of building/deploying perl program like StrawberryPerl
3 direct replies — Read more / Contribute
by xiaoyafeng
on Dec 10, 2018 at 03:04

    Hi, Monks

    Recently,I have to port my program from Windows to Linux since the whole industry I've been worked on has gradually switch to it. Let me mention a little bit of current situation: When I'm on windows, I maintain an environment of Perl which is based on portable strawberry Perl. I added some more Perl libraries to Perl sub directory, some c libraries to c directory, and some executables to bin then I test my program on this . When the first installation, I installed the whole perl dist on customer machines, and with the every updates, I just need to change several files or scripts accordingly. Being about 8 years, this way works fine.

    It doesn't work on Linux world. Since the every Linux dist has already maintain a perl respectly which I may not test So I want to isolate my perl environment from system perl including 3rd binary libraries like I did on windows. but How install them(perl and c libraries) on individual users and the program can find it? I'm heard that the Docker would be suitable for this scenario, but I'm not sure. maybe it's out of topic, but if any monks know that Please point it out also.

    Based on Perl, as my poor perl knowledge (Little linux), there are several weapons I could use: perlbrew, Alien and Task family. As I preliminary think, I could use perlbrew to build a base perl dist, set it to default on .profile file. then use/create Alien module to add binary libraries for perl or directly using and Task for installing perl library. At last tar the whole directory and sent to customer! Am I right? Please enlighten me before I dive in, or point me out a better way! Thanks in advance.

    Andy




    I am trying to improve my English skills, if you see a mistake please feel free to reply or /msg me a correction

Spreadsheet::Read Win32::LongPath::openL
2 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 09, 2018 at 08:48

    Hi

    I am trying to open Excel and ODS files with longnames paths (and possibly not Latin characters) on Windows. I use Win32::LongPath::openL to open the files. For XLS I then use Spreadsheet::ParseExcel. This works fine. For ODS I use Spreadsheet::Read. This doesn't work.

    use Spreadsheet::Read; use Spreadsheet::ParseExcel; my $InputFile; Win32::LongPath::openL (\$InputFileReadable, '<', $InputFile); #opening XLS my $parser = Spreadsheet::ParseExcel->new(); my $workbook = $parser->parse($InputFileReadable); if ( defined $workbook ) { print "I could read the XLS file\n"; } #opening ODS my $workbook2 = ReadData ($InputFileReadable); if ( defined $workbook2 ) { print "I could read the ODS file\n"; }

    Why is $workbook2 always undefined?

Browser::Open Windows metacharacters
2 direct replies — Read more / Contribute
by IB2017
on Dec 09, 2018 at 05:08

    Hello Monks,

    is it a bug in Browser::Open or a 'bug' in my module understanding? The following doesn't work on Windows 10:

    my $url='https://www.google.com/search?q=finance&source=lnms&tbm=isch' +; my $ok = open_browser($url);

    It breaks after shell metacharacters (in this case &) which Windows is trying to use as commands. Should I pass $url in a different way?

How Can My Perl/Tk Program use a Defined Font for All Widgets?
4 direct replies — Read more / Contribute
by ozboomer
on Dec 08, 2018 at 23:21

    Something of a silly question, I fear...

    The code:

    use strict; use warnings; use Tk; my $tstate = 0; # State of the dynamic text my $mw = MainWindow->new( # Create a window -width => 300, -height => 110, ); $mw->minsize( 300, 110 ); $mw->fontCreate('standard_font', # ..and some fonts +for it -family => 'Arial', -size => 12, -weight => 'normal'); $mw->fontCreate('alternate_font', -family => 'Times', -size => 24, -weight => 'bold'); $mw->fontCreate('my_default_font', -family => 'Sans', -size => 8, -weight => 'normal'); # $mw->configure(-font => 'my_default_font'); # '-font' is unkn +own to configure() # $mw->fontConfigure('my_default_font'); # Does nothing my $static_text_lbl = $mw->Label( # Uses the system ' +default' font -text => 'UNCHANGING TEXT', )->pack(-anchor => "center", -side => 'top'); my $text_lbl = $mw->Label( # An object with an + assigned font -text => 'DYNAMIC TEXT', -font => 'standard_font', )->pack(-anchor => "n", -side => 'top'); my $Exit_Btn = $mw->Button( # A button to exit -text => 'Exit', -width => 8, -command => sub { $mw->destroy }, )->pack(-anchor => 's', -side => 'bottom'); my $Toggle_Btn = $mw->Button( # ..and another to +toggle the font -text => 'Toggle', -command => [ \&fix_fonts ], )->pack(-anchor => 's', -side => 'bottom'); MainLoop; # ---------- sub fix_fonts { if ($tstate ^= 1) { $text_lbl->configure(-font => 'alternate_font') } else { $text_lbl->configure(-font => 'standard_font') } } # [eof]

    I can assign a different font from the standard 'system defined' type through the command line invocation, viz:-

          c:\> perl prg.pl -font "sans 12"
    

    ...and the window and its child widgets will all have the "sans 12" font (unless it's explicitly changed).

    However, it appears that if I want to do that same thing within the program itself, I have to do it explicitly on every widget, which seems redundant and annoying.

    Is there a defined/accepted/working way to do things 'globally' within the program?

    I've tried a couple of ways to apply a font to the Main Window (see in the code) and they don't seem to work.

    I've tried checking on-line, in the Monastery, the O'Reilly books and some various examples of code... and I can't find anything that will do what the command line approach does.

    This example is using ActiveState Perl v5.20.2 under Windows 8 32-bit.

    I'd greatly appreciate any clues.

    Thanks.

New Meditations
RFC: Set::Select: get intersection or union of sets; or more generally, the set of elements that are in one or more input sets
No replies — Read more | Post response
by kikuchiyo
on Dec 12, 2018 at 16:58

    If we have two sets, it is considered a solved problem to get their union or intersection or symmetric difference, there is even an entry in perlfaq4 about it. The situation is slightly more complicated if we have more than two input sets, because then it's a valid question to ask to e.g. get the set of elements that are in the first or second set but not in the third and fourth etc. The number of combinations grows rapidly with the number of input sets, and just writing ad hoc solutions to each little problem becomes infeasible. So a more general solution is needed - the hard part is designing the user interface so that it is able to express all the possible combinations of selections in a general and flexible, yet efficient and understandable manner. A cursory search of CPAN brought up several (abandoned?) modules in the Set::* namespace, but none of them was exactly what I needed.

    I have the outline of an attempted solution. It's an OO module that has a constructor to which the input sets can be fed, and one method called select, which accepts a selector string argument and emits (an arrayref of) the elements that match the selector. If we have 3 input sets, then the '110' selector string selects all elements that are in the first and second sets but not in the third.

    #!/usr/bin/perl { package Set::Select; use strict; use warnings; sub new { my ($class, $args, @sets) = @_; my $attr; $attr = $args->{key} if (ref $args eq 'HASH' and exists $args->{ke +y}); my $self; for my $i (0..$#sets) { for my $elem (@{$sets[$i]}) { my $key = defined $attr && ref $elem eq 'HASH' ? $elem->{$ +attr} : $elem; $self->{$key}->[1] //= $elem; $self->{$key}->[0] //= '0' x @sets; vec($self->{$key}->[0], $i, 8) = 0x31; } } bless $self, $class; } sub select { my ($self, $bits) = @_; return [map { $self->{$_}->[1] } grep { $self->{$_}->[0] =~ $bits +} keys %$self]; } } package main; use strict; use warnings; use Data::Dumper; my $x = Set::Select->new({}, [1, 3, 5, 7], [2, 3, 6, 7], [4, 5, 6, 7]) +; print Dumper $x->select($_) for qw/100 101 111 10. ... /; my $y = Set::Select->new({key => 'id' }, [{id => 1, value => 1}, {id => 3, value => 1}, {id => 5, value => +1}, {id => 7, value => 1}], [{id => 2, value => 2}, {id => 3, value => 2}, {id => 6, value => +2}, {id => 7, value => 2}], [{id => 4, value => 3}, {id => 5, value => 3}, {id => 6, value => +3}, {id => 7, value => 3}], ); print Dumper $y->select($_) for qw/100 101 111 10. ... /;

    A Venn diagram that may or may not make the intent clearer:

             .---.
            /  1  \
           |       |
        .--+--. .--+--.
       /   | 3 X 5 |   \
      |    |  / \  |    |
      |  2  \/ 7 \/  4  |
      |     |`---'|     |
      |      \ 6 /      |
       \      \ /      /
        `------^------'
    

    I think these selector strings as the primary (and only) user interface are better than the possible alternatives that come to mind: a verbose, ad hoc query language would have to be explained at length in the documention, tested carefully in the source, and parsed painfully at runtime, while a forest of arbitrarily named methods to select this or that subset would bloat the code needlessly and make it harder to use.

    Using regular expressions opens the door to abuse, but it also allows convenient and terse selector strings, makes the implementation efficient, and it's something people already know.

    If the elements are hashrefs (representing a record or object or something), there is a mode to use not the elements themselves but a named key inside them as the basis of selection, as the second example shows. This mode can be considered buggy as it is now, because only one version of a record with the same key is stored (in the example, some values are discarded. I don't have a good solution for this problem yet, partly because it would make the implementation slower and more complicated, partly because I don't know what would be the right thing to do.

    Questions:

    • Is this useful to anyone?
    • How to make it better?
    • What would be a good name if this were to become a module? I've tentatively chosen Set::Select but it may be too generic.
Camel vs. Gopher
4 direct replies — Read more / Contribute
by reisinge
on Dec 08, 2018 at 14:16

    I've been using Perl for several years mostly for small to medium sized programs of sysadmim type (automation, gluing, data transformation, log searching). Recently I started to learn Go. I wanted to write something in both languages and compare. Here goes.

    The Perl code is more than 2 times smaller:

    $ ls -l x.* | perl -lanE 'say "$F[8]\t$F[4] bytes"' x.go 694 bytes x.pl 294 bytes

    Perl code is more than 4 times slower when run ...

    $ time go run x.go > /dev/null real 0m1.222s user 0m1.097s sys 0m0.220s $ time perl x.pl > /dev/null real 0m5.358s user 0m4.778s sys 0m0.497s

    ... and more than 5 times slower when I built the Go code:

    $ go build x.go $ time ./x > /dev/null real 0m0.947s user 0m0.890s sys 0m0.126s

    The code generates 10 million random integers from 0 to 9. Than it counts the occurrence of each generated integer and prints it.

    $ cat x.go package main import ( "fmt" "math/rand" "time" ) func main() { // Seed the random number generator seed := rand.NewSource(time.Now().UnixNano()) r1 := rand.New(seed) // Generate random integers var ints []int for i := 0; i < 10000000; i++ { n := r1.Intn(10) ints = append(ints, n) } // Count ints occurrence count := make(map[int]int) for _, n := range ints { count[n]++ } // Sort ints var intsSorted []int for n := range count { intsSorted = append(intsSorted, n) } // Print out ints occurrence for n := range intsSorted { fmt.Printf("%d\t%d\n", n, count[n]) } } $ cat x.pl #!/usr/bin/perl use warnings; use strict; # Generate random integers my @ints; push @ints, int rand 10 for 1 .. 10_000_000; # Count ints occurrence my %count; $count{$_}++ for @ints; # Print out ints occurrence for my $int ( sort keys %count ) { printf "%d\t%d\n", $int, $count{$int}; }

    In conclusion I must say that I like both languages. I like beer too :-).

    Always rewrite your code from scratch, prefefably twice. -- Tom Christiansen
New Obfuscated Code
VT100 Screensaver
1 direct reply — Read more / Contribute
by kschwab
on Dec 09, 2018 at 16:27

    Only works on Unix like machines...requires a VT100 compatible terminal like an xterm, and a working "stty" binary. Handles resizing the window while it's running. Ctrl-C to stop it.

    #!/usr/bin/perl use warnings;use strict;my($r,$c);$|=1;init(); sub init{print "\ec";($r,$c)=split' ',qx"stty size";$r-=5;$c-=16}; $SIG{INT}= sub{print "\ec\n";exit};$SIG{WINCH}=sub{init()}; $_='!X!E!EIC%IC%IC%!X!ECu#kCD@3ilowg!E!WICD@biloQgIO#kAr@DiloT@/@j'. '@D@j@%IO#myD@gg!QCu#kC%IO#kO#gO#gC%!MIC%!QCu#kC%IO#ne#me#ni%!MICD'. '@f@/iloQK';s/!/4pa/g;s/@/ilp/g;s/#/KW/g;s/%/Ag/g;tr|A-Za-z0-9+/| -_|; @_=split(/\n/,unpack('u',join($',map(chr(32+length($_)*3/4). $_,/(.{1,60})/gs))));print "\ec\e[2J\e[?25l";srand(); for (;;) { my($x,$y)= map{int(rand($_))+1}($c,$r); for(0..4){print "\e[".($y+$_).";${x}H".$_[$_];} select($\,$\,$\,rand(1.2)+.3); for(0..4){print "\e[".($y+$_).";${x}H"." "x16;} }
Christmas Package Obfuscation
1 direct reply — Read more / Contribute
by kschwab
on Dec 08, 2018 at 14:11
    #!/usr/bin/perl $;;$^;s#^#$\ _-~,..___ .-' .--._ ```--.-----.___ ._^---- (`-...`-. _/,----. ) ````---=. _.-'' ````-- `.___.-.) (---=='' .-' | _.-' _.-. )(`.-._``--.._ .' | |`---..__ .-'.-'.' )| |_ ``--...`. | | ``--.._ ,'.-' ( ( `-.`-. .'| : | | | | --.._`. ) `. `. | : | | | | ( )-.._.') ) ) : | | | | | | | ( ( ) : | | | | (_( | ) ) | : .' | | | | L/ | : .' (__ | | | | :.' `-.._ | | | | : `-.._ | | | |/ `--`_|_ | .' `._ | .' ``-.__ | .' `--`; # and "Happy Holidays" or Merry Christmas! print "Is print broken?\n";print;# guess not?
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2018-12-13 02:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How many stories does it take before you've heard them all?







    Results (61 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!