Perl Config File

We can make use of Config::Simple module for this.
This library supports parsing, updating and creating configuration files.

Main Features of Config::Simple are as mentioned below:
1) It allows to read config file in different formats/styles like INI-FILE format and HTML format.
2) It allows to read config file in the form of objects and access the variables from the object.
3) It allows to fetch all the variables at into a hash/hashref using "vars" method.

Let's discuss how can we read/modify/write config files easily in perl as mentioned below :
Reading config file in INI-FILE (ini) style
Reading config file in HTTP-LIKE style
Creating config file in INI style

1) Reading/Updating config file in INI-FILE (ini) style

If the configuration file has different blocks, then this style is very useful
Let's explain with the below mentioned example

db_ini.cfg

[mysql]
host=DBI:mysql:host
login=mysql_user
password=mysql_pass
db_name=test
RaiseError=1
PrintError=1

[oracle]
host=DBI:oracle:host
login=oracle_user
password=oracle_pass
db_name=oracle_db
RaiseError=1
PrintError=1
  

Script

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Config::Simple;

my $cfg = new Config::Simple('db_ini.cfg');

#Get Values from Config File
print "\n MySql DB Name     : " . $cfg->param("mysql.db_name");
print "\n MySql DB Password : " . $cfg->param("mysql.password");

print "\n\n Oracle DB Name     : " . $cfg->param("oracle.db_name");
print "\n Oracle DB Password : " . $cfg->param("oracle.password");
 
#Set/Update Values Config File
$cfg->param("mysql.db_name", "new_mysql_db_name");
$cfg->param("mysql.password", "new_mysql_password");

print "\n\n MySql DB Name     : " . $cfg->param("mysql.db_name");
print "\n MySql DB Password : " . $cfg->param("mysql.password");

$cfg->param("oracle.db_name", "new_orcl_db_name");
$cfg->param("oracle.password", "new_orcl_password");

print "\n\n Oracle DB Name     : " . $cfg->param("oracle.db_name");
print "\n Oracle DB Password : " . $cfg->param("oracle.password");

#Adding a new Variable to Config File
$cfg->param("mysql.new_var", "mysql_adding_variable");

print "\n\n MySql New Var     : " . $cfg->param("mysql.new_var");

$cfg->param("oracle.new_var", "oracle_adding_variable");

print "\n\n Oracle New Var     : " . $cfg->param("oracle.new_var");

print "\n\n Deleting Mysql New Var 'new_var' ... ";
$cfg->delete('mysql.new_var'); # deletes 'new_var' from [mysql] block

print "\n\n Deleting Oracle New Var 'new_var' ... ";
$cfg->delete('oracle.new_var'); # deletes 'new_var' from [oracle] block

#Config Vars
#Config::Simple also supports vars() method, which, depending on the context used, returns all the values either as hash or hashref
my %Config = $cfg->vars();
print "\n\n Config Hash Obj : " . Dumper(\%Config);

my $config_ref = $cfg->vars();
print "\n\n Config Hash Ref : " . Dumper($config_ref);
  

db_ini.cfg Output

 MySql DB Name     : test
 MySql DB Password : mysql_pass

 Oracle DB Name     : oracle_db
 Oracle DB Password : oracle_pass

 MySql DB Name     : new_mysql_db_name
 MySql DB Password : new_mysql_password

 Oracle DB Name     : new_orcl_db_name
 Oracle DB Password : new_orcl_password

 MySql New Var     : mysql_adding_variable

 Oracle New Var     : oracle_adding_variable

 Deleting Mysql New Var 'new_var' ... 
 
 Deleting Oracle New Var 'new_var' ... 
 
 Config Hash Obj : $VAR1 = {
          'mysql.PrintError' => '1',
          'mysql.db_name' => 'new_mysql_db_name',
          'oracle.password' => 'new_orcl_password',
          'oracle.host' => 'DBI:oracle:host',
          'mysql.host' => 'DBI:mysql:host',
          'mysql.password' => 'new_mysql_password',
          'oracle.PrintError' => '1',
          'oracle.login' => 'oracle_user',
          'mysql.RaiseError' => '1',
          'oracle.db_name' => 'new_orcl_db_name',
          'oracle.RaiseError' => '1',
          'mysql.login' => 'mysql_user'
        };


 Config Hash Ref : $VAR1 = {
          'mysql.PrintError' => '1',
          'oracle.password' => 'new_orcl_password',
          'mysql.db_name' => 'new_mysql_db_name',
          'oracle.host' => 'DBI:oracle:host',
          'mysql.host' => 'DBI:mysql:host',
          'oracle.PrintError' => '1',
          'mysql.password' => 'new_mysql_password',
          'oracle.login' => 'oracle_user',
          'mysql.RaiseError' => '1',
          'oracle.db_name' => 'new_orcl_db_name',
          'oracle.RaiseError' => '1',
          'mysql.login' => 'mysql_user'
        };
  

2) Reading/Updating config file in HTTP-LIKE style

When we just key and value pairs, this simple HTTP-Like style works.
Let's explain with the below mentioned example

db_http.cfg

host:'DBI:mysql:host'
login:user
password:secret
db_name:test
RaiseError:1
PrintError:1
  

Script

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Config::Simple;

my $cfg = new Config::Simple('db_http.cfg');

#Get Values from Config File
print "\n DB Name     : " . $cfg->param("db_name");
print "\n DB Password : " . $cfg->param("password");
 
#Set/Update Values Config File
$cfg->param("db_name", "new_db_name");
$cfg->param("password", "new_password");

print "\n\n DB Name     : " . $cfg->param("db_name");
print "\n DB Password : " . $cfg->param("password");

#Adding a new Variable to Config File
$cfg->param("new_var", "adding_variable");

print "\n\n New Var     : " . $cfg->param("new_var");

print "\n\n Deleting New Var 'new_var' ... ";
$cfg->delete('new_var'); # deletes 'new_var'

#Config Vars
#Config::Simple also supports vars() method, which, depending on the context used, returns all the values either as hash or hashref
my %Config = $cfg->vars();
print "\n\n Config Hash Obj : " . Dumper(\%Config);

my $config_ref = $cfg->vars();
print "\n\n Config Hash Ref : " . Dumper($config_ref);

db_http.cfg Output

 DB Name     : test
 DB Password : secret

 DB Name     : new_db_name
 DB Password : new_password

 New Var     : adding_variable

 Deleting New Var 'new_var' ... 
 
 Config Hash Obj : $VAR1 = {
          'db_name' => 'new_db_name',
          'password' => 'new_password',
          'RaiseError' => '1',
          'PrintError' => '1',
          'login' => 'user',
          'host' => 'DBI:mysql:host'
        };

 Config Hash Ref : $VAR1 = {
          'db_name' => 'new_db_name',
          'password' => 'new_password',
          'RaiseError' => '1',
          'host' => 'DBI:mysql:host',
          'login' => 'user',
          'PrintError' => '1'
        };
  

3) Creating config file in INI style

Creating a config file is explained as mentioned below.

$cfg = new Config::Simple(syntax=>'ini');
$cfg->write("test.cfg");

Supported "syntax" keywords are "ini", "simple" or "http"

write()
Alternatively, you can pass a name to either write() or save() to indicate the name of the file to create instead of modifying existing configuration file

Since we are trying to create a new config file, we need to pass the file name.

Script

$cfg = new Config::Simple(syntax=>'ini');

$cfg->param("mysql.dsn", "DBI:mysql:db;host=localhost.com");
$cfg->param("mysql.user", "username");
$cfg->param("mysql.pass", 'secret');
$cfg->write("test.cfg");
  

test.cfg Output

[mysql]
dsn:mysql:db;host=localhost.com
user:username
pass:secret
  

Unit Testing in Perl

We can write test scripts in Perl using Test::Simple and Test::More in easy way.

Test::More is an yet another framework for writing test scripts

Lets explain Test::More module with examples.

ok() vs is() 

1) Similar to ok(), is() and isnt() compare their two arguments with eq and ne respectively and use the result of that to determine if the test succeeded or failed. 

is($hsh{a}, 200, 'Test 200');
isnt($hsh{a}, 200, 'Test 200');

are similar to these:

ok($hsh{a} eq 200, 'Test 200');
ok($hsh{a} ne 200, 'Test 200');

2) They produce better diagnostics on failure. 
ok() cannot know what you are testing for (beyond the name)
but 
is() and isnt() know what the test was and why it failed. 

In case of test fail, ok() shows fail like below :
ok($hsh{a} == 200, 'Test 200');
# not ok 5 - Fail
#   Failed test 'Fail'
#   at main.pl line 21.

In case of test fail, is() or isnt() shows fail like below :
is($hsh{a}, 200, 'Test 200');
# not ok 5 - Fail
#   Failed test 'Fail'
#   at main.pl line 20.
#          got: '100'
#     expected: '200'

like()
like() allows to use regular exporessions in writing test cases
The following example, we are trying to check $str contains string 'freedom' or not

like($str, qr/freedom/i, 'String contains Freedom - ignore case');
ok($str =~ /freedom/i, 'String contains Freedom - ignore case');


cmp_ok()
cmp_ok() also useful in those cases where you are giving explicit conditions like >=, <=, ==, != etc.,

cmp_ok($scalar, "<=", 200, '10 is less than or equal to 200 - pass');
cmp_ok($scalar, "==", 10, '10 is equal to 10 - pass');

can_ok()

Syntax:
can_ok($module, @methods);
can_ok($object, @methods);

can_ok checks if a mthod exists in an object, here $obj is the object of "support" class
can_ok also checks if a method exists in an class, here "support" is the class
can_ok is good at taking mutiples methods to test at one shot

E.g.,
can_ok($obj, "add");
can_ok("support", "multiply");
can_ok("support", qw(test add multiply));

Lets explain the above methods with an example :
In the following example, we use support.pm for testing object, class and methods

support.pm

#!/usr/bin/perl

package support;

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

sub new {
    my($class) = shift;
        
    my($self) = {};

    return(bless($self, $class));
}


sub multiply {
  my $a = shift;
  my $b = shift;
 
  return ($a*$b);
}  

sub add {
  my $a = shift;
  my $b = shift;
 
  return ($a+$b);
}  

sub test {
    print "\n test mehthod inside support package"; 
}  

1;  

main.pl

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Test::More tests=>20;
use support;

my $obj = new support;

#You usually want to test if the module you're testing loads ok, rather than just vomiting if its load fails. It's recommended that you run use_ok() inside a BEGIN block so its functions are exported at compile-time and prototypes are properly honored.
BEGIN { use_ok("CGI"); }

#print "\n Obj : " . Dumper($obj);


#Testing Packages and Objects -----------------------------------------------
#Testing an object belongs to a class or not
ok (defined($obj) && ref $obj eq 'support', 'support obj new worked');

#can_ok checks if a mthod exists in an object, here $obj is the object of "support" class
#can_ok also checks if a method exists in an class, here "support" is the class
#can_ok is good at taking mutiples methods to test at one shot
can_ok($obj, "add");
can_ok("support", "multiply");
can_ok("support", qw(test add multiply));


#isa_ok checks if an object belongs to a class or not
isa_ok($obj, 'support');


#Testing Values -----------------------------------------------
my $scalar = 10;
my %hsh    = (a=>100, b=>200, c=>300);
my $str    = 'Freedom lies in being bold';


#is() vs ok()
#is() is recommended over ok()
#ok() function doesn't provide good diagnostic output.
#ok() cannot know what you are testing for (beyond the name), but is() and isnt() know what the test was and why it failed.

ok($scalar == 10, 'Pass');
is($scalar, 10, 'Pass');

is($hsh{a}, 100, 'Pass');
ok($hsh{a} == 100, 'Pass');

#is($hsh{a}, 200, 'Fail');
# not ok 5 - Fail
#   Failed test 'Fail'
#   at main.pl line 20.
#          got: '100'
#     expected: '200'

#ok($hsh{a} == 200, 'Fail');
# not ok 5 - Fail
#   Failed test 'Fail'
#   at main.pl line 21.

isnt($scalar, 20, 'Pass');

#like() allows to use regular exporessions in writing test cases
like($str, qr/freedom/i, 'String contains Freedom - ignore case');
ok($str =~ /freedom/i, 'String contains Freedom - ignore case');

#It's also useful in those cases where you are comparing numbers and applying conditions
cmp_ok($scalar, "<=", 200, '10 is less than or equal to 200 - pass');
cmp_ok($scalar, "==", 10, '10 is equal to 10 - pass');

Output:

1..20
ok 1 - use CGI;
ok 2 - support obj new worked
ok 3 - support->can('add')
ok 4 - support->can('multiply')
ok 5 - support->can(...)
ok 6 - The object isa support
ok 7 - Pass
ok 8 - Pass
ok 9 - Pass
ok 10 - Pass
ok 11 - Pass
ok 12 - String contains Freedom - ignore case
ok 13 - String contains Freedom - ignore case
ok 14 - 10 is less than or equal to 200 - pass
ok 15 - 10 is equal to 10 - pass
# Looks like you planned 20 tests but ran 15.
  

Perl Debug

Perl Debug is simple tool to easily debug perl scripts.

Few people like me find it difficult using Debug, but to be frank this is quite simple and straight forward. It makes the life of programmer easy to trace the bugs in a fast mode.

Without this, programmer needs to write unnecessary Print statements inside code and check where exactly things going wrong.

If you invoke Perl with the -d switch, your script runs under the Perl source debugger.

This works like an interactive Perl environment, prompting for debugger commands that let you examine source code, set breakpoints, dynamically pass the values of variables, etc.

This is so convenient that you often fire up the debugger all by itself just to test out Perl constructs interactively.

Debug Interactively:
Andrew E. Page, written an useful CPAN module Devel::Ptkdb, using this we can debug interactively.

This makes life much easier, no need to use <debug> prompt instead one can use the interactive mode to set the break points and pass the values to arguments dynamically.


How to Debug Perl Script Interactively using above module
perl -d:ptkdb myscript.pl  (for graphical representation of debugging)

Normal Debugger
perl debugger works using -d switch
Once you execute script using -d switch, it will change to debug prompt as mentioned below :
DB<1> ....
DB<2> ....

Some commonly used commands in Debug mode:

1) "s"  (Stepping through line by line execution) 
Keep pressing "s" will execute line by line

2) "l"  (List line) 
e.g.,
l 20                   #Lists line 20
l 20-25             #Lists 20 to 25 lines of script
l <subroutine>   #Lists a sub-routine

3) "b" (Setting break point on subroutine)
    "b" <subroutine>  
     #This will allow you to set a break point (set a break point on first line of subroutine)

4) "c" <subrutine>    
#This will take you directly to that break point (set one-time bkpt at subname and continue)

5) "q"                         
#It will quit  the debugger        

Mod Perl Notes

mod-perl:
##########
http://www.perl.com/pub/2002/02/26/whatismodperl.html
http://www.perl.com/pub/2002/03/22/modperl.html

Having the Perl interpreter embedded in the server saves the very considerable overhead of starting an external interpreter for any HTTP request that needs to run Perl code.

At least as important is code caching: the modules and scripts are loaded and compiled only once, when the server is first started. Then for the rest of the server's life the scripts are served from the cache, so the server only has to run the pre-compiled code. In many cases, this is as fast as running compiled C programs.

The primary advantages of mod_perl are power and speed

You have full access to the inner workings of the Web server and you can intervene at any stage of HTTP request processing

There are big savings in startup and compilation times.


Difference between Apache::Registry, Apache::PerlRun ?
################################################################

Speed Wise :
Apache::Registry > Apache::PerlRun > Perl CGI

The Apache::PerlRun Class
###########################

The Apache::PerlRun handler is intended for Perl CGI scripts that depend strongly on the traditional
one-process-per-execution CGI model and cannot deal with being invoked repeatedly in the same process.

For example,
a script that depends on a lot of global variables being uninitialized when it starts up is unlikely to work properly under Apache::Registry.

Like Apache::Registry, Apache::PerlRun manages a directory of CGI scripts, launching them when they are requested.
However, unlike Apache::Registry, Apache::PerlRun module does not cache compiled scripts between runs. A script is loaded and compiled freshly each time it is requested.

However, Apache::PerlRun still avoids the overhead of starting a new Perl interpreter for each CGI script,
so it's faster than traditional Perl CGI scripting but slower than Apache::Registry or vanilla Apache API modules.

It offers a possible upgrade path for CGI scripts: move the script to Apache::PerlRun initially to get a modest performance bump.
This gives you time to rework the script to make it globally clean so that it can run under Apache::Registry for the full performance benefit.

The configuration section for running Apache::PerlRun is similar to Apache::Registry:

Alias /perl-run/ /home/www/perl-run/
<Location /perl>
 SetHandler     perl-script
 PerlHandler    Apache::PerlRun
 Options        +ExecCGI
 # optional
 PerlSendHeader On
</Location>

The Apache::PerlRun handler is only a small part of the picture. The rest of the Apache::PerlRun class provides subclassable methods that implement the functionality of Apache::Registry.

The Apache::PerlRun handler simply uses a subset of these methods; other modules may override certain methods to implement the Apache::Registry enviroment with a few twists. However, these Apache::PerlRun class methods were not fully defined when this book was going to press.


The Apache::Registry Class
##############################

The Apache::Registry class is essentially a CGI environment emulator that allows many CGI scripts to run without modification under mod_perl. Because there are many differences between CGI and the Apache API, Apache::Registry has to do a great deal of work to accomplish this sleight of hand.

It loads the scripts in its designated directory, compiles them, and stores them persistently in a memory structure. Before Apache::Registry runs a script, mod_perl will set up the various CGI environment variables, provided PerlSetupEnv is configured to On, which is the default.

When the PerlSendHeader directive is On, mod_perl monitors the text printed by the script, intercepts the HTTP header, and passes it through send_cgi_header(). It also arranges for STDIN to be read from the request object when the script attempts to process POST data.

Apache::Registry also monitors the modification dates of the script files it is responsible for and reloads them if their timestamp indicates they have been changed more recently than when they were last compiled.

Despite its complexity, Apache::Registry is easy to set up. The standard configuration consists of an Alias directive and a <Location> section:

Alias /perl/ /home/www/perl
<Location /perl>
 SetHandler     perl-script
 PerlHandler    Apache::Registry
 Options        +ExecCGI
 # optional
 PerlSendHeader On
</Location>

After restarting the server, you can place any (well, almost any) Perl CGI script into /home/www/perl (or the location of your choice) and make it executable. It runs just like an ordinary CGI script but will load much faster. The behavior of Apache::Registry can be tuned with the following directives:

PerlTaintCheck
    When set to On, mod_perl will activate Perl taint checks on all the scripts under its control. Taint checks cause Perl to die with a fatal error if unchecked user-provided data (such as the values of CGI variables) is passed to a potentially dangerous function, such as exec(), eval(), or system().

PerlSendHeader
    When set to On, mod_perl will scan for script output that looks like an HTTP header and automatically call send_http_header(). Scripts that send header information using CGI. pm's header() function do not need to activate PerlSendHeader. While scripts that use CGI.pm's header() will still function properly with PerlSendHeader On, turning it Off will save a few CPU cycles.

PerlFreshRestart
    If PerlFreshRestart is set to On, mod_perl will flush its cache and reload all scripts when the server is restarted. This is very useful during module development to immediately see the changes to the source code take effect.

PerlWarn
    If the script mentions the -w switch on its #! line, Apache::Registry will turn Perl warnings on by setting the $^W global to a nonzero value. The Perl-Warn directive can be configured to On to turn on warnings for all code inside the server.

Apache::Registry has several debug levels which write various informational messages to the server error log.

Apache::Registry scripts can change the debug level by importing Apache::Debug with its level pragma:

 use Apache::Debug level => $level;

The debug level is a bit mask generated by ORing together some combination of the following values:

1     Make a note in the error log whenever the module is recompiled
2     Call Apache::Debug::dump() on errors
4     Turn on verbose tracing

The current value of the debug level can be found in the package global $Apache::Registry::Debug. You should not set this value directly, however. See Chapter 2, A First Module, for more hints on debugging Apache::Registry scripts.

===============================================================================================================

HTML::Template using tmpl_loop

template2.cgi
############
#!c:/perl/bin/perl  
  use CGI qw(:all); 
 
  my $q = CGI->new;
  print $q->header();
     
 my @languages = (   
      {   
          language_name => 'Perl',   
          description   => 'Practical Extraction and Report Language'   
      },   
      {   
          language_name => 'PHP',   
          description   => 'Hypertext Preprocessor'   
      },   
      {   
          language_name => 'ASP',   
          description   => 'Active Server Pages'   
      },   
  );   

  my $template = HTML::Template->new( filename => 'template2.tmpl' );   
  $template->param( language => \@languages );     # Array ref You have to pass => [ {a=>10, b=>20}, {a=>30, b=>40}, {a=>50, b=>60} ]
  print $template->output();    

template2.html
################

<head>   
<title>Template 2</title>   
</head>   
<body>   
<table>   
  <tr>   
    <th>Language</th>   
    <th>Description</th>   
  </tr>   
  <tmpl_loop name="language">   
  <tr>   
    <td><tmpl_var name="language_name"></td>   
    <td><tmpl_var name="description"></td>   
  </tr>   
  </tmpl_loop>   
</table>   
</body>   
</html> 

HTML::Template example 1 in MVC

template1.cgi
############
    #!c:/perl/bin/perl  
      use CGI qw(:all);  
      use HTML::Template;  
      use POSIX;
     
      my $q = CGI->new;
      print $q->header();
     
      my $template = HTML::Template->new(filename => 'template1.tmpl');
      $template->param(day => strftime('%A', localtime()) );
      print $template->output(); 

template1.html
################
<html>  
<head>  
  <title>Template 1</title>  
</head>  
<body>  
Today is <tmpl_var name=day>  
</body>  
</html> 

Perl File Operations Read, Write

Reading from File:
#########################
 #!/usr/local/bin/perl

 my $filename = '/path/to/your/data.txt';

  unless (-e $filename) {
    print "File Doesn't Exist!";
 }

 open (MYFILE, $filename);
 while (<MYFILE>) {
     chomp;
     print "$_\n";
 }
 close (MYFILE);

Writing to File
######################
 #!/usr/local/bin/perl

 my $filename = '/path/to/your/data.txt';

 if (-e $filename) {
    print "File Exists!";
 }

 unless (-e $filename) {
    print "File Doesn't Exist!";
 }

 open (MYFILE, ">>$filename");
 print MYFILE "Bob\n";
 close (MYFILE);

 use the > single greater than symbol to tell the open function that you want a fresh file each time.
 use the >> to append to the file data.txt


File::Basename for type of file
##################################
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use File::Basename;

    #my($filename, $directories, $suffix) = fileparse($path);
    #my($filename, $directories, $suffix) = fileparse($path, @suffixes);
    #my $filename = fileparse($path, @suffixes);
   
    #fileparse("/foo/bar/baz");        - On Unix returns ("baz", "/foo/bar/", "")       
    #fileparse('C:\foo\bar\baz');    - On Windows returns ("baz", 'C:\foo\bar\', "")
    #fileparse("/foo/bar/baz/");    - On Unix returns ("", "/foo/bar/baz/", "")

my @exts = qw(.txt .zip);
   
while (my $file = <DATA>) {
  chomp $file;
  my ($dir, $name, $ext) = fileparse($file, @exts);
   
  given ($ext) {
    when ('.txt') {
      say "$file is a text file";
    }
    when ('.zip') {
      say "$file is a zip file";
    }
    default {
      say "$file is an unknown file type";
    }
  }
}

__DATA__
file.txt
file.zip
file.pl


File::Type (mime_type)
##########################
use strict;
use warnings;
use File::Type;

my $file      = '/path/to/file.ext';
my $ft        = File::Type->new();
my $file_type = $ft->mime_type($file);

if ( $file_type eq 'application/octet-stream' ) {
    # possibly a text file
}
elsif ( $file_type eq 'application/zip' ) {
    # file is a zip archive
}

Slurp

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


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

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

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

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

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

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

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