Dell's blog

Data Type validation using DATA::Util.

 

                       I am always looking to get better at the way I look, comprehend and write code. And, am completely open to others providing input to help me get better in my coding process.  Last week I decided to purchase the Perl best practices book in an effort to make my code uniform for all applications I create and deploy within an enviroment. In the process of reading and speaking with a few other people who work with other scripting languages the main arguement I hear is that Perl isn`t scalable past a few hundred lines of code. I know this isn`t true because I have seen and written well over a thousand lines of clear readable code.    Although in looking at past code from previous posts I can see where improvements can be made especially removing repetative subroutines making them a single subroutine accessable from other parts of the application.

 

 Perl Best Practices on Amazon: http://www.amazon.com/Perl-Best-Practices-Damian-Conway/dp/0596001738/ref=sr_1_1?ie=UTF8&qid=1296418240&sr=8-1

 

                             Back to the main topic of this post,  the reason Perl seems to not be scalable is readability  I think this is addressed very well by reading Perl best practices. And, the other reason properly  identifying  data types in large applications when receiving user data. The latter question is what I am going to try to address with a simple script below.

 

Data::Util is a Perl module that attemps to identify data types within an application and it does it very well for most of your programming needs. Here is a simple quick and dirty script that validates an SSN from the user is a number and the correct length. Using the Data::Util  Perl module along with other Perl Best Practices tools gives you a huge advantage when you need to write small or large applications.

use strict;
use warnings;
use Data::Util qw(:all);
my $bool_val;

  $bool_val =  is_string('foo');
           print  "Bool scalar value: $bool_val, Prints out returned 1 value as successfull \n"; # Returns true.

  $bool_val = is_integer(1);
           print  "Bool scalar value: $bool_val, Prints out returned 1 value as successfull \n";     # Returns true.

  $bool_val = is_string([]);
           print "Bool scalar value: $bool_val, Does not return a value it is null \n";     # Returns false.

  $bool_val = is_string(undef);
           print  "Bool scalar value: $bool_val, Does not return a value it is null \n";  # Returns false.

  $bool_val = is_number('number');
           print "Bool scalar value: $bool_val, Does not return a value string so null value \n"; #Returns false empty null value.



#How are these used within your application.

# lets say this is a random ssn number that a client enters into your banking web application for a new car credit check

 my $client_ssn =456123497;

 # Lets validate that this is indeed a interger string and that the length is correct.

 
 if (is_integer($client_ssn)  &&  length($client_ssn) == 9 ){

        print " SSN number is correct and valid: $client_ssn \n";


     }

        else

     {

            print "Please enter a valid 9 digit ssn: $client_ssn  without dashes \n";

     }

 

 

 

 

Here is the Data::Util Perl module link and information below.

http://search.cpan.org/~gfuji/Data-Util-0.58/lib/Data/Util.pm

This module provides utility functions for data and data types, including functions for subroutines and symbol table hashes (stashes).

The implementation of this module is both Pure Perl and XS, so if you have a C compiler, all the functions this module provides are really faster.

There are many benchmarks in the DIST-DIR/benchmark/ directory.

 

 

