Program to display complete information about a file: Perm, inode, acl bits.

#!/usr/bin/perl

use File::stat;
$pwd = (getpwuid($<))[1];
print "$pwd";
                   system "stty -echo";
                   print "Password: ";
                   chomp($word = );
                   print "\n";
                   system "stty echo";

                   if (crypt($word, $pwd) ne $pwd) {
                       print "Sorry...\n";
                   } else {
                       print "ok\n";
                   }
$ret = index("hello this is a test for index","index");
print $ret;
lc("HeLlO");
$str = "\LHeLlO";
print $str;
$len = length("Hello testing...");
print $len;
$filename = "data.txt";
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($filename);
@statinfo = stat($filename);
for $val (@statinfo)
	{
		print "$val\n";
	}
                   $sb = stat($filename);
                   printf "File is %s, size is %s, perm %04o, mtime %s\n",$filename, $sb->size, $sb->mode & 07777,scalar localtime $sb->mtime;
$str = "this is sample test";
$str =~ m/sample/g;
$post = pos $str;
print $post;
print quotemeta("this is sample . testing gg :");
split(/,/,'value1,value2');
print "@_";

Word wrap in perl

Word wrap plays an important role while displaying any output to the standard output or a file. This is used to display the output neatly and in a ordered way.

#!/usr/bin/perl -w
use strict;

 use Text::Wrap;
 undef $/;
 print wrap('', '', split(/\s*\n\s*/, ));
use Text::Wrap qw(&wrap $columns);
use Term::ReadKey qw(GetTerminalSize);
($columns) = GetTerminalSize();
print $columns;
($/, $\) = ('', "\n\n"); # read by paragraph, output 2 newlines
while () { # grab a full paragraph
s/\s*\n\s*/ /g; # convert intervening newlines to spaces
print wrap('', '', $_); # and format
}

Print the kind of number

Print whether a number is integer, decimal, positive, negative .. etc.,

 #!/usr/bin/perl
sub getnum {
use POSIX qw(strtod);
my $str = shift;
$str =~ s/^\s+//;
$str =~ s/\s+$//;
$! = 0;
my($num, $unparsed) = strtod($str);
if (($str eq '') || ($unparsed != 0) || $!) {
return;
} else {
return $num;
}
}
sub is_numeric { defined scalar &getnum }
$_ = "-0.65";
if (/\D/){
print "is a nondigit"; }
else {
print "is a digit or someother"; }
# warn "is a nondigit"  if /\D/;
warn "not a natural number" unless /^\d+$/;
warn "not a integer" unless /^[-+]?\d+$/;
warn "not an decimal number" unless /^-?\d+\.?\d*$/;
print is_numeric( defined scalar &getnum);
print getnum("A143");

Program to test with different basic functions in perl

Remove to comments to test different functions in perl.

#!/usr/bin/perl

# $substr = substr($string,$offset,$count)
# $substr = substr($string,$offset)
# substr($string,$offset,$count) = $newstring;  is used to replace the string with the new
# string
# substr($string,$offset) = $newstring;
# The number of A's in the unpack function is the number of variables towards left
# ($str1,$str2,$str3,$final) = unpack("A5 x3 A6 A8 A*",$data)
# split at five byte boundaries
# @fivers = unpack("A5" x (length($string)/5), $string);
# split individual characters
# @chars = unpack("A1" x length($string),$string);


# ---------------------------------------------------------------------------------

use Text::Tabs;


 sub cut2fmt {
	my(@positions) = @_;
	my $template = '';
	my $lastpos = 1;
	foreach $pos (@positions) {
		$template =  "A" . ($pos-$lastpos) . " ";
		$lastpos = $pos;
	}
	$template .= 'A*';
	return $template;
  }

$newstring = "is also a sample string";
$string = q{this is a sample string to be tested on different functions};
$string1 = q{this is a sample string to be tested on different functions};
$data = q{this is a sample string to test the unpack function};
$substr = substr($string,5,18);
$substr1 = substr($string,5);
print $substr . "\n";
print $substr1 . "\n";
substr($string1,5,18) = $newstring;
print $string1 . "\n";
$_ = $data;
$data = s/(\b)/ /;
print "$data";
($first,$last) = unpack("A4 A*", $data);
print $first . "\n";
print $last;


# -----------------------------------------------------------------------------------
# converting between ASCII characters and values
# this is to demonstrate and use function "ord" and "chr"
# Use ord to convert character to a number or use chr to convert number to character
# $char = sprintf("%c", $num); # slower than chr($num)
# printf("Number %d is character %c\n", $num, $num);

$num = 70;

$char = sprintf("%c", $num); # slower than chr($num)
print "$char" . "\n";
printf("Number %d is character %c\n", $num, $num);

# "unpack" and "pack" functions can also be used to convert many characters

$string = "test string\n";
@ASCII = unpack("C*", $string);
print "@ASCII";			#see the difference
print @ASCII;   		#see the difference
foreach $val (@ASCII) {
	print $val . " ";
	}
print "\n";
$STRING = pack("C*", @ASCII);
print "$STRING";



# -----------------------------------------------------------------------------------
# processing a string one character at a time
# and caluculating the checksum of a string

$string = "characters string";
%seen = ();
$sum = 0;

@array = split(//, $string);
print "@array\n";

@array1 = unpack("C*", $string);
foreach $num (@array1) {
	$sum += $num;
	printf("%c ", $num);
	}
print "\n";

while ($string =~ /(.)/g) {
	print "$1 ";
	$seen{$1}++;
	}
print "\nunique characters are ", sort(keys %seen), "\n";
print "the checksum of \"$string\" is $sum" . "\n";



# -----------------------------------------------------------------------------------
# reversing a string by word or character
# fucntions used are "reverse" , "join" and "split"

$string = "sample string to test these characters";
# $revstr = reverse($string);
 @words = split(" ", $string);
@revwor = join(" ", reverse @words);
print "@revwor";
# print "$revstr";


# -----------------------------------------------------------------------------------
# expanding and compressing tabs
# functions used are "expand" and "unexpand"
# use Text::Tabs module

$string = "sample    text   to test these characters\n";
while ($string =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) { print "in the loop";}
print "$string";

$tabstop = 8;
# while() {print expand($_)}
# while() {print expand($_)}


# -----------------------------------------------------------------------------------
# expanding variables in user input

use vars qw($rows $coloums);
no strict 'refs';
my $text;
# print "enter number of rows :";
# chomp($rows = );
# print "enter number of coloums :";
# chomp($coloums = );
$text = q(i'm $rows high and $coloums long);
# $text =~ s/\$(\w+)/${$1}/g;
# $text =~ s/(\$\w+)/$1/gee;
# print $text;


# -----------------------------------------------------------------------------------
# interpolating functions

# $rec = "raghu:sample:pp:praveen:mukki";
# $wiw = "what i want is @{[join(" ",(split /:/, $rec))]} items";
# print $wiw;


# -----------------------------------------------------------------------------------
# trimming blanks from end of the string
# regexp : s/^\s+// to delete blanks from start of the string
# regexp : s/\s+$// to delete blanks and spaces from end of the string
# funtions used are trim and trim :D

$string = "      sample         test string to test trim nature            ";
$string =~ s/^\s+//;
$string =~ s/\s+$//g;
print $string;
$| = 0;
print "$%";
print "$=";
print "sampel";

Slow print the text!!

Print the desired text slowly using perl.

#!/usr/bin/perl

$DELAY = ($ARGV[0] =~ /^-([.\d]+)/) ? (shift, $1) : 1;
$| = 1;
$_ = "Print this";
while ($_) {
    for (split(//)) {
            print;
                    select(undef,undef,undef, 0.005 * 20);
                      }
        $_ = "";
           }