perl extract urls from file

As a developer, we need to extract URLs from an input file quite often in our day to day work.
Let us discuss how to extract URLs from an input Text or HTML file using a perl snippet.
Let us automate extracting URLs

What does the script do?
The following script will take input file as command line argument.
It will read the file line by line, extract the HTTP urls and push the results into an array.
Finally prints the array object.

How to call the script?
perl get_urls_from_input_file.pl "C:\Files_To_Read\blog_html.txt"


get_urls_from_input_file.pl

use strict;
use warnings;
use warnings;
use Data::Dumper;

my %substitute = ( '%20' => '', '%3A' => '' , '%24' => '');
my @result_urls;

#perl get_urls_from_input_file.pl 'C:\Files_To_Read\blog_html.txt'

my $infile  = $ARGV[0];

open(my $fh, '<', $infile) or die "Could not open logfile: $!";
while ( my $each_line = <$fh> ) {
    chomp $each_line;

 if ($each_line =~ /['"](http:\/\/.*?)['"]/) {
  my $grep_url = $1;
  push(@result_urls, $1);
 }
}
close $fh;

print "\n" . Dumper(\@result_urls);

1;

How to pass command line arguments to perl script

We can pass command line arguments with the labels and we can make use of Getopt::Long module for achieving this

If an user tries to pass a wrong/invalid parameter, the following will throw an error.

The following script takes the parameters like
    -str (String value)
    -how_many_times (integer)
   
The following will print the string (from -str parameter) as many times the user the entered -how_many_times parameter

pass_command_line_params.pl

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Getopt::Long;
use File::Basename;

#Extract the nae of this script. 
my $scriptname = basename($0);

my @usage =("$scriptname",
           "-str  = Enter a String",
           "-how_many_times = Enter an integer, how many times you want the String to print");

my $opt_help     = 0;
my $opt_str     = ""; 
my $opt_how_many_times  = ""; 

my $ret = &GetOptions('help',  \$opt_help,
                      'str=s',\$opt_str,
                      'how_many_times=i',\$opt_how_many_times);


# Check parameters
if (($ret != 1) || (! $opt_str) || (! $opt_how_many_times)){
    &usage();
    exit;   
}

sub usage {
    print "\n How to use this Script : ". Dumper(\@usage) . "\n";

    print "\n You didn't pass str parameter " if (!$opt_str);
    print "\n You didn't pass how_many_times parameter " if (!$opt_how_many_times);
    print "\n";

    exit;
}


for (my $i=0; $i<$opt_how_many_times; $i++) {
    print $opt_str. "\n";
}
1;  

Outout :
1) perl pass_command_line_params.pl -str=Peter -how_many_times=

    Value "dd" invalid for option how_many_times (number expected)

    How to use this Script : $VAR1 = [
              'pass_command_line_params.pl',
              '-str  = Enter a String',
              '-how_many_times = Enter an integer, how many times you want the String to print'
            ];


    You didn't pass how_many_times parameter  

2) perl pass_command_line_params.pl -str="Mother Teresa" -how_many_times=5

    Mother Teresa
    Mother Teresa
    Mother Teresa
    Mother Teresa
    Mother Teresa  

Please refer to other topics in Perl like :
Loop through Directory and read the files in Perl
How to create excel report in Perl

Please refer to other topics on Unix like :
Unix Delete Duplicated Lines in a File
Unix Unique Lines in a File
Unix Grep Examples
Unix Cut Command Examples
Search a Directory in Unix
Unix For Loop
pushd & popd in Unix
Find Size of Directory
Word Count

Please refer to other topics on AWK like :
Awk Examples
Print First Two Columns of File
Print Last Two Columns of File

Please refer to other topics on Dict like :
Dict in Python
Dict keys and values in Python

Please refer to other topics on List like :
List in Python
Append to list in Python
Delete the last name from the list in Python
Remove an element from List in Python
Check an element exists in an list in Python
Python Filter Vs Map Vs List Comprehension

Please refer to other topics on File Concepts like :
Print File Content in Python
Print File in Reverse Order in Python

