Perl 101

Information here is useful for all Unix systems ; some examples are geared toward Solaris, AIX, and Linux systems.

This examples are meant to get the job done - and have maintainable and deciperable code at the same time.



Back to main page



email ... js99@rocket99.com

Copyright 1998-2001 © Citisoft, Inc. All Rights Reserved.























Binary File Viewer

#!/usr/bin/perl
#--------------------------------------------
#  Display file in PCTOOLS ASCII mode
#--------------------------------------------

$file1 = $ARGV[0];

$size1 = -s $file1 ;

open(FILE1,"<$file1") or die "Input file: Cannot open file\n\n";

$i = 0 ;
$j = 0 ;

while ($i < $size1 ) 
  {
  $ch = getc(FILE1);

  $part1 = $part1 . ' ' . $ch  ;
  $part2 = $part2 . ' ' . ord($ch)  ;

  $i ++ ;
  $j ++ ;

  if ($j==20)
      {
      $part1 =~ s/\n/\*/g ;
      $part1 =~ s/\r/\*/g ;
      $part1 =~ s/\t/\*/g ;
      print $part1 . '    ' . $part2 . "\n" ;
      $part1 = '' ;
      $part2 = '' ;
      $j = 0 ;
      }

  } 

if ($j>0)
      {
      $part1 =~ s/\n/\*/g ;
      $part1 =~ s/\r/\*/g ;
      $part1 =~ s/\t/\*/g ;
      print $part1 . '    ' . $part2 . "\n" ;
      }

close(FILE1);



Binary File Compare

#!/usr/bin/perl
#----------------------------------------
#  Compare two binary files
#  See comments below for modifications
#----------------------------------------

$file1 = $ARGV[0];
$file2 = $ARGV[1];

$size1 = -s $file1 ;

open(FILE1,"<$file1") or die "Input file: Cannot open file1\n\n";
open(FILE2,"<$file2") or die "Input file: Cannot open file2\n\n";

$i = 0 ;
$j = 0 ;

while ($i < $size1 ) 
  {
  $i ++ ;

  $ch1 = getc(FILE1);

  $ch2 = getc(FILE2);

  print $ch1 . $ch2 . "\n" ;

  if (!($ch1 eq $ch2))
     {
     print "Difference detected at character: " . $i . "\n"  ;
  
     $j ++ ;
     }

  # diff limiter:  edit this line to modify
  # the number of differences before exiting program
  if ($j > 15)
      { 
      exit ; 
      } 

  } 


close(FILE1);
close(FILE2);


Binary File Cutter

#!/usr/bin/perl
#------------------------------------------
#  Read characters from file1, and
#  write to file2, where character# is between
#  $start and $end
#------------------------------------------

$file1 = $ARGV[0];
$file2 = $ARGV[1];

$size1 = -s $file1 ;


# modify below settings, for different ranges to extract
$start1 = 100 ;
$end1   = 200 ;


open(FILE1,"<$file1") or die "Input file: Cannot open file1\n\n";
open(FILE2,">>$file2") or die "Input file: Cannot open file2\n\n";

binmode FILE1 ;
binmode FILE2 ;


$i = 0 ;

while ($i < $size1 ) 
  {
  $i ++ ;

  $ch = getc(FILE1);

  if (($i >= $start1) && ($i <= $end1))
     {
     print FILE2 $ch ;
     }

  } 



close(FILE1);
close(FILE2);


Text to Rec Utility

This sample is very handy for handing data extract files containing embedded CR and LF character within text data. Originally created to process Sybase BCP files.
#!/usr/bin/perl
#===================================
# text2rec : Remove embedded tabs/CR within BCP-out files
#           ( 99% successful )
#
# Arguments:  infile outfile
#
#===================================

$cmtfile=$ARGV[0];
$outfile=$ARGV[1];

open(FILE1,"<$cmtfile") or die "Input file: Cannot open $cmtfile\n\n";
open(FILE2,">$outfile") or die "Output file: Cannot write $outfile\n\n";

# number if lines, for current record 
$count2  = 0 ;


