Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Pattern matching

by Stud_Perl
on Jun 30, 2005 at 23:18 UTC ( #471508=perlquestion: print w/replies, xml ) Need Help??

Stud_Perl has asked for the wisdom of the Perl Monks concerning the following question:

I need help anybody please... Write a program that prints only words (not the entire line) in the file part3.txt (attached) on a word boundary that have the letter "p" or "P" in them. the part3.txt is " CPAN stands for comprehensive Perl Archive Network. ^ and $ are used as anchors in a regular expression. /pattern/ is a pattern match operator. Perl is very easy to learn. Enter 'H' or 'h' for help." please helpp thanks

Replies are listed 'Best First'.
Re: Pattern matching
by Joost (Canon) on Jun 30, 2005 at 23:24 UTC
Re: Pattern matching
by Adrade (Pilgrim) on Jun 30, 2005 at 23:49 UTC
    As a hint - your professor is testing your grasp of patterns... this is a really important part of Perl that you'll eventually get to know much better as you get a chance to play around with it. You should read and go through perlre - it will tell you exactly how to approach this problem. As GrandFather said, once you take a stab at it, everyone here will be more than ready to help you with tweeks, confusions, and modifications.

    Good luck!
      -Adam

    P.S. As another hint: look in the man page for what represents a word boundry, and what it means for characters to be placed within square brackets.

    --
    Impossible! The Remonster can only be killed by stabbing him in the heart with the ancient bone saber of Zumakalis!

Re: Pattern matching
by thundergnat (Deacon) on Jul 01, 2005 at 01:45 UTC

    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.

Re: Pattern matching
by GrandFather (Sage) on Jun 30, 2005 at 23:31 UTC

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


    Perl is Huffman encoded by design.
Re: Pattern matching
by holli (Monsignor) on Jul 04, 2005 at 09:56 UTC
    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


    holli, /regexed monk/
      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;
        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; }
        $\="$\$_"; 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
        Alter the regex here to your liking.


        holli, /regexed monk/
Re: Pattern matching
by CountZero (Bishop) on Jul 01, 2005 at 06:00 UTC
    You are really NOT getting it, are you? This is the third time you are posting homework questions without even the slightest hint of having made any try of solving it yourself.

    CountZero

    "If you have four groups working on a compiler, you'll get a 4-pass compiler." - Conway's Law

Re: Pattern matching
by holli (Monsignor) on Jul 01, 2005 at 06:52 UTC
    You may also want to have a look into the "Selected Nodes for Newbies" section on my homenode, esp. Everyone Hates Me.


    holli, /regexed monk/
Re: Pattern matching
by ysth (Canon) on Jul 01, 2005 at 01:38 UTC
    What on earth is a "word...on a word boundary" ?
Re: Pattern matching
by ambrus (Abbot) on Aug 12, 2005 at 11:01 UTC
    #!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]}

    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)}

      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__

      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__
Re: Pattern matching
by holli (Monsignor) on Jun 30, 2005 at 23:55 UTC
    You're really a stud, man. /me whinnies and whuffs.

    Update: I'm as sorry as possible, but he who asks for homework despite beeing warned, deserves no better.

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



    holli, /regexed monk/

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://471508]
Approved by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (7)
As of 2019-05-26 13:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you enjoy 3D movies?



    Results (153 votes). Check out past polls.

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