Please refer to Regular Expressions Concepts :
Brief on Regular Expressions
Greedy Operators in Regular Expressions in Perl
Modifiers in Regular Expressions in Perl
Capturing concept in Regular Expressions in Perl
Capture Pre Match ,Post Match, Exact match in Regular Expressions in Perl
Non Capturing Paranthesis in Regular Expressions in Perl
Substitute nth occurance in Regular Expressions in Perl
All Topics in Regular Expressions in Perl

You might also wish to read other topics on Python like :
Python Class and Object Example
Inheritance in Python
Packages in Python
Exceptions in Python
How to remove duplicate lines from a file in Perl
How to remove duplicate lines from a file in Pyhton

Loop through Directory and read the files in Perl

Now, we discuss about how to loop through a directory and read all the files in Perl
I have a directory with name "humanists" which has different files as mentioned below :

humanists :
abraham_lincon.txt
alfred_nobel.txt
mahatma_gandhi.txt
mother_teresa.txt
winston_churchill.txt

All the files has details in the following format
Name: <>
Born: <>
Died: <>

Now we have to loop thorugh all the files in the directory and get the information from these files and create a hash object.

Lets dive into this example. Please drop me a comment if you have any doubts on the same.


read_humanists.pl

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my $dir_path = "/home/prabhath/prabhath_test/test/humanists";

my %humanists_list;

opendir(IN_DIR, $dir_path) or die $!; 
open (LOG_FILE, "> read_humanists.log") or die $!; 

unless ( -d $dir_path) {
   print "\n Path not present: " . $dir_path;
} else {
   print "\n Path is present: " . $dir_path;
}


while (my $file = readdir(IN_DIR)) {
    next if $file =~ /^\./;
    
    unless (-f "$dir_path/$file") {
        print "\n -W- Not a File, Ignoring : " . "$dir_path/$file" . "\n";
        next;
    }   

    open(IN_FILE, "< $dir_path/$file")
                    ||  die "\n Cant open file for reading: " . "$dir_path/$file";

    my @lines = ;
    close(IN_FILE);

    my @newlines;
    foreach my $each_line (@lines) {
        if ($each_line =~ /^Name:/) {
           my ($name) = $each_line =~ /Name:\s(.*)$/;
           $humanists_list{$file}{"name"} = $name;
        }

        if ($each_line =~ /^Born:/) {
           my ($dob) = $each_line =~ /Born:\s(.*)$/;
           $humanists_list{$file}{"date_of_birth"} = $dob;
        }

        if ($each_line =~ /^Died:/) {
           my ($dod) = $each_line =~ /Died:\s(.*)$/;
           $humanists_list{$file}{"died"} = $dod;
        }
    }   
} 

Output:

          'abraham_lincon.txt' => {
                                    'died' => 'April 15, 1865',
                                    'date_of_birth' => 'February 12, 1809',
                                    'name' => 'Abraham Lincon'
                                  },
          'winston_churchill.txt' => {
                                       'died' => 'January 24, 1965',
                                       'date_of_birth' => 'November 30, 1874',
                                       'name' => 'Winston Churchill'
                                     },
          'alfred_nobel.txt' => {
                                  'died' => 'December 10, 1896',
                                  'date_of_birth' => 'October 21, 1833',
                                  'name' => 'Alfred Nobel'
                                },
          'mother_teresa.txt' => {
                                   'died' => 'September 5, 1997',
                                   'date_of_birth' => 'August 26, 1910',
                                   'name' => 'Mother Teresa'
                                 },
          'mahatma_gandhi.txt' => {
                                    'died' => 'January 30, 1948',
                                    'date_of_birth' => 'October 2, 1869',
                                    'name' => 'Mahatma Gandhi'
                                  }
  

Please refer to other topics on Unix like :
Unix Delete Duplicated Lines in a File
Unix Unique Lines in a File
Unix Grep Examples
Unix Cut Command Examples
Search a Directory in Unix
Unix For Loop
pushd & popd in Unix
Find Size of Directory
Word Count

Please refer to other topics on AWK like :
Awk Examples
Print First Two Columns of File
Print Last Two Columns of File

Please refer to other topics on Dict like :
Dict in Python
Dict keys and values in Python

Please refer to other topics on List like :
List in Python
Append to list in Python
Delete the last name from the list in Python
Remove an element from List in Python
Check an element exists in an list in Python
Python Filter Vs Map Vs List Comprehension

Please refer to other topics on File Concepts like :
Print File Content in Python
Print File in Reverse Order in Python

Please refer to Regular Expressions Concepts :
Brief on Regular Expressions
Greedy Operators in Regular Expressions in Perl
Modifiers in Regular Expressions in Perl
Capturing concept in Regular Expressions in Perl
Capture Pre Match ,Post Match, Exact match in Regular Expressions in Perl
Non Capturing Paranthesis in Regular Expressions in Perl
Substitute nth occurance in Regular Expressions in Perl
All Topics in Regular Expressions in Perl

You might also wish to read other topics like :
Python Class and Object Example
Inheritance in Python
Packages in Python
Exceptions in Python
How to remove duplicate lines from a file in Perl
How to remove duplicate lines from a file in Pyhton

How to create excel report in Perl

We can generate Microsoft Excel (XLS) report using Perl

Note:
Please install module Spreadsheet::WriteExcel before running the program

We can create worksheets
We can set styles like color/font/size etc for the cells

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Spreadsheet::WriteExcel;


my ($xls_label, $workbook, $worksheet, $format_header, $format_row);

$xls_label = "test.xls";

$workbook = Spreadsheet::WriteExcel->new($xls_label);

$worksheet = $workbook->add_worksheet();

$format_header = $workbook->add_format(); # Add a format
$format_header->set_bold();
$format_header->set_color('purple');
$format_header->set_align('center');
$format_header->set_size(12);

$format_row = $workbook->add_format(); # Add a format
$format_header->set_bold();
$format_row->set_align('center');

my $row = 0;
my $column = 0;

$worksheet->write($row, 0, 'S.No', $format_header);
$worksheet->write($row, 1, 'Humanists', $format_header);

my @humanists_arr = ("Mother Teresa", "Mahatma Gandhi", "Abraham Lincoln", "Winston Churchil", "Alfred Nobel");

foreach my $each_humanist (@humanists_arr) {
   $row++;
   $worksheet->write($row, 0, $row, $format_row);
   $worksheet->write($row, 1, $each_humanist, $format_row);
}

1;

Output :

S.No Humanists
1 Mother Teresa
2 Mahatma Gandhi
3 Abraham Lincoln
4 Winston Churchil
5 Alfred Nobel  

Please refer to other topics on Unix like :
Unix Delete Duplicated Lines in a File
Unix Unique Lines in a File
Unix Grep Examples
Unix Cut Command Examples
Search a Directory in Unix
Unix For Loop
pushd & popd in Unix
Find Size of Directory
Word Count

Please refer to other topics on AWK like :
Awk Examples
Print First Two Columns of File
Print Last Two Columns of File

Please refer to other topics on Dict like :
Dict in Python
Dict keys and values in Python

Please refer to other topics on List like :
List in Python
Append to list in Python
Delete the last name from the list in Python
Remove an element from List in Python
Check an element exists in an list in Python
Python Filter Vs Map Vs List Comprehension

Please refer to other topics on File Concepts like :
Print File Content in Python
Print File in Reverse Order in Python

Please refer to Regular Expressions Concepts :
Brief on Regular Expressions
Greedy Operators in Regular Expressions in Perl
Modifiers in Regular Expressions in Perl
Capturing concept in Regular Expressions in Perl
Capture Pre Match ,Post Match, Exact match in Regular Expressions in Perl
Non Capturing Paranthesis in Regular Expressions in Perl
Substitute nth occurance in Regular Expressions in Perl
All Topics in Regular Expressions in Perl

You might also wish to read other topics like :
Python Class and Object Example
Inheritance in Python
Packages in Python
Exceptions in Python
How to remove duplicate lines from a file in Perl
How to remove duplicate lines from a file in Pyhton

Replace string in all files in a directory in perl

We will discuss briefly about the script (To replace string in all files in a directory in perl)

Please define your directory path in the following :
my $input_dir  = "/usr/src/perl_test/input/";
my $output_dir = "/usr/src/perl_test/output/";
my $log_dir    = "/usr/src/perl_test/log/";

Define the string to replace and string to replace with as mentioned below
my $str_to_replace = "Mother Teresa":
my $str_replace_with = "MOTHER TERESA";

If you want to replace a particular string in all the files in the same directory path, then give the same path for both $input_dir & $output_dir.
E.g.,
my $input_dir  = "/usr/src/perl_test/same_path/";
my $output_dir = "/usr/src/perl_test/same_path/";

Log Directory :
It creates the log file(log_<timestamp>.log) in the path mentioned in $log_dir

Important Note : 
Please take a backup before running the script for safer side in case if you are replacing the strings in the same folder


conversion_script.pl

#!/usr/intel/bin/perl

use strict;
use warnings;
use Data::Dumper;

my $input_dir  = "/usr/src/perl_test/input/";
my $output_dir = "/usr/src/perl_test/output/";
my $log_dir    = "/usr/src/perl_test/log/";

my $str_to_replace = "Mother Teresa":
my $str_replace_with = "MOTHER TERESA";

my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 $sec  = sprintf("%02d",$sec);
 $min  = sprintf("%02d",$min);
 $hour = sprintf("%02d",$hour);
 $mday = sprintf("%02d", $mday);
 $mon  = sprintf("%02d", $mon+1);
 $year = sprintf("%04d", $year+1900);

my $output_tag = $mday .'_'. $mon .'_'. $year .'_'. $hour .'_'. $min;

opendir(IN_DIR, $input_dir)   or die $!;
opendir(OUT_DIR, $output_dir) or die $!;
opendir(LOG_DIR, $log_dir)    or die $!;

open (LOG_FILE, "> $log_dirlog_$output_tag.log");

print LOG_FILE "------------- START ------------ \n";

#print LOG_FILE "Started Copying Files from Source: $srcdir   to Destination: $dest \n";
#my $cmd = "cp -R $srcdir/* $dest/";
#`$cmd`; #or die "Chk the command : " . $cmd;
#print LOG_FILE "Finished Copying Files from Source: $srcdir   to Destination: $dest \n";

my (%files_changed, %files_not_changed, @invalid_list_files);

while (my $file = readdir(IN_DIR)) {

    # Ignore if it is not file 
    unless (-f "$input_dir$file") {
       print LOG_FILE "-W- Not a File, Ignoring : " . $file . "\n";
       next;
    }

    print LOG_FILE "\n\nFile Name : " . $file . "\n";

    open(IN_FILE, "<$input_dir$file") || warn "Cant open file for reading: " . "$input_dir$file";
    my @lines = ;
    close(IN_FILE);

    my @newlines;
    foreach my $each_line (@lines) {
        #chomp $each_line;
        if($each_line =~ /$str_to_replace/) {
            print LOG_FILE "Converting String From : " . $each_line;
            $each_line =~ s/$str_to_replace/$str_replace_with/ig;
            print LOG_FILE "Converting String To   : " . $each_line;
            push(@newlines, $each_line);
            $files_changed{$file} = 1;
        } else {
            push(@newlines, $each_line);
            $files_not_changed{$file} = 1;
        }   
    }

    open(OUT_FILE, ">$output_dir$file") || warn "-W- Cant open file for writing: " . "$output_dir$file";
    print OUT_FILE @newlines;
    close(OUT_FILE);
}

my @f_changed     = keys %files_changed;
my @f_not_changed = keys %files_not_changed;

print LOG_FILE "\n\nOutput Summary as below ------------------------- : ";

print LOG_FILE "\n List of all the Files changed     : " . Dumper(\@f_changed);
print LOG_FILE "\n List of all the Files NOT changed : " . Dumper(\@f_not_changed);

print LOG_FILE "\n\n Total No.of files changed   : " . scalar(@f_changed);
print LOG_FILE "\n Total No.of files NOT changed : " . scalar(@f_not_changed);

close (LOG_FILE);
closedir(IN_DIR);
closedir(OUT_DIR);
closedir(LOG_DIR);

1;  

Input Directory: /usr/src/perl_test/input/

1) mother_teresa_intro.txt
Mother Teresa born on August 26, 1910
Full name of Mother Teresa is "Agnes Gonxha Bojaxhiu"
Mother Teresa founded the Missionaries of Charity, which in 2012 consisted of over 4,500 sisters and is active in 133 countries.

2) mother_teresa_awards.txt
In 1962, Mother Teresa was awarded the Ramon Magsaysay Award
In 1979, Mother Teresa was awarded the Nobel Peace Prize, for work undertaken in the struggle to overcome poverty and distress
In 1980, Mother Teresa was awarded the Bharat Ratna Prize  

Output Directory: /usr/src/perl_test/output/

1) mother_teresa_intro.txt
MOTHER TERESA born on August 26, 1910
Full name of MOTHER TERESA is "Agnes Gonxha Bojaxhiu"
MOTHER TERESA founded the Missionaries of Charity, which in 2012 consisted of over 4,500 sisters and is active in 133 countries.


2) mother_teresa_awards.txt
In 1962, MOTHER TERESA was awarded the Ramon Magsaysay Award
In 1979, MOTHER TERESA was awarded the Nobel Peace Prize, for work undertaken in the struggle to overcome poverty and distress
In 1980, MOTHER TERESA was awarded the Bharat Ratna Prize  

Log Directory: /usr/src/perl_test/log/
log_<time_stamp>.log

How to remove duplicate lines from a file in perl

Today, we discuss about the following :
1) How to open the directory & read all the files
2) In each file, remove duplicate lines from a file and keep it in same path/file or different path/file
4) How to create time-stamp in Perl
3) How to create a log file and log the changes

Mention the corresponding path where you want to copy

e.g., If you want to remove duplicated line and copy in the same file
my $input_dir  = "/nfs/fm/disks/my_files";
my $output_dir = "/nfs/fm/disks/my_files";
my $log_dir    = "/nfs/fm/disks/my_files";

e.g., If you want to copy the output of the files in different locations
my $input_dir  = "/nfs/fm/disks/input_dir";
my $output_dir = "/nfs/fm/disks/output_dir";
my $log_dir    = "/nfs/fm/disks/log_fir";

remove_duplicates.pl

#!/usr/bin/perl

use strict;
use warnings;

my $input_dir  = "/nfs/fm/disks/my_files";
my $output_dir = "/nfs/fm/disks/my_files"; 
my $log_dir    = "/nfs/fm/disks/my_files";

my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$sec  = sprintf("%02d",$sec);
$min  = sprintf("%02d",$min);
$hour = sprintf("%02d",$hour);
$mday = sprintf("%02d", $mday);
$mon  = sprintf("%02d", $mon+1);
$year = sprintf("%04d", $year+1900);

my $output_tag = $mday .'_'. $mon .'_'. $year .'_'. $hour .'_'. $min;

opendir(IN_DIR, $input_dir) or die $!; 
opendir(OUT_DIR, $output_dir) or die $!; 
opendir(LOG_DIR, $log_dir) or die $!; 

open (LOG_FILE, "> $log_dir/remove_duplicate_lines.log");

print LOG_FILE "------------- START ------------ \n";

my (@invalid_list_files, %file_without_dup );

while (my $file = readdir(IN_DIR)) {

    next if $file =~ /^\./;

    print LOG_FILE "\n Folder Path : " , "$input_dir/$file";    

    unless (-f "$input_dir/$file") {
        print LOG_FILE "\n Not a File : " . $file;
        next;
    }
        
    print LOG_FILE "\n File Name : " . $file  . "\n";

    #Reading the File 
    open(IN_FILE, "<$file") ||  die "\n Cant open file for reading: " . $file;
    my @lines = 
    close(IN_FILE);

    my @newlines;
    foreach my $each_line (@lines) {
        if (not defined $file_without_dup{$each_line}) {
            push(@newlines, $each_line);
        }
        $file_without_dup{$each_line} = 1;
    }

    #Writing into Output Files
    open(OUT_FILE, ">$output_dir/$file") || die "-W- Cant open file for writing: " . "$output_dir/$file";
    print OUT_FILE @newlines;
    close(OUT_FILE);
    
}
close (LOG_FILE);
closedir(IN_DIR);
closedir(OUT_DIR);
closedir(LOG_DIR);

1;

You may also wish to read Object Oriented Concepts in Python as mentioned :
Python Class and Object Example
Inheritance in Python
Packages in Python
Exceptions in Python

IP Address Validation in Perl

IP Address Validation in Perl:
###############################
print "Enter an ip address: ";
$ans = <stdin>;
chomp($ans);

if ($ans =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
{
    if ( ($1>0) && ($1<=255) && ($2<=255) && ($3<=255) &&
($4<=255))
    {
    print "An IP Address";
    }
    else
    {
    print "Not an IP Address";
    }
}
else
{
    print "Not an IP Address";
}

Delete logs older than 7 days

#! /usr/bin/perl

use strict;
use warnings;
#use CGI;
#use CGI::Carp qw(fatalsToBrowser);   
use Data::Dumper;

foreach my $file (</test/logs/log_*.txt>) {   
    if ( -M $file > 7 ) {
        print "\n Deleting the log file more than 7 days old: " . $file;
        unlink $file; #or die "\nFailed to remove $file: $!";
    }
}

print "\n\n";


1;


Note:

• The above program is based on the time stamp of the files. 
• The program detects files staring with 'log_' format and deletes these files whose time stamp of the file is greater than 7 days (since the current time stamp).
• '-M' is used to check the timestamp
• 'ulink' is used to remove file 
• Please change the corresponding shebang line  (#! /usr/bin/perl) if you are using windows environment to test this perl script

• In the above example, in the specified path (/test/logs/) I have some files like... Let us assume we have files like this 

log_1.txt (7 days old)
log_2.txt (8 days old)
log_3.txt (9 days old)
log_4.txt (10 days old)
log_5.txt (3 days old)
log_6.txt (4 days old)
error_log.txt (10 days old)
server_log.txt (10 days old)

Program Output: The program will delete files
log_1.txt, log_2.txt, log_3.txt, log_4.txt

Since the files 'error_log.txt' and 'server_log.txt' won't start with 'log_' the program don't delete them irrespective of the timestamp.

Another way to delete old files in perl

Note: 

1) Please remove comment (#)

2) 'unlink' is the command used to remove file in Unix

#!perl
foreach my $file (</path/to/logs/*.log>) {
  next unless -M $file > 7;
  print "Deleting the File $file...\n";
  # unlink $file or die "Failed to remove file $file: $!";
}

-->

Get unique elements from string

#!F:\Perl\bin\perl -w
use strict;
use Data::Dumper;
my $abc = "prabhath vamsi vamsi eswar sandhya vinayaka ";

my @arr = split /\s+/, $abc;
my %uniq = map { $_, 1} @arr;
my @final = keys %uniq;
print Dumper(\@final)

Get unique keys from different hashes

- As we konw, keys in a hash are unique, but not the values.

#!F:\Perl\bin\perl -w
use Data::Dumper;
use strict;

#Get unique keys from different hashes
my %hash1 = (a=>10,b=>20,c=>30);
my %hash2 = (a1=>10,b1=>20,c1=>30);
my %hash3 = (a=>10,b=>20,c=>30);
my %uniq_hash;
for my $each (keys(%hash1), keys(%hash2), keys(%hash3)) {
$uniq_hash{$each}++;
}
print "\n", $_ for (keys %uniq_hash),"\n";

Get unique elemenets from Arrays

#!F:\Perl\bin\perl -w
use Data::Dumper;
use strict;

#unique elements from different arrays
my @array1 = (10,20,30);
my @array2 = (11,22,33);
my @array3 = (10,20,30);
my %uniq_arr;

for my $each (@array2, @array3, @array1) {
$uniq_arr{$each}++;
}
print "\n", $_ for (keys %uniq_arr),"\n";

substitute for n'th occurance

#!F:\Perl\bin\perl -w
use strict;

# Substitue 3rd occurance of 'perl' with 'PERL'
my $text = 'perl is good, perl is better, perl is best';
print "\n INPUT Text:", $text;

my $nth_occurance = 3;
my $count=0;

$text =~ s{(perl)}{
++$count == $nth_occurance ? 'PERL' : $1
}ige;

print "\n OUTPUT Text:", $text,"\n";

Sort an Array

1) For number Array

#!F:\Perl\bin\perl -w
use Data::Dumper;

my @array = (20,10,50,40,30); #Unsorted Number Array
print "\n Unsorted Array is: @array";
my @sorted = sort { $a <=> $b } @array;

# '<=>' for numbers only# 'cmp' used for numbers as well as strings
print "\n sorted Array is: @sorted";
my @sorted = sort { $a cmp $b } @array;

print "\n sorted Array is: @sorted";


2) For String Array

#!F:\Perl\bin\perl -w
use Data::Dumper;#Unsorted String Array
my @array = qw/sandhya eswar prabhath vamsi/;
print "\n Unsorted Array is: @array";

my @sorted = sort { $a cmp $b } @array;

# 'cmp' can be used for both strings as well as numbers
print "\n sorted Array is: @sorted";

Slurp

- Slurp means reading or writing a file at one shot, instead of
reading or writing line by line.
- Generally slurp if very fast than normal reading a file line by line
- But slurp uses more memory, as it needs to keep th whole file
in a scalar (or) an array, but now a days as everybody is
having enormous amount of hard disk space and RAM, its not
a problem with Slurp.
- But those people where memeory and space concerns are there,
don't go for Slurp
- Some Cpan modules on Slurp are:
1) Slurp # Allows you to read multiple files at a time
2) File::Slurp # Good module for Slurp
3) Perl6::Slurp # Recent module on Slurp with lot more features


The Program will read a folder and read all the files and slurp them into an array and writes to output file
-------------------------------
#!F:\Perl\bin\perl -w

use Slurp;
use File::Slurp;
use Data::Dumper;
use strict;

my $dir='F:\Documents and Settings\Administrator\Desktop\sample_programs';
opendir DIR, $dir or die "cannot open dir $dir: $!";
my @file= readdir DIR;
closedir DIR;

my @final_files;
print "\n All file names before:", Dumper(\@file);

for (@file) {
next if($_ =~/^\.+|\.swp$|\~$/ig);
push (@final_files, $_);
}

my @zx = slurp(@final_files);
write_file('output.txt', @zx);

my @out = File::Slurp::read_file('output.txt');
print "\n output:" , Dumper(\@out);

Get a Random element from an Array

#!F:\Perl\bin\perl -w
use Data::Dumper;

my @array = (10,20,30,40,50);
#'rand' gives some random index number
$index = rand @array;
print "\n Random index from an array is:", $index;
$element = $array[$index];
print "\n Random element from an array is:", $element,"\n";

Different ways to remove duplicates from array

#!F:\Perl\bin\perl -w
use strict;
use Data::Dumper;

#Remove duplicates from array.
my @array = qw/10 20 20 20 30 40 40 40 50 50 50/;
print "\n Duplicate array: @array";

1) Good

my %hash;
$hash{$_} = 0 for (@array);
# $hash{$_} = () for (@array); #You can do this also

my @final = keys (%hash);
print "\n Unique Array: @final";
print "\n";


2) Best of all

my %hash = map { $_ , 1 } @array;
my @uniq = keys %hash;
print "\n Uniq Array:", Dumper(\@uniq);


3) Costly process as it involves 'greping'

my %saw;
my @out = grep(!$saw{$_}++, @array);
print "\n Uniq Array: @out \n";