in reply to Re^3: What does $_ = qq~"$_"~ do?
in thread What does $_ = qq~"$_"~ do?

Fun fact: Your coworkers will curse your name unto the end of time if you . . . erm, "code" like this in anything production (especially if you do it without leaving 30 foot high neon warning signs in a comment :). (If you do it in code for personal use you might want to talk with a professional about the deep seated self loathing you're manifesting.)

Obvious reference to relevant Jurassic Park quote . . .

The cake is a lie.
The cake is a lie.
The cake is a lie.

Replies are listed 'Best First'.
Re^5: What does $_ = qq~"$_"~ do?
by haukex (Archbishop) on May 28, 2019 at 20:28 UTC

    More fun facts! I once wrote a script to search a word list for words that make valid regexen which convert one valid word into another.

    $ perl -le 'print bangs =~s engender' bands $ perl -le 'print halved =~s avatar' halted $ perl -le 'print stove =~s evener' stone

      haukex is Evil.


      Give a man a fish:  <%-{-{-{-<

        I rewrote the code to find even more matches, here it is, enjoy :-)

        use warnings; use 5.014; # mostly for /r my %words = map {chomp; $_=>1} grep {!/'s$/} do { open my $fh, '<', '/usr/share/dict/words' or die $!; <$fh> }; my %search; for my $word (sort keys %words) { next unless $word=~ m{ \A (?<pre> s )? (?<sep> [a-zA-Z0-9] ) (?<search> (?: (?!\g{sep}) . )+ ) \g{sep} (?! \g{search} \g{sep} ) (?<repl> (?: (?!\g{sep}) . )* ) \g{sep} (?<flags> [msixpongr]* ) \z }msx; push @{ $search{$+{search}} }, { word=>$word, %+ }; } my @search = sort { length $b <=> length $a or $a cmp $b } keys %search; my ($re) = map {qr/$_/} join '|', map {quotemeta} @search; for my $word (sort keys %words) { next unless length $word > 1 && $word=~/($re)/; for my $s (@search) { next unless $word=~/\Q$s/; for my $r (@{$search{$s}}) { my $test = eval '$word=~s/\Q$s/$$r{repl}/r'.$$r{flags}; defined $test or die $@; next unless length $test > 1 && exists $words{$test} && $test ne $word; my ($pre,$pat) = ($$r{pre}//'s',$$r{word}); ( $pat = $$r{word} ) =~ s/\A\Q$$r{pre}// if $$r{pre}; my $code = "\$word =~$pre $pat$$r{flags}r"; eval($code) eq $test or die "$code - $test - $@"; say "$word =~$pre $pat => $test"; } } }

        But seriously, to respond to Fletch's comments, of course this is just for fun ;-) When I wrote it I was thinking I might try my hand at some Perl poetry some time, unfortunately I don't think I'm creative enough in that way... at least here's some code if anyone else wants to give it a spin ;-)

      and now pretty please an even weirder example with the x modifier and interspersed white-spaces, using your own name dear haukex! ;-)

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

        an even weirder example

        In the meantime, there's this message from Dave Mitchell available for studying on the fun-with-perl mailing list:

        Dave Mitchell Tue, 19 Sep 2006 17:53:37 -0700 I believe the following is a genuine, punctuation-free Quine: s zzs vvxv and s ZVZchr 122Zie and s ZVZchr 122Zie and s ZVZchr 122Zie and s SxSlcfirstSe and s YZZxZYvvxvYi and print z and s ZVZchr 122Zie and s ZVZchr 122Zie and s ZVZchr 122Zie and s SxSlcfirstSe and s YZZxZYvvxvYi and print -- A walk of a thousand miles begins with a single step... then continues for another 1,999,999 or so.
        perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
        example with the x modifier and interspersed white-spaces

        A good idea for a coding challenge, perhaps? ;-)