while ()
  {
  $line1 = $_;


  chomp $line1 ;

  $field1=" ";
  $field2=" ";

  # replace tabs with pipes, good for debugging
  $line1 =~ s/\t/\|/g ;

  # replace bizarre characters
  $line1 =~ s/°/ /g ;
  $line1 =~ s/í/ /g ;

  # attempt to grab first two fields of line
  if ($line1 =~ /\|/)
   {
   @line1 = split(/\|/,$line1);

   $field1 = shift @line1 ;
   $field2 = shift @line1 ;

   }

# --> Check for record start.
# check if the fields are for real, i.e. numeric / all caps
# ... two examples are below, will need to modify for
# different file layouts

# 2 numeric fields
#  if ( ($field1 =~ /[0-9]/) && ($field2 =~ /[0-9]/)  )

# code field,  numeric field
if ( ($field1 =~ /[A-Z][A-Z]/) && ($field2 =~ /[0-9]/)  )
     {
     if ($line2=~/[a-z]/)
        {
        $line2 =~ s/\|/\t/g ;
        print FILE2 $line2,"\n";
        }
     $line2 = $line1 ;
     $count2 = 0 ;
     }
  else
     {
     # ---> Not a record start, but a record chunk.
     # check for embedded tabs, within the text field; an attempt
     # to remove them here.
     if (!($line1 =~ /\|[0-9]/))
        {
        $line1 =~ s/\|/  /g ;
        }
     $line2 = $line2 . " " . $line1 ;
     $count2 ++ ;

     # print warning, for excessively long
     # text fields.  
     # If you see this message for all lines in the file,
     # then the if..then above is never succeeding, and needs
     # to be adjusted

     if ($count2 > 300)
        { print "Limit exceeded: $count2 \n"; }
     }


  }

# last line

$line2 =~ s/\|/\t/g ;
print FILE2 $line2,"\n";

close(FILE2);
close(FILE1);

CSV Processor

#!/usr/bin/perl
# --------------------------------------
# Process data file, and convert to 
# CSV quote delimited format
# --------------------------------------

use Text::ParseWords ;


while () {
   $line1 = $_ ;

   chomp $line1 ;

   $line1 =~ s/\\/0/;
   $line1 =~ s/X/Z/;

   #print $line1 , "\n" ;

   @flist = parse_it ($line1) ;
   
   for ($i=0;$i<@flist;$i++)
       {
       if ( $i > 0 )
           {
           $line2 = $line2 . "|";
           }
       else
           {
           $line2 = "";
           }

       $line2 = $line2 . $flist[$i];        
       }

   print $line2 , "\n" ;
}

sub parse_it {

  return quotewords(",", 0, @_ );
  
}

Char Replacement

#!/usr/bin/perl
#==============================
#  Replace _db with given parm
#==============================

$dbname="_db" . $ARGV[0] ;

while ()
  {
  $line1 = $_ ;

  for ($line1) { 

       s/(_db)(\s|\n|\.)/$1X$2/g ;
       s/_db[0-9][0-9]/_dbX/g;
       s/_db[0-9]/_dbX/g;
       s/_dbX/$dbname/g;

  }


  print $line1 ;

  }

Char Translate

#!/usr/bin/perl                    
                                   
$foo = "Hryyb jbeyq!\n";           
$foo =~ tr/[a-m][n-z]/[n-z][a-m]/; 
print $foo;                        
print "\n\n";
print "The answer is: $foo \n\n";









Arrays and Lists


#!/usr/bin/perl

$fname=$ARGV[0] ;
$tname=$ARGV[1] ;

open(FILE1, "<$fname") or die "Error opening input: $fname\n\n" ;

while()
  {
  $line1 = $_ ;

  chomp $line1 ;

  if ($print_ind eq 1)
     {  
     print $line1 . "\n" ; 

     $lines = $lines . $line1 . '=' ;
     }


  if ($line1 =~ /^$tname/)
   {
   $print_ind = 1 ;
   }
  if (length($line1)==0)
   {
   $print_ind = 0 ;
   }

  }

@lines = split(/=/,$lines);

foreach $line (@lines)
  {
  #print $line . "\n" ;

  ($part1,$part2) = split('\|\|',$line) ;

  print $part1 . ' === ' . $part2 . "\n" ;

  }


close (FILE1);








Back to main page




email ... js99@rocket99.com

Copyright 1998-2000 © Citisoft, Inc. All Rights Reserved.