And please don't put your whole post in a <code> block. Writeup Formatting Tips should help.

Ah. I think I see your problem. Excessive use of white space. In fact, total lack of code whatsoever.

In case you didn't realize it from the replies to your previous questions, Perlmonks is not a homework service. While we are more than happy to help with any questions you may have, in general, we take a dim view of you asking us to do your homework for you, especially when you don't seem to have made any attempt to solve it on your own first.

Show us the code you have written so far and ask for help with the area that you are having difficulty with.

open OUTPUT, join "", map chr,
,,,,,,,,,112+($\=\1)-$\,,,,,,,
,97+($/=\1)-$/,,,,,,,,114+($\=
\1)-$\,,,,,,116+($/=\1)-$/,,,,
,51+($\=\1)-$\,,,,,46+($/=\1)-
$/,,,116+($\=\1)-$\,,,120+($/=
\1)-$/,,,,,,,,,,,,116+($\="");
while(<OUTPUT>){{$\="$\$_";$_=
$\;$\ = substr((push @w,$\),0,
0)if$\=~/\s$/msg;}}print grep{
  eval'/^\b.*(p).*$/msgi'}@w
[download]

Instead of wasting time lecturing the guy about not being a homework site, holli's code should have the first responce. The OP won't understand it (heck even I don't) and the teacher will know the guy cheated. He'll either fail the assignment or figure out what the code does. Whichever one happens, he'll learn the lesson he needs to be taught.

The OP won't understand it (heck even I don't)

Want a spoiler?
+($\=\1)-$\ evaluates to zero, so we can take those out.
+($/=\1)-$/ evaluates to zero too, just we need one of them to set the input separator $/ to 1 (bytewise reading).
We can also take out the subsequent commas from the join (since they do nothing), so the first line becomes:
open OUTPUT, join "", map chr,112,114,116,51,46,116,120,116;
$\="";
$/=\1;
[download]
The numbers are the ordinals of the single chars of the filename "part3.txt".

Now for the while loop. If we write it clearer it looks like
while(<OUTPUT>)
{
    $\="$\$_";
    $_=$\;
    $\ = substr((push @w,$\),0,0) if $\=~ /\s$/msg;
}
[download]
$\="$\$_"; simply concatenates the read char with $\.
$_=$\; has no effect.
$\ = substr((push @w,$\),0,0) if $\=~ /\s$/msg; pushes $\ to an array if the last char of $\ is a whitespace or newline, thus a "word".
In the same statement $\ is cleared because the return value of substr(something, 0,0) is empty.

The last part is a simple grep of the array we built. We can safely leave out the eval so it becomes:
print grep{ /^\b.*(p).*$/msgi } @w
[download]
Alter the regex here to your liking.


holli, /regexed monk/

#!perl
use warnings; use strict; use integer;
for(my@a=(
0,42,0,0,0,0,0,0,-198,0,0,0,1,-1,-10,-14,64,-64,6,6,6,7,5,5,5,6,32,32,
+5,17,32,
2,0,188,5,5,5,8,9,9,9,5,49,49,49,8,7,7,7,0,8,12,58,58,7,11,58,2,0,189,
+1,190,
10,10,10,15,5,5,5,7,5,7,7,7,7,5,7,5,10,12,5,5,88,88,5,10,88,2,0,197,96
+,96,7,
11,96,2,0,191,5,5,106,106,5,7,106,2,0,192,115,115,115,9,7,7,7,0,4,4,4,
+7,3,12,
3,3,9,12,6,6,6,8,5,5,5,9,140,140,5,6,140,2,0,194,149,149,149,8,7,7,7,0
+,6,6,6,
7,5,5,5,17,164,164,5,6,164,2,0,195,4,4,4,14,3,12,3,3,1,193,4,4,4,7,3,1
+2,3,3,8,
12,1,196,-28,42,62,56,66,134,34,-10,46,24,
unpack"U*",`cat part3.txt`.v0);
$a[1];){$a[2]=-(($a[$a[$a[1]++]]-=$a[$a[$a[1]++]])<0);$a[3]&&print chr
+$a[4]}
[download]

Update: This would have been better written as

#!perl
use warnings; use strict; use integer;
for(my@a=(
0,42,0,0,0,0,0,0,-198,0,0,0,1,-1,-10,-14,64,-64,6,6,6,7,5,5,5,6,32,32,
+5,17,32,
2,0,188,5,5,5,8,9,9,9,5,49,49,49,8,7,7,7,0,8,12,58,58,7,11,58,2,0,189,
+1,190,
10,10,10,15,5,5,5,7,5,7,7,7,7,5,7,5,10,12,5,5,88,88,5,10,88,2,0,197,96
+,96,7,
11,96,2,0,191,5,5,106,106,5,7,106,2,0,192,115,115,115,9,7,7,7,0,4,4,4,
+7,3,12,
3,3,9,12,6,6,6,8,5,5,5,9,140,140,5,6,140,2,0,194,149,149,149,8,7,7,7,0
+,6,6,6,
7,5,5,5,17,164,164,5,6,164,2,0,195,4,4,4,14,3,12,3,3,1,193,4,4,4,7,3,1
+2,3,3,8,
12,1,196,-28,42,62,56,66,134,34,-10,46,24,
unpack"U*",`cat part3.txt`.v0);
$a[1];$a[3]&&print chr$a[4]){$a[2]=-(($a[$a[$a[1]++]]-=$a[$a[$a[1]++]]
+)<0)}
[download]

Here's the code I used to generate this obfu.

First, I've written the algorithm in perl:

#!perl

use warnings;
use strict;

my @a = unpack "U*", `cat part3.txt` . pack "x";

my($b, $k, $c, $s);


use integer;

$k = 0;
goto F;

J:
#print "[J]";
64 < $c and goto W;
$b = $k;
F:
#print "[F";
$c = $a[$k];
#print chr($c) . "]";
$k += 1;
0 < $c and goto J;
#print "[0]\n";
exit;
W:
#print "[W]";
$s = 14;
S:
$c *= 4;
$s -= 1;
0 < $s and goto S;
0 < $c and goto F;
$c < 0 and goto F;
P:
#print "[P]";
$c = $a[$b];
print chr($c);
$b += 1;
$b < $k and goto P;
T:
#print "[T]";
$c = $a[$k];
64 < $c and goto C;
print chr(10);
goto F;
C:
#print "[C]";
print chr($c);
$k += 1;
goto T;

__END__
[download]

Then I transcoded that to an assembly language for the virtual machine the obfu interprets. This code, when ran with ruby, will assemble the obfu and write it to the file named "pie".

#!/home/ambrus/local/devel/bin/ruby -w

src = %{

? 
ip: F
lt: ? !_
print: ?
buf: ?

t: ?
u: ?
_c: ?
_k: -Input
_b: ?
s: ?

$0: 0
$1: 1
$_1: -1
$_10: -10
$_14: -14
$64: 64
$_64: -64

J:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_karJ  pr
+int $1  print print  buf buf  buf $_rbrace  print $1  print print  
u u  u _c  t t  t u  1> 1>  t $_64  1> lt  1: ? W1$W W1:
t t  t _k  _b _b  _b t
F:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_karF  pr
+int $1  print print  
1> 1>  1> _k  _c _c  _c 1: ?
!buf buf  buf _c  print $1  print print  buf buf  buf $_rbrace  print 
+$1  print print  
_k $1
1> 1>  _c $0  1> lt  1: ? J1$J J1:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_kar0  pr
+int $1  print print  buf buf  buf $_rbrace  print $1  print print  bu
+f buf  buf $_10  print $1  print print  
ip Ex1$0 Ex1:
W:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_karW  pr
+int $1  print print  buf buf  buf $_rbrace  print $1  print print  
s s  s $_14
S:
t t  t _c  t _c  _c _c  _c t  _c t
s $1
t t  1> 1>  t s  1> lt  1: ? S1$S S1:
1> 1>  _c $0  1> lt  1: ? F1$F F1:
t t  1> 1>  t _c  1> lt  1: ? F2$F F2:
P:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_karP  pr
+int $1  print print  buf buf  buf $_rbrace  print $1  print print  
1> 1>  1> _b  _c _c  _c 1: ?
buf buf  buf _c  print $1  print print
_b $1
u u  u _k  t t  t _b  1> 1>  t u  1> lt  1: ? P1$P P1:
T:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_karT  pr
+int $1  print print  buf buf  buf $_rbrace  print $1  print print  
1> 1>  1> _k  _c _c  _c 1: ?
u u  u _c  t t  t $_64  1> 1>  t u  1> lt  1: ? C1$C C1:
buf buf  buf $_10  print $1  print print
ip F3$F F3:
C:
!buf buf  buf $_lbrace  print $1  print print  buf buf  buf $_karC  pr
+int $1  print print  buf buf  buf $_rbrace  print $1  print print  
buf buf  buf _c  print $1  print print
_k $1
ip T1$T T1:

W1$W: W1-W
J1$J: J1-J
Ex1$0: Ex1-0
F1$F: F1-F
F2$F: F2-F
F3$F: F3-F
P1$P: P1-P
C1$C: C1-C
T1$T: T1-T
S1$S: S1-S

!$_lbrace: -'['  $_rbrace: -']'
!$_karJ: -'J'  $_karF: -'F'  $_karW: -'W'  
!$_karP: -'P'  $_karT: -'T'  $_karC: -'C'  $_kar0: -'0'

Input:

};


def val e, sgn, adr = @code.size;
    case e;
        when /^(-?\d+)$/;
            $1.to_i;
        when /^'(.)'$/;
            $1[0];
        when /^\?$/;
            0;
        when /^([\w@%$.]+)<$/;
            @labels[$1] or 
                fail "back reference not found: #{$1}";
        when /^([\w@%$.]+)>$/;
            (@forward[$1] ||= []).push [adr, sgn];
            0;
        when /^([\w@%$.]+)$/;
            @labels[$1] or (
                (@forward[$1] ||= []).push [adr, sgn];
                0;
            );
        else
            fail %Q'expr error: "#{e}"';
    end;
end;

@code = [];
@labels = Hash[];
@forward = Hash[];
@literal = Hash[];
src.gsub!(/[#!].*/) {""};

src.scan(/(\S+)/) {
    tok = $1;
    if tok =~ /^([\w@%$.]+):$/;
        @labels[$1] = @code.size;
        (f = @forward[$1]) and 
            f.each {|fr| 
                (a, sgn) = fr;
                @code[a] = sgn * @code.size; 
            };
        @forward.delete($1);
    else
        r = 0;
        tok.scan(/\G(?:(?:(-)|\+|)([^+\-]+)|(.))/) {
            $3 and 
                fail "toke error 2";
            sgn = (if $1; -1 else 1 end);
            r += sgn * val($2, sgn);
        };
        @code.push r;
    end;
};
@forward.empty? or
    fail "forward reference not found: #{@forward.keys[0]}";


fh = File.open("pie", "w");
fh.print(%{#!perl
use warnings; use strict; use integer;
for(my@a=(
});
@code.each {|n| 
    Integer === n or
        fail "internal error: invalid code";
    fh.print n, ","
};
fh.print(%{
unpack"U*",`cat part3.txt`.v0);
$a[1];$a[3]&&print chr$a[4]){$a[2]=-(($a[$a[$a[1]++]]-=$a[$a[$a[1]++]]
+)<0)}
});
fh.close;

warn "" + @code.size.to_s + " words";

__END__
[download]

Considered (davido) Reap: Inflamatory and insulting, lacking redeeming value.
Unconsidered: (holli): Enough Keep Votes (Keep/Edit/Delete : 10/1/15)