Need help to write a Perl script

Shell Programming and Scripting
1

Hello friends,

   I am having a awk script which does my goal , but I want to learn perl , after learning the basics in perl now  I am trying to convert my nawk script to perl .

Please help me to do some task in perl that I ve already did in nawk.

Like I am facing some problem in perl with $_, I think it is similar to $0 in nawk.

part of my perl code as follows

open(IN, $file)|| die("Could not open file");
while(<IN>) {
 if($_ !~ /^"/){
    if($_ =~ /^\*/){
    }
    else{
       @fld = split(/,/, $_);
       if( $fld[3] == 1 ){
              print $_;
              $binary1 = HexToBinary(substr($fld[0],0,2));
              print $_;
        }
     }
  }
}
sub HexToBinary{
        my(%h)=( '0'=>'0000'
                ,'1'=>'0001'
                ,'2'=>'0010'
                ,'3'=>'0011'
                ,'4'=>'0100'
                ,'5'=>'0101'
                ,'6'=>'0110'
                ,'7'=>'0111'
                ,'8'=>'1000'
                ,'9'=>'1001'
                ,'A'=>'1010'
                ,'B'=>'1011'
                ,'C'=>'1100'
                ,'D'=>'1101'
                ,'E'=>'1110'
                ,'F'=>'1111'
        );
        $_=uc $_[0];
        s/([0-9A-F])/$h{$1}/g;
        return $_;
};

Although both the print statement seems to be same but gives me a different result. If i am not wrong incase of nawk we can print the current line anywhere with just typing

print $0

Regards,
user_prady

2

Got the problem ...

 $_=uc $_[0];
        s/([0-9A-F])/$h{$1}/g;
        return $_;

Changed to

  $val = uc $_[0];
  $val =~ s/([0-9A-F])/$h{$1}/gi;
  return $val;

Regards,
user_prady

3

$_ is used when no lvalue defined. $_ =~ /expr/ is equil to /expr/

Let's Perl!

4

An example of why you should use "strict" and declare your variables properly.

5

The logic is a bit hard to follow. Could you post a sample input and sample output for that?

I would start by refactoring your script based on the following observations;

  • the "if" has only an "else" clause. It would seem more natural to invert the test and have only a "then" clause.

  • Perl can easily convert hex to binary, and generally between different number bases, so that part of the script is easy to simplify. But you are not using the value of $binary anywhere?

open(IN, $file)|| die("Could not open file: $!");
while(<IN>) {
 unless (/^["*]/) {
   @fld = split(/,/, $_);
   if( $fld[3] == 1 ){
          print $_;
          $binary1 = HexToBinary(substr($fld[0],0,2));
          print $_;
	  # do you mean
	  # $first = $binary1 . substr($fld[0],2);
          # shift @fld
          # print join ("," $first, @fld)
          # ?
    }
  }
}
sub HexToBinary{
    my $hex = $h;
    return sprintf "%b", hex($h);
}
6

Thank you all for your kind reply.

Era sorry for not sending my whole goal and code.

Here it goes...Its a FPGA test pattern .But I think I cant send all my constarints at once.

Input

"RxData","Time","NSysClkEn"
000000,0000,1,0,0,0,0,0,0
000000,0000,0,0,0,0,0,0,0
*Comment Control Frame at 10 us
000000,030C,0,0,0,0,1,0,1
241000,0000,0,1,3,0,0,0,0
000100,0000,0,0,2,0,0,0,0
*Comment Control Frame at 65 us
000000,13CE,0,0,0,0,1,0,1
000200,0000,0,1,2,0,0,0,0

*Main Start
*Comment Frame 2 at 1.04167 us
000000,2451,0,0,0,0,1,0,1
A8F9FF,0000,0,1,3,0,0,0,0
9F999F,0000,0,0,3,0,0,0,0
FFF9FF,0000,0,0,3,0,0,0,0
F9FF9F,0000,0,0,3,0,0,0,0
999DF3,0000,0,0,3,0,0,0,0
73BDF5,0000,0,0,3,0,0,0,0
D5FDF5,0000,0,0,3,0,0,0,0
5FD9B5,0000,0,0,3,0,0,0,0
1BB3BB,0000,0,0,3,0,0,0,0
7DF97D,0000,0,0,3,0,0,0,0
3BDDDB,0000,0,0,3,0,0,0,0
*Main End

Constraints:

1.dont process lines starting with lines " (double quotes)and  * (astris)
2.Prints the lines starting with * as it is. 
3.if the fourth field is "1" then take the fist two digits of the first field and then convert it to binary.
   checks the binary no with a look up table.
4.prints the second field in decimal when field 9th and 7th are "1".

For the time being I am explananing that much when I ll archive that goal in Perl I ll explain further friends.

Regards,
user_prady

7

Just to help you get a feel for some Perl idioms, here's how I'd tackle those two.

while (<>) {
  next if m/^"/;
  if (m/^\*/) {  # that's "as-te-risk" btw (^:
    print;
    next;
  }

  # ... more processing here
}

A few "next if" up near the top of the loop let you do away with simple special cases, and then concentrate on the real meat in the main loop, without putting you inside too many conditional braces -- they tend to make the code harder to grasp, even if the conditions are simple.

Making the main loop work over standard input is often a good idea; even if you always process the same file name in the production system, modularity is a good help whenever you need to test, modify, debug, or otherwise maintain the code -- you can run a few simple test files through it when you like, without modifying the code. (And if you are at all ambitious, you should store it with a few such test files and a test script which verifies that they are processed by the spec. This is a lifesaver when you need to make a strategic modification a few years from now and wonder whether you're breaking anything. See the Test::Simple documentation for more on this.)

8

Is this school work? That reads just like a book excersize or school assignment .

9

Give the guy some slack, he already explained and I certainly believe him.

10

As far as I can tell, you do not set the standards here. If I want to ask for clarification, I will. Thank you.

11

Sorry for if I made any mistake. But as I told I just started learning perl few days back . I agree you are a genious in Perl but I am just a begineer here.

Regarding school work or home work , please dont discourage somebody to learn something , You may be genious in Perl or something else but just think who just started learning perl 30 days back ..

If you still think Its a school work or home work Please go through the attachments . now that is my final goal in perl (convert to perl from nawk) not the above what I mentioned..

Thank you for your support..