Wednesday, April 13, 2011

PERL5LIB

-- Set the environment variable PERL5LIB
Perl will look for modules in the directories specified in PERL5LIB environment variable before looking in the standard library and current directory, so you can set this variable to locate your modules.

A More Complex Flat File Sort

sub specificSort
    {
            join( "", substr( $a,  18,  8 ),     # job number
                      substr( $a,  26,  8 ),     # quote number
                      substr( $a,  83,  4 ),     # option number
                      substr( $a, 135, 10 ),     # part application
                      substr( $a,  91,  2 ),     # part type
                      substr( $a,  93, 22 ),     # part number
                      substr( $a, 155, 10 ),     # product line
                      substr( $a, 252, 10 ),     # market program
                      substr( $a, 266,  1 ))     # special offer
            cmp
            join( "", substr( $b,  18,  8 ),
                      substr( $b,  26,  8 ),
                      substr( $b,  83,  4 ),
                      substr( $b, 135, 10 ),
                      substr( $b,  91,  2 ),
                      substr( $b,  93, 22 ),
                      substr( $b, 155, 10 ),
                      substr( $b, 252, 10 ),
                      substr( $b, 266,  1 ))
    }

Sorting Tab-Delimited Data

A different approach is needed in order to sort a tab-delimited flat file. Our reference book reveals a useful function, split, which can change a line of text into an array of strings, dividing the line based on a key character or string. In our case, we want to split the line based on the tab character, identified in Perl by '\t'.
Using split, we can sort our file using a uniquely different sorting approach:
sub specificSort2
{
    @first = split( '\t', $a );
    @second = split( '\t', $b );

    $compare = ( $first[2] cmp $second[2] );           # job number
    if ( $compare != 0 ) { return ( $compare ); }

    $compare = ( $first[6] cmp $second[6] );           # period
    if ( $compare != 0 ) { return ( $compare ); }

    $compare = ( $first[3] cmp $second[3] );           # product
    if ( $compare != 0 ) { return ( $compare ); }

    $compare = ( $first[4] <=> $second[4] );           # system price
    if ( $compare != 0 ) { return ( $compare ); }

    $compare = ( $first[5] <=> $second[5] );           # net price
    return ( $compare );
}

datestamp in perl

$datestamp = sprintf "%04d-%02d-%02d", ((localtime )[5]+1900), (localtime )[4]+1, (localtime)[3];
print $datestamp;

spliting limit in perl with example

my $string = "Group: ALL:ALL:Good";
my @str    = split(/:/, $string, 2);

print $str[0],"\n";
print $str[1];

#Group
# ALL:ALL:Good


use strict;
use warnings;

my $x = "object1:object2:object3:rest of the line with a : character";
my @x = split (":", $x, 3);
foreach my $s (@x) {
        print "$s\n";
}

perl different type of perl input separator

$/ = undef        Slurp mode
$/ = ""             Paragraph mode
$/ = "\n"          Line by line mode
$/ = " "           Almost word-by-word mode

rotating the array in perl

#Rotating the alphabet the three letters
@letters = ('A' .. 'Z');
for ($i = 1; $i <= 3; $i++) {
unshift(@letters, pop(@letters));
}
print @letters, "\n";


#rotating the alphabet in the opposite direction
@letters = ('A' .. 'Z');
for ($i = 1; $i <= 3; $i++) {
push(@letters, shift(@letters));
}
print @letters, "\n";

sorted by length and alphabetical order

#Example of sorting strings first by length then by alphabetical order

@words = qw(This is a list of words using qw);

@sorted_words =

sort {
    $value = (length($a) <=> length($b));
    if($value == 0) {
       return lc($a) cmp lc($b);
    }
    else
    {
    return $value;
    }
} @words;

$"="\n";
print "@sorted_words";

counts the frequency of each word in perl

#This code counts the frequency of each word in the sentence by using a hash.

$sentence = "The cat that saw the black cat is a calico.";
$sentence =~ s/[.,?;:'"(){}\[\]]//g; #Remove punctuation

@words = split (/ /, $sentence);

foreach $word (@words) {
    ++$counts{lc($word)};
}

foreach $word (keys %counts) {
   print "$word, $counts{$word}\n";
}

Capturing the output of a shell command

Just being picky, this will print all of the output lines on a single
line separated by spaces. Since you probably want to see them on
separate lines, you could either not chomp

   my @files = qx(ls);
   print @files;

or append newlines on output

   chomp(my @files = qx(ls));
   print "$_\n" foreach @files;

$, @, % in Perl variable declaration

$foo is a scalar variable. It can hold a single value which can be a string, numeric, etc.

@foo is an array. Arrays can hold multiple values. You can access these values using an index. For example $foo[0] is the first element of the array and $foo[1] is the second element of the array, etc. (Arrays usually start with zero).

%foo is a hash, this is like an array because it can hold more than one value, but hashes are keyed arrays. For example, I have a password hash called %password. This is keyed by the user name and the values are the user's password. For example:
$password{Fred} = "swordfish"; $password{Betty} = "secret";
$user = "Fred"; print "The Password for user $user is $password{$user}\n"; #Prints out Swordfish $user = "Betty"; print "The Password for user $user is $password{$user}\n"; #Prints out secret

Match character position in perl

my $line = "foo 123 bar";
if ($line =~ m{(\d+)}g) {
   my $pos = pos($line) - length $1;
   print "$pos\n\n";   
}

my $line = "foo 123 bar";
if ($line =~ m{(\d+)}g) {
    my $pos = length $`;
    print "$pos\n";
}

How do I process an entire hash in perl

foreach my $key ( keys %hash ) {
my $value = $hash{$key}
}

foreach my $key ( sort keys %hash ) {
my $value = $hash{$key}
}

foreach my $key ( grep /^text:/, keys %hash ) {
my $value = $hash{$key}
}

while( my( $key, $value ) = each( %hash ) ) {
}

Get the size of a hash

Solution
    print "size of hash:  " . keys( %hash ) . ".\n";Solution
    my $i = 0;
    
    $i += scalar keys %$hash_ref;  # method 1: explicit scalar context
    $i += keys %$hash_ref;         # method 2: implicit scalar context

listbox example in perl tk

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new;
$mw->title("Listbox");

# For example purposes, we will use one word for each letter
my @choices = qw/alpha beta charlie delta echo foxtrot golf hotel
india juliet kilo lima motel nancy oscar papa quebec radio sierra
tango uniform victor whiskey xray yankee zulu/;

#Create the text box and insert the list of choices in to it
my $lb = $mw->Scrolled("Listbox",
       -scrollbars => "osoe",
       -height => 10,
       -width => 10,
       -selectmode => "multiple");

my $real_lb = $lb->Subwidget('scrolled');
$real_lb->configure(-
borderwidth=>0);
$lb->insert("end", sort @choices);
$lb->pack(-side => "left");


$mw->Button(-text => "Exit",
             -command => sub{exit; })->pack(-side => "bottom");

$mw->Button(-text=>"View",
             -command => sub {
         foreach ($lb->curselection()) {
                        print "$choices[$_]\n";
                }
      my $w = $real_lb->width;
      print "$w\n";
      my $sample = ' ' x 10;
      my $font_len = $lb->fontMeasure('default', $sample );        
      print "$font_len\n";   


     }
    )->pack(-side => "bottom");


$lb->selectionSet('end');
$lb->see('end');
MainLoop;




OR


open(CON, "<", "c:/MyContacts.txt") || open(CON, "<", "MyContacts.txt");
@contact = <CON>;
@contact = grep {chomp; s/\s+\d+//} @contact;
close CON;

$Search_Listbox = $mw->Scrolled("Listbox",
    -background => "white",
    -scrollbars => "osoe",
    -height => 10,
    -width => 15,
    -selectmode => "multiple",
    -background=>"#8BB381",
    -listvariable => \@contact);
$Search_Listbox->place(-x => 350, -y => 10);

Printing all the files that have both ".rtf" and ".ftp"

use warnings;
use strict;
use File::Find::Rule;
use Data::Dumper;

my @files = File::Find::Rule->file()
                            ->name( '*.rtf', '*.ftp' )
                            ->in( './' );
print Dumper(\@files);