فریم بندی کردن محتوای فراهم شده از فایل یا ورودی استاندارد

می خواهیم برنامه ای بنویسیم که محتوای یک یا چند فایل را بخواند و آن را به صورت فریم شده مانند زیر نمایش دهد . اگر هیچ فایل ورودی برای برنامه فراهم نشده باشد ، برنامه می بایست محتوا را از ورودی استاندارد (standard input) بخواند و همین عمل را انجام دهد .

نمونه خروجی می بایست به این صورت باشد :

**************************************************************
* total 36                                                   *
* drwxr-xr-x  2 mohsen  wheel   512B Nov 27 12:24 ./         *
* drwxr-xr-x  6 mohsen  wheel   512B Nov 25 12:45 ../        *
* -rw-r--r--  1 mohsen  wheel    30B Nov 26 21:22 b          *
* -rwxr-xr-x  1 mohsen  wheel   1.4k Nov 27 11:20 format.pl* *
* -rw-r--r--  1 mohsen  wheel   277B Nov 25 22:11 l1.pl      *
* -rw-r--r--  1 mohsen  wheel   284B Nov 25 22:50 l2.pl      *
* -rw-r--r--  1 mohsen  wheel   606B Nov 26 10:34 l3.pl      *
* -rw-r--r--  1 mohsen  wheel   348B Nov 26 12:02 l4.pl      *
* -rw-r--r--  1 mohsen  wheel   256B Nov 26 12:23 l5.pl      *
**************************************************************

تکه کد زیر این عملیات را انجام می دهد :

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

# maximum length of all lines.
my $max = 0;
# store @ARGV to @arr for restoring after first traverse over @ARGV with <>.
my @arr = @ARGV;
# temp file to store data will be read from standard input.
# if no named file are provided at command line.
my $tmp_name = "$$.txt";

# if !@arr then we are reading from standard input.
# then we must open a file for writing our lines.
if (!@arr) {
	open HANDLE, ">$tmp_name" or die "Could not open temp file: $!\n";
}

while(<>) {
	chomp;
	# convert each tab character to 4 space character.
	s/\t/    /g;
	if (length > $max) {
		$max = length;
	}

	if (!@arr) {
		# Store each line in opened temporary file. 
		# We are reading from standard input.
		print HANDLE $_, "\n";
	}
}

# if !@ARGV close the opened File Handle and store
# the temporary file name in @arr to next to be restored in @ARGV;
if (!@arr) {
	close HANDLE;
	push @arr, "$tmp_name";
}

# restore @arr to @ARGV
@ARGV = @arr;
# our formating pattern require 4 more character that longest line. 
$max += 4;

# beginning to write formatted lines on standard output.
print "*" x $max, "\n";
while (<>) {
	chomp;
	# convert each tab character to 4 space character.
	s/\t/    /g;
	my $length = length;
	my $remain = $max - $length - 3;
	print "* $_";
	print " " x $remain;
	print "*\n";
}
print "*" x $max, "\n";

# if temporary file exists then delete it!
if (-e $tmp_name) {
	unlink $tmp_name or die "$!\n";
}

برنامه به صورت کامل مستند شده است . شیوه استفاده از برنامه به صورت زیر است :

# cat b
man
too
ooo
radr
baba
nan
dad
# ./format.pl b
********
* man  *
* too  *
* ooo  *
* radr *
* baba *
* nan  *
* dad  *
********
# date | ./format.pl
*********************************
* Thu Nov 27 12:41:09 IRST 2014 *
*********************************