Perl Tutorial - Practical Extraction and Reporting Language (Perl)
Please leave a remark at the bottom of each page with your useful suggestion.
Table of Contents
- Perl Introduction
- Perl Program Startup
- Perl Regular Expressions
- Perl Array Program
- Perl Basic Program
- Perl Subroutine / Function Program
- Perl XML Program
- Perl String Program
- Perl Statement Program
- Perl Network Program
- Perl Hash Program
- Perl File Handling Program
- Perl Data Type Program
- Perl Database Program
- Perl Class Program
- Perl CGI Program
- Perl GUI Program
- Perl Report Program
Perl File Handling Program
Access permissions for the mkdir function.
Value Permission
4000 Set user ID on execution
2000 Set group ID on execution
1000 Sticky bit (see the UNIX chmod manual page)
0400 Read permission for file owner
0200 Write permission for file owner
0100 Execute permission for file owner
0040 Read permission for owner's group
0020 Write permission for owner's group
0010 Execute permission for owner's group
0004 Read permission for world
0002 Write permission for world
0001 Execute permission for world
Apply chomp to all elements of an array
#!usr/bin/perl
use warnings;
use strict;
my @array = ( "One\n", "Two\n", "Three", "Four", "Five\n" );
my $newlines = chomp ( @array );
print "\nWe just removed $newlines newlines from that list!\n";
print "\nThe list is now @array.";
'-B filehandle': True if file is binary.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-T $name) {
print ", text file ";
} elsif (-B $name) {
print ", binary file ";
}
print "\n"; # End line.
}
binmode command sets up a file for access in binary mode with no mapping of carriage returns.
#!/usr/bin/perl -w
# Usage:
# copy1.pl infile outfile
$input = $ARGV[0];
$output = ">" . $ARGV[1];
open(INPUT, $input) or die "Can't open $input due to $!.";
open(OUTPUT, $output) or die "Can't open $output due to $!.";
# Use shorthand for reading file.
while ( <INPUT> ) {
print OUTPUT $_;
}
# Close the files when done.
close (INPUT);
close (OUTPUT);
Calculating Byte Offsets with telldir
#!/usr/local/bin/perl
chdir ("c:\\temp");
use Cwd;
$dir = cwd();
opendir (DH, $dir) || warn $!;
$sByteOffset = telldir DH;
$pbo = $sByteOffset;
while ($dirName = (readdir(DH))){
$dirNameLength = length($dirName);
$byteOffset = telldir DH;
$diff = $byteOffset - $pbo;
$totalSize = $pbo - $sByteOffset;
print "$dirName is $dirNameLength characters long at $pbo which is $diff bytes\n";
$pbo = $byteOffset;
}
print "Total directory bytes is: $totalSize\n";
Call stat function from file handle
use IO::File;
$filename = 'file.txt';
$filehandle = new IO::File;
$filehandle->open("<$filename") or die "Cannot open $filename";
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks) = $filehandle->stat;
print "$filename is $size bytes long.";
Call tell function from file handle
use IO::File;
use IO::Seekable;
$filehandle = new IO::File;
$filehandle->open("<file.txt") or die "Cannot open file.txt";
$filehandle->seek(12, 0);
print $filehandle->tell;
$filehandle->close;
CDROM operation
#!/usr/bin/perl
use warnings;
use strict;
open CDROM, '/dev/cdrom' or die "$!";
ioctl CDROM, 0x5309, 1; # the ioctl number for CDROMEJECT
close CDROM;
Change a directory
#!/usr/bin/perl -w
use strict;
print "please enter a directory name: ";
chomp(my $dir = <STDIN>);
mkdir $dir, 0777 or die "failed to make directory $dir: $!\n";
print "made the directory $dir ok!\n";
chdir $dir or die "failed to change into $dir: $!\n";
print "changed into $dir ok!\n";
Change a file's permissions?
#!/usr/local/bin/perl -w
use Getopt::Long;
my $ret = GetOptions ("f|filename:s", "p|permission:s");
my $filename = $opt_f || die "Usage: $0 -f filename -p Permission\n";
my $newPerm = $opt_p || die "Usage: $0 -f filename -p Permission\n";
# Does the file exist?
if (! -e $filename)
{
print "The file $filename does not exist.\n";
exit;
}
# Translate the string mode to an octal value
my $mode = oct($newPerm);
# Change the permissions of the file.
if ((chmod $mode, $filename) != 1)
{
print "Error: Could not change permissions on $filename : $!\n";
}
Change dir with chdir
#! /usr/local/bin/perl
use Cwd;
$dir = cwd;
print "dir=> $dir\n";
chdir ('D:\\mydir');
$dir = cwd;
Change file handle to binary mode
open (FILEHANDLE, ">data.txt")
or die ("Cannot open data.txt");
binmode FILEHANDLE;
print FILEHANDLE "Hello\nthere!";
close (FILEHANDLE);
Checks the permissions of a file
#!/usr/local/bin/perl -w
use Getopt::Long;
my $ret = GetOptions ("f|filename:s");
my $filename = $opt_f || die "Usage: $0 -f filename\n";
# Check if the file exists
if (! -e $filename)
{
print "The file $filename does not exist.\n";
exit;
}
# Perform a stat on the file.
my $perms = (stat ($filename))[2] & 07777;
printf "The octal permissions of the file $filename are %o\n", $perms;
Checks whether an unopened file actually exists.
#!/usr/local/bin/perl
unless (open(MYFILE, "file1")) {
if (-e "file1") {
die ("File file1 exists, but cannot be opened.\n");
} else {
die ("File file1 does not exist.\n");
}
}
$line = <MYFILE>;
while ($line ne "") {
chop ($line);
print ("\U$line\E\n");
$line = <MYFILE>;
}
Close a file handle
use IO::File;
$filehandle = new IO::File;
$filehandle->open(">hello.txt") or die "Cannot open hello.txt";
$filehandle->print("Hello!");
$filehandle->close;
Closing the Filehandle
#Format:
#close (FILEHANDLE);
#close FILEHANDLE;
open(INFILE, "datebook");
close(INFILE);
Contents of the current directory
#!/usr/bin/perl
use strict;
print "Contents of the current directory:\n";
foreach (<*>) {
next if $_ eq "." or $_ eq "..";
print $_, " " x (30 - length($_));
print "d" if -d $_;
print "r" if -r _;
print "w" if -w _;
print "x" if -x _;
print "o" if -o _;
print "\t";
print -s _ if -r _ and -f _;
print "\n";
}
Contents of the entire file are printed
#!/usr/bin/perl
open(FILE, "<data.txt") || die "Can't open data.txt: $!\n";
@lines = <FILE>;
print @lines;
print "\nThe file contains ", $#lines + 1," lines of text.\n";
close(FILE);
Copy file by reading one file and save to another file
open INFILEHANDLE, "<data.uue";
open OUTFILEHANDLE, ">data.dat";
binmode OUTFILEHANDLE; #Necessary in MS DOS!
while (defined($line = <INFILEHANDLE>)) {
print OUTFILEHANDLE unpack('u*', $line);
}
close INFILEHANDLE;
close OUTFILEHANDLE;
Copy files
#!/usr/bin/perl
use warnings;
use strict;
use File::Copy;
print "Filename: ";
my $infile = <>;
chomp $infile;
print "New name: ";
my $outfile = <>;
chomp $outfile;
unless (copy $infile, $outfile) {
print "Failed to copy '$infile' to '$outfile': $! \n";
}
Copying a file using the File::Copy
#!/usr/bin/perl -w
use File::Copy;
$input = "text.txt";
$output = "text1.txt";
copy($input, $output) or die "Can't copy $input to $output due to $!.";
Copying files
#!/usr/bin/perl -w
# Usage:
# copy1.pl infile outfile
$input = $ARGV[0];
$output = ">" . $ARGV[1];
open(INPUT, $input)
or die "Can't open $input due to $!.";
open(OUTPUT, $output)
or die "Can't open $output due to $!.";
# Use shorthand for reading file.
while ( <INPUT> ) {
print OUTPUT $_;
}
# Close the files when done.
close (INPUT);
close (OUTPUT);
Count the lines of a file
#!/usr/bin/perl
use strict;
use IO::File;
my $file = "yourFile.txt";
my $counter = 0;
my $fh = IO::File->new($file) or die "Can't open $file: $!\n";
while ( defined (my $line = $fh->getline) ) {
$counter++;
}
STDOUT->print("Counted $counter lines\n");
Create a directory tree
#!/usr/local/bin/perl -w
use File::Path;
my $count = mkpath(\@ARGV, 1, 0711);
print "The number of directories created is $count\n";
Create dir with mkdir and remove dir with rmdir
#! /usr/local/bin/perl
use Cwd;
$dir = cwd;
print "dir=> $dir\n";
mkdir ('D:\\newdir',000) || warn "mkdir failed $!";
mkdir ('newdir2',000) || warn "mkdir failed $!";
rmdir ('newdir');
print "\n\n";
Creating a file with the numbers 0-9: +>
#!/usr/bin/perl
use strict;
use warnings;
print "Creating a file with the numbers 0-9.\n";
open FILE, "+>file.txt" or die "Unable to open file: $!\n";
print FILE "0\n1\n2\n3\n4\n5\n6\n7\n8\n9\n";
close FILE or die "Unable to open file: $!\n";
Creating Directory
!#c:\perl\bin
print "Content-type: text/html\n\n";
print "Creating Directory ...";
mkdir("c:/newdir")|| die "Directory could not be created ...";
Creating Directory with mkdir
!#c:\perl\bin
print "Content-type: text/html\n\n";
print "Creating Directory ...";
mkdir("c:/newdir") || die "Directory could not be created ...";
Deal with \r character during file copy
$infile = $ARGV[0];
$outfile = $ARGV[1];
open (INFILEHANDLE, "<$infile") or die ("Cannot open file.");
open (OUTFILEHANDLE, ">$outfile") or die ("Cannot open file.");
binmode OUTFILEHANDLE;
while (defined($line = <INFILEHANDLE>)) {
$line =~ s/\r//g;
print OUTFILEHANDLE $line;
}
close INFILEHANDLE;
close OUTFILEHANDLE;
Deal with the \r\n character during file copy
$infile = $ARGV[0];
$outfile = $ARGV[1];
open (INFILEHANDLE, "<$infile") or die ("Cannot open file.");
open (OUTFILEHANDLE, ">$outfile") or die ("Cannot open file.");
binmode OUTFILEHANDLE;
while (defined($line = <INFILEHANDLE>)) {
$line =~ s/\n/\r\n/g;
print OUTFILEHANDLE $line;
}
close INFILEHANDLE;
close OUTFILEHANDLE;
defined lines in a file
!#c:\perl\bin
print "Content-type: text/html\n\n";
open(MYFILE, "c:\\testfile.dat")|| die print "Error encountered opening file ... $!";
while(defined($dataline=<MYFILE>))
{
print "$dataline <br>";
}
close(MYFILE);
Delete a file
#!/usr/local/bin/perl -w
use Getopt::Long;
my $ret = GetOptions ("f|filename:s");
my $filename = $opt_f || die "Usage: $0 -f filename\n";
if (-e $filename)
{
# Delete the file.
if (unlink ($filename))
{
print "The file $filename has been deleted.\n";
}
else
{
print "The file $filename was not deleted: $!\n";
}
}
else
{
print "The file $filename does not exist.\n";
}
Delete every file whose name ends in .bak:
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
find ( \&callback, "/") ;
sub callback {
unlink $_ if /\.bak$/;
}
Deleting Multiple Directories
#!/usr/local/bin/perl
mkdir ("c:\\",0)||warn "$!";
for ($i = 0; $i < 10; $i++){
mkdir ("c:\\\\rmdir$i",0)||warn "$!";
}
chdir ("c:\\Testlistings");
use Cwd;
$dir = cwd();
opendir (DH, $dir) || warn $!;
while ($dirName = (readdir(DH))){
if ($dirName =~ /^rm/){
print "Removing $dirName\n";
rmdir ("$dirName") || warn $!;
}
}
Detecting the current directory
#!/usr/bin/perl -w
use Cwd;
$dir = getcwd();
print "Current directory is:\n";
print "$dir\n";
Determine the contents of a directory tree?
#find function side effect variables
#VARIABLE NAME CONTENTS
#$dir The current directory name
#$_ The current file name within that directory
#!/usr/local/bin/perl -w
use Getopt::Long;
use File::Find;
my $ret = GetOptions ("d|directory:s");
my $directory = $opt_d || die "Usage: $0 -d directory\n";
sub wanted
{
print "Dir =<$dir>\n";
print "Name=<$name>\n";
print "File=<$_>\n";
}
find(\&wanted, $directory);
'-d filehandle': True if file is a directory.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-l $name) {
print "symbolic link";
} elsif (-d $name) {
print "directory";
} elsif (-p $name) {
print "FIFO pipe";
} elsif (-f $name) {
print "normal file";
} else {
print "unknown file type";
}
}
does file exist?
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "The file $file is:" );
print( " executable" ) if ( -x $file );
print( " readable" ) if ( -r $file );
print( " writable" ) if ( -w $file );
print( "\n" );
print( "It is ", -s $file, " bytes.\n" );
}
elsif ( -d $file ) { # is it a directory?
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
'-e filehandle': True if file exists.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-e $name) {
print " exist ";
}
print "\n"; # End line.
}
Extracting file names from paths
#use File::Basename;
#($basename, $directory_path, $suffix) = fileparse($fullname, @suffixlist);
#The $fullname value holds the full directory path.
#The @suffixlist array is a list of regular expressions used to match against the file name.
@suffixlist = '.pl';
#!/usr/bin/perl -w
use File::Basename;
$fullname = "/usr/local/lib/perl5/validate.pl";
@suffixlist = '.pl';
($basename, $directory_path, $suffix) = fileparse($fullname, @suffixlist);
print "For $fullname\n";
print "base: $basename\n";
print "path: $directory_path\n";
print "ext.: $suffix\n";
Extracts base file name from full path. Uses DOS/Windows conventions.
#use File::Basename;
#fileparse_set_fstype("MSDOS");
#The other supported types are AmigaOS, os2, MSWin32, VMS, MacOS, and RISCOS.
#UNIX is the default type.
#!/usr/bin/perl -w
use File::Basename;
fileparse_set_fstype("MSDOS");
$fullname = 'C:\Perl\lib\site\validate.pl';
@suffixlist = '.pl';
($basename, $directory_path, $suffix) = fileparse($fullname, @suffixlist);
print "For $fullname\n";
print "base: $basename\n";
print "path: $directory_path\n";
print "ext.: $suffix\n";
'-f filehandle': True if file is a normal file.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-f $name) {
print "normal file";
} else {
print "unknown file type";
}
}
File copying
#!/usr/bin/perl -w
use strict;
my $source = shift @ARGV;
my $destination = shift @ARGV;
open(IN, '<', $source) or die "Can't read source file $source: $!\n";
open(OUT, '>', $destination) or die "Can't write on to file $destination: $!\n";
print "Copying $source to $destination\n";
while (<IN>) {
print OUT $_;
}
close IN;
close OUT;
File find closure
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
die "Give me a directory\n" unless @ARGV;
{
my @results;
sub wanted { push @results, $File::Find::name }
sub findfiles {
@results=();
find \&wanted, $_[0];
return @results;
}
}
foreach my $dir (@ARGV) {
print("Error: $dir is not a directory\n"), next unless -d $dir;
my @files=findfiles($dir);
print "$_ contains @files\n";
}
File finder and callback
use File::Find;
find(\&wanted, '/httpd', '/ellie/testing' );
sub wanted{
-d $_ && print "$File::Find::name\n";
}
$File::Find::prune = 1 if /dir1/;
use File::Find;
find sub {
$File::Find::prune = 1 if /dir1/;
print "Here's a text file: $File::Find::name\n" if -T
},
'.';
Filehandle References
#!/bin/perl
open(README, "/etc/passwd") || die;
&readit(\*README); # Reference to a typeglob
sub readit {
my ($passwd)=@_;
print "\$passwd is a $passwd.\n";
while(<$passwd>){
print;
}
}
seek(README,0,0) || die "seek: $!\n"; # Reset back to begining of job
File read and write
#!/usr/bin/perl
use warnings;
use strict;
open READ, "myfile" or die "Cannot open: $! \n";
my @lines = <READ>;
print "$. lines read \n";
close READ;
exit if $#lines < 9;
open WRITE, "> myfile" or die "Cannot write: $! \n";
print WRITE $_ foreach @lines[-10..-1];
print "done \n";
close WRITE;
File seek operations
COMMAND RESULT
seek (FD, 10, 0) The file descriptor pointer moves to the 10th character from the beginning of the file.
seek (FD, 5, 1) The file descriptor pointer moves 5 characters forward from its current position.
seek (FD, -5, 1) The file descriptor pointer moves 5 characters backward from its current position.
seek (FD, -10, 2) The file descriptor is moved 10 characters from the end of the file.
File size with FIELDS
#!/usr/bin/perl
use warnings;
use strict;
use File::stat qw(:FIELDS);
my $filename = "data.txt";
if (stat $filename) {
print "'$filename' is ", $st_size,
" bytes and occupies ", $st_blksize * $st_blocks,
" bytes of disc space \n";
} else {
print "Cannot stat $filename: $| \n";
}
File statistics returned from the stat command
ELEMENT DESCRIPTION
dev ID of device containing a directory entry for this file.
ino Inode number.
mode File permission mode.
nlink Number of links.
uid User ID of the file's owner.
gid Group ID of the file's group.
rdev ID of device. This is defined only for character of block special files.
size File size in bytes.
atime Time of last access in seconds since the epoch.
mtime Time of last modification in seconds since the epoch.
ctime Time of last status change in seconds since the epoch.
blksize Preferred I/O block size. Valid only on BSD type systems.
blocks Number of blocks allocated for file. Valid only on BSD systems.
File stats
#!/usr/bin/perl
use warnings;
use strict;
print "Enter filename to test: ";
my $filename = <>;
chomp $filename;
if (lstat $filename) {
print "$filename is a file \n" if -f _;
print "$filename is a directory \n" if -d _;
print "$filename is a link \n" if -l _;
print "$filename is readable \n" if -r _;
print "$filename is writable \n" if -w _;
print "$filename is executable \n" if -x _;
} else {
print "$filename does not exist \n";
}
File testing script
#!/usr/bin/perl
$file=perl.test;
print "File is readable\n" if -r $file;
print "File is writeable\n" if -w $file;
print "File is executable\n" if -x $file;
print "File is a regular file\n" if -f $file;
print "File is a directory\n" if -d $file;
print "File is text file\n" if -T $file;
printf "File was last modified %f days ago.\n", -M $file;
print "File has been accessed in the last 12 hours.\n" if -M <= 12;
print "File has read, write, and execute set.\n" if -r $file && -w _ && -x _;
stat("afile"); # stat another file
print "File is a set user id program.\n" if -u _;# underscore evaluates to last file stat'ed
print "File is zero size.\n" if -z_;
File test operators
OPERATOR DESCRIPTION
-A Age of file in days from the last access time.
-B if the file is a binary file.
-C Age of file in days from the last inode change.
-M Age of file in days when script started.
-O if the file is owned by the real user ID (UID).
-R if the file is readable by real UID or group ID (GID).
-S if the file is a socket.
-T if the file is a text file.
-W if the file is writable by real UID or GID.
-X if the file is executable by real UID or GID.
-b if the file is a block special file.
-c if the file is a character special file.
-d if the file is a directory.
-e if the file exists.
-f if the file is a plain file.
-g if the file has setgid bit set.
-k if the file has sticky bit set.
-l if the file is a symbolic link.
-o if the file is owned by effective UID.
-p if the file is a named pipe.
-r if the file is readable by effective UID or GID.
-s if the file has nonzero size and returns the size of the file.
-t if the filehandle is opened to a TTY.
-u if the file has setuid bit set.
-w if the file is writable by effective UID or GID.
-x if the file is executable by effective UID or GID.
-z if the file has zero size.
File Test Operators[a]
Operator Meaning
-r $file True for a readable file.
-w $file True for a writeable file.
-x $file True for an executable file.
-o $file True for owned by effective uid.
-e $file True if exists.
-z $file True for zero size.
-s $file True if $file has nonzero size. Returns the size of the file in bytes.
-f $file True for a plain file.
-d $file True for a directory file.
-l $file True for a symbolic link.
-p $file True for a named pipe or FIFO.
-S $file True for a socket.
-b $file True for a block special file.
-c $file True for a character special file.
-u $file True for a setuid bit set.
-g $file True for a setgid bit set.
-k $file True for a sticky bit set.
-t $file True if filehandle is opened to a tty.
-T $file True for a text file.
-B $file True for a binary file.
-M $file Age in days since modified.
-A $file Age in days since last accessed.
-C $file Age in days since the inode changed.
File-test operators that check information returned by stat.
Operator Description
-b Is filename a mountable disk (block device)?
-c Is filename an I/O device (character device)?
-s Is filename a non-empty file?
-t Does filename represent a terminal?
-A How long since filename accessed?
-C How long since filename's inode accessed?
-M How long since filename modified?
-S Is filename a socket?
File-test operators that test for permissions.
Operator Description
-g Does filename have its set group ID bit set?
-k Does filename have its "sticky bit" set?
-r Is filename a readable file?
-u Does filename have its set user ID bit set?
-w Is filename a writable file?
-x Is filename an executable file?
-R Is filename readable only if the real user ID can read it?
-W Is filename writable only if the real user ID can write?
-X Is filename executable only if the real user ID can execute it?
File-Test Operator Syntax
Operator Description
-b Is name a block device?
-c Is name a character device?
-d Is name a directory?
-e Does name exist?
-f Is name an ordinary file?
-g Does name have its setgid bit set?
-k Does name have its "sticky bit" set?
-l Is name a symbolic link?
-o Is name owned by the user?
-p Is name a named pipe?
-r Is name a readable file?
-s Is name a non-empty file?
-t Does name represent a terminal?
-u Does name have its setuid bit set?
-w Is name a writable file?
-x Is name an executable file?
-z Is name an empty file?
-A How long since name accessed?
-B Is name a binary file?
-C How long since name's inode accessed?
-M How long since name modified?
-O Is name owned by the "real user" only?*
-R Is name readable by the "real user" only?*
-S Is name a socket?
-T Is name a text file?
-W Is name writable by the "real user" only?*
-X Is name executable by the "real user" only?*
File Tests
#-e True if the file exists.
#-f True if the file is a plain file not a directory.
#-d True if the file is a directory.
#-z True if the file has zero size.
#-s True if the file has nonzero size returns size of file in bytes.
#-r True if the file is readable by you.
#-w True if the file is writable by you.
#-x True if the file is executable by you.
#-o True if the file is owned by you.
#!/usr/bin/perl
use warnings;
use strict;
my $target = "myFile";
while (1) {
if (-e $target) {
print "File already exists. What should I do?\n";
print "(Enter 'r' to write to a different name, ";
print "'o' to overwrite or\n";
print "'b' to back up to $target.old)\n";
my $choice = <STDIN>;
chomp $choice;
if ($choice eq "r") {
next;
} elsif ($choice eq "o") {
unless (-o $target) {
print "Can't overwrite $target, it's not yours.\n";
next;
}
unless (-w $target) {
print "Can't overwrite $target: $!\n";
next;
}
} elsif ($choice eq "b") {
if ( rename($target,$target.".old") ) {
print "OK, moved $target to $target.old\n";
} else {
print "Couldn't rename file: $!\n";
next;
}
} else {
print "I didn't understand that answer.\n";
next;
}
}
last if open OUTPUT, "> $target";
print "I couldn't write on $target: $!\n";
}
print OUTPUT "Congratulations.\n";
print "Wrote to file $target\n";
File Tests for Age
Operator Meaning
-A Returns the number of days since last access relative to the program's beginning execution time.
-C Returns the number of days since last inode change relative to the program's beginning execution time (for Unix systems).
-M Returns the number of days since last modification, relative to the program's beginning execution time.
File Tests for Execution
Operator Meaning
-u Returns true if this file will execute with the user ID of the file.
-g Returns true if this file will execute with the group ID of the file.
-k Returns true if this file will execute with the privileges of the user ID of the file.
File Tests for Existence and Size
Operator Meaning
-e Returns true if this file exists.
-s Returns true if this file has nonzero size.
-z Returns true if this file has zero size.
File Tests for Privileges
Operator Meaning
-r Returns true if this file is readable by the effective ID (user ID and group ID).
-w Returns true if this file is writable by the effective ID (user ID and group ID).
-x Returns true if this file is executable by the effective ID (user ID and group ID).
-o Returns true if this file is owned by the effective ID (user ID and group ID).
-R Returns true if this file is readable by the login ID (real user ID and group ID).
-W Returns true if this file is writable by the login ID (real user ID and group ID).
-X Returns true if this file is executable by the login ID (real user ID and group ID).
-O Returns true if this file is owned by the login ID (real user ID and group ID).
File Tests for Type
Operator Meaning
-f Returns true if this file a plain file.
-d Returns true if this file is a directory.
-l Returns true if this file is a symbolic link (for Unix systems).
-T Returns true if this file is a text file.
-B Returns true if this file is a binary file.
-b Returns true if this file is a block special file.
-c Returns true if this file is a character special file.
File Tests for Unix File Handle Types
Operator Meaning
-p Returns true if this file is a named pipe.
-S Returns true if this file is a socket.
-t Returns true if this file is a tty device.
Find file
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
use File::Copy;
die "Usage: $0 <dir> [<dir>...] \n" unless @ARGV;
foreach (@ARGV) {
die "'$_' does not exist \n" unless -e $_;
}
sub lcfile {
print "$File::Find::dir - $_ \n";
move ($_, lc $_);
}
finddepth (\&lcfile, @ARGV);
Find out if there's a copy of the dir program on this computer
#!/usr/bin/perl
use warnings;
use strict;
use File::Spec::Functions;
foreach (path()) {
my $test = catfile($_,"dir");
print "Yes, dir is in the $_ directory.\n";
exit;
}
print "dir was not found here.\n";
Get current dir
#! /usr/local/bin/perl
use Cwd;
$dir = cwd;
print "dir=> $dir\n";
chdir ('D:\\mydir');
$dir = cwd;
Get file list from a specific folder
print join ("\n", glob ('/home/steve/*'));
Get file list under C:/* (C:\\*)
print join ("\n", glob ('C:/*'));
print join ("\n", glob ('C:\\*'));
Get file modified/accessed time
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "The file $file is:" );
my @time = timeconv( -A $file );
print( "Last accessed at $time[0] days, ","$time[1] hours, $time[2] minutes ","and $time[3] seconds.\n" );
@time = timeconv( -M $file );
print( "Last modified at $time[0] days, ","$time[1] hours, $time[2] minutes, ","and $time[3] seconds ago.\n" );
}
elsif ( -d $file ) {
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
sub timeconv
{
my $time = shift();
my $days = int( $time );
$time = ( $time - $days ) * 24;
my $hours = int( $time );
$time = ( $time - $hours ) * 60;
my $minutes = int( $time );
$time = ( $time - $minutes ) * 60;
my $seconds = int( $time );
return ( $days, $hours, $minutes, $seconds );
}
Get folder size, attributes and name
#!/usr/bin/perl
use strict;
print "Contents of the current directory:\n";
opendir DH, "." or die "Couldn't open the current directory: $!";
while ($_ = readdir(DH)) {
next if $_ eq "." or $_ eq "..";
print $_, " " x (30 - length($_));
print "d" if -d $_;
print "r" if -r _;
print "w" if -w _;
print "x" if -x _;
print "o" if -o _;
print "\t";
print -s _ if -r _ and -f _;
print "\n";
}
closedir DH;
Get return value from stat function
$filename = 'file.txt';
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks) = stat($filename);
print "$filename is $size bytes long.";
Get the file size
#!/usr/bin/perl
use warnings;
use strict;
use File::stat;
my $filename = "data.txt";
if (my $stat = stat $filename) {
print "'$filename' is ", $stat->size,
" bytes and occupies ", $stat->blksize * $stat->blocks,
" bytes of disc space \n";
} else {
print "Cannot stat $filename: $| \n";
}
Get the length of a file
#!/usr/bin/perl
use strict;
use warnings;
print "Creating a file with the numbers 0-9.\n";
open FILE, "+>file.txt" or die "Unable to open file: $!\n";
print FILE "0\n1\n2\n3\n4\n5\n6\n7\n8\n9\n";
close FILE or die "Unable to open file: $!\n";
open FILE, "<file.txt" or die "Unable to open file: $!\n";
<FILE>;
my $length = tell( FILE );
print $length;
close FILE or die "Unable to open file: $!\n";
Get the size of a file
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "It is ", -s $file, " bytes.\n" ); # size
}
elsif ( -d $file ) {
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
Getting Information on a File
The stat function gets a host of information about a file:
($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,$mtime, $ctime, $blksize, $blocks) = stat(file);
The file can be either a file handle referring to a file you've opened or a file name.
The stat function returns a list.
The values returned from the stat function are listed in the following table.
The time values are returned as seconds from January 1, 1970.
If you don't have permission to read the file, lstat and stat will return an empty list.
Value Holds
$dev Device number of file system.
$inode Inode number.
$mode File mode (type and permissions).
$nlink Number of hard links to the file.
$uid Numeric user ID of file's owner.
$gid Numeric group ID of file's owner.
$rdev The device identifier device (special) files only.
$size Total size of file, in bytes.
$atime Time of last access.
$mtime Time of last modification.
$ctime Time of inode change.
$blksize Preferred block size for file system I/O.
$blocks Actual number of blocks allocated.
glob pack
#!/usr/bin/perl
use warnings;
use strict;
sub define_global {
use vars qw($package_variable); #scope NOT limited
$package_variable = "defined in subroutine";
}
print $package_variable;
define_global;
print $package_variable;
Ignoring PIPE exceptions.
#!/usr/bin/perl
use strict;
$SIG{PIPE} = 'IGNORE';
open (PIPE,"| yourFile.txt") or die "Can't open pipe: $!";
select PIPE;
$|=1;
select STDOUT;
my $count=0;
for (1..10) {
warn "$_\n";
if (print PIPE "number $_\n") {
$count++;
} else {
warn "An error occurred during writing: $!\n";
last;
}
sleep 1;
}
close PIPE or die "Can't close pipe: $!";
print "Wrote $count lines of text\n";
Input Filter: open(FILEHANDLE, COMMAND|);
!/bin/perl
open(INPIPE, "date /T |");
$today = <INPIPE> ";
print $today;
close(INPIPE);
Intercepting the PIPE signal
#!/usr/bin/perl
use strict;
my $ok = 1;
$SIG{PIPE} = sub { undef $ok };
open (PIPE,"| yourFile.txt") or die "Can't open pipe: $!";
select PIPE;
$|=1;
select STDOUT;
my $count = 0;
for ($_=1; $ok && $_ <= 10; $_++) {
warn "Writing line $_\n";
print PIPE "This is line number $_\n" and $count++;
sleep 1;
}
close PIPE or die "Can't close pipe: $!";
print "Wrote $count lines of text\n";
is the file a executable file?
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "The file $file is:" );
print( " executable" ) if ( -x $file );
}
elsif ( -d $file ) {
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
is the file a plain file?
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "It is ", -s $file, " bytes.\n" ); # size
}
elsif ( -d $file ) {
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
is the file a readable file?
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "The file $file is:" );
print( " readable" ) if ( -r $file );
}
elsif ( -d $file ) {
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
is the file a writable file?
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file ( @ARGV ) {
print( "Checking $file: " );
if ( -e $file ) {
print( "$file exists!\n" );
if ( -f $file ) {
print( "The file $file is:" );
print( " writable" ) if ( -w $file );
print( "\n" );
}
elsif ( -d $file ) { # is it a directory?
print( "$file is a directory!\n" );
}
}
else {
print( "$file doesn't exist.\n" );
}
print( "\n" );
}
'-l filehandle': True if file is a symbolic link.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-l $name) {
print "symbolic link";
} elsif (-d $name) {
print "directory";
} elsif (-p $name) {
print "FIFO pipe";
} elsif (-f $name) {
print "normal file";
} else {
print "unknown file type";
}
}
Link two files
#!/usr/bin/perl -w
use strict;
my $filetolink = 'a.pl';
my $linkname = 'linktoa.pl';
symlink($filetolink, $linkname) or die "link creation failed: $!";
print "link created ok!\n";
my $readlinkresult = readlink($linkname);
print "$linkname is a sym link to $readlinkresult\n";
List all the files in a directory
#!/usr/local/bin/perl -w
while (glob("*"))
{
print "File: $_\n";
}
Lists files in directory; then gets info on files with stat
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "\nEntry: $name\n";
($dev, $inode, $mode, $nlink,$uid, $gid, $rdev, $size, $atime,$mtime, $ctime, $blksize, $blocks) = stat($name);
if (defined($dev) ) {
print "Device number : $dev\n";
print "Inode number : $inode\n";
print "File mode : $mode\n";
print "Number hard links: $nlink\n";
print "Owner ID : $uid\n";
print "Owner Group ID : $gid\n";
print "Device ID : $rdev\n";
print "Total size : $size\n";
print "Last access time : $atime\n";
print "Last modify time : $mtime\n";
print "Last inode time : $ctime\n";
print "Block size : $blksize\n";
print "Number blocks : $blocks\n";
}
}
List the content of current folder
#!/usr/bin/perl -w
use strict;
print "contents of the new directory:\n";
opendir DH, '.' or die "opendir failed: $!";
my $filename;
while ($filename = readdir(DH)) {
print " $filename\n";
}
close DH;
List the files and subdirectories in a directory.
#!/usr/local/bin/perl
opendir(HOMEDIR, "/u/jqpublic") || die ("Unable to open directory");
while ($filename = readdir(HOMEDIR)) {
print ("$filename\n");
}
closedir(HOMEDIR);
List the files and subdirectories in a directory in alphabetical order.
#!/usr/local/bin/perl
opendir(HOMEDIR, "/u/jqpublic") || die ("Unable to open directory");
@files = readdir(HOMEDIR);
closedir(HOMEDIR);
foreach $file (sort @files) {
print ("$file\n");
}
Look for all files that end with the extension .pl
#!/usr/local/bin/perl -w
while (glob("*.pl"))
{
print "File: $_\n";
}
Make a folder (directory)
#!/usr/bin/perl -w
use strict;
print "please enter a directory name: ";
chomp(my $dir = <STDIN>);
mkdir $dir, 0777 or die "failed to make directory $dir: $!\n";
print "made the directory $dir ok!\n";
Merges two files.
#!/usr/local/bin/perl
open (INFILE1, "merge1") || die ("Cannot open input file merge1\n");
open (INFILE2, "merge2") || die ("Cannot open input file merge2\n");
$line1 = <INFILE1>;
$line2 = <INFILE2>;
while ($line1 ne "" || $line2 ne "") {
if ($line1 ne "") {
print ($line1);
$line1 = <INFILE1>;
}
if ($line2 ne "") {
print ($line2);
$line2 = <INFILE2>;
}
}
Move file pointer by using the seek function
#!/usr/bin/perl
use strict;
use warnings;
print "Creating a file with the numbers 0-9.\n";
open FILE, "+>file.txt" or die "Unable to open file: $!\n";
print FILE "0\n1\n2\n3\n4\n5\n6\n7\n8\n9\n";
close FILE or die "Unable to open file: $!\n";
print "Printing the third item:\n";
seek( FILE, 4, 0 );
my $in = <FILE>;
print "$in";
print "Printing the rest of the file:\n";
print while ( <FILE> );
close FILE or die "Unable to close file: $!";
Numbering Lines
#!/usr/bin/perl
use warnings;
use strict;
open FILE, "nlexample.txt" or die $!;
my $lineno = 1;
while (<FILE>) {
print $lineno++;
print ": $_";
}
Numbering Lines in Multiple Files
#!/usr/bin/perl
use warnings;
use strict;
my $lineno;
my $current = "";
while (<>) {
if ($current ne $ARGV) {
$current = $ARGV;
print "\n\t\tFile: $ARGV\n\n";
$lineno=1;
}
print $lineno++;
print ": $_";
}
Open a file
#!/usr/bin/perl -w
use strict;
open(FH, '<', 'yourFileName.dat') or die "We have a problem: $!";
close FH;
Open a file from another file handle
open FILEHANDLE, "<file.txt" or die "Can not open file";
open (FILEHANDLE2, "<&FILEHANDLE");
while (<FILEHANDLE2>) {
print;
}
Open a file to read
open FILEHANDLE, "<yourFile.xml";
while(<FILEHANDLE>) {
print;
}
Open a pipe to the who command
#!/usr/bin/perl
use strict;
my %who;
open (WHOFH,"who |") or die "Can't open who: $!";
while (<WHOFH>) {
next unless /^(\S+)/;
$who{$1}++;
}
foreach (sort {$who{$b}<=>$who{$a}} keys %who) {
printf "%10s %d\n",$_,$who{$_};
}
close WHOFH or die "Close error: $!";
Open command expressions
EXPRESSION EFFECT
open (FH, "<filename") Opens file name for reading.
open (FH, "+<filename") Opens file name for both reading and writing.
open (FH, ">filename") Opens file name for writing.
open (FH, "+>filename") Opens file name for both reading and writing.
open (FH, ">>filename") Opens file name for appending.
open (FH, "command|") Runs the command and pipes its output to the filehandle.
open (FH, "|command") Pipes the output along the filehandle to the command.
open (FH, "-") Opens STDIN.
open (FH, ">-") Opens STDOUT.
open (FH, "<&=N") Where N is a number, this performs the equivalent of C's fdopen for reading.
open (FH, ">&=N") Where N is a number, this performs the equivalent of C's fdopen for writing.
Open file for update
#!/usr/bin/perl
use warnings;
use strict;
use Fcntl qw(:seek :flock);
open LOGFILE, ">>", "/tmp/mylog" or die "Unable to open: $! \n";
# lock file for exclusive access
flock LOGFILE, LOCK_EX;
# now seek to end of file explicitly, in case it changed since the open
seek LOGFILE, 0, SEEK_END;
# write our log message
print LOGFILE "Log message...\n";
# remove lock and close file
flock LOGFILE, LOCK_UN;
close LOGFILE;
Open file for writing
open (FILEHANDLE, ">yourFile.txt") or die "Cannot open hello.txt";
print FILEHANDLE "Hello!";
close (FILEHANDLE);
Open FILEHANDLE
$filename = "file.dat";
open FILEHANDLE, ">$filename" or die "Cannot open $filename\n";
open (FILEHANDLE2, "<&=FILEHANDLE");
open FILEHANDLE, "<file.txt" or die "Can not open file";
open (FILEHANDLE2, "<&=FILEHANDLE");
while (<FILEHANDLE2>) {
print;
}
open (FILEHANDLE, "<&FILEHANDLE2");
open FILEHANDLE, "<file.txt" or die "Can not open file";
open FILEHANDLE2, "<otherfile.txt" or die "Can not open file";
open (FILEHANDLE, "<&FILEHANDLE2");
while (<FILEHANDLE>) {
print;
}
Open file reading
open (FILEHANDLE, "<yourFile.txt") or die ("Cannot open hello.txt");
print <FILEHANDLE>;
close (FILEHANDLE);
Open for Appending
#Format: open(FILEHANDLE, ">> FILENAME");
#!/usr/bin/perl
open(HANDLE, ">>newfile") || die print "Can't open newfile: $!\n";
print HANDLE "appended \"hello world\" to the end of newfile.\n";
Open for Reading
#open(FILEHANDLE, "FILENAME");
#open(FILEHANDLE, "<FILENAME");
#open(FILEHANDLE);
#open FILEHANDLE;
open(MYHANDLE, "myfile");
open (FH, "</etc/passwd");
open (MYHANDLE);
Open for Reading and Writing
#Symbol Open For
#+< Read first, then write
#+> Write first, then read
#+>> Append first, then read
open(FH, "+<visitor_count") ||die "Can't open visitor_count: $!\n";
$count=<FH>;
print "You are visitor number $count.";
$count++;
seek(FH, 0,0) || die;
print FH $count;
close(FH);
Open for Writing
# Format: open(FILEHANDLE, ">FILENAME)";
#!/usr/bin/perl
$file="data.txt";
open(HANDOUT, ">$file") || die "Can't open newfile: $!\n";
print HANDOUT "hello world.\n";
print HANDOUT "hello world again.\n";
Open for writing first, then reading
#!/usr/bin/perl
print "\n\n";
open(FH, "+>aFile") || die;
print FH "This line is written to joker.\n";
seek(FH,0,0); # Go to the beginning of the file
while(<FH>) {
print; # Reads from aFile; the line is in $_
}
Opening an input filter on a Win32 platform
open(LISTDIR, 'dir "C:\perl" |') || die;
@filelist = <LISTDIR>;
foreach $file ( @filelist ){
print $file;
}
Opening files and using file handles: open(filehandle, name);
It's conventional to use uppercase names for file handles.
The name is the name of the file, along with some special codes for the particular mode you want to use when you open the file.
The special codes used with the file names and determine whether the file will open for reading or writing.
File Name Meaning
<filename Open file for input.
+<filename Open file for input and output.
+>filename Open file for input and output, truncate existing data.
filename Open file for input.
>filename Open file for output, truncate existing data.
>>filename Open file for output, append to end of existing data.
open(MYFILE, ">>c:\\outfile.dat")
!#c:\perl\bin
print "Content-type: text/html\n\n";
@linestring = ("line 1\n",
"line 2\n");
open(MYFILE, ">>c:\\outfile.dat")|| die print "Error encountered opening file ... $!";
for($i = 0; $i < 5; $i++)
{
$thisline = $linestring[$i];
print MYFILE "$thisline";
}
close(MYFILE);
print "Data has been written ..."
Open Operators
Operation Syntax Description
Read open(INFILE,"<filename"); Read from the file.
Write open(OUTFILE, ">filename"); Destroy any existing file and write to a new file.
Append open(APP, ">>filename"); Write to the end of an existing file.
Read/write open(RW, "+<filename"); Read and write from an existing file.
Write to a program open(PIPEOUT, "|filename"); Send data to a program or command. Also called opening a program pipe.
Read from a program open(PIPEIN"filename|"); Receive data from a program or command.
Opens two files and copies one into another.
#!/usr/local/bin/perl
unless (open(INFILE, "file1")) {
die ("cannot open input file file1\n");
}
unless (open(OUTFILE, ">outfile")) {
die ("cannot open output file outfile\n");
}
$line = <INFILE>;
while ($line ne "") {
print OUTFILE ($line);
$line = <INFILE>;
}
Output file
open(SORT, "| sort" ) or die; # Open pipe to write to
print SORT "dogs\ncats\nbirds\n" # Sorts birds, cats, dogs on separate lines.
Output file line by line
!#c:\perl\bin
print "Content-type: text/html\n\n";
open(MYFILE, "c:\\testfile.dat")|| die print "Error encountered opening file ... $!";
while(defined($dataline=<MYFILE>)){
print "$dataline <br>";
}
Pass file handle reference in a the form of '*FILEHANDLE{IO}'
sub printem
{
my $file = shift;
while (<$file>) {
print;
}
}
open FILEHANDLE, "<file.txt" or die "Can not open file";
printem *FILEHANDLE{IO};
Pass file handle reference to a subroutine
sub printem
{
my $file = shift;
while (<$file>) {
print;
}
}
open FILEHANDLE, "<file.txt" or die "Can not open file";
printem *FILEHANDLE;
Pass file handle to stat function
$filename = 'file.txt';
open FILEHANDLE, "<$filename";
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks) = stat(FILEHANDLE);
print "$filename is $size bytes long.";
Passing Filehandles by Reference
#!/bin/perl
open(READMEFILE, "f1") || die;
&readit(*READMEFILE); # Passing a filehandle to a subroutine
sub readit{
local(*myfile)=@_; # myfile is an alias for READMEFILE
while(<myfile>){
print;
}
}
Passing file handles to functions
#!/usr/bin/perl
use warnings;
use strict;
my $file = "yourFile.txt";
open( FILE, $file ) or die( "Error opening $file: $!" );
my $filehandle = *FILE;
readhandle( $filehandle );
close( FILE ) or die( "Error closing $file: $!" );
sub readhandle
{
my $fh = shift();
print while ( <$fh> );
}
Passing file name to functions
#!/usr/bin/perl
use warnings;
use strict;
my $file = "yourFile.txt";
print( "\n\nAnd finally...\n" );
readfile( $file );
sub readfile
{
my $file = shift();
local *FILE;
open( FILE, $file ) or die( "Error opening $file: $!" );
print while ( <FILE> );
}
'-p filehandle': True if file is a named pipe (FIFO).
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-l $name) {
print "symbolic link";
} elsif (-d $name) {
print "directory";
} elsif (-p $name) {
print "FIFO pipe";
} elsif (-f $name) {
print "normal file";
} else {
print "unknown file type";
}
}
Piping Data Between Processes
#!/usr/bin/perl -w
pipe(FROM_CHILD, TO_PARENT);
$pid = fork();
if ($pid == 0) {
# We're in the child process.
close(FROM_CHILD);
# Send data to parent.
print TO_PARENT "Hello, parent\n";
exit(0); # Terminate child.
} elsif (undef $pid) {
print "Not defined: means an error.";
} else {
# Parent process.
close(TO_PARENT);
$data = <FROM_CHILD>;
print "From child: $data\n";
$id = wait();
print "Child $id is dead.\n";
}
Print data to a file
!#c:\perl\bin
print "Content-type: text/html\n\n";
$thisline = "asdf 9045";
open(MYFILE, ">c:/personnel.dat")|| die print "Error encountered opening file ... $!";
print MYFILE "$thisline";
close(MYFILE);
print "Data has been written ..."
Print message in case of file open failure
open (FILEHANDLE, ">hello.txt") or die "Cannot open hello.txt";
print FILEHANDLE "Hello!";
close (FILEHANDLE);
Print out file line number
#!/usr/bin/perl -w
use strict;
open(FILE, '<', 'yourFile.txt') or die $!;
my $lineno = 1;
while (<FILE>) {
print $lineno++;
print ": $_";
}
close FH;
Prints the size of a file in bytes.
#!/usr/local/bin/perl
print ("Enter the name of the file:\n");
$filename = <STDIN>;
chop ($filename);
if (!(-e $filename)) {
print ("File $filename does not exist.\n");
} else {
$size = -s $filename;
print ("File $filename contains $size bytes.\n");
}
Print symbolic links.
#!/usr/local/bin/perl
$dir = "/u/Tom";
opendir(MYDIR, $dir);
while ($name = readdir(MYDIR)) {
if (-l $dir . "/" . $name) {
print ("$name is linked to ");
print (readlink($dir . "/". $name) . "\n");
}
}
closedir(MYDIR);
Print text to file
#!usr/bin/perl
use strict;
use warnings;
print "Opening file for output:\n";
open OUTFILE, ">file.txt" or die "Can't find file.txt : $!";
print "Outputting to file.\n";
print OUTFILE "There was an old lady\n";
close OUTFILE or die "Can not close file.txt : $!";
Program that uses file locking -- UNIX
$LOCK_EX = 2;
$LOCK_UN = 8;
open(DB, ">>datafile") || die "Can't open: $!\n";
flock(DB, $LOCK_EX) || die ;
print DB "asdf:asdf\n";
flock(DB, $LOCK_UN) || die;
Read a directory entry
#!/usr/bin/perl -w
$name = "c:\\";
opendir(DIR, $name) or die "Can't open $name due to $!";
$entry = readdir(DIR);
while ( defined($entry) ) {
print "$entry\n";
$entry = readdir(DIR);
}
closedir(DIR);
Read file content to a scalar variable
open (FILEHANDLE, "<file.txt") or die "Cannot open file.txt";
$text = "";
until (eof FILEHANDLE) {
read (FILEHANDLE, $newtext, 1)
$text .= $newtext;
}
print $text;
Read from a file
#!usr/bin/perl
use strict;
use warnings;
print "Opening file for output:\n";
open OUTFILE, ">file.txt" or die "Can't find file.txt : $!";
print "Outputting to file.\n";
print OUTFILE "There was an old lady\n";
close OUTFILE or die "Can not close file.txt : $!";
print "It now reads:\n";
open INFILE, "file.txt" or die "Can not open file.txt : $!";
print while (<INFILE>);
close INFILE or die "Can not close file.txt : $!";
Read hash value from a file
%hash = (
meat => turkey,
drink => tea,
cheese => colby,
);
open FILEHANDLE, ">hash.dat" or die "Can not open hash.dat";
$, = " ";
print FILEHANDLE %hash;
close FILEHANDLE;
open FILEHANDLE2, "<hash.dat" or die "Can not open hash.dat";
%hash2 = split(" ", <FILEHANDLE2>);
close FILEHANDLE2;
foreach $key (keys %hash2) {
print "$key => $hash2{$key}\n";
}
Reading a directory all at once with an array: Use an array with the readdir command, instead of a scalar variable
#!/usr/bin/perl -w
$name = "c:\\";
opendir(DIR, $name) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
# Sort results.
@sorted = sort(@entries);
foreach $entry (@sorted) {
print "$entry\n";
}
Reading from a file
#!/usr/bin/perl
use strict;
use warnings;
open IN, "in.txt" or die "Can not open in.txt for reading : $!";
while ( my $line = <IN> ) {
print "file:$line\n";
}
close IN or die "Can not close file : $!";
Reading from a Pipe
#(UNIX)
$ date | perl -ne 'print "Today is $_";'
Today is Mon Mar 12 20:01:58 PDT 2007
#(Windows)
$ date /T | perl -ne "print qq/Today is $_/;"
Today is Tue 04/24/2007
Reading from the Filehandle
#!/usr/bin/perl
open(FILE, "data.txt") || die "Can't open data.txt: $!\n";
while(<FILE>) {
print if /A/;
}
close(FILE);
Reading More than One Line
#!/usr/bin/perl
use warnings;
use strict;
open FILE, "test.txt" or die $!;
my @last5;
while (<FILE>) {
push @last5, $_; # Add to the end
shift @last5 if @last5 > 5; # Take from the beginning
}
print "Last five lines:\n", @last5;
Reading one line from the file handle STDIN.
$lang = <STDIN>;
#!/usr/bin/perl -w
# Usage:
# copy1.pl infile outfile
$input = $ARGV[0];
$output = ">" . $ARGV[1];
open(INPUT, $input)
or die "Can't open $input due to $!.";
open(OUTPUT, $output)
or die "Can't open $output due to $!.";
# Use shorthand for reading file.
while ( <INPUT> ) {
print OUTPUT $_;
}
# Close the files when done.
close (INPUT);
close (OUTPUT);
Reading the contents of a directory: change to that directory and then use the glob command
# @list = glob(expression);
# The expression needs to be a shell-style wildcard, such as *.pl for all file names ending in .pl.
#!/usr/bin/perl -w
@list = glob("*.pl");
print ".pl files: @list";
Read line splitted by space
!#c:\perl\bin
print "Content-type: text/html\n\n";
open(MYFILE, "c:/personnel.dat") || die print "Error encountered opening file ... $!";
while(defined($dataline=<MYFILE>))
{
print "Reading file ...<br>";
@fields = split(/ /, $dataline);
}
foreach $field(@fields)
{
print "$field <br>";
}
close(MYFILE);
readlink reads the link and returns the true file name that a link points to
$true_file = readlink($file);
Read only the last file line from a text file
#!/usr/bin/perl -w
# tail2.pl
use strict;
open(FILE, '<', 'yourFile.txt') or die $!;
my @speech = <FILE>; # slurp the whole file into memory
close FILE;
print "Last five lines:\n", @speech[-5 .. -1];
Reads an entire input file into an array.
#!/usr/local/bin/perl
unless (open(MYFILE, "file1")) {
die ("cannot open input file file1\n");
}
@input = <MYFILE>;
print (@input);
Reads lines from a file and prints them.
#!/usr/local/bin/perl
if (open(MYFILE, "file1")) {
$line = <MYFILE>;
while ($line ne "") {
print ($line);
$line = <MYFILE>;
}
}
Read the first line of a local file
#!/usr/bin/perl
use IO::File;
my $file = "yourFile.txt";
my $fh = IO::File->new($file);
my $line = <$fh>;
print $line;
Read till the end of the file
#!/usr/bin/perl
while(<>){
print "$.\t$_";
if (eof){
print "-" x 30, "\n";
close(ARGV);
}
}
Redirects standard input and output and turns off buffering.
#!/usr/local/bin/perl
open (STDOUT, ">file1") || die ("open STDOUT failed");
open (STDERR, ">&STDOUT") || die ("open STDERR failed");
$| = 1;
select (STDERR);
$| = 1;
print STDOUT ("line 1\n");
print STDERR ("line 2\n");
close (STDOUT);
close (STDERR);
Redirects the standard output and standard error files.
#!/usr/local/bin/perl
open (STDOUT, ">file1") || die ("open STDOUT failed");
open (STDERR, ">&STDOUT") || die ("open STDERR failed");
print STDOUT ("line 1\n");
print STDERR ("line 2\n");
close (STDOUT);
close (STDERR);
Reference eof function from file handle to check if it is the end of file
use IO::File;
$filehandle = new IO::File;
$filehandle->open("<file.txt") or die "Could not open file.txt";
$text = "";
until ($filehandle->eof) {
$filehandle->read($newtext, 1);
$text .= $newtext;
}
print $text;
$filehandle->close;
Remove a directory tree?
#!/usr/local/bin/perl -w
use File::Path;
my $count = rmtree(\@ARGV, 1, 1);
print "There were $count files removed.\n";
Remove all paths supplied, silently and safely.
#!/usr/bin/perl
use strict;
use warnings;
use File::Path;
my $path=$ARGV[0];
my $verbose = 0;
my $safe = 1;
rmtree $path, $verbose, $safe;
rmtree(\@ARGV, 0, 1);
Removing Directory
!#c:\perl\bin
print "Content-type: text/html\n\n";
print "Removing Directory ...";
rmdir("c:/newdir")|| die "Directory could not be created ...";
Rename a file
#!/usr/bin/perl -w
use strict;
print "enter new file name: ";
chomp(my $newname = <STDIN>);
rename "../yourData.dat", $newname or die "rename failed: $!\n";
print "file moved successfully!\n";
Rename a group of files with a common extension?
#!/usr/local/bin/perl -w
use Getopt::Long;
use File::Basename;
my $ret = GetOptions ("e|extension:s");
my $ext = $opt_e || die "Usage: $0 -e Extension\n";
my $filename;
opendir (DIR, ".") || die "Can't open directory . $! \n";
my @filelist = grep (/$ext$/, readdir (DIR));
closedir (@filelist);
for $filename (@filelist)
{
my $base = basename($filename, $ext);
print "Renaming $filename -> $base\n";
if (!rename $filename, $base)
{
print "Could not rename file $filename : $!\n";
}
}
Renaming a file before accidental deletion
#!/usr/bin/perl
use warnings;
use strict;
if ( -e 'file.txt' ) {
print( "Do you want to write over file.txt? (yes or no): " );
chomp( my $response = <STDIN> );
rename( 'file.txt', 'file.old' ) or die( "Error renaming : $!" ) if ( $response eq 'no' );
}
open( FILE, ">file.txt" ) or die( "Error opening: $!" );
print( FILE "A copy of file.txt is saved in file.old.\n" );
close( FILE ) or die( "Cannot close: $!" );
Renaming Files: rename(OLDFILENAME, NEWFILENAME);
rename ("tmp", "datafile");
Rewind dir
#! /usr/local/bin/perl
use Cwd;
$dir = cwd;
print "dir=> $dir\n";
opendir(THISDIR, "$dir");
@dirList = <THISDIR>;
print "OPEN @dirList\n";
$loc = telldir THISDIR;
print "Before Rewind Loc ==> $loc\n";
rewinddir THISDIR;
$loc = telldir THISDIR;
print "After Rewind Loc ==> $loc\n";
rewinddir THISDIR;
Save formatted data to a file
open (FILEHANDLE, ">format.txt") or die ("Cannot open format.txt");
format FILEHANDLE =
@<<<<<<<<<<<@>>>>>>>>>>>>>>>
$text1 $text2
.
$text1 = "Hello";
$text2 = "there!";
write FILEHANDLE;
close (FILEHANDLE);
Save hash value to a file
%hash = (
meat => turkey,
drink => tea,
cheese => colby,
);
open FILEHANDLE, ">hash.dat" or die "Can not open hash.dat";
$, = " ";
print FILEHANDLE %hash;
close FILEHANDLE;
open FILEHANDLE2, "<hash.dat" or die "Can not open hash.dat";
%hash2 = split(" ", <FILEHANDLE2>);
close FILEHANDLE2;
foreach $key (keys %hash2) {
print "$key => $hash2{$key}\n";
}
Save new line character to a file
open (FILEHANDLE, ">data.txt")
or die ("Cannot open data.txt");
print FILEHANDLE "Hello\nthere!";
close (FILEHANDLE);
Save packed data to a file
$time = time;
$s = pack ("a8a8L", Mike, Flash, $time);
open FILEHANDLE, ">file.dat" or die "Can not open file.dat";
print FILEHANDLE $s;
close FILEHANDLE;
open FILEHANDLE2, "<file.dat" or die "Can not open file.dat";
$s2 = <FILEHANDLE2>;
close FILEHANDLE2;
($first, $last, $time) = unpack ("a8a8L", $s2);
print "First name: $first\n";
print "Last name: $last\n";
print "Time: ", scalar localtime($time);
Seek a file
open (FILEHANDLE, "<file.txt") or die "Cannot open file.txt";
seek FILEHANDLE, 12, 0;
while (<FILEHANDLE>){
print;
}
close (FILEHANDLE);
Seek a minus value
open(FH, "db") or die "Can't open datebook: $!\n";
seek(FH,-13,2) or die;
while(<FH>){
print;
}
Seek and tell.
#!/usr/local/bin/perl
@array = ("This", "is", "a", "test");
open (TEMPFILE, ">file1");
foreach $element (@array) {
print TEMPFILE ("$element\n");
}
close (TEMPFILE);
open (TEMPFILE, "file1");
while (1) {
$skipback = tell(TEMPFILE);
$line = <TEMPFILE>;
last if ($line eq "");
print ($line);
$line = <TEMPFILE>; # assume the second line exists
print ($line);
seek (TEMPFILE, $skipback, 0);
$line = <TEMPFILE>;
print ($line);
$line = <TEMPFILE>;
print ($line);
}
Seek current position
open(FH, "db") or die "Can't open datebook: $!\n";
while(<FH>){
last if /Tom/;
}
seek(FH,0,1) or die; # Seeking from the current position
$line=<FH>; # This is where the read starts again
print "$line";
close FH;
Seek log file
#!/usr/bin/perl
use strict;
use warnings;
open LOGFILE, "log.txt";
while (1) {
print "$.: $_" while <LOGFILE>;
sleep(1);
seek LOGFILE, 0, 1;
}
Select a file handle
open (FILEHANDLE, ">hello.txt") or die ("Cannot open hello.txt");
select FILEHANDLE;
print "Hello!";
close (FILEHANDLE);
Selecting A Log File
#!/usr/bin/perl
use warnings;
use strict;
my $logging = "screen"; # Change this to "file" to send the log to a file!
if ($logging eq "file") {
open LOG, "> output.log" or die $!;
select LOG;
}
print "Program started: ", scalar localtime, "\n";
sleep 30;
print "Program finished: ", scalar localtime, "\n";
select STDOUT;
Sending the Output of a Filter to a File: open(STDOUT, ">/dev/tty");
#!/usr/bin/perl
# Program to redirect STDOUT from filter to a UNIX file
$| = 1;
$tmpfile = "temp";
open(DB, "data.txt") || die qq/Can't open "data": $!\n/;
open(SAVED, ">&STDOUT") || die "$!\n";
open(STDOUT, ">$tmpfile" ) || die "Can't open: $!\n";
open(SORT, "| sort +1") || die;
while(<DB>){
print SORT;
}
close SORT;
open(STDOUT, ">&SAVED") || die "Can't open";
'-s filehandle': Returns size if file exists and has nonzero size.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
$size = -s $name;
print " $size bytes, ";
}
'-S filehandle': True if file is a socket (uppercase S).
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-S $name) {
print ", socket ";
}
}
Shuffle a file?
#!/usr/local/bin/perl -w
# Randomize input lines
srand; # make the rand function random
while(<>){
push @lines, $_;
}
while(@lines) {
print splice(@lines, rand @lines, 1);
}
Some -X File Tests
-e File or directory exists.
-z File is empty (zero size).
-s File is not empty; function returns size in bytes.
-f Argument is a plain file.
-d Argument is a directory.
-l Argument is a symbolic link.
-p Argument is a named pipe.
-S Argument is a socket.
-b File is a block special file.
-c File is a character special file.
-t Filehandle is an open tty (isatty()).
-f Argument is readable by effective uid/gid.
-w Argument is writable by effective uid/gid.
-x Argument is executable by effective uid/gid.
-o Argument is owned by effective uid.
-R Argument is readable by real uid/gid.
-W File is writable by real uid/gid.
-X File is executable by real uid/gid.
-O File is owned by real uid.
-T File is an ASCII text file.
-B File is a binary file.
-u Argument has setuid bit set.
-g Argument has setgid bit set.
-k Argument has sticky bit set.
-M Time in days from argument modification time to Perl program start time.
-A Time in days from argument access time to Perl program start time.
-C Time in days from argument change time to Perl program start time.
Sort a file
#!/usr/bin/perl -w
use strict;
my $input = shift;
my $output = shift;
open(INPUT, '<', $input) or die "Couldn't open file $input: $!\n";
open(OUTPUT, '>', $output) or die "Couldn't open file $output: $!\n";
my @file = <INPUT>;
@file = sort @file;
print OUTPUT @file;
close INPUT;
close OUTPUT;
Split a file handle containing array
@a1 = (1, 2, 3);
open FILEHANDLE, ">array.dat" or die "Can not open array.dat";
print FILEHANDLE "@a1";
close FILEHANDLE;
open FILEHANDLE2, "<array.dat" or die "Can not open array.dat";
@a2 = split(" ", <FILEHANDLE2>);
print "@a2";
close FILEHANDLE2;
telldir and readdir
#! /usr/local/bin/perl
use Cwd;
$dir = cwd;
print "dir=> $dir\n";
opendir(THISDIR, "$dir");
@dirList = <THISDIR>;
print "OPEN @dirList\n";
$loc = telldir THISDIR;
print "Before Rewind Loc ==> $loc\n";
rewinddir THISDIR;
$loc = telldir THISDIR;
print "After Rewind Loc ==> $loc\n";
rewinddir THISDIR;
do {
$tellSpot[$i++] = telldir THISDIR;
} while (readdir THISDIR);
print "\n\nUsing seek to reset the directory handle\n\n";
for ($i = 2; $i <= $#tellSpot; $i++){
seekdir (THISDIR,$tellSpot[$i]);
$fn = readdir THISDIR;
print"$fn\n";
}
closedir THISDIR;
Test for file attributes
use Win32::File;
$File='C:\Drivers';
Win32::File::GetAttributes($File, $attr) or die;
print "The attribute value returned is: $attr.\n";
if ( $attr ){
if ($attr & READONLY){
print "File is readonly.\n";
}
if ($attr & ARCHIVE){
print "File is archive.\n";
}
if ($attr & HIDDEN){
print "File is hidden.\n";
}
if ($attr & SYSTEM){
print "File is a system file.\n";
}
if ($attr & COMPRESSED){
print "File is compressed.\n";
}
if ($attr & DIRECTORY){
print "File is a directory.\n";
}
if ($attrib & NORMAL){
print "File is normal.\n";
}
if ($attrib & OFFLINE){
print "File is normal.\n";
}
if ($attrib & TEMPORARY){
print "File is temporary.\n";
}
}
else{
print Win32::FormatMessage(Win32::GetLastError),"\n";
}
Tests for read permission on a file.
#!/usr/local/bin/perl
unless (open(MYFILE, "file1")) {
if (!(-e "file1")) {
die ("File file1 does not exist.\n");
} elsif (!(-r "file1")) {
die ("You are not allowed to read file1.\n");
} else {
die ("File1 cannot be opened\n");
}
}
Tests whether the file is empty before opening it for writing.
#!/usr/local/bin/perl
if (-e "outfile") {
if (!(-w "outfile")) {
die ("Missing write permission for outfile.\n");
}
if (!(-z "outfile")) {
die ("File outfile is non-empty.\n");
}
}
'-T filehandle': True if file is an ASCII text file.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-T $name) {
print ", text file ";
} elsif (-B $name) {
print ", binary file ";
}
print "\n"; # End line.
}
The chmod function modifies the read, write, and execute permissions on a file.
The chmod command takes the following parameters:
chmod($mode, $filename);
You can pass more than one file name.
The $mode value is a numeric value based on UNIX file permissions
The $mode value is usually specified in octal notation.
To mark a file as read-only, you can use the following command:
chmod(0444, $filename);
UNIX File Permissions is listed in the following table.
Value Meaning
0400 Owner of file has read permission.
0200 Owner has write permission.
0100 Owner has execute permission.
0040 All users in same group have read permission.
0020 Group users have write permission.
0010 Group users have execute permission.
0004 All users have read permission.
0002 All users have write permission.
0001 All users have execute permission.
The leading zero means these values are octal.
The chmod Function (UNIX)
Octal Binary Permissions Meaning
0 000 none All turned off
1 001 --x Execute
2 010 -w- Write
3 011 -wx Write, execute
4 100 r-- Read
5 101 r-x Read, execute
6 110 rw- Read, write
7 111 rwx Read, write, execute
The chmod Function (Windows)
#Format
#chmod(LIST);
#chmod LIST;
$ perl -e '$count=chmod 0755, "foo.p", "boo.p" ;print "$count files changed.\n"'
The chown function changes the owner and group of a list of files.
#Format
#chown(LIST);
#chown LIST;
$ uid=9496;
$ gid=40;
$number=chown($uid, $gid, 'foo.p', 'boo.p');
print "The number of files changed is $number\.n";
The closedir function closes the directory that was opened by the opendir function.
#Format
#closedir (DIRHANDLE);
#closedir DIRHANDLE;
opendir(DIR, "..") || die "Can't open: $!\n";
@parentfiles=readdir(DIR);
closedir(DIR);
foreach $file ( @parentfiles ){
print "$file\n";
}
The directory listing
#! /usr/local/bin/perl
use Cwd;
$dir = cwd;
print "dir=> $dir\n";
opendir(THISDIR, "$dir");
@dirList = <THISDIR>;
print "OPEN @dirList\n";
@dirList = readdir THISDIR;
print "READ @dirList\n";
print "\n\nThe directory listing after using readdir\n";
foreach $dir (@dirList){
print "$dir\n";
}
The eof function can be used to test if end of file has been reached.
#Format:
#eof(FILEHANDLE)
#eof()
#eof
open ( DB, "data.txt") || die "Can't open emp.names: $!";
while(<DB>){
print if (/Norma/ .. eof); # .. is the range operator
}
The file list in current folder
print join ("\n", glob ('*'));
The flock Function
#!/usr/local/bin/perl
use Fcntl ":flock";
open (OUTFILE, ">>flockTest.txt") || warn $!;
print ("Requesting Exclusive lock\n");
flock(OUTFILE, LOCK_EX) || warn $!;
print ("This process now owns the Exclusive lock\n");
$in = <STDIN>;
flock(OUTFILE, LOCK_UN)|| warn $!;
close (OUTFILE);
unlink ("flockTest.lck");
The getc function gets a single character from the keyboard or from a file.
At EOF, getc returns a null string.
getc(FILEHANDLE)
getc FILEHANDLE
getc
# Getting only one character of input
print "Answer y or n ";
$answer=getc; # Gets one character from stdin
$restofit=<>; # What remains in the input buffer is assigned to $restofit
print "$answer\n";
print "The characters left in the input buffer were: $restofit\n";
The link function creates a hard link on UNIX systems.
#Format: link(OLDFILENAME, NEWFILENAME);
$ perl -e 'link("dodo", "newdodo");'
The mkdir function creates a new, empty directory with the specified permissions (mode).
#Format:
#mkdir(FILENAME, MODE); (UNIX)
#mkdir(FILENAME); (Windows)
mkdir("mydir", 0755); # UNIX
mkdir(mydir); # Windows
The read Function (fread)
#Format
#read(FILEHANDLE, SCALAR, LENGTH, OFFSET);
#read(FILEHANDLE, SCALAR, LENGTH);
open(PASSWD, "/etc/passwd") || die "Can't open: $!\n";
$bytes=read (PASSWD, $buffer, 50);
print "The number of bytes read is $bytes.\n";
print "The buffer contains: \n$buffer";
The read Function reads a number of bytes into a variable from a filehandle.
number_of_bytes = read(FILEHANDLE,buffer,how_many_bytes);
# Reading input in a requested number of bytes
print "10 bytes or less.\n";
print "If you type less than 10 characters, press Ctrl-d on a line by itself.\n";
$number=read(STDIN, $favorite, 10);
print "typed: $favorite\n";
print "bytes read was $number.\n";
The readlink function returns the value of the symbolic link
#Format:
#readlink(SYMBOLIC_LINK);
#readlink SYMBOLIC_LINK;
$ perl -e 'readlink("new")';
The seekdir sets the current position for readdir() on the directory filehandle.
The position is set by the a value returned by telldir().
opendir(DIR, "."); # current directory
while( $myfile=readdir(DIR) ){
$spot=telldir(DIR);
if ( "$myfile" eq ".login" ) {
print "$myfile\n";
last;
}
}
rewinddir(DIR);
seekdir(DIR, $spot);
$myfile=readdir(DIR);
print "$myfile\n";
The seek Function randomly accesses a file.
#Format: seek(FILEHANDLE, OFFSET, POSITION);
#POSITION
#0 = Beginning of file
#1 = Current position in file
#2 = End of file
open(PASSWD, "/etc/passwd") || die "Can't open: $!\n";
while ( chomp($line = <PASSWD>) ){
print "---$line---\n" if $line =~ /root/;
}
seek(PASSWD, 0, 0) || die "$!\n";
while(<PASSWD>){print if /ellie/;}
close(PASSWD);
The seek Function randomly accesses a file: seek(FILEHANDLE, BYTEOFFSET, FILEPOSITION);
#Positions are
#0 = Beginning of the file
#1 = Current position in the file
#2 = End of the file
open(FH,"db") or die "Can't open: $!\n";
while($line=<FH>){
if ($line =~ /LLLL/) {
print "--$line--\n";
}
}
seek(FH,0,0);
while(<FH>) {
print if /Sss/;
}
The select Function
#! /usr/bin/perl
open (FILEOUT,">newfile") || die "Can't open newfile: $!\n";
select(FILEOUT);
open (DB, "<datebook") || die "Can't open datebook: $!\n";
while(<DB>) {
print ;
}
select(STDOUT);
print "Good-bye.\n";
The stat Function for Windows NT File Attributes
open(FH, "io.txt");
@fileAttributes = stat (FH);
close (FH);
foreach $attribute (@fileAttributes){
print "==> $attribute\n";
}
@accessTime = localtime($fileAttributes[8]);
@modifyTime = localtime($fileAttributes[9]);
@inodeTime = localtime($fileAttributes[10]);
$month = $accessTime[4] + 1;
print "Access time = $accessTime[2]:$accessTime[1]:$accessTime[0], $month/$accessTime[3]/$accessTime[5]\n";
$month = $modifyTime[4] + 1;
print "Modify time = $modifyTime[2]:$modifyTime[1]:$modifyTime[0], $month/$modifyTime[3]/$modifyTime[5]\n";
$month = $inodeTime[4] + 1;
print "Inode time = $inodeTime[2]:$inodeTime[1]:$inodeTime[0], $month/$inodeTime[3]/$inodeTime[5]\n";
The symlink and readlink Functions (UNIX)
Format: symlink(OLDFILE, NEWFILE)
$ perl -e 'symlink("/home/jody/test/old", "new");'
The tell Function returns the current byte position in the file
#Format:
#tell(FILEHANDLE);
#tell;
#!/usr/bin/perl
open(FH,"db") || die "Can't open: $!\n";
while ($line=<FH>) {
chomp($line);
if ($line =~ /^Tom/) {
$currentpos=tell;
print "position: $currentpos.\n";
print "$line\n\n";
}
}
seek(FH,$currentpos,0);
@lines=(<FH>);
print @lines;
The tell function returns the current byte position of a filehandle.
#Format
#tell (FILEHANDLE);
#tell FILEHANDLE;
#tell;
open(PASSWD, "/etc/passwd") || die "Can't open: $!\n";
while ( chomp($line = <PASSWD>) ){
if ( $line =~ /sync/){
$current = tell;
print "---$line---\n";
}
}
printf "The position returned by tell is %d.\n", $current;
seek(PASSWD, $current, 0);
while(<PASSWD>){
print;
}
The umask Function (UNIX)
#Format
#umask(EXPR)
#umask EXPR
#umask
$ perl -e 'printf("The umask is %o.\n", umask);'
$ perl -e 'umask 027; printf("The new mask is %o.\n", umask);'
The unlink function deletes a list of files on both UNIX and Windows systems.
#Format
#unlink (LIST);
#unlink LIST;
unlink('a','b','c') || die "remove: $!\n";
$count=unlink <*.c>;
print "The number of files removed was $count\n";
To create a directory, use the mkdir command:
mkdir($directory_name, $mode);
The $mode value is a numeric set of UNIX read, write, and execute permissions.
The $mode value is masked by your default umask value.
The mkdir command returns a true value on success and false on failure.
If it fails, mkdir sets $! with an error.
UNIX permission values used for the $mode value, shown as octal values.
The leading zero means these values are octal.
Value Meaning
0400 Owner of file has read permission.
0200 Owner has write permission.
0100 Owner has execute permission.
0040 All users in same group have read permission.
0020 Group users have write permission.
0010 Group users have execute permission.
0004 All users have read permission.
0002 All users have write permission.
0001 All users have execute permission.
For example, 0666 means all users can read and write.
To open a directory, use the opendir command:
$status = opendir(dirhandle, $name);
#!/usr/bin/perl -w
$name = "c:\\";
opendir(DIR, $name) or die "Can't open $name due to $!";
$entry = readdir(DIR);
while ( defined($entry) ) {
print "$entry\n";
$entry = readdir(DIR);
}
closedir(DIR);
To open a file for appending:
open(FH, ">>filename"); # Opens "filename" for appending.
# Creates or appends to file.
To open a file for reading:
open(FH, "<filename"); # Opens "filename" for reading.
# The < symbol is optional.
open (DB, "/home/ellie/myfile") or die "Can't open file: $!\n";
To open a file for reading and writing:
open(FH, "+<filename"); # Opens "filename" for read, then write.
open(FH, "+>filename"); # Opens "filename" for write, then read.
To open a file for writing
open(FH, ">filename"); # Opens "filename" for writing.
# Creates or truncates file.
To read a directory entry (usually a file name), use the readdir function
$entry = readdir(dirhandle);
The $entry variable holds the file name read from the directory.
If there are no more names, readdir will return an undefined value in scalar context.
In scalar context, readdir returns the next entry.
In array context, it returns all the contents of the directory:
@entries = readdir(dirhandle);
If there are no entries, readdir will return a null list in array context.
To read a number of bytes from a file: $bytes_read = read(filehandle, $var, $length, $offset);
#!/usr/bin/perl -w
# Usage:
# read.pl infile outfile
#
$input = $ARGV[0];
$output = ">" . $ARGV[1];
open(INPUT, $input) or die "Can't open $input due to $!.";
open(OUTPUT, $output) or die "Can't open $output due to $!.";
$length = 1024;
$bytes_read = read(INPUT, $var, $length);
while ($bytes_read > 0) {
print OUTPUT $var;
$bytes_read = read(INPUT, $var, $length);
}
close (INPUT);
close (OUTPUT);
To read from a file:
while(<FH>){ print; } # Read one line at a time from file.
@lines = <FH>; # Slurp all lines into an array.
print "@lines\n";
To truncate the data in a file, you can use the truncate function:
truncate($file, $new_size)
The $file value can be either a file name or a file handle.
The $new_size value is usually 0, to eliminate all data in a file.
To write to a file:
open(FH, ">file") or die "Can't open file: $!\n";
print FH "this is a test.\n";
print FH "a test.\n";
Truncate a file
#!/usr/bin/perl
use warnings;
use strict;
my $file = "data.txt";
my $truncate_to = 100;
open READ, "$file" or die "Cannot open: $! \n";
while (<READ>) {
last if $. == $truncate_to;
}
my $size = tell READ;
print "$. lines read ($size bytes) \n";
exit if $. < $truncate_to; # already shorter
close READ;
print "Truncating to $size bytes...";
open WRITE, "+< $file" or die "Cannot write: $! \n";
truncate WRITE, $size;
print "done \n";
close WRITE;
Unbuffered perl io
#!/usr/bin/perl
binmode(STDOUT,":unix"); #requires PerlIO
for (0..9) {
print "."; sleep 1;
}
print "\n";
Unbuffer output
use FileHandle;
print "to STDOUT\n";
print STDERR "to STDERR\n";
STDOUT->autoflush(1);
STDERR->autoflush(1);
print "to STDOUT\n";
print STDERR "to STDERR\n";
undef file handle
use IO::File;
$filehandle = new IO::File;
if ($filehandle->open("<hello.txt")) {
print <$filehandle>;
undef $filehandle;
}
Uses die when testing for a successful file open operation.
#!/usr/local/bin/perl
unless (open(MYFILE, "file1")) {
die ("cannot open input file file1\n");
}
# if the program gets this far, the file was opened successfully
$line = <MYFILE>;
while ($line ne "") {
print ($line);
$line = <MYFILE>;
}
Use the functions opendir, readdir, and closedir
#!/usr/local/bin/perl -w
opendir (DIRHANDLE, ".");
@filelist = readdir (DIRHANDLE);
closedir (DIRHANDLE);
foreach $file (@filelist)
{
print "File: $file\n";
}
Using a Callback
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
find ( \&callback, "/") ; # Warning: Lists EVERY FILE ON THE DISK!
sub callback {
print $File::Find::name, "\n";
}
Using a scalar variable to store a file variable name.
#!/usr/local/bin/perl
&open_file("INFILE", "", "file1");
&open_file("OUTFILE", ">", "file2");
while ($line = &read_from_file("INFILE")) {
&print_to_file("OUTFILE", $line);
}
sub open_file {
local ($filevar, $filemode, $filename) = @_;
open ($filevar, $filemode . $filename) || die ("Can't open $filename");
}
sub read_from_file {
local ($filevar) = @_;
<$filevar>;
}
sub print_to_file {
local ($filevar, $line) = @_;
print $filevar ($line);
}
Using chdir to change the current directory
chdir '..';
opendir(DIRECTORY, '.')
or die "Can't open directory.";
print join (', ', readdir(DIRECTORY));
closedir DIRECTORY;
Using file handle variable
open FILEHANDLE, "<file.txt" or die "Can not open file";
*FILEHANDLE2 = *FILEHANDLE;
while (<FILEHANDLE2>) {
print;
}
Using format_write function to save formatted data to a file
use IO::File;
format TEXTFORMAT =
@<<<<<<<<<<<@>>>>>>>>>>>>>>>
$text1 $text2
.
$text1 = "Hello";
$text2 = "there!";
$filehandle = new IO::File;
$filehandle->open(">yourFile.txt") or die "Cannot open format.txt";
$filehandle->format_write (::TEXTFORMAT);
$filehandle->close;
Using getc.
#!/usr/local/bin/perl
&start_hot_keys;
while (1) {
$char = getc(STDIN);
last if ($char eq "\\");
$char =~ tr/a-zA-Z0-9/b-zaB-ZA1-90/;
print ($char);
}
&end_hot_keys;
print ("\n");
sub start_hot_keys {
system ("stty cbreak");
system ("stty -echo");
}
sub end_hot_keys {
system ("stty -cbreak");
system ("stty echo");
}
Using getc function to read character from a file
open (FILEHANDLE, "<file.txt") or die ("Cannot open file.txt");
while (defined($char = getc FILEHANDLE)){
print $char;
}
close FILEHANDLE;
Using getc function with while loop
use IO::File;
$filehandle = new IO::File;
$filehandle->open("<file.txt") or die "Could not open file.txt";
while (defined($char = $filehandle->getc)) {
print $char;
}
$filehandle->close;
Using IO:File open to open a file for read
use IO::File;
$filehandle = new IO::File;
$filehandle->open("<hello.txt") or die "Cannot open hello.txt";
print <$filehandle>;
$filehandle->close;
Using IO::File to write string to a file
use IO::File;
$filehandle = new IO::File;
$filehandle->open(">hello.txt") or die "Cannot open hello.txt";
$filehandle->print("Hello!");
$filehandle->close;
Using open to connect different processes
#!/usr/bin/perl
use warnings;
use strict;
open( DIR, "dir *.* |" ) or die( "Cannot open dir pipe: $!" );
open( MORE, "| more" ) or die( "Cannot open more: $!" );
while ( <DIR> ) {
print( MORE );
}
close( DIR ) or die( "Cannot close DIR: $!" );
close( MORE ) or die( "Cannot close MORE: $!" );
Using readdir to get the content in a folder
opendir(DIRECTORY, '.')
or die "Can't open current directory.";
print join (', ', readdir(DIRECTORY));
closedir DIRECTORY;
Using read function in while loop
use IO::File;
$filehandle = new IO::File;
$filehandle->open("<file.txt") or die "Could not open file.txt";
$text = "";
while ($filehandle->read($newtext, 1)) {
$text .= $newtext;
}
print $text;
$filehandle->close;
Using read function to read a file
open (FILEHANDLE, "<file.txt") or die "Cannot open file.txt";
$text = "";
while (read (FILEHANDLE, $newtext, 1)){
$text .= $newtext;
}
print $text;
Using seek function from IO:File
use IO::File;
use IO::Seekable;
$filehandle = new IO::File;
$filehandle->open("<file.txt") or die "Cannot open file.txt";
$filehandle->seek(12, 0);
while (<$filehandle>){
print;
}
$filehandle->close;
Using store function to save array to a file
use Storable;
@a = (1, 2, 3);
store(\@a, "array.dat");
@a2 = @{retrieve("array.dat")};
print $a2[1];
Using store function to save hash value to a file
use Storable;
%hash = (
meat => turkey,
drink => tea,
cheese => colby,
);
store(\%hash, "hash.dat");
%hash2 = %{retrieve("hash.dat")};
print $hash2{drink};
Using tell function to check a file handle
open (FILEHANDLE, "<file.txt") or die "Cannot open file.txt";
seek FILEHANDLE, 12, 0;
print tell FILEHANDLE;
close (FILEHANDLE);
Using while loop to read content
open (FILEHANDLE, "<file.txt")
or die ("Cannot open file.txt");
while (<FILEHANDLE>){
print;
}
Using write function to write string to a file
use IO::File;
$filehandle = new IO::File;
$filehandle->open(">hello.txt") or die "Cannot open hello.txt";
$text = "Hello!";
$filehandle->write($text, length($text));
$filehandle->close;
Wait for lock
while (-e "flockTest.lck") {
print "waiting for lock\n"; sleep(1.0);
}
open (LOCK, ">flockTest.lck") || die "Lock error $!";
open (OUTFILE, ">>flockTest.txt") || warn $!;
print ("This process now owns the Exclusive lock\n");
$in = <STDIN>;
close (OUTFILE);
close (LOCK);
unlink ("flockTest.lck");
'-w filehandle': True if filehandle is writable.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-w $name) {
print "w";
} else {
print "-";
}
}
When you're done with a directory, you need to close it with the closedir command:
#!/usr/bin/perl -w
$name = "c:\\";
opendir(DIR, $name) or die "Can't open $name due to $!";
$entry = readdir(DIR);
while ( defined($entry) ) {
print "$entry\n";
$entry = readdir(DIR);
}
closedir(DIR);
When you're done with a file, call close
close(filehandle);
#!/usr/bin/perl -w
# Test of open and die with $!.
$filename = "nofile";
open(TMP, $filename)
or die "Can't open \"$filename\" due to $! ";
Win32 Binary Files
#binmode FILEHANDLE
#binmode FILEHANDLE, DISCIPLINE
$infile="a.gif";
open( INFILE, "<$infile" );
open( OUTFILE, ">out.gif" );
binmode( INFILE );
binmode( OUTFILE );
while ( read( INFILE, $buffer, 1024 ) ) {
print OUTFILE $buffer;
}
close( INFILE );
close( OUTFILE );
Write array to a file
open (FILEHANDLE, ">array.dat") or die ("Cannot open array.dat");
$, = "\n"; #Set output separator to a comma
@array = (1, 2, 3);
print FILEHANDLE @array;
close FILEHANDLE;
Write data to file
!#c:\perl\bin
print "Content-type: text/html\n\n";
@linestring = ("line 1\n",
"line 2\n");
open(MYFILE, ">c:\\outfile.dat") || die print "Error encountered opening file ... $!";
for($i = 0; $i < 5; $i++)
{
$thisline = $linestring[$i];
print MYFILE "$thisline";
}
close(MYFILE);
print "Data has been written ..."
Writes to the standard error file.
#!/usr/local/bin/perl
open(MYFILE, "file1") || die ("Unable to open input file file1\n");
print STDERR ("File file1 opened successfully.\n");
$line = <MYFILE>;
while ($line ne "") {
chop ($line);
print ("\U$line\E\n");
$line = <MYFILE>;
}
Write ten lines of text to a pipe
#!/usr/bin/perl
use strict;
open (PIPE,"| yourFile.txt") or die "Can't open pipe: $!";
select PIPE;
$|=1;
select STDOUT;
my $count = 0;
for (1..10) {
print PIPE "line number $_\n" and $count++;
sleep 1;
}
close PIPE or die "Can't close pipe: $!";
print "Wrote $count lines of text\n";
Write unpack data to a file
open INFILEHANDLE, "<data.uue";
open OUTFILEHANDLE, ">data.dat";
binmode OUTFILEHANDLE; #Necessary in MS DOS!
while (defined($line = <INFILEHANDLE>)) {
print OUTFILEHANDLE unpack('u*', $line);
}
close INFILEHANDLE;
close OUTFILEHANDLE;
'-x filehandle': True if filehandle is executable.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-x $name) {
print "x";
} else {
print "-";
}
}
'-z filehandle': True if file exists and its size is 0.
#!/usr/bin/perl -w
$dir = "c:\\";
opendir(DIR, $dir) or die "Can't open $name due to $!";
@entries = readdir(DIR);
closedir(DIR);
@sorted = sort(@entries);
foreach $entry (@sorted) {
$name = $dir . '/' . $entry;
print "$name ";
if (-z $name) {
print "exist and file size is 0";
}
}