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.