Two stepping with Dancer!!!

   I have been writing perl scripts for system monitoring, parsing data and moving files for a few years now but never had an assignment to create a web application or use DBI.  I began looking around for a web application framework in Perl narrowing my findings down to Catalyst and Dancer.

   I tried Catalyst first because I hear thats what all of the kids are writing apps in these days. :-) I have to be honest it is far too blotted for my needs at this time. Catalyst seems like a true Enterprise web application framework and takes almost an hour and a half just to download install. I just want something simple to get a freaking app up and running and I don`t have to do too much thunkin. :-)

 

Then Dancer came into my life doing a chi-town two step!! This is a great and I mean great simple web framework.  I love it already and I have only been doing example code for one day! I still a long ways to go but I can see the potential. Take a look at the information and document links below below.

 

http://perldancer.org/

Dancer is a web application framework designed to be as effortless as possible for the developer, taking care of the boring bits as easily as possible, yet staying out of your way and letting you get on with writing your code.

Dancer aims to provide the simplest way for writing web applications, and offers the flexibility to scale between a very simple lightweight web service consisting of a few lines of code in a single file, all the way up to a more complex fully-fledged web application with session support, templates for views and layouts, etc.

If you don't want to write CGI scripts by hand, and find Catalyst too big or cumbersome for your project, Dancer is what you need.

Dancer has few pre-requisites, so your Dancer webapps will be easy to deploy.

 

Dancer apps can be used with a an embedded web server (great for easy testing), and can run under PSGI/Plack for easy deployment in a variety of webserver environments.

 

http://search.cpan.org/~xsawyerx/Dancer-1.2003/lib/Dancer.pm

 

 

Dancer slides

Perl Dancer for Python programmers

View more presentations from xSawyer.

 

More old Perl Code :-)!!

I cant remeber if I ever moved this into production but it was an old script to pull windows information. If you want to use it feel free all though it may need to be tweaked a bit.  I got some of the information from the microsoft.com site.

 

#!/usr/perl/bin
#######################################################################
#Created By Wendell L. Hatcher
# 03/23/2009
# This perl script pulls anything and everything from a CPU from current threads running to cpu/memory and services processes. logs onto the mer2-PGPCLP1 server and checks the 6 a.m. Files logs
# as well as the sftp server to confirm that the file was or was not received.
#####################################################################
#main variable declaration#######################################################
use strict;
use Win32::OLE('in');
use constant wbemFlagReturnImmediately => 0x10;
use constant wbemFlagForwardOnly => 0x20;
my $computer;
my $logpath = 'C:\Logs'."\\";                    #Global var for logpath
my $logprocessname = 'ClarifyProcess';
#Create and Open a log file.
chdir($logpath);
my $shortdate = getLogExt();
my $logname = $logprocessname.".$shortdate.csv";
my $objWMIService;
my $colItems;
my $objItem ;


open Wlog,">$logname" unless open Wlog,">>$logname";
#Retrieves information about the operating system installed on a computer, including language, encryption level, and build number

$computer = ".";
 $objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2") or die "WMI connection failed.\n";
  $colItems = $objWMIService->ExecQuery
    ("SELECT * FROM Win32_OperatingSystem","WQL",wbemFlagReturnImmediately | wbemFlagForwardOnly);
   print Wlog "Retrieving information about the operating system installed on a computer\n\n\n";
foreach  $objItem (in $colItems)
{
     
      print Wlog "Caption: $objItem->{Caption}\n";
      print Wlog "Creation Class Name: $objItem->{CreationClassName}\n";
      print Wlog "CSD Version: $objItem->{CSDVersion}\n";
      print Wlog "Computer Name: $objItem->{CSName}\n";
      print Wlog "Current Time Zone: $objItem->{CurrentTimeZone}\n";
      print Wlog "Description: $objItem->{Description}\n";
      print Wlog "Free Physical CPU Memory: $objItem->{FreePhysicalMemory}\n";
      print Wlog "Free Space In Paging Files: $objItem->{FreeSpaceInPagingFiles}\n";
      print Wlog "Free Virtual CPU Memory: $objItem->{FreeVirtualMemory}\n";
      print Wlog "Large System Cache: $objItem->{LargeSystemCache}\n";
      print Wlog "Local Date Time: $objItem->{LocalDateTime}\n";
      print Wlog "Locale: $objItem->{Locale}\n";
      print Wlog "Max Number Of Processes running at this time: $objItem->{MaxNumberOfProcesses}\n";
      print Wlog "Max Process MemorySize: $objItem->{MaxProcessMemorySize}\n";
      print Wlog "Name: $objItem->{Name}\n";
      print Wlog "Number Of Processes Currently running: $objItem->{NumberOfProcesses}\n";
      print Wlog "Organization: $objItem->{Organization}\n";
      print Wlog "OS Type: $objItem->{OSType}\n";
      print Wlog "Size Stored In Paging Files: $objItem->{SizeStoredInPagingFiles}\n";
      print Wlog "Status: $objItem->{Status}\n";
      print Wlog "Suite Mask: $objItem->{SuiteMask}\n";
      print Wlog "System Device: $objItem->{SystemDevice}\n";
      print Wlog "System Directory: $objItem->{SystemDirectory}\n";
      print Wlog "System Drive: $objItem->{SystemDrive}\n";
      print Wlog "Total Swap Space Size: $objItem->{TotalSwapSpaceSize}\n";
      print Wlog "Total Virtual Memory Size: $objItem->{TotalVirtualMemorySize}\n";
      print Wlog "Total Visible Memory Size: $objItem->{TotalVisibleMemorySize}\n";
      print Wlog "Version: $objItem->{Version}\n";
      print Wlog "Windows Directory: $objItem->{WindowsDirectory}\n";
      print Wlog "\n";
}



#Retrieves a complete list of services and their associated properties. Information is saved to a text file:.

print Wlog "Retrieves a complete list of services and their associated properties\n\n\n";
$objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2") or die "WMI connection failed.\n";
$colItems = $objWMIService->ExecQuery
    ("SELECT * FROM Win32_Service","WQL",wbemFlagReturnImmediately | wbemFlagForwardOnly);


foreach  $objItem (in $colItems){
      print Wlog "Service Running: $objItem->{Description}\n";
      print Wlog "Accept Pause: $objItem->{AcceptPause}\n";
      print Wlog "Accept Stop: $objItem->{AcceptStop}\n";
      print Wlog "Caption: $objItem->{Caption}\n";
      print Wlog "Creation Class Name: $objItem->{CreationClassName}\n";
      print Wlog "Description: $objItem->{Description}\n";
      print Wlog "Service Display Name: $objItem->{DisplayName}\n";
      print Wlog "Path Name: $objItem->{PathName}\n";
      print Wlog "Process Id: $objItem->{ProcessId}\n";
      print Wlog "Service Specific Exit Code: $objItem->{ServiceSpecificExitCode}\n";
      print Wlog "Service Type: $objItem->{ServiceType}\n";
      print Wlog "Started: $objItem->{Started}\n";
      print Wlog "Start Mode: $objItem->{StartMode}\n";
      print Wlog "State: $objItem->{State}\n";
      print Wlog "Status: $objItem->{Status}\n";   
      print Wlog "\n";
 
}
#Returns information about all the processes running on a computer
$computer = ".";
$objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2") or die "WMI connection failed.\n";
$colItems = $objWMIService->ExecQuery
    ("SELECT * FROM Win32_Process","WQL",wbemFlagReturnImmediately | wbemFlagForwardOnly);
print Wlog " All Windows Processes on the Computer\n\n\n";

foreach $objItem (in $colItems)
{
   
      print Wlog "Application Process: $objItem->{Caption}\n";
      print Wlog "Running from the Command Line: $objItem->{CommandLine}\n";
      print Wlog "Process Type Name: $objItem->{CreationClassName}\n";
      print Wlog "Creation Date: $objItem->{CreationDate}\n";
      print Wlog "Computer Name: $objItem->{CSName}\n";
      print Wlog "Cpu Status: $objItem->{CpuStatus}\n";
      print Wlog "Current Clock Speed: $objItem->{CurrentClockSpeed}\n";
      print Wlog"Current Voltage: $objItem->{CurrentVoltage}\n";
      print Wlog"Ext Clock: $objItem->{ExtClock}\n";
      print Wlog "Family: $objItem->{Family}\n";
      print Wlog "L2 Cache Size: $objItem->{L2CacheSize}\n";
      print Wlog "L2 Cache Speed: $objItem->{L2CacheSpeed}\n";
      print Wlog "Last Error Code: $objItem->{LastErrorCode}\n";
      print Wlog "Level: $objItem->{Level}\n";
      print Wlog "Load Percentage: $objItem->{LoadPercentage}\n";
      print Wlog "Manufacturer: $objItem->{Manufacturer}\n";
      print Wlog "Max Clock Speed: $objItem->{MaxClockSpeed}\n";
      print Wlog "Description: $objItem->{Description}\n";
      print Wlog "Execution State: $objItem->{ExecutionState}\n";
      print Wlog "Name: $objItem->{Name}\n";
      print Wlog "OS Creation Class Name: $objItem->{OSCreationClassName}\n";
      print Wlog "Priority: $objItem->{Priority}\n";
      print Wlog "Process Id: $objItem->{ProcessId}\n";
      print Wlog "Processor Type: $objItem->{ProcessorType}\n";
      print Wlog "Session Id: $objItem->{SessionId}\n";
      print Wlog "Status: $objItem->{Status}\n";
      print Wlog "Revision: $objItem->{Revision}\n";
      print Wlog "Role: $objItem->{Role}\n";
      print Wlog "Socket Designation: $objItem->{SocketDesignation}\n";
      print Wlog "Thread Count: $objItem->{ThreadCount}\n";
      print Wlog "Write Operation Count: $objItem->{WriteOperationCount}\n";
      print Wlog "Write Transfer Count: $objItem->{WriteTransferCount}\n";
      print Wlog "\n";
  

}
#Get all CPU Information from the local computer.


$computer = ".";
$objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2") or die "WMI connection failed.\n";
$colItems = $objWMIService->ExecQuery
    ("SELECT * FROM Win32_Processor","WQL",wbemFlagReturnImmediately | wbemFlagForwardOnly);
print Wlog "Print out all CPU processing information\n\n\n";
foreach my $objItem (in $colItems)
{
      print Wlog "Availability: $objItem->{Availability}\n";
      print Wlog "Caption: $objItem->{Caption}\n";
      print Wlog "Config Manager Error Code: $objItem->{ConfigManagerErrorCode}\n";
      print Wlog "Config Manager User Config: $objItem->{ConfigManagerUserConfig}\n";
      print Wlog "Cpu Status: $objItem->{CpuStatus}\n";
      print Wlog "Creation Class Name: $objItem->{CreationClassName}\n";
      print Wlog "Current Clock Speed: $objItem->{CurrentClockSpeed}\n";
      print Wlog "Current Voltage: $objItem->{CurrentVoltage}\n";
      print Wlog "Data Width: $objItem->{DataWidth}\n";
      print Wlog "Description: $objItem->{Description}\n";
      print Wlog "Device ID: $objItem->{DeviceID}\n";
      print Wlog "Error Cleared: $objItem->{ErrorCleared}\n";
      print Wlog "Error Description: $objItem->{ErrorDescription}\n";
      print Wlog "Ext Clock: $objItem->{ExtClock}\n";
      print Wlog "Family: $objItem->{Family}\n";
      print Wlog "Install Date: $objItem->{InstallDate}\n";
      print Wlog "L2 Cache Size: $objItem->{L2CacheSize}\n";
      print Wlog "L2 Cache Speed: $objItem->{L2CacheSpeed}\n";
      print Wlog "Last Error Code: $objItem->{LastErrorCode}\n";
      print Wlog "Level: $objItem->{Level}\n";
      print Wlog "Load Percentage: $objItem->{LoadPercentage}\n";
      print Wlog "Max Clock Speed: $objItem->{MaxClockSpeed}\n";
      print Wlog "Name: $objItem->{Name}\n";
      print Wlog "Processor Id: $objItem->{ProcessorId}\n";
      print Wlog "Processor Type: $objItem->{ProcessorType}\n";
      print Wlog "Revision: $objItem->{Revision}\n";
      print Wlog "Role: $objItem->{Role}\n";
      print Wlog "Socket Designation: $objItem->{SocketDesignation}\n";
      print Wlog "Status: $objItem->{Status}\n";
      print Wlog "Status Info: $objItem->{StatusInfo}\n";
      print Wlog "Stepping: $objItem->{Stepping}\n";
      print Wlog "System Name: $objItem->{SystemName}\n";
      print Wlog "Unique Id: $objItem->{UniqueId}\n";
      print Wlog "\n";
}

$computer = ".";
$objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2") or die "WMI connection failed.\n";
$colItems = $objWMIService->ExecQuery
    ("SELECT * FROM Win32_DiskPartition","WQL",wbemFlagReturnImmediately | wbemFlagForwardOnly);
  print Wlog "Show all Hard Drive partition info \n\n\n";
foreach my $objItem (in $colItems)
{
      print "Access: $objItem->{Access}\n";
      print "Availability: $objItem->{Availability}\n";
      print "Block Size: $objItem->{BlockSize}\n";
      print "Bootable: $objItem->{Bootable}\n";
      print "Boot Partition: $objItem->{BootPartition}\n";
      print "Caption: $objItem->{Caption}\n";
      print "Config Manager Error Code: $objItem->{ConfigManagerErrorCode}\n";
      print "Config Manager User Config: $objItem->{ConfigManagerUserConfig}\n";
      print "Creation Class Name: $objItem->{CreationClassName}\n";
      print "Description: $objItem->{Description}\n";
      print "Device ID: $objItem->{DeviceID}\n";
      print "Disk Index: $objItem->{DiskIndex}\n";
      print "Error Cleared: $objItem->{ErrorCleared}\n";
      print "Error Description: $objItem->{ErrorDescription}\n";
      print "Error Methodology: $objItem->{ErrorMethodology}\n";
      print "Hidden Sectors: $objItem->{HiddenSectors}\n";
      print "Index: $objItem->{Index}\n";
      print "Install Date: $objItem->{InstallDate}\n";
      print "Last Error Code: $objItem->{LastErrorCode}\n";
      print "Name: $objItem->{Name}\n";
      print "Number Of Blocks: $objItem->{NumberOfBlocks}\n";
      print "PNP Device ID: $objItem->{PNPDeviceID}\n";
      print "Power Management Capabilities: " . join(",", (in $objItem->{PowerManagementCapabilities})) . "\n";
      print "Power Management Supported: $objItem->{PowerManagementSupported}\n";
      print "Primary Partition: $objItem->{PrimaryPartition}\n";
      print "Purpose: $objItem->{Purpose}\n";
      print "Rewrite Partition: $objItem->{RewritePartition}\n";
      print "Size: $objItem->{Size}\n";
      print "Starting Offset: $objItem->{StartingOffset}\n";
      print "Status: $objItem->{Status}\n";
      print "Status Info: $objItem->{StatusInfo}\n";
      print "System Creation Class Name: $objItem->{SystemCreationClassName}\n";
      print "System Name: $objItem->{SystemName}\n";
      print "Type: $objItem->{Type}\n";
      print "\n";
}


#Returns proxy and NNTP information for a computer.
$computer = ".";
$objWMIService = Win32::OLE->GetObject
    ("winmgmts:\\\\$computer\\root\\CIMV2") or die "WMI connection failed.\n";
$colItems = $objWMIService->ExecQuery
    ("SELECT * FROM NetDiagnostics","WQL",wbemFlagReturnImmediately | wbemFlagForwardOnly);
print  Wlog "Print All Networking information\n\n\n";
foreach  $objItem (in $colItems)
{
      print Wlog "bIE Proxy: $objItem->{bIEProxy}\n";
      print Wlog "id: $objItem->{id}\n";
      print Wlog "IE Proxy: $objItem->{IEProxy}\n";
      print Wlog "IE Proxy Port: $objItem->{IEProxyPort}\n";
      print Wlog "News NNTP Port: $objItem->{NewsNNTPPort}\n";
      print Wlog "News Server: $objItem->{NewsServer}\n";
      print Wlog "\n";
}

close Wlog;

#Generates short timestamp for logname
#INPUT:   n/a
#RETURNS: Timestamp
sub getLogExt {
    my @time = localtime;
    my ($second,$minute,$hour,$day,$month,$year) = @time;
    $month = $month +1;
    $month = "0".$month if $month < 10;
    $day = "0".$day if $day < 10;
    $year = $year + 1900;
    my $stamp = $day.$month.$year;
    return $stamp;
}


#Generates timestamp for log
#INPUT:   n/a
#RETURNS: Timestamp
sub getDT {
    my @time = localtime;
    my ($second,$minute,$hour,$day,$month,$year) = @time;
    $second = "0".$second if $second < 10;
    $minute = "0".$minute if $minute < 10;
    $hour = "0".$hour if $hour < 10;
    $day = "0".$day if $day < 10;
    $month = $month +1;
    $month = "0".$month if $month < 10;
    $year = $year + 1900;
    my $stamp = "$month"."/"."$day"."/"."$year $hour:$minute:$second";
    return $stamp;
}

Old Perl Code, Good Stuff!!! :-)

      I woke up this morning and logged onto my suse laptop to check email etc... I noticed an old perl code folder that I hadn`t look into in a while and found this script along with a few others.

       I thought I would post it because it has some pretty good ideas as well as get thoughts from other perl peeps on how to improve the way I write code. Mind you I have improved in some areas while slacking in others since I wrote this. :-)

#!/usr/perl/bin
#######################################################################
#Created By Wendell L. Hatcher
# 03/16/2009
# This process logs onto the mer2-PGPCLP1 server and checks the 6 a.m. Files logs
# as well as the sftp server to confirm that the file was or was not received.
#####################################################################
#main variable declaration#######################################################
use strict;
my $DIR = "D:\\FileRepository\\Distributor\\";
my $mdayminus;
my ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst);
my ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2);
my $logpath = 'D:\FileRepository\Distributor\Perl\Logs'."\\";                    #Global var for logpath
my $logprocessname = '6AMFileCheckerProcess';
my $deflogname = $logpath."generic_perl.log";
my $msg;
my $rc;
my $emailreceiver = 'wendell.hatcher@XXXXXXXX.com';
my $subjectemail;
my $erroremail;
my $status;
##################Main program################################
#Create and Open a log file.
my $logname = logName($logprocessname);
$msg = "Successfully created and name $logname\n";
$rc =0;
openLog($logname);
success($logname,$msg,$rc);
#
#AGMT Outbound filechecker subroutine call.
# Get the current date and minus one for the day before
#
AGMTOutbound($DIR);

#DHPP filechecker subroutine call.
#DHPP($DIR);

#GCI-Outbound filechecker subroutine call.
#GCIOutbound($DIR);

#Inbound filechecker subroutine call.
#Inbound($DIR);

#IRT-Outbound subroutine call.
#IRTOutbound($DIR);

#OOB subroutine call.
#OOB($DIR);

#Outbound subroutine call.
#Outbound($DIR);

#SUMMIT subroutine call.
#SUMMIT($DIR);

##############################################################
#AGMT Outbound filechecker subroutin.
sub AGMTOutbound {

   my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."AGMT-Outbound";
my $backupdir = $a."AGMT-Outbound\\Backup";
my $filename = "AGMT";
my $backupfile = "AGMT";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'AGMT/*AGMT*';
########First Check  for Files in FTP Server###################################
my $agmtpsftppath = "D:\\Batch_Apps\\Partners\\Distributor\\AGMT-Outbound";
my $agmtpsftbat = 'psftpagmt.bat';
checkFTP($agmtpsftppath,$agmtpsftbat );
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(AGMT).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " GCI 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
         }
} if ($count == 0) {
   
              $subjectemail = "Process Failed!!\n";
          $status = 16;
          fail($logname,$subjectemail,$status);
        Email($emailreceiver,$subjectemail,$status);
        closeLog($logname);
             return exit(16);
     }

  }
############################################################
#DHPP filechecker process
sub DHPP {
   my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."DHPP";
my $backupdir = $a."DHPP\\Backup";
my $filename = "DHPP";
my $backupfile = "DHPP";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'DHPP/*DHPP*';
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(DHPP).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " DHPP 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
        
}
  }


}
###########################################################
#GCI-Outbound
sub GCIOutbound {
 my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."GCI-Outbound";
my $backupdir = $a."GCI-Outbound\\Backup";
my $filename = "GCI";
my $backupfile = "GCI";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'GCI/*GCI*';
########First Check  for Files in FTP Server###################################
my $gcipsftppath = "D:\\Batch_Apps\\Partners\\Distributor\\GCI-Outbound";
my $gcipsftbat = 'psftpgci.bat';
checkFTP($gcipsftppath,$gcipsftbat );
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(AGMT).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " GCI 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
         }
} if ($count == 0) {
   
              $subjectemail = "GCI Process Failed!!\n";
          $status = 16;
          fail($logname,$subjectemail,$status);
        Email($emailreceiver,$subjectemail,$status);
        closeLog($logname);
             return exit(16);
     }

  }
###########################################################
#Inbound
sub Inbound {
 my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."Ibound";
my $backupdir = $a."Inbound\\Backup";
my $filename = "SHIPMENT";
my $backupfile = "SHIPMENT";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'Inbound/*SHIPMENT*';
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(SHIPMENT).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " Inbound 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
        
}
  }

}
##########################################################
#IRT-Outbound
sub IRTOutbound {
 my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."IRT-Outbound";
my $backupdir = $a."IRT-Outbound\\Backup";
my $filename = "IRT";
my $backupfile = "IRT";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'IRT/*IRT*';
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(IRT).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " IRT 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
        
}
  }
}
#########################################################
#OOB
sub OOB {
 my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."OOB";
my $backupdir = $a."OOB\\Backup";
my $filename = "OOB";
my $backupfile = "OOB";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'OOB/*OOB*';
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(OOB).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " OOB 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
        
}
  }
}
#########################################################
#Outbound
sub Outbound {
 my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."Outbound";
my $backupdir = $a."Outbound\\Backup";
my $filename = "SHIPMENT";
my $backupfile = "SHIPMENT";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'SHIPMENT/*SHIPMENT*';
########First Check  for Files in FTP Server###################################
my $gcipsftppath = "D:\\Batch_Apps\\Partners\\Distributor\\Outbound";
my $gcipsftbat = 'psftout.bat';
checkFTP($outsftppath,$outsftbat );
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(SHIPMENT).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " OUTBOUND 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
         }
} if ($count == 0) {
   
              $subjectemail = "OUTBOUND Process Failed!!\n";
          $status = 16;
          fail($logname,$subjectemail,$status);
        Email($emailreceiver,$subjectemail,$status);
        closeLog($logname);
             return exit(16);
     }

  }
}
#########################################################
#SUMMIT
sub SUMMIT {
 my($a); # declare single variable for inbound file constant directory.
  ($a) = @_;    # assign constant directory.
my $newdir = $a."SUMMIT";
my $backupdir = $a."SUMMIT\\Backup";
my $filename = "SUMMIT";
my $backupfile = "SUMMIT";
my @dir = ();
my @directorynames = ();
my $singlebackupfile;
my $count = 0;
my $mtime;
my $atime;
my $dirwildcard = 'SUMMIT/*SUMMIT*';
#Change Directory path and verify a file exists.#######################################
   chdir($newdir);
     opendir (DIRH, $newdir) or die "couldn`t open $newdir: $!";
           @dir = grep {-f && /$filename/i} readdir DIRH;
    closedir DIRH;

foreach $filename(@dir) {
#Check the main directory to confirm files do not exists on that level
    next if $filename eq '.' or $filename eq '..';
   if (-f $filename){
          $subjectemail = " $filename, :File exists on main directory process failed.\n"; 
          $status = 16;
      fail($logname,$subjectemail,$status);
          Email($emailreceiver,$subjectemail,$status);
      closeLog($logname);
       return exit(16);
  }
}
#Check the backup directory and confirm 6 backup files from yesterday exist within the directory
# Once all 6 files are confirmed exit out with a return code of 0.
      chdir($backupdir);
           opendir (DIR, $backupdir) or die "$!";
            @directorynames = grep {-f && /$backupfile/i} readdir DIR;
        close DIR;    
#Check the backup directory and confirm all of the files are there and current for todays date. #####################################
  foreach $singlebackupfile(@directorynames) {         
                 
                if ($singlebackupfile =~ /.(SUMMIT).*/i )                                
                  {
                        
            ($mtime) = (stat("$singlebackupfile"))[9];
                        ($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday,$isdst) = localtime();
                        ($seconds2, $minutes2, $hours2, $day2, $month2, $year2, $wday2,$yday2, $isdst2) = localtime($mtime);

             if ($day == $day2 && $month == $month2) {                       
                          $count++;
                          $subjectemail = "The file name: $singlebackupfile and first day: $day first month: $month and secondday: $day2 and second month: $month2\n";
                  $status = 0;
               success($logname,$subjectemail,$status);
                  if($count <= 6) {
                       $subjectemail = " SUMMIT 6 am jobs Data processessed successfully";
               $status = 0;
             success($logname,$subjectemail,$status);
           }
    }
        
}
  }
}
##########################################################
#Check FTP files
sub checkFTP {
    #set path to putty to use putty sftp.
    my $puttystatus;
    my $psftppath $_[0];
        my $dir;   
    my $ftpbatfile$_[1];
    my $status;
    ($psftppath, $ftpbatfile) = @_; 

     chdir($psftppath);        
         my $newputty = $ftpbatfile;
    $puttystatus= system($newputty);
                     die "$newputty exited with error: $?" unless $status ==0;
    success($logname,$puttystatus,$status);
      #Send email notification with information to the client through email and log inside of output file.##################################             

        if ($puttystatus != 0) {
             $subjectemail = "FTP process failed for some reason check 6am logs.\n";
          fail($logname,$subjectemail,$puttystatus);
     Email($emailreceiver,$subjectemail,$puttystatus);
      }
}
##############################################################
#Email Success or Failure
sub Email {
use Net::SMTP;
my $emailto;
my $emailsubject;
my $emailerror;

 ($emailto, $emailsubject,$emailerror) = @_; 

my $smtp_temp = Net::SMTP->new('rf-mail1.XXXXXXXX', Debug   => 1);

#my $smtp_temp = Net::SMTP->new('localhost', Debug   => 0);

$smtp_temp->mail('IT.ApplicationsMgmt.CustomApps@XXXXXXXX');

$smtp_temp->to($emailto);

$smtp_temp->data();

$smtp_temp->datasend($emailsubject);

$smtp_temp->datasend($emailerror);

$smtp_temp->quit;
 
   
}
#### Logging For the application############################################################################
#This part of the application can be taken apart and used within other apps on its own with a little tweaking.


#Calls writeLog to write a line indicating success to a log
#INPUT:   Message and return code to write to log.
#RETURNS: Message and return code for the method
sub success {
    my $self = $_[0];
    my $msg = $_[1];                    #Message to log
    my $rc = $_[2];                        #Return code to log
    my $flag = "SUCCESS";
    ($msg,$rc) = writeLog($self,$msg,$rc,$flag);
    return $msg,$rc;
}
#Calls writeLog to write a line indicating warning to a log
#INPUT:   Message and return code to write to log.
#RETURNS: Message and return code for the method
sub warn {
    my $self = $_[0];
    my $msg = $_[1];                    #Message to log
    my $rc = $_[2];                        #Return code to log
    my $flag = "WARN";
    ($msg,$rc) = writeLog($self,$msg,$rc,$flag);
    return $msg,$rc;
}

#Calls writeLog to write a line indicating failure to a log
#INPUT:   Message and return code to write to log.
#RETURNS: Message and return code for the method
sub fail {
    my $self = $_[0];
    my $msg = $_[1];                    #Message to log
    my $rc = $_[2];                        #Return code to log
    my $flag = "ERROR";
    ($msg,$rc) = writeLog($self,$msg,$rc,$flag);
    return $msg,$rc;
}

#Writes a line indicating failure to a log
#INPUT:   Log reference, message, return code, flag to write to log.
#         Also, $self->{NAME} (name of log) is required
#RETURNS: Message and return code for the method
sub writeLog {
    my $self = $_[0];
    my $msg = $_[1];                    #Message to log
    my $rc = $_[2];                        #Return code to log
    my $flag = $_[3];
    my $logname = $self;                #Name of log to write to
    $msg =~ s/\n*//g;                    #Remove newlines
    if ($logname eq "") {                    #Requires a log reference to be passed
        $msg = "Filename $logname does not exist";
        $rc = 1001;
        return $msg,$rc;
    }
       
        my $date = getDT();                    #Get the timestamp
    ($submsg,$subrc) = fileChecks($logname);        #Check to see if the file is readable, writable
    if ($subrc != 0) {
        open(LOG,">>$deflogname");            #Writes to default log
        print LOG "$date $subrc ERROR: $submsg\n";
        close LOG;
        $msg = "$submsg".", wrote to $deflogname instead";
        return $msg,$rc;
    } else {
        $rc = "0   " if $rc == 0;
        open(LOG,">>$logname");                #Opens log
        print LOG "$date $rc $flag: $msg\n";    #Writes log record
        close LOG;                    #Closes log
        return $msg,$rc;
    }   
}
#Opens a log, and prints the header information
#INPUT:   $self->{NAME} (name of log) is required
#RETURNS: Message and return code for the method
sub openLog {
    my ($msg,$rc);
    my $date = getDT();                    #Get the timestamp
    my $logname = $_[0];                #Name of log to write to
    if ($logname eq "") {                    #Requires a log reference to be passed
        $msg = "Filename $logname does not exist";
        $rc = 1001;
        return $msg,$rc;
    }
    ($msg,$rc) = fileChecks($logname);            #Check to see if the file is readable, writable
    if ($rc != 0) {                        #Writes to default log
        open(LOG,">>$deflogname");
        print LOG "###################### BEGIN ######################\n";
        print LOG "$date $rc ERROR: $msg\n";
        print LOG "####################### END #######################\n";
        close LOG;
        $msg = "$msg".", wrote to $deflogname instead";
        return $msg,$rc;
    } else {
        open(LOG,">>$logname");                #Opens log
        $msg = "Log $logname opened";
        $rc = "0   ";
        print LOG "######################  BEGIN ######################\n";
        print LOG "$date $rc SUCCESS: $msg\n";    #Writes log message
        close LOG;                    #Closes log
        return $msg,$rc;
    }
}
#Opens a log, and prints the footer information
#INPUT:   $self->{NAME} (name of log) is required
#RETURNS: Message and return code for the method
sub closeLog {
    my ($msg,$rc);
    my $date = getDT();                    #Get the timestamp
    my $logname = $_[0];                #Name of log to write to
    if ($logname eq "") {                    #Requires a log reference to be passed
        $msg = "Filename $logname does not exist";
        $rc = 1001;
        return $msg,$rc;
    }
    ($msg,$rc) = fileChecks($logname);            #Check to see if the file is readable, writable
    if ($rc != 0) {                        #Writes to default log
        open(LOG,">>$deflogname");
        print LOG "###################### BEGIN ######################\n";
        print LOG "$date $rc ERROR: $msg\n";
        print LOG "####################### END #######################\n";
        close LOG;
        $msg = "$msg".", wrote to $deflogname instead";
        return $msg,$rc;
    } else {
        open(LOG,">>$logname");                #Opens log
        $msg = "Log $logname closed";
        $rc = "0   ";
        print LOG "$date $rc SUCCESS: $msg\n";    #Writes log message
        print LOG "####################### END #######################\n";
        close LOG;                    #Closes log
        return $msg,$rc;
    }
}
#Creates the name of the log to write to
#INPUT:   Original process name
#RETURNS: Entire logname
sub logName {
    my $process = $_[0];
    my $shortdate = getLogExt();
    my $logname = $logpath.$process.".$shortdate.log";
    return $logname;
}
#Checks to see if file is readable, writable, exists
#If file does not exist, it will be created
#INPUT:   Logname to check
#RETURNS: Message and return code
sub fileChecks {
    my $logname = $_[0];
    my ($msg,$rc);
    $rc = 0;
    if (!-e $logname) {
        unless (open(LOG,">>$logname") && (print LOG "") && close LOG) {
            $msg = "Filename $logname not writable";
            $rc = 1002;
        }
    } elsif (!-r $logname) {
        $msg = "Filename $logname not readable";
        $rc = 1003;
    } elsif (!-w $logname) {
        $msg = "Filename $logname not writable";
        $rc = 1002;
    } else {
        $msg = "Filename $logname is ready for writing";
        $rc = 0;
    }
    return $msg,$rc;
}

#Generates short timestamp for logname
#INPUT:   n/a
#RETURNS: Timestamp
sub getLogExt {
    my @time = localtime;
    my ($second,$minute,$hour,$day,$month,$year) = @time;
    $month = $month +1;
    $month = "0".$month if $month < 10;
    $day = "0".$day if $day < 10;
    $year = $year + 1900;
    my $stamp = $day.$month.$year;
    return $stamp;
}

#Generates timestamp for log
#INPUT:   n/a
#RETURNS: Timestamp
sub getDT {
    my @time = localtime;
    my ($second,$minute,$hour,$day,$month,$year) = @time;
    $second = "0".$second if $second < 10;
    $minute = "0".$minute if $minute < 10;
    $hour = "0".$hour if $hour < 10;
    $day = "0".$day if $day < 10;
    $month = $month +1;
    $month = "0".$month if $month < 10;
    $year = $year + 1900;
    my $stamp = "$month"."/"."$day"."/"."$year $hour:$minute:$second";
    return $stamp;
}

 

Time to begin work again on improving my perl programming

Haven`t updated my site in awhile. I felt it is time to start improving my perl programming abilities using the list below and focusing on more moose,cataylst and database programming. Will keep updating new information as I progress in my coding.

Here's a quick checklist to help those of you writing Perl (or those of you trying to hire people to write Perl (or those of you trying to hire people to learn to write Perl)) to determine if you're capable of writing Perl well:

• Do you know how to use the Perl documentation
• Do you use CPAN modules?
• Do you use the CPAN distribution layout for organizing your code?
• Have you enabled strictures and warnings? Is the resulting code clean of warnings and errors?
• Are you using the standard Perl testing framework? (Did you write tests at all?)
• Do you have an automated Perl configuration, build, dependency resolution, installation, and distribution mechanism?
• Does your code conform to local Perl layout guidelines?
• Does your code conform to Perl community standards for maintainability and correctness?
• Are you familiar with the local Perl mongers group?
• Are you using a recent version of Perl?
• Are you familiar with writing secure Perl?
• Do you use source control?
• Do you use functions?
• Do you use modules?
• Do you use objects?
• Do you use Moose or another abstraction mechanism from the CPAN?
• Do you document your Perl code?
• Do you use language constructs you don't understand, copied and pasted from elsewhere, smushed together into a hateful melange of barely-working confusion you occasionally tweak just to see what happens, and one afternoon you get sick of it and call it done?

Wt, C++ Web Toolkit

Wt, C++ Web Toolkit

http://www.webtoolkit.eu/wt

The API is widget-centric and inspired by desktop GUI APIs. To the developer, it offers complete abstraction of any web-specific implementation details, including event handling, graphics support, and pretty URLs.

Witty the C++ webframework

In my spare time I have been looking at web frameworks working on learning Catalyst,which is a great Perl web framework as well as looking into potentially designing one my self. But, at this point I am an intermediate Perl programmer and this was a dream, Then came along Witty a C++ web-framework that is really scalable and seems to fit everything I am looking for in an enterprise web development environment. The great thing about this framework is that bindings can be created for Perl or any other scripting language.

              There`s currently a rubyqt implementation but there doesn't seem to be one for Perl on the near horizon. So, I took time to contact some of the developers and discuss potentially building a Perl framework to gain experience and have a large scale project under my programming belt. This is probably going to be a 6 to 12 months work in progress,which I will post on my blog site as work moves forward in the next three months.

http://www.webtoolkit.eu/wt

Wt (pronounced 'witty') is a C++ library for developing interactive web applications.

The API is widget-centric and inspired by desktop GUI APIs. To the developer, it offers complete abstraction of any web-specific implementation details, including event handling, graphics support, and pretty URLs.

Unlike many page-based frameworks, Wt was designed for creating stateful applications that are at the same time highly interactive (leveraging techinques such as AJAX to their fullest) and accessible (supporting plain HTML browsers), using automatic graceful degradation or progressive enhancement.

It comes with an application server that acts as a stand-alone web server or integrates through FastCGI with other web servers.

Great video on MOOSE::X and perl 5.10.1

An introduction to MooseX::Declare from Piers Cawley on Vimeo.

Pier Crawley`s article on Moose:X Perl 5.10.1

Recording Web interaction with http::recorder and www::mechanize

I came to work this morning and received a request to created a quick and dirty Perl script that validates a websites up and running after a software release. This is extremely easy to do using htttp::recorder. This Perl module records all of your clicks and creates a script using the www::mechanize Perl module. After you have downloaded and installed both HTTP::Recorder and WWW::Mechanize from CPAN.

Create a simple perl script with the following information for the  http::recorder. I use the proxy recorder since the example is inside of the module itself and is pretty easy to kick off. From this point kick off your script and go into your proxy settings and setup the proxy to point to your localhost::8080 and viola!!  the script is running.

   #!/usr/bin/perl

    use HTTP::Proxy;
    use HTTP::Recorder;

    my $proxy = HTTP::Proxy->new();

    # create a new HTTP::Recorder object
    my $agent = new HTTP::Recorder;

    # set the log file (optional)
    #The scripts out logfile can be changed to anything you want and directory path.
    $agent->file("/tmp/myfile");

    # set HTTP::Recorder as the agent for the proxy
    $proxy->agent( $agent );

    # start the proxy
    $proxy->start();

    1;

After the script has start you can go to the http://http-recorder control panel. I included documentation from the site since it can go into better detail on what needs to be configured than I can. :-)

Using the Control Panel

If you have Javascript enabled in your browser, go to the HTTP::Recorder control URL (http://http-recorder by default), optionally type a URL into the "Goto page" field, and click "Go".

In the new window, interact with web sites as you normally do, including typing a new address into the address field. The Control Panel will be updated after each recorded action.

The Control Panel allows you to modify, delete, or save your script.

SSL sessions

As of version 0.03, HTTP::Recorder can record SSL sessions.

To begin recording an SSL session, go to the control URL (http://http-recorder/ by default), and enter the initial URL. Then, interact with the web site as usual.

After everything is configured in the control panel the way you like and the proxy is setup correctly go to the site you are testing in my case it was a company we validation site and click away!! This process will record the basics and you will need to add the mechanize module to rerun the script once it is created in your chosen directory.

Here is the script I completed in about 16 minutes beginning with http-recorder and going into adding www::mechanize. There are a couple of caveats with using http-recorder it doesn't record java-script very well and you will not be able to record sites that use any type of heavy encryption like a banking site etc.... You must enter the ssl site into the control panel before bringing it up and recording your session.

#!/usr/bin/perl -w
use strict;
use WWW::Mechanize;
use Test::More qw(no_plan);
my $agent = WWW::Mechanize->new();
my $ccm_http_value;
my $monitoring_ccm;
$agent->get('https://somesite/login');
$agent->form_name('loginForm');
$agent->field('loginForm:loginBody:Password', 'passXXXXX');
$agent->field('Username', 'XXXXXX');
$agent->click('login');

$ccm_http_value = $agent->get('https://somesite');
if($ccm_http_value->is_success){
      print "Successfully logged into ccm: $ccm_http_value \n";
      #print $ccm_http_value->content;

      print "Getting monitoring link at this time. \n";
    $monitoring_ccm = $agent->get('https://somesite');
   if($monitoring_ccm->is_success){
      print "Validation completed successfully logged into monitoring:  $monitoring_ccm ";
     # print $monitoring_ccm->content;
 
    } else {
            print STDERR $monitoring_ccm->status_line, "\n";
     
    } 
 }
    else {
        print STDERR $ccm_http_value->status_line, "\n";      
      }

Really good links directly from the CPAN http:recorder module below helped me as well.

More information

You can read more about HTTP::Recorder, including browsing the current source tree, at http://www.bitmistress.org/.

There's a mailing list for users and developers of HTTP::Recorder. You can subscribe at http://lists.fsck.com/mailman/listinfo/http-recorder, or by sending email to http-recorder-request@lists.fsck.com with the subject "subscribe".

Mailing list archives can be found at http://lists.fsck.com/pipermail/http-recorder.

 

Beginning Perl (free) - www.perl.org

Beginning Perl (free)

www.perl.org

• Home
• Learn
• Documentation
• CPAN
• Community
• Get Involved
• About Perl
• Download

 

by Simon Cozens

Introduction ⇩

Chapter 1: First Steps In Perl ⇩

Chapter 2: Working with Simple Values ⇩

Chapter 3: Lists and Hashes ⇩

Chapter 4: Loops and Decisions ⇩

Chapter 5: Regular Expressions ⇩

Chapter 6: Files and Data ⇩

Chapter 7: References ⇩

Chapter 8: Subroutines ⇩

Chapter 9: Running and Debugging Perl ⇩

Chapter 10: Modules ⇩

Chapter 11: Object-Oriented Perl ⇩

Chapter 12: Introduction to CGI ⇩

Chapter 13: Perl and Databases ⇩

Chapter 14: The World of Perl ⇩

Appendix A: Regular Expressions ⇩

Appendix B: Special Variables ⇩

Appendix C: Function Reference ⇩

Appendix D: The Perl Standard Modules ⇩

Appendix E: Command Line Reference ⇩

Appendix F: The ASCII Character Set ⇩

Appendix G: Licenses ⇩

Appendix H: Solutions to Exercises ⇩

Appendix J: Support, Errata and P2P.Wrox.Com ⇩

Index ⇩

Code Examples (Zip Format) ⇩

Code Examples (tar.gz Format) ⇩

Buy This Book: Amazon.com - Amazon UK - Powells

What does this book cover?

• Installing Perl on Windows and UNIX
• Making use of online Perl resources like CPAN
• First principles in programming and the Perl syntax
• Working with files and databases
• Writing web pages in Perl
• Using Perl as an object-oriented language

Book overview

Perl is a well-established programming language that has been developed through the time and effort of countless free software programmers into an immensely powerful tool that can be used on pratically every operating system in the world. Perl started out as the "Swiss army knife" of computer languages and was used primarily by system administrators, but over time it's grown into an immensely robust language used by web-developers and programmers worldwide. It's also a great way to learn programming techniques and develop your own style of coding.

"There's more than one way to do it" is the motto of Perl, but this book aims to take you through them all. We'll take you from installation, through the core language elements - regular expressions, references, modules and the like - and onto basic applied techniques. You'll see how to access and work with databases in Perl, write CGI scripts to generate web pages and beyond. Coverage is bang up to date, using Perl 5.6 in all our examples and there's a handy reference section in the back.

Who is this book for?

This book is for those new to programming who want to learn with Perl. You will find it easier if you already have some basic programming experience, but the material covered can be mastered by anyone with just a text editor, some common sense and a computer. If you want to learn how to program with Perl and then find out how far you can go with it, this is the book for you. An excellent companion on any programming course.

Starting points

Free online books

Books and More

learn.perl.org

Presentations

Related sites

Learn

Perldoc

FAQ

Books

Where next?

Download

Documentation

Community