# posts

who: JAPH
where: freenode#perl
what: JAPH
paste:
                                                       #
                                                   sub j(\$){($
                     P,$V)=                      @_;while($$P=~s:^
                 ([()])::x){                    $V+=('('eq$1)?-32:31
           }$V+=ord(  substr(                 $$P,0,1,""))-74} sub a{
          my($I,$K,$  J,$L)=@_               ;$I=int($I*$M/$Z);$K=int(
         $K*$M/$Z);$J=int($J*$M             /$Z);$L=int($L*$M/$Z); $G=$
         J-$I;$F=$L-$K;$E=(abs($          G)>=abs($F))?$G:$F;($E<0) and($
          I,$K)=($J,$L);$E||=.01       ;for($i=0;$i<=abs$E;$i++ ){ $D->{$K
                  +int($i*$F/$E)      }->{$I+int($i*$G/$E)}=1}}sub p{$D={};$
                 Z=$z||.01;map{    $H=$_;$I=$N=j$H;$K=$O=j$H;while($H){$q=ord
                substr($H,0,1,"" );if(42==$q){$J=j$H;$L=j$H}else{$q-=43;$L =$q
              %9;$J=($q-$L)/9;$L=$q-9*$J-4;$J-=4}$J+=$I;$L+=$K;a($I,$K,$J,$ L);
              ($I,$K)=($J,$L)}a($I,$K,$N,$O)}@_;my$T;map{$y=$_;map{ $T.=$D->{$y}
              ->{$_}?$\:' '}(-59..59);$T.="\n"}(-23..23);print"\e[H$T"}$w= eval{
              require Win32::Console::ANSI};$b=$w?'1;7;':"";($j,$u,$s,$t,$a,$n,$o
              ,$h,$c,$k,$p,$e,$r,$l,$C)=split/}/,'Tw*JSK8IAg*PJ[*J@wR}*JR]*QJ[*J'.
               'BA*JQK8I*JC}KUz]BAIJT]*QJ[R?-R[e]\RI'.'}Tn*JQ]wRAI*JDnR8QAU}wT8KT'.
               ']n*JEI*EJR*QJ]*JR*DJ@IQ[}*JSe*JD[n]*JPe*'.'JBI/KI}T8@?PcdnfgVCBRcP'.
                '?ABKV]]}*JWe*JD[n]*JPe*JC?8B*JE};Vq*OJQ/IP['.'wQ}*JWeOe{n*EERk8;'.
                  'J*JC}/U*OJd[OI@*BJ*JXn*J>w]U}CWq*OJc8KJ?O[e]U/T*QJP?}*JSe*JCnTe'.
                   'QIAKJR}*JV]wRAI*J?}T]*RJcJI[\]3;U]Uq*PM[wV]W]WCT*DM*SJ'.  'ZP[Z'.
                      'PZa[\]UKVgogK9K*QJ[\]n[RI@*EH@IddR[Q[]T]T]T3o[dk*JE'.  '[Z\U'.
                        '{T]*JPKTKK]*OJ[QIO[PIQIO[[gUKU\k*JE+J+J5R5AI*EJ00'.  'BCB*'.
                             'DMKKJIR[Q+*EJ0*EK';sub h{$\ = qw(% & @ x)[int    rand
                              4];map{printf  "\e[$b;%dm",int(rand 6)+101-60*   ($w
                               ||0);system(  "cls")if$w ;($A,$S)=    ($_[1],   $
                                _[0]);($M,   @,)= split  '}';for(     $z=256
                                ;$z>0; $z   -=$S){$S*=   $A;p @,}      sleep$_
                                [2];while   ($_[3]&&($    z+=$ S)       <=256){
                                p@,}}("".   "32}7D$j"     ."}AG".       "$u}OG"
                                ."$s}WG"    ."$t",""      ."24}("        ."IJ$a"
                                ."}1G$n"    ."}CO$o"     ."}GG$t"        ."}QC"
                                 ."$h}"      ."^G$e"    ."})IG"          ."$r",
                                 "32}?"       ."H$p}FG$e}QG$r".          "}ZC"
                                 ."$l",          "28}(LC" .""            ."".
                                 "$h}:"           ."J$a}EG".             "$c"
                                 ."}M"             ."C$k}ZG".            "$e"
                                 ."}"             ."dG$r","18"          ."}("
                                ."D;"            ."$C"  )}{h(16         ,1,1,0
                               );h(8,          .98,0,0   );h(16         ,1,1,1)
                               ;h(8.0         ,0.98,0,     1);         redo}###
                             #written                                 060204 by
                           #liverpole                                  @@@@@@@
                        #@@@@@@@@@@@


who: JAPH
where: freenode#perl
what: JAPH
paste:
`$=`;$_=\%!;($_)=/(.)/;$==++$|;($.,$/,$,,$\,$",$;,$^,$#,$~,$*,$:,@%)=(
$!=~/(.)(.).(.)(.)(.)(.)..(.)(.)(.)..(.)......(.)/,$"),$=++;$.++;$.++;
$_++;$_++;($_,$\,$,)=($~.$"."$;$/$%[$?]$_$\$,$:$%[$?]",$"&$~,$#,);$,++
;$,++;$^|=$";`$_$\$,$/$:$;$~$*$%[$?]$.$~$*${#}$%[$?]$;$\$"$^$~$*.>&$=`


paste:


TestRun::Run();

package MyRole;

use Moose::Role;

requires '_get_foo';

has 'foo' => (
  is => 'ro',
  isa => 'Maybe[Str]',
  reader => '_get_foo',
);

package MyTest

use Moose;

with 'MyRole';

sub _get_foo {
  my $self = shift;
  return undef;
}


package TestRun

sub Run {
  my $test = MyTest->new();
  $test->foo();  # this produces a Moose error: Can't locate object method "foo" via package "MyTest"
}



paste:
TestRun::Run();

package MyRole;

use Moose::Role;

requires '_get_foo';

has 'foo' => (
  is => 'ro',
  isa => 'Maybe[Str]',
  reader => '_get_foo',
);

package MyTest

use Moose;

with 'MyRole';

sub _get_foo {
  my $self = shift;
  return undef;
}


package TestRun

sub Run {
  my $test = MyTest->new();
  $test->foo();  # this produces a Moose error: Can't locate object method "foo" via package "MyTest"
}


paste:
TestRun::Run();

package MyRole;

use Moose::Role;

requires '_get_foo';

has 'foo' => (
  is => 'ro',
  isa => 'Maybe[Str]',
  reader => '_get_foo',
);

package MyTest;

use Moose;

with 'MyRole';

sub _get_foo {
  my $self = shift;
  return undef;
}


package TestRun;

sub Run {
  my $test = MyTest->new();
  $test->foo();  # this produces a Moose error: Can't locate object method "foo" via package "MyTest"
}


where: freenode#perl
what: maybe fixed?
paste:
TestRun::Run();

package MyRole;

use Moose::Role;

requires '_get_foo';

has 'foo' => (
  is => 'ro',
  isa => 'Maybe[Str]',
  #reader => '_get_foo',
);

package MyTest;

use Moose;

with 'MyRole';

sub _get_foo {
  my $self = shift;
  return undef;
}


package TestRun;

sub Run {
  my $test = MyTest->new();
  $test->foo();  # this produces a Moose error: Can't locate object method "foo" via package "MyTest"
}


paste:
for (0..99) {
    my $beer = 99-$_;
    say "$beer bottles of beer on the wall,";
    say "$beer bottles of beer.";
    say "Take one down, pass it around,";
}


who: zxd
where: localhost:perlbot:#perl
what: I expect 'print $row_class;' to print 'foo' but it does not
paste:
use 5.010;
use strict;
use warnings;

package Tie::Cycle;

sub TIESCALAR {
  my $class = shift;
  my $list_ref = shift;
  return unless ref $list_ref eq ref [];
  my @shallow_copy = map { $_ } @$list_ref;
  my $self = [ 0, scalar @shallow_copy, \@shallow_copy ];
  bless $self, $class;
}

sub FETCH {
  my $self = shift;
  my $index = $self->[0]++;
  $self->[0] %= $self->[1];
  return $self->[2]->[ $index ];
}

sub STORE {
  my $self = shift;
  my $list_ref = shift;
  return unless ref $list_ref eq ref [];
  $self = [ 0, scalar @$list_ref, $list_ref ];
}



tie my $row_class, "Tie::Cycle", [ qw(cheese bananas) ];
$row_class = [ 'foo', 'bar' ];


print $row_class;


paste:
{package FOO;
  sub method {
      print "World, ";
  }
};

my $ref = sub {print "Hello!"};
bless $ref, "FOO";

$ref->method();
$ref->();


paste:
{package FOO;
  sub new {
      my $self;
      
      $self = sub {my ($method, @args) = @_; $self->$method(@args);};
      bless $self, "FOO";
      
      return $self;
  };
  
  sub method {
      print "World, ";
  }
  
  sub foo {
      print "Hello!";
  }
};

my $cr = FOO->new();
$cr->method();
$cr->("foo");


paste:
# Modules
use warnings;
use strict;
use POE;
use File::Path;

# Configuration
my $daemons = 10;
my $dlevel = 0;

# Generate the required directory structure.
POE::Session->create(
	object_states => [
		'main' => [ '_start', '_stop' ],
	]
);
 
POE::Kernel->run();
exit;

# ------------ Console -------------------

$ perl hub
'main' is not an object at hub line 15.
Starting tor daemons.
$


paste:
#!/usr/bin/env perl

# ---------------------------------------------------------------------------- #
# brimonk
# Sat Aug 06, 2016 13:42
#
# this bot is built for the retrobot irc channel on irc.freenode.net. First, it
# parses the markdown and creates a hash based off of the following pattern:
#
#   [text](link)
#
# The result is used within a hash, the text being the key, and the value it
# points to is the link. When the bot recieves a command, it uses 

use strict;
use warnings;

# ---------------------------------------------------------------------------- #
# We're using raw sockets for this shit. Because we're literally the best.
# This bot also uses 
# use IO::Socket;
use Data::Dumper;
use POE;
use POE::Component::IRC;

# ---------------------------------------------------------------------------- #
# Let's define a handful of global variables before we get too far ahead of
# ourselves.
my $nickName = "TheRetroBot";
my $startTime = time;

# wiki specific setup -> REMOVE ME IF YOU WANT TO USE FOR OTHER PROJECTS
my $wiki_file = "wiki";
my $web_prefix = "https://github.com/RetroPie/RetroPie-Setup/wiki/";

# my @admin_commands_list
my @regular_commands_list = ["!wiki", "!rot13"];
my @op_users = ("up2late", "brimonk");

# Define what channels we'll be joining.
sub CHANNEL () { "##pentest" }



# ---------------------------------------------------------------------------- #
# This creates the hash globally so we can use it within the poe session
my %wiki_commands = create_wiki_commands($wiki_file);

# Create the component that will represent an IRC network.
my ($irc) = POE::Component::IRC->spawn();

# Create the bot session.  The new() call specifies the events the bot
# knows about and the functions that will handle those events.
POE::Session->create(
  inline_states => {
    _start     => \&bot_start,
    irc_001    => \&on_connect,
    irc_public => \&on_public,
  },
);

# The bot session has started.  Register this bot with the "magnet"
# IRC component.  Select a nickname.  Connect to a server.
sub bot_start {
  $irc->yield(register => "all");
  $irc->yield(
    connect => {
      Nick     => $nickName,
      Username => 'TheRetroBot',
      Ircname  => 'POE::Component::IRC Retropie Wiki Bot',
      Server   => 'irc.freenode.net',
      Port     => '6667',
    }
  );
}

# The bot has successfully connected to a server.  Join a channel.
sub on_connect {
  $irc->yield(join => CHANNEL);
}

# The bot has received a public message.  Parse it for commands, and
# respond to interesting things.
sub on_public {


    my ($kernel, $who, $where, $msg) = @_[KERNEL, ARG0, ARG1, ARG2];

    my $nick    = (split /!/, $who)[0];
    my $channel = $where->[0];

    print "[" . getTS() . "] <$nick:$channel> $msg\n";

    # ------------------------------------------------------------------------ #
    # rot13 message. This was more just an experiment than anything, really.
    if (my ($rot13) = $msg =~ /^!rot13 (.+)/) {
        $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];

        # Send a response back to the server.
        $irc->yield(privmsg => CHANNEL, $rot13);

        print "[" . getTS() . "]" . $rot13 . "\n";
    } elsif (my ($kickme) = $msg =~ /^!kickme/) {
        $irc->yield(privmsg => CHANNEL, "/kick " . $nick);
    }

    # This is not how you actually kick people
    elsif (my ($kick) = $msg =~ /^!kick (.+)/) {
        $irc->yield(privmsg => CHANNEL, "/kick " . $kick);
    }

    elsif (my ($wiki) = $msg =~ /^!wiki/) {
        my $irc_message = "wiki functions are being worked on!\n";

        $irc->yield(privmsg => CHANNEL, $irc_message);
    }

    elsif ($msg =~ /^!changelog/) {

        print $1 . "\n";
        my $tmp = "https://github.com/RetroPie/RetroPie-Setup/wiki/Changelogs";

        print $tmp . "\n";
        $irc->yield(privmsg => CHANNEL, $tmp);
    }

    elsif ($msg =~ /^!quit/ || $msg =~ /^!exit/) {
        # move through the list of op_users and if the person who sent
        # the !quit || !exit commands is in the list,
        #
        # Print a leaving message, and shutdown
        for (my $i = 0; $i < scalar @op_users + 1; $i++) {
            if ($nick eq $op_users[$i]) {
                my $tmp = "Leaving. Requested by: " . $nick . "\n";
                print $tmp;
                $irc->yield(privmsg => CHANNEL, $tmp);

                # Quit out of this block, and shutdown IRC components
                $poe_kernel->signal($poe_kernel, 'POCOIRC_SHUTDOWN');
            }
        }
    }

    # ------------------------------------------------------------------------ #
    # END OF IRC --NON-- WIKI COMMANDS
    else {
        # -------------------------------------------------------------------- #
        # we should be able to do a quick, "if %hash{$1} =~ /w+/ statement,
        # but it apparently isn't that easy. I think I might just look into
        # java bot frameworks because using perl is literally the only reason
        # this thing isn't done yet.
        if ($msg =~ /^!w/) {
            my $command = $1;

            # Do stuff here
        }
    }
}

# parse the webpage

printStartupInfo();

# Run the bot until it is sent the command to exit.
$poe_kernel->run();

# while( my( $key, $value ) = each %wiki_commands ){
# print "$key : $value";
# }

printEndInfo();

# ---------------------------------------------------------------------------- #
# Method : create_wiki_commands
# Purpose: Separate out the creation of the wiki commands into its own thing
# parms  : name of file to parse
# returns: a hash, where the key is the sub command, and the link it'll spit out
#
# NOTE   : This doesn't actually do much parsing. It does this:
#
#   Read in a line
#       Get the position of the first '"'
#       Get the position of the second '"'
#       Get the position of the =
#       Get the position of the third '"'
#       Get the position of the fourth '"'
#
#       add it to the hash like this:
#           $hash{betwee_first_and_second} = between_third_and_fourth;
#
#   return the hash
sub create_wiki_commands {
    # Begin to read in the file
    my $filename = $_[0];
    my $text;

    open (my $fileHandle, "<", $filename) || 
                    die "Couldn't open file $filename\n";

    my %wiki_commands_hash;
    my $char = '"';

    while (<$fileHandle>) {
        my $text = $_;
        my $first = index($text, $char, 0);
        my $second = index($text, $char, $first + 1);
        my $third = index($text, $char, $second + 1);
        my $fourth = index($text, $char, $third + 1);

        my $linkText = substr ($text, $first, $second);
        my $link     = substr ($text, $third, $fourth);

        $wiki_commands_hash{$linkText} = $link;
    }

    return %wiki_commands_hash;
}

sub getTS {
    return scalar localtime;
}

sub printStartupInfo {
    print "Brimonk's Retropie Bot.\n";
    print "Feel free to modify and distribute changes as you see fit\n";
    print "\n\n$nickName has started up at <" . localtime .  "> \n";

    return;
}

sub printEndInfo {
    print "Quitting...\n";
    print "We were online for: " . $startTime - time . " seconds.\n";

    exit 0;
}


who: xenu
where: localhost:perlbot:#perl
what: scientific benchmark of POSIX and Fcntl
paste:
bash-4.1$ time perl -MPOSIX -E ''

real    0m0.013s
user    0m0.011s
sys     0m0.001s
bash-4.1$ time perl -MFcntl -E ''

real    0m0.004s
user    0m0.004s
sys     0m0.000s


who: _slade_
where: localhost:perlbot:#perl
what: attempt to copy freed scalar
paste:
#!/usr/bin/env perl
use Getopt::Long;
sub main
{
    GetOptions();
    shift;
}
exit(main(@ARGV));

# Running this as: 
#     $ perl test.pl <(echo foo)
# Causes perl to crash with this:
#     panic: attempt to copy freed scalar 1e88980 to 1e6a158 at test.pl line 6.
# (I'm running perl 5.24.0 built for x86_64-linux-thread-multi)


where: localhost:perlbot:#perl
paste:
#!/usr/bin/perl
use Getopt::Std;
use Data::Dumper;
my %opts;
getopts('s:',\%opts);
print Dumper(@ARGV);
print $opts{s}."\n";

=head
running:
test.pl  -s server{1..4}

gives:
$VAR1 = 'server2';
$VAR2 = 'server3';
$VAR3 = 'server4';
server1
=cut


paste:
use File::Slurper 'read_text'; 
use Mojo::DOM; 
use Data::Dumper;
my %counts; 
Mojo::DOM->new(read_text 'example.html')->find('a.subreddit')->each(sub { $counts{$_->text}++ }); 
\%counts


who: Dagda
where: localhost:perlbot-magnet:#perl
paste:

           Result_Name                    Original_Name         Value  Factor Result_(Calib.) Unit String_Reference Lower_Limit Upper_Limit Min_Result Max_Result  Range  Average  Sigma   Judgment   NG NG_Max Errors Scans
                                 
C1_Stubbing_Bottom               WI[1;1]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C2_Stubbing_Bottom               WI[1;2]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C3_Stubbing_Bottom               WI[1;3]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C4_Stubbing_Bottom               WI[1;4]areaSize                0     1       0                    ---              0           100         0          9          9       0.003   0.155  Not Executed 0  1      0      5400 
C5_Stubbing_Bottom               WI[1;5]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C6_Stubbing_Bottom               WI[1;6]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C7_Stubbing_Bottom               WI[1;7]areaSize                0     1       0                    ---              0           100         0          9          9       0.002   0.122  Not Executed 0  1      0      5400 
C8_Stubbing_Bottom               WI[1;8]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C9_Stubbing_Bottom               WI[1;9]areaSize                0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C10_Stubbing_Bottom              WI[1;10]areaSize               0     1       0                    ---              0           100         0          9          9       0.013   0.285  Not Executed 0  1      0      5400 
C11_Stubbing_Bottom              WI[1;11]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C12_Stubbing_Bottom              WI[1;12]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C1_Stubbing_Top                  WI[1;31]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C2_Stubbing_Top                  WI[1;22]areaSize               0     1       0                    ---              0           100         0          371        371     1.412   14.454 Not Executed 14 1      0      5400 
C3_Stubbing_Top                  WI[1;33]areaSize               0     1       0                    ---              0           100         0          9          9       0.002   0.122  Not Executed 0  1      0      5400 
C4_Stubbing_Top                  WI[1;34]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C5_Stubbing_Top                  WI[1;25]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C6_Stubbing_Top                  WI[1;36]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C7_Stubbing_Top                  WI[1;37]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C8_Stubbing_Top                  WI[1;32]areaSize               0     1       0                    ---              0           100         0          12         12      0.002   0.163  Not Executed 0  1      0      5400 
C9_Stubbing_Top                  WI[1;39]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C10_Stubbing_Top                 WI[1;40]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      Not Executed 0  1      0      5400 
C11_Stubbing_Top                 WI[1;35]areaSize               0     1       0                    ---              0           100         0          2          2       0       0.027  Not Executed 0  1      0      5400 
C12_Stubbing_Top                 WI[1;42]areaSize               0     1       0                    ---              0           100         0          4          4       0.001   0.054  Not Executed 0  1      0      5400 
Rib_1_Absence_Check              WI[1;13]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_2_Absence_Check              WI[1;14]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_3_Absence_Check              WI[1;15]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_4_Absence_Check              WI[1;16]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_5_Absence_Check              WI[1;17]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_6_Absence_Check              WI[1;18]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_7_Absence_Check              WI[1;19]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_8_Absence_Check              WI[1;20]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_9_Absence_Check              WI[1;51]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Rib_10_Absence_Check             WI[1;54]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      Not Executed 0  1      0      5400 
Coding_Keys_Sequence1            CM[1;1]numberOfJudgedObjects   10    1       10                   ---              10          10          10         10         0       10      0      Not Executed 0  1      0      5400 
coding_key_check_seq1            DI[1;1]Total_Difference        0     1       0                    ---              0           0           0          0          0       0       0      Not Executed 0  1      0      5400 
C1_Gap                           ED_GP[1;1]pairInterDistance_1  33.37 21.9927 733.895         um   ---              610         820         597.981    781.18     183.199 704.056 31.215 Not Executed 2  1      0      5400 
C2_Gap                           ED_GP[1;2]pairInterDistance_1  0     19      0               um   ---              0           300         0          0          0       0       0      Not Executed 0  1      0      5400 
C3_Gap                           ED_GP[1;3]pairInterDistance_1  33.57 21.9051 735.353         um   ---              610         820         604.361    769.744    165.383 705.79  30.923 Not Executed 2  1      0      5400 
C4_Gap                           ED_GP[1;4]pairInterDistance_1  33.86 21.9927 744.672         um   ---              610         820         0          776.781    776.781 711.067 34.611 Not Executed 2  1      0      5400 
C5_Gap                           ED_GP[1;5]pairInterDistance_1  0     19      0               um   ---              0           300         0          591.85     591.85  0.216   11.21  Not Executed 2  1      0      5400 
C6_Gap                           ED_GP[1;6]pairInterDistance_1  33.43 21.9051 732.287         um   ---              610         820         0          916.289    916.289 705.666 35.814 Not Executed 3  1      0      5400 
C8_Gap                           ED_GP[1;8]pairInterDistance_1  0     19      0               um   ---              0           300         0          0          0       0       0      Not Executed 0  1      0      5400 
C7_Gap                           ED_GP[1;7]pairInterDistance_1  33.63 22.1031 743.329         um   ---              610         820         608.721    793.945    185.224 708.795 32.486 Not Executed 1  1      0      5400 
C9_Gap                           ED_GP[1;9]pairInterDistance_1  33.43 21.9415 733.504         um   ---              610         820         607.999    766.416    158.418 700.488 31.587 Not Executed 1  1      0      5400 
C10_Gap                          ED_GP[1;10]pairInterDistance_1 33.06 22.1551 732.447         um   ---              610         820         614.804    773.656    158.852 707.217 32.549 Not Executed 0  1      0      5400 
C11_Gap                          ED_GP[1;11]pairInterDistance_1 0     19      0               um   ---              0           300         0          648.28     648.28  0.233   12.103 Not Executed 2  1      0      5400 
C12_Gap                          ED_GP[1;12]pairInterDistance_1 32.25 22.1477 714.262         um   ---              610         820         0          777.604    777.604 709.268 36.816 Not Executed 4  1      0      5400 
C13_Gap                          ED_GP[1;13]pairInterDistance_1 33.11 22.5026 745.06          um   ---              610         820         618.145    819.993    201.848 720.456 32.028 OK           4  1      4      5400 
C14_Gap                          ED_GP[1;14]pairInterDistance_1 0     19      0               um   ---              0           300         0          0          0       0       0      OK           4  1      4      5400 
C15_Gap                          ED_GP[1;15]pairInterDistance_1 33.44 21.7535 727.436         um   ---              610         820         607.792    765.504    157.713 698.424 30.454 OK           5  1      4      5400 
C16_Gap                          ED_GP[1;16]pairInterDistance_1 33.43 21.8905 731.801         um   ---              610         820         606.587    770.766    164.179 704.521 32.372 OK           6  1      4      5400 
C17_Gap                          ED_GP[1;17]pairInterDistance_1 0     19      0               um   ---              0           300         0          0          0       0       0      OK           4  1      4      5400 
C18_Gap                          ED_GP[1;18]pairInterDistance_1 33.38 21.9269 731.92          um   ---              610         820         601.236    763.276    162.04  699.526 33.557 OK           10 1      4      5400 
C13_Stubbing_Bottom              WI[1;21]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
C14_Stubbing_Bottom              WI[1;38]areaSize               0     1       0                    ---              0           100         0          8          8       0.009   0.231  OK           4  1      4      5400 
C15_Stubbing_Bottom              WI[1;23]areaSize               0     1       0                    ---              0           100         0          4          4       0.001   0.054  OK           4  1      4      5400 
C16_Stubbing_Bottom              WI[1;24]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
C17_Stubbing_Bottom              WI[1;41]areaSize               0     1       0                    ---              0           100         0          18         18      0.004   0.248  OK           4  1      4      5400 
C18_Stubbing_Bottom              WI[1;26]areaSize               0     1       0                    ---              0           100         0          11         11      0.003   0.155  OK           4  1      4      5400 
C13_Stubbing_Top                 WI[1;43]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
C14_Stubbing_Top                 WI[1;44]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
C15_Stubbing_Top                 WI[1;45]areaSize               0     1       0                    ---              0           100         0          3          3       0.001   0.041  OK           4  1      4      5400 
C16_Stubbing_Top                 WI[1;46]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
C17_Stubbing_Top                 WI[1;47]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
C18_Stubbing_Top                 WI[1;48]areaSize               0     1       0                    ---              0           100         0          0          0       0       0      OK           4  1      4      5400 
Rib_11_Absence_Check             WI[1;27]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      OK           4  1      4      5400 
Rib_12_Absence_Check             WI[1;28]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      OK           4  1      4      5400 
Rib_13_Absence_Check             WI[1;29]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      OK           4  1      4      5400 
Rib_14_Absence_Check             WI[1;30]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      OK           4  1      4      5400 
Rib_15_Absence_Check             WI[1;59]areaSize               0     1       0                    ---              0           700         0          0          0       0       0      OK           4  1      4      5400 
Coding_Keys_Sequence2            CM[1;2]numberOfJudgedObjects   5     1       5                    ---              5           5           0          5          5       4.996   0.136  OK           4  1      0      5400 
coding_key_check_seq2            DI[1;2]Total_Difference        0     1       0                    ---              0           0           0          0          0       0       0      OK           4  1      4      5400 
box_area_1                       FE[1;1]numberOfJudgedObjects   0     1       0                    ---              0           0           0          1          1       0       0.014  Not Executed 1  1      0      5400 
box_area_2                       FE[1;2]numberOfJudgedObjects   0     1       0                    ---              0           0           0          0          0       0       0      Not Executed 0  1      0      5400 
box_area_3                       FE[1;3]numberOfJudgedObjects   0     1       0                    ---              0           0           0          0          0       0       0      Not Executed 0  1      0      5400 
box_area_4                       FE[1;4]numberOfJudgedObjects   0     1       0                    ---              0           0           0          1          1       0       0.014  Not Executed 1  1      0      5400 
box_area_5                       FE[1;5]numberOfJudgedObjects   0     1       0                    ---              0           0           0          0          0       0       0      Not Executed 0  1      0      5400 
box_area_6                       FE[1;6]numberOfJudgedObjects   0     1       0                    ---              0           0           0          0          0       0       0      Not Executed 0  1      0      5400 
box_area_7                       FE[1;7]numberOfJudgedObjects   0     1       0                    ---              0           0           0          0          0       0       0      Not Executed 0  1      0      5400 
box_area_8                       FE[1;8]numberOfJudgedObjects   0     1       0                    ---              0           0           0          1          1       0       0.014  Not Executed 1  1      0      5400 
box_area_9                       FE[1;9]numberOfJudgedObjects   0     1       0                    ---              0           0           0          0          0       0       0      OK           4  1      4      5400 
box_area_10                      FE[1;10]numberOfJudgedObjects  0     1       0                    ---              0           0           0          1          1       0       0.014  OK           5  1      4      5400 
box_area_11                      FE[1;11]numberOfJudgedObjects  0     1       0                    ---              0           0           0          0          0       0       0      OK           4  1      4      5400 
box_area_12                      FE[1;12]numberOfJudgedObjects  0     1       0                    ---              0           0           0          1          1       0       0.014  OK           5  1      4      5400 
Position_Keys_Full_Check_Right_1 FE[1;13]numberOfJudgedObjects  5     1       5                    ---              5           5           2          5          3       4.997   0.084  Not Executed 10 1      0      5400 
Position_Keys_Full_Check_Right_2 FE[1;15]numberOfJudgedObjects  5     1       5                    ---              5           5           5          5          0       5       0      Not Executed 0  1      0      5400 
Position_Keys_Full_Check_Left    FE[1;14]numberOfJudgedObjects  5     1       5                    ---              5           5           5          5          0       5       0      OK           4  1      4      5400 
SEQ1_All_OK?                                                    ---   ---     ---             ---  ---              ---         ---         ---        ---        ---     ---     ---    Not Executed 28 1      0      5400 
SEQ2_All_OK?                                                    ---   ---     ---             ---  ---              ---         ---         ---        ---        ---     ---     ---    OK           15 1      0      5400 


paste:
!c:\strawberry\perl\bin\perl.exe
use strict;
use warnings;

use Path::Class;
use autodie; # die if problem reading or writing a file

my $dir = dir("c:\strawberry\scripts"); # /tmp

my $file = $dir->file("file.txt"); # /tmp/file.txt

# Get a file_handle (IO::File object) you can write to
my $file_handle = $file->openw();

my @list = ('a', 'list', 'of', 'lines');

foreach my $line ( @list ) {
    # Add the line to the file
    $file_handle->print($line . "\n");
}


paste:
#!c:\strawberry\perl\bin\perl.exe
use strict;
use warnings;

use Path::Class;
use autodie; # die if problem reading or writing a file

my $dir = dir("c:\strawberry\scripts"); # /tmp

my $file = $dir->file("file.txt"); # /tmp/file.txt

# Get a file_handle (IO::File object) you can write to
my $file_handle = $file->openw();

my @list = ('a', 'list', 'of', 'lines');

foreach my $line ( @list ) {
    # Add the line to the file
    $file_handle->print($line . "\n");
}


paste:
use strict;
use warnings;

use Path::Tiny;
use autodie; # die if problem reading or writing a file

my $dir = Path::Tiny->tempdir; # /tmp

my $file = $dir->child("file.txt"); # /tmp/file.txt

# Get a file_handle (IO::File object) you can write to
my $file_handle = $file->openw_utf8();

my @list = ('a', 'list', 'of', 'lines');

foreach my $line ( @list ) {
    # Add the line to the file
    $file_handle->print($line . "\n");
}


paste:
#!/usr/bin/perl

use strict;
use warnings;

sub foo {
        print "@_\n";
}

my @a1 = (1, 2, 3, 4);
my @a2 = (5, 6, 6, 7);
foo(@a1, @a2);



who: mauke
where: localhost:perlbot-magnet:#perl
what: I heard you like state machines
paste:
#!/usr/bin/env perl
use strict;
use warnings;

my $src = <<'_EOT_';
Digital(
    Type(SPEEDOMETER DIGITAL) Position(251 332 30 28) ScaleRange(0 80) Accuracy(
        1) AccuracySwitch(9.9) LeadingZeros(0) Justification(1) PositiveColour(
        1 ControlColour(0 201 0)) NegativeColour(0) DecreaseColour(0) Units(
        MILES_PER_HOUR) ORTSFont(8 0 "Times New Roman")
)
Digital(
    Type(ACCELEROMETER DIGITAL) Position(282 316 17 10) ScaleRange(-99 99) Accuracy(
        0) AccuracySwitch(0) LeadingZeros(0) Justification(1) PositiveColour(
        1 ControlColour(0 201 0)) NegativeColour(1 ControlColour(255 255 0)) DecreaseColour(
        0 ControlColour(0 0 0)) Units(MILES / HOUR / MIN) ORTSFont(7 1 "Arial")
)
Digital(
    Type(TRACTION_BRAKING DIGITAL) Position(287 332 21 7) ScaleRange(-105 191) Accuracy(
        0) AccuracySwitch(0) LeadingZeros(0) Justification(1) PositiveColour(
        1 ControlColour(0 201 0)) NegativeColour(1 ControlColour(255 255 0)) DecreaseColour(
        0 ControlColour(0 0 0)) Units(KILO_LBS) ORTSFont(8 0 "Courier New")
)
_EOT_

my $lvl = 0;
my @ctx;
my $sp = 0;

$src =~ s/\A\s+//;
$src =~ s/\s+\z//;

$src =~ s{
    \G
    (?:
        (\w++) \s*+ \(
    |
        ( \) )
    |
        (
            -?+ \d++ (?: \. \d++)?+
        |
            [^\W\d] \w*+ (?! \( )
        |
            " [^"]*+ "
        |
            [^[:^punct:]()"]
        )
    )
    \s*+
}{
    my $p = $sp ? " " : "";
    $sp = 1;
    my $q =
        defined $1 ? do {
            $sp = 0;
            my $r = "$1(";
            if (@ctx) {
                if (!$ctx[-1]) {
                    $ctx[-1] = 1;
                    $lvl++;
                }
                $p = "";
                $r = "\n" . " " x (4 * $lvl) . $r;
            }
            push @ctx, 0;
            $r
        } :
        defined $2 ? do {
            $p = "";
            my $d = pop @ctx;
            ($d ? "\n" . " " x (4 * --$lvl) : "") . ")"
        } :
        $3;
    $p . $q
}xaeg;

print $src, "\n";


who: russoisraeli
where: localhost:perlbot:#perl
what: clueless about this...
paste:
if (exists $hosts{$curhst} -> {'contacts'} && @{$hosts{$curhst} -> {'contacts'}} && $curhst =~ m#cisdr301w#) {
        print HSTFL "Debug for cisdr301w: " . join (", ", @{$hosts{$curhst} -> {'contacts'}});
        print "Debug for cisdr301w: " . join (", ", @{$hosts{$curhst} -> {'contacts'}});                                                                       
        print "\nDebug for cisdr301w: "; print Dumper($hosts{$curhst} -> {'contacts'});
}


Debug for cisdr301w: ARRAY(0x7ff45b31a878)
Debug for cisdr301w: $VAR1 = [
          'ARRAY(0x7ff45b31a878)'
        ];
        
## The file has this:
Debug for cisdr301w: ARRAY(0x7ff45b31a878)


who: russoisraeli
where: localhost:perlbot:#perl
paste:
'cisdr301w' => {
                           '_contacts' => {
                                            'disk' => {
                                                        '.*' => [
                                                                  'Name A',
                                                                  'Name B'                                                                                                                                       
                                                                  ]
                                                      }
                                          }                                                                                          
                         },


who: Grinnz
where: localhost:perlbot:#perl
what: not so much
paste:
grinnz@home ~> perl -MPOSIX=isinf -E "say isinf('Inf')"
"isinf" is not exported by the POSIX module
Can't continue after import errors at /home/grinnz/.plenv/versions/5.20.3/lib/perl5/5.20.3/x86_64-linux/POSIX.pm line 30.
BEGIN failed--compilation aborted.
grinnz@home ~> plenv shell 5.22.1
grinnz@home ~> perl -MPOSIX=isinf -E "say isinf('Inf')"
1


who: vlad
where: localhost:perlbot:#perl
paste:
has 'columns' => (
	traits  => ['Array'],
	is => 'rw',
	isa => 'ArrayRef[Str]',
	default => sub { [] },
	required => 1
);


paste:
use feature 'say';
Foo::bar();

package Foo;
sub bar { Fub::bar() };
package Fub;
sub bar { Bar::bar() };
package Bar;
use Carp;
sub bar {
#  local $Carp::CarpInternal{'Fub'} = 1;                                                                                                                                                              
 say join ", " => map "$_ => $Carp::CarpInternal{$_}", keys %Carp::CarpInternal;
 carp("I like pie")
}


who: simcop2387
where: localhost:perlbot:#perl
what: math bigint internal representation change
paste:
#          got: 'bless( {sign => "+",value => bless( [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,10], 'Math::BigInt::Calc' )}, 'Math::BigInt' )'
#     expected: 'bless( {sign => "+",value => [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,10]}, 'Math::BigInt' )'


who: Grinnz
where: localhost:perlbot-magnet:#perl
what: Basic use of overload on a circle angle
paste:
package My::CircleAngle {
    use Class::Tiny 'angle';
    use overload
        '0+' => sub { $_[0]->angle },
        '+' => sub { __PACKAGE__->new(angle => ($_[0]->angle + $_[1]) % 360) },
        '-' => sub { __PACKAGE__->new(angle => ($_[2] ? $_[1] - $_[0]->angle : $_[0]->angle - $_[1]) % 360) },
        '*' => sub { __PACKAGE__->new(angle => ($_[0]->angle * $_[1]) % 360) },
        '/' => sub { __PACKAGE__->new(angle => ($_[2] ? $_[1] / $_[0]->angle : $_[0]->angle / $_[1]) % 360) },
        'bool' => sub { 1 },
        fallback => 1,
}

my $angle = My::CircleAngle->new(angle => 50);
say $angle;
say $angle + $angle;
say $angle - $angle;
say $angle + 10;
say $angle - 70;
say $angle + 400;
say $angle < $angle + 10;
say $angle < $angle - 70;
say $angle < $angle + 400;
say $angle * 20;
say 600 / $angle;


who: Grinnz
where: localhost:perlbot:#perl
what: or a more mutable object approach, less overload magic
paste:
package My::CircleAngle {
    use Moo;
    use Carp 'croak';
    use overload '0+' => sub { $_[0]->angle }, 'bool' => sub { 1 }, fallback => 1;
    has 'angle' => (
        is => 'rw',
        required => 1,
        coerce => sub { $_[0] % 360 },
    );
    sub add { $_[0]->angle($_[0]->angle + $_[1]); $_[0] }
    sub subtract { $_[0]->angle($_[0]->angle - $_[1]); $_[0] }
    sub clone { __PACKAGE__->new(angle => $_[0]->angle) }
}

my $angle = My::CircleAngle->new(angle => 50);
say $angle;
say $angle->clone->add($angle);
say $angle->clone->subtract($angle);
say $angle->clone->add(10);
say $angle->clone->subtract(70);
say $angle->clone->add(400);
say $angle < $angle->clone->add(10);
say $angle < $angle->clone->subtract(70);
say $angle < $angle->clone->add(400);


who: Dmitrykit
where: localhost:perlbot:#perl
paste:

foreach $objzzz(keys %MY_3dSOLIDS){
  
  
my $sset  = Variant( VT_VARIANT | VT_BYREF);
 $sset = $selectionsettest->Add("TESTSELECTIONSET");
 


  
      my $object = $ACAD->ActiveDocument()->HandleToObject(($MY_3dSOLIDS{$objzzz}->Handle()));
      
      
        #$kkk->Highlight(1); #its work
        $object->{Color}=int(rand(250));
         $ACAD->Update();#sleep 1;
  
      
      my $Var = Variant(VT_ARRAY|VT_BYREF, 1);

      $Var->Put(0,$object);
      
$ACAD->ActiveDocument->SelectionSets->Item('TESTSELECTIONSET')->AddItems($Var);


print (Dumper(Win32::OLE->LastError() . 'lasterror2'."\n"));

   
    
}
}


where: localhost:perlbot:#perl
what: I broke this
paste:
#!/usr/bin/perl

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib/", "$FindBin::Bin/local/lib/perl5";
use Grid::HTML5;
use CGI;

my $query = CGI->new;

my $post = $query->url_param('post');
my $upvote = $query->url_param('upvote');

if ($post > 0 and $upvote > -1 and $upvote < 2) {
  my $path = "data/text/$post" . ".txt";

  my $file = open(my $fh, '<', $path) or die "Failed to open $path:$!";
  local $/ = "```";
  (my $body, my $count) = <$fh>;
  close($fh);

  my $newfile = open($fh, '>', $path) or die "Failed to open $path:$!";

  if ($upvote == 0) {
    print $fh $body;
    print $fh $count-1;
  }
  elsif ($upvote == 1) {
    print $fh $body;
    print $fh $count+1;
  }

  close($fh);

  print "Location: feed.cgi\n\n";
}
else {
  print "Location: feed.cgi\n\n";
}


who: Grinnz
where: localhost:perlbot:#perl
what: A cgi script that redirects using a modern framework
paste:
#!/usr/bin/env perl

use Mojolicious::Lite;

get '/*path' => sub {
    my $c = shift;
    my $url = $c->req->url;
    unshift @{$url->path->parts}, 'cgi-bin';
    $c->redirect_to($url);
};

app->start;


who: simcop2387
where: localhost:perlbot:#perl
what: rewrite of bhelit's code to be more idiomatic
paste:
# withold_calc.pl $exception $salary
use strict; use warnings;
my ($exception, $salary) = (1, 2222);

my $tax = parse_fwh('single.fwp', $exception, $salary);
print "$tax\n";

sub parse_fwh {
    my ($table, $exception, $salary) = @_;

    my @data;

    open(my $fh, '<', $table) or die "can't open $table: $!";
    readline($fh); # drop the headers
    while (my $line = readline $fh) {
        my @tmp = split ' ', $line;
        foreach my $item (@tmp)
            { $item =~ s/,//; }
        push @data, [ @tmp ];
    }
    
    for my $row (@data) {
        if (($salary > $row->[0]) and ($salary < $row->[1]))
            { return $row->[$exception]; }
    }
}


who: vague
what: Silly
paste:
-P INPUT ACCEPT
-P FORWARD ACCEPT
-P OUTPUT ACCEPT
-A INPUT -p tcp -m state --state NEW -m tcp --dport 22 -j ACCEPT
-A INPUT -p tcp -m state --state NEW -m tcp --dport 80 -j ACCEPT
-A INPUT -p tcp -m state --state NEW -m tcp --dport 443 -j ACCEPT


who: bhelit
what: derping out
paste:
use strict; use warnings;
use Term::Menus;
my ($data) = @ARGV;
# POPULATE HASHES;
open(my $nam, '<', $data) or die ("Couldn't open NAM\n");
my @name = readline $nam;
chomp @name;
my %name;
foreach my $i (@name) {
	my @n = split(" ", $i);
	$name{$n[0]} = $n[1];
}
# USER INPUT
START:
print "MKRX SYSTEMS RDY!\n: ";
my $input = <STDIN>;
chomp($input);
print "\nwork'n on $input\n";
# OPTIONS
my @cmds = (split ' ', $input)[0,1];
my $cmd = $cmds[0];
my $string = $cmds[1];
# ACTION
L1:
my @res = grep /$string/i, values %name;
my @lay1;
push @lay1, [ splice @res, 0, 25 ] while @res;

# Select @lay[$n]; print $selection = print @lay[$n][0..24];
my $banner = " Page Selection ";
my $selection=&pick(\@lay1,$banner);
print "SELECTION = $selection\n";
goto L1;


who: bhelit
where: localhost:perlbot-magnet:#perl
what: does this do what comments think?
paste:
# hashes: %name %size %location
sub search {
    my ($type) = shift @_; #if shift eq 'name' $type will reference $%name;
    my ($list) = shift @_; #list of keys; all hashes have same keys but diff values;
    my @newkeyset;
    my %hashsub = \%$type;
    foreach my $key (keys %hashsub) {
        if (grep /\Q$string\E/i, values %hashsub)
            { $newkeyset[++$#keyset] = $key; }
    }
    my $newkeyset = \@newkeyset;
    return $newkeyset;
}


who: bhelit
where: localhost:perlbot:#perl
what: thanks for the help :D (i have to build the rest before i test it)
paste:
sub search {
    my ($hashtype) = @_; 
    my ($keylist) = @_;
    my %hashsub = %{$hashtype};
    my @keyset = @{$keylist};
    my @newkeyset;
    foreach my $key (keys %hashsub) {
        if (grep /\Q$string\E/i, values %hashsub)
            { $newkeyset[++$#keyset] = $key; }
    }
    my $newkeyset = \@newkeyset;
    return $newkeyset;
}


who: starvin_darlin
where: localhost:perlbot:#perl
what: capstone project ":D
paste:
#!/usr/local/bin/perl
use strict; use warnings;
# MKRX - cli to regex browswer
my ($data_dir) = @ARGV;
# POPULATE HASHES
my $ndata = $data_dir . '/NAM';
open(my $nam, '<', $ndata) or die ("Couldn't open NAM\n");
my @name = readline $nam;
chomp @name;
my %name;
foreach my $i (@name) {
	my @n = split(" ", $i);
	$name{$n[0]} = $n[1];
}
my $pdata = $data_dir . '/PAT';
open(my $pat, '<', $pdata) or die ("Couldn't open PAT\n");
my @path = readline $pat;
chomp @path;
my %path;
foreach my $i (@path) {
	my @p = split(" ", $i);
	$path{$p[0]} = $p[1];
}
my $zdata = $data_dir . '/SIZ';
open(my $siz, '<', $zdata) or die ("Couldn't open SIZ\n");
my @size = readline $siz;
chomp @size;
my %size;
foreach my $i (@size) {
	my @z = split(" ", $i);
	$size{$z[0]} = $z[1];
}
my $edata = $data_dir . '/ENC';
open(my $enc, '<', $edata) or die ("Couldn't open ENC\n");
my @encode = readline $enc;
chomp @encode;
my %encode;
foreach my $i (@encode) {
	my @e = split(" ", $i);
	$encode{$e[0]} = $e[1];
}
# USER INPUT
START:
print "MKRX SYSTEMS RDY!\n: ";
my $input = <STDIN>;
chomp($input);
print "\nwork'n on $input\n";
# OPTIONS
my @cmds = (split ' ', $input)[0,1];
my $cmd = $cmds[0];
my $string = $cmds[1];
# ACTION
if ( $cmd eq 'name' ) {
		my @names = keys %name;
		my $key_set = \@names;
		layer_s($cmd, $key_set, $string);
}
if ( $cmd eq 'path' ) {
		my @path = keys %path;
		my $key_set = \@path;
		layer_s($cmd, $key_set, $string);
}
if ( $cmd eq 'size' ) {
		my @size = keys %size;
		my $key_set = \@size;
		layer_s($cmd, $key_set, $string);
}
if ( $cmd eq 'encode' ) {
		my @encode = keys %encode;
		my $key_set = \@encode;
		layer_s($cmd, $key_set, $string);
}

# PASS KEYSET TYPE STRING
sub layer_s { # ARGV1 type ARGV2 keyset ARGV3 string
	my $type = @_;
	my $k_set = @_;
	my $layer_string = @_;
	my @keyset = @{$k_set};
	my $l_hash = l_hash($type);
	my %layer_hash = %{ $l_hash };
  my @newkeyset;
	foreach my $keyy (@keyset) {
		@newkeyset = grep /\Q$layer_string\E/i, values %layer_hash;
	}
	foreach my $r_key (@newkeyset)
		{ print "$r_key\n"; }
	my $return_keyset = \@newkeyset;
	return $return_keyset;
}

sub l_hash { # ARGV1 type
	my $type = @_;
	if ($type eq 'name') {
			my %l_hash = %name;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	elsif ($type eq 'path'){
			my %l_hash = %path;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	elsif ($type eq 'size') {
			my %l_hash = %size;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	elsif ($type eq 'encode') {
			my %l_hash = %encode;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	else
		{ print "ARG1 tye\n"; goto LAYER; }
}


who: ningu
where: localhost:perlbot:#perl
what: something like this
paste:
#!/usr/local/bin/perl
use strict; use warnings;
# MKRX - cli to regex browswer
my ($data_dir) = @ARGV;
# POPULATE HASHES
my $ndata = $data_dir . '/NAM';
open(my $nam, '<', $ndata) or die ("Couldn't open NAM\n");
my @name = readline $nam;
chomp @name;
my %name;
foreach my $i (@name) {
	my @n = split(" ", $i);
	$name{$n[0]} = $n[1];
}
my $pdata = $data_dir . '/PAT';
open(my $pat, '<', $pdata) or die ("Couldn't open PAT\n");
my @path = readline $pat;
chomp @path;
my %path;
foreach my $i (@path) {
	my @p = split(" ", $i);
	$path{$p[0]} = $p[1];
}
my $zdata = $data_dir . '/SIZ';
open(my $siz, '<', $zdata) or die ("Couldn't open SIZ\n");
my @size = readline $siz;
chomp @size;
my %size;
foreach my $i (@size) {
	my @z = split(" ", $i);
	$size{$z[0]} = $z[1];
}
my $edata = $data_dir . '/ENC';
open(my $enc, '<', $edata) or die ("Couldn't open ENC\n");
my @encode = readline $enc;
chomp @encode;
my %encode;
foreach my $i (@encode) {
	my @e = split(" ", $i);
	$encode{$e[0]} = $e[1];
}
# USER INPUT

while (1) {

print "MKRX SYSTEMS RDY!\n: ";
my $input = <STDIN>;
chomp($input);
print "\nwork'n on $input\n";
# OPTIONS
my @cmds = (split ' ', $input)[0,1];
my $cmd = $cmds[0];
my $string = $cmds[1];
# ACTION
if ( $cmd eq 'name' ) {
		my @names = keys %name;
		my $key_set = \@names;
		layer_s($cmd, $key_set, $string);
}
if ( $cmd eq 'path' ) {
		my @path = keys %path;
		my $key_set = \@path;
		layer_s($cmd, $key_set, $string);
}
if ( $cmd eq 'size' ) {
		my @size = keys %size;
		my $key_set = \@size;
		layer_s($cmd, $key_set, $string);
}
if ( $cmd eq 'encode' ) {
		my @encode = keys %encode;
		my $key_set = \@encode;
		layer_s($cmd, $key_set, $string);
}

}

# PASS KEYSET TYPE STRING
sub layer_s { # ARGV1 type ARGV2 keyset ARGV3 string
	my $type = @_;
	my $k_set = @_;
	my $layer_string = @_;
	my @keyset = @{$k_set};
	my $l_hash = l_hash($type);
	my %layer_hash = %{ $l_hash };
  my @newkeyset;
	foreach my $keyy (@keyset) {
		@newkeyset = grep /\Q$layer_string\E/i, values %layer_hash;
	}
	foreach my $r_key (@newkeyset)
		{ print "$r_key\n"; }
	my $return_keyset = \@newkeyset;
	return $return_keyset;
}

sub l_hash { # ARGV1 type
	my $type = @_;
	if ($type eq 'name') {
			my %l_hash = %name;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	elsif ($type eq 'path'){
			my %l_hash = %path;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	elsif ($type eq 'size') {
			my %l_hash = %size;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	elsif ($type eq 'encode') {
			my %l_hash = %encode;
			my $l_hash = \%l_hash;
			return $l_hash;
	}
	else
		{ print "ARG1 tye\n"; goto LAYER; }
}


who: ningu
where: localhost:perlbot:#perl
what: refactored version
paste:
#!/usr/local/bin/perl
use strict;
use warnings;

# MKRX - cli to regex browswer
my ($data_dir) = @ARGV;

my %map;
my @commands = qw(name path size encode)

# POPULATE HASHES

foreach my $cmd (@commands) {
    read_file(uc substr($cmd, 0, 3), $cmd);
}

my @keyset = keys %{$map{(keys %map)[0]}};
my @newkeyset = @keyset;

# USER INPUT

while (1) {
    print "MKRX SYSTEMS RDY!\n: ";
    my $input = <STDIN>;
    chomp($input);
    print "\nwork'n on $input\n";

    # OPTIONS
    my ($cmd, $string) = split(' ', $input, 2);

    # ACTION
    if ($map{$cmd}) {
        layer_s($cmd, $string);
    }
    else {
        print "unknown command $cmd\n";
    }
}

sub read_file {
    my ($filename, $cmd) = @_;

    my $path = "$data_dir/$filename";
    open(my $fh, '<', $path) or die "Couldn't open $filename\n";

    my @lines = readline $fh;
    chomp @lines;

    my %m;
    foreach my $i (@lines) {
        my @kv = split(" ", $i, 2);
        $m{$kv[0]} = $kv[1];
    }

    $map{$cmd} = \%m;
}

# ARGS: cmd string
sub layer_s {
    my ($cmd, $string) = @_;

    my $m = $map{$cmd};

    @newkeyset = grep { $m->{$_} =~ /\Q$layer_string\E/i } @newkeyset;

    foreach my $r_key (@newkeyset) { 
        print "$r_key\n"; 
    }
}


who: ningu
where: localhost:perlbot:#perl
what: fixed last version
paste:
#!/usr/bin/env perl
use strict;
use warnings;

# MKRX - cli to regex browswer

my %map;
my @commands = qw(name path size encode);

die "no dir provided" unless @ARGV;
my ($data_dir) = @ARGV;
die "no directory $data_dir" unless -d $data_dir;

# POPULATE HASHES

foreach my $cmd (@commands) {
    read_file(uc substr($cmd, 0, 3), $cmd);
}

my @keyset = keys %{$map{(keys %map)[0]}};
my @newkeyset = @keyset;

# USER INPUT

while (1) {
    print "MKRX SYSTEMS RDY!\n: ";
    my $input = <STDIN>;
    chomp($input);
    print "\nwork'n on $input\n";

    # OPTIONS
    my ($cmd, $string) = split(' ', $input, 2);

    # ACTION
    if ($map{$cmd}) {
        layer_s($cmd, $string);
    }
    else {
        print "unknown command $cmd\n";
    }
}

sub read_file {
    my ($filename, $cmd) = @_;

    my $path = "$data_dir/$filename";
    open(my $fh, '<', $path) or die "Couldn't open $filename\n";

    my @lines = readline $fh;
    chomp @lines;

    my %m;
    foreach my $i (@lines) {
        my @kv = split(" ", $i, 2);
        $m{$kv[0]} = $kv[1];
    }

    $map{$cmd} = \%m;
}

# ARGS: cmd string
sub layer_s {
    my ($cmd, $string) = @_;

    my $m = $map{$cmd};

    @newkeyset = grep { $m->{$_} =~ /\Q$string\E/i } @newkeyset;

    foreach my $r_key (@newkeyset) {
        print "$r_key\n";
    }
}


who: ningu
where: localhost:perlbot:#perl
what: added close $fh
paste:
#!/usr/bin/env perl
use strict;
use warnings;

# MKRX - cli to regex browswer

my %map;
my @commands = qw(name path size encode);

die "no dir provided" unless @ARGV;
my ($data_dir) = @ARGV;
die "no directory $data_dir" unless -d $data_dir;

# POPULATE HASHES

foreach my $cmd (@commands) {
    read_file(uc substr($cmd, 0, 3), $cmd);
}

my @keyset = keys %{$map{(keys %map)[0]}};
my @newkeyset = @keyset;

# USER INPUT

while (1) {
    print "MKRX SYSTEMS RDY!\n: ";
    my $input = <STDIN>;
    chomp($input);
    print "\nwork'n on $input\n";

    # OPTIONS
    my ($cmd, $string) = split(' ', $input, 2);

    # ACTION
    if ($map{$cmd}) {
        layer_s($cmd, $string);
    }
    else {
        print "unknown command $cmd\n";
    }
}

sub read_file {
    my ($filename, $cmd) = @_;

    my $path = "$data_dir/$filename";
    open(my $fh, '<', $path) or die "Couldn't open $filename\n";
    my @lines = readline $fh;
    chomp @lines;
    close $fh;

    my %m;
    foreach my $i (@lines) {
        my @kv = split(" ", $i, 2);
        $m{$kv[0]} = $kv[1];
    }

    $map{$cmd} = \%m;
}

# ARGS: cmd string
sub layer_s {
    my ($cmd, $string) = @_;

    my $m = $map{$cmd};

    @newkeyset = grep { $m->{$_} =~ /\Q$string\E/i } @newkeyset;

    foreach my $r_key (@newkeyset) {
        print "$r_key\n";
    }
}


who: bhelit
where: localhost:perlbot:#perl
what: does this code do what comments want it too?
paste:
# regex browser of metadata masterlists
# hash key = file's sha; hash value = searchable data;
# sha binds the values four hashes to homogenous keys;
 
# EX:MKRX SYS RDY: name matrix; $name[$key_iteration] = the?matrix; returns @newkeyset;
# MKRX SYS RDY: encode zip; greps $ecode[$key_iteration] = zip; returns @newkeyset;
# print list || wipe @newkeyset;
# --------feat. ningu of irc.freenode.org (sorry if ive mutilated ur code)
use strict; use warnings;
my %map;
my @commands = qw(name path size encode);
die "no source directory" unless @ARGV;
my ($data_dir) = @ARGV;
die "no dir $data_dir" unless -d $data_dir;
my $key_path = "$data_dir/latest";
open(my $keyfile, '>>', $key_path) or die "couldn't open latest";
# POPULATE HASHES
foreach my $cmd (@commands)
    { read_file(uc substr($cmd, 0, 3), $cmd); }
my @masterkeyset = keys %{$map{(keys %map)[0]}}; # derp dont know what this does
my @newkeyset;
# USER INPUT
while (1) {
    print "usage: type string || reset; print;\n"
    print "MKRX SYSTEMS RDY: ";
    my $input = <STDIN>; chomp $input;
    print "\nwork'n on $input\n";

    my ($cmd, $string) = split(' ', $input, 2);
    if (($cmd eq 'reset') && (defined @newkeyset) # correct way to check if undef;
        { undef(@newkeyset); next; }
    if (($cmd eq 'print') && (defined @newkeyset)) {
        foreach $key_item (@newkeyset)
            { print $keyfile "$key_item\n"; next; }
    }
    if ($map{$cmd})
        { layer_s($cmd, $string); } # does this retain @newkeyset or do i need to return a ref?
    else
        { print "unknown command $cmd\n"; }
}
################################################
sub read_file {
    my ($filename, $cmd) = @_;
    my $path = "$data_dir/$filename";
    open(my $fh, '<', $path) or die "Couldn't open $filename\n";
    my @lines = readline $fh; chomp @lines; close $fh;
    my %sub_hash;
    foreach my $i (@lines) {
        my @key_value = split(" ", $i, 2);
        $sub_hash{$key_value[0]} = $key_value[1];
    }
    $map{$cmd} = \%sub_hash;
}
sub layer_s {
    my ($cmd, $string) = @_;
    my $m = $map{$cmd};
    @newkeyset = grep { $m->{$_} =~ /$string/i } @newkeyset;
    foreach my $r_key (@newkeyset)
        { print "$r_key\n"; }
#    my $newkeyset = \@newkeyset;
#    return $newkeyset;
}


