Package declaration

package mkdefault;
use strict;
use warnings;
use Data::Dumper;
use File::Basename;
#use experimental 'smartmatch';
use vars qw(%GLOB $dbh %ENV $curdate1 $curdate2 $AUTOLOAD $name);
use DBI;
use POSIX qw(strftime);
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(is_array is_hash is_nan %GLOB);
$GLOB{out_date_pattern}='%Y-%m-%d';
$GLOB{out_datetime_pattern}='%Y-%m-%d %H:%M:%S';
$GLOB{DB_date_format}='yyyy-mm-dd hh:mm:ss';
$GLOB{Display_date_pattern}='%Y-%m-%d %H:%M:%S';

Package creation

sub new {
    my $curdate1=strftime "%Y-%m-%d", localtime;
    my $curdate2=strftime "%F %r %Z(%z)", localtime;
    my $current_dir=dirname(__FILE__);
    my $class = shift;
    my $self = bless {}, $class;
    my %hash = @_;
    my $config_file="mt_requests.config";
    if (exists($hash{config_file})) {
        $config_file=$hash{config_file};
        require $current_dir."/var/".$config_file;
    }
    $self->{config_file}=$config_file;
    $GLOB{settings}{error_log}=exists($hash{error_log})?$hash{error_log}:'/var/logs';
    my $error_log_file=$GLOB{settings}{error_log}."/error.";
    if (exists($hash{script})) {
        $error_log_file.=$hash{script}.".";
    }
    $error_log_file.=$curdate1.".log";
    $GLOB{current_execiton_script}=$hash{script};
    #open(STDOUT, ">>", $error_log_file) or die "Can't open log";
    #open(STDERR, ">>", $error_log_file) or die "Can't open log";
    my $process_id=&creatprocessId();
    print STDOUT "\n\n\n************************************  $curdate2  ***************************************** --- START\n\n\n";
    print STDOUT "Process # : ".$process_id."\n";
    $self->_initialize(@_);
    $self->{process_id}=$process_id;
    $self->{process_time}=$curdate2;
    $self->{error_log_file}=$error_log_file;
    return $self;
}

Package Initialization

sub _initialize {
    my $self = shift;
    my %hash = @_;
    $self->{host} = $GLOB{db}{hostname};
    $self->{port} = $GLOB{db}{port};
    $self->{username} = $GLOB{db}{username};
    $self->{password} = $GLOB{db}{password};
    $self->{dbname} = $GLOB{db}{name};
    if (exists($hash{host})) {
        $self->{host} = $hash{host};
    }
    if (exists($hash{port})) {
        $self->{port} = $hash{port};
    }
    if (exists($hash{username})) {
        $self->{username} = $hash{username};
    }
    if (exists($hash{password})) {
        $self->{password} = $hash{password};
    }
    if (exists($hash{dbname})) {
        $self->{dbname} = $hash{dbname};
    }
}

DataBase Connection

sub getDBConnection {
    my $self = shift;
    my %hash = @_;
    if (exists($hash{host})) {
        $self->{host} = $hash{host};
    }
    if (exists($hash{port})) {
        $self->{port} = $hash{port};
    }
    if (exists($hash{username})) {
        $self->{username} = $hash{username};
    }
    if (exists($hash{password})) {
        $self->{password} = $hash{password};
    }
    if (exists($hash{dbname})) {
        $self->{dbname} = $hash{dbname};
    }
    my $extra .= "host=$self->{host};" if $self->{host};
    $extra .= "port=$self->{port};" if $self->{port};
    my $temp_dbh = DBI->connect("DBI:mysql:database=$self->{dbname};$extra", $self->{username}, $self->{password},{AutoCommit => 1});
    if(!$temp_dbh){
        $self->printFatalError("head"=>"MySql Error","message"=>qq{MySQL Connection Error to host }.$self->{host}.qq{. Database Connection Failed. DB Name :-}.$self->{dbname}.qq{.});
    }
    $temp_dbh->{HandleError} = sub {
        my ($errmsg, $h) = @_;
        $self->printFatalError("head"=>qq{MySQL Error},"message"=>$errmsg.qq{. DB Name :-$GLOB{db}{name}. --- }.$self->{process_id}."--".$self->{host}."--".$self->{username});
    };
    return ($temp_dbh);
}

Print Fata Error

sub printFatalError {
    my $self = shift;
    my %hash = @_;
    my($heading,$message) = ($hash{head},$hash{message});
    print STDERR qq{FatalError --> $heading :- $message\n};
    exit(1);
}

Print Normal Error

sub printError {
    my $self = shift;
    my %hash = @_;
    my($heading,$message) = ($hash{head},$hash{message});
    print STDERR qq{Error --> $heading :- $message\n};
    return 0;
}

Print Warning

sub printWarning {
    my $self = shift;
    my %hash = @_;
    my($heading,$message) = ($hash{head},$hash{message});
    print STDERR qq{Warning --> $heading :- $message\n};
    return 1;
}

Print Output

sub printOutput {
    my $self = shift;
    my %hash = @_;
    my($heading,$message) = ($hash{head},$hash{message});
    print STDOUT qq{Output --> $heading :- $message\n};
    return 1;
}

Print Information

sub printInfo {
    my $self = shift;
    my %hash = @_;
    my($heading,$message) = ($hash{head},$hash{message});
    print STDOUT qq{Info --> $heading :- $message\n};
    return 1;
}

Mail sending function (support text and file sending)

sub mailSender {
    use Mail::Sender;
    my $self = shift;
    my %hash = @_;
    my ($from,$to,$cc,$bcc,$subject,$body)=($hash{from},$hash{to},$hash{cc},$hash{bcc},$hash{subject},$hash{body});
    my $smtphost=$hash{smtpserver};
    if (exists($hash{from})) {
        $from = $hash{from};
    }
    $hash{ctype}=(exists($hash{ctype}) && $hash{ctype} ne '')?$hash{ctype}:'text/html; charset=us-ascii';
    my $sender = new Mail::Sender{
        smtp        =>  $smtphost,
        from        =>  $from,
        on_errors   =>  'code'
    };
    $Mail::Sender::NO_X_MAILER = 1;
    if(defined($hash{file}) && $hash{file} ne '') {
        $sender->OpenMultipart({
            to          =>  $to,
            cc          =>  $cc,
            bcc         =>  $bcc,
            subject     =>  $subject,
            headers     =>  "X-Mailer: MK Mailer\nX-Sender: manu.co.in",
        }) or return $self->printError("head"=>"Mail Send Status","message"=>"Cannot send mail: $Mail::Sender::Error");
        my @temp_file=split(',',$hash{file});
        my @temp_file_name=split(',',$hash{file_name});
        $sender->Body({charset => 'US-ASCII',encoding => 'utf8',ctype => $hash{ctype},msg=>$body."\n"});
        for(my $a=0;$a<=$#temp_file;$a++) { $sender->Attach({
                description => $hash{description},
                ctype => 'application/octet-stream',
                encoding => 'Base64',
                disposition => 'attachment; filename="'.$temp_file_name[$a].'"',
                file => $temp_file[$a]
            });
            
        }
        $sender->Close();
    } else {
        my %mail_data=(
            ctype       =>  $hash{ctype},
            headers     =>  "X-Mailer: MK Mailer\nX-Sender: manu.co.in",
            to          =>  $to,
            cc          =>  $cc,
            bcc         =>  $bcc,
            subject     =>  $subject,
            msg         =>  $body
        );
        if(ref $sender->MailMsg(\%mail_data)) {
            return $self->printInfo("head"=>"Mail Send Status","message"=>"success");
        } else {
            return $self->printError("head"=>"Mail Send Status","message"=>"Cannot send mail: $Mail::Sender::Error");
        }
    }
}

Process id genearator

sub creatprocessId {
    my $processId=time();
    $processId.="-".int(rand(99999));
    return $processId;
}

To check whether it is an array

sub is_array {
    my $self = shift;
    my ($ref) = @_;
    return 0 unless ref $ref;
    eval {
        my $a = @$ref;
    };
    if ($@=~/^Not an ARRAY reference/) {
        return 0;
    } elsif ($@) {
        return 0;
    } else {
        return 1;
    }
}

To check whether it is a hash

sub is_hash {
    my $self = shift;
    my $ref = @_;
    return 0 unless ref $ref;
    if ( $ref =~ /^HASH/ )
    {
        return 1;
    }
    else {
        return 0;
    }
}

To check whether it is not a number

sub is_nan {
    my $self = shift;
    use Scalar::Util qw(looks_like_number);
    my ($value) = @_;
    
    if( looks_like_number($value) ) {
        return 0;
    } else {
        return 1;
    }
}

To check whether it is a text

sub text_validator {
    my $self = shift;
    my %hash = @_;
    if($hash{value} && $hash{value} ne '') {
        return $hash{value};
    } else {
        return 0;
    }
}

To check whether it is a valid date

sub date_validator {
    my $self = shift;
    my %hash = @_;
    if($hash{in_pattern} && $hash{in_pattern} ne '' && $hash{out_pattern} && $hash{out_pattern} ne '' && $hash{value} && $hash{value} ne '') {
        use DateTime::Format::Strptime;
        use Date::Parse;
        my $strp = DateTime::Format::Strptime->new(pattern=>$hash{in_pattern},on_error=>'undef');
        my $dt = $strp->parse_datetime($hash{value});
        if(!$dt) {
            return 0;
        } else {
            $strp->pattern($hash{out_pattern});
            return $strp->format_datetime($dt);
        }
    } else {
        return 0;
    }
}

Function which should load when an unknown subroutine is called

sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self) || croak("$self is not an object");
    my $field = $AUTOLOAD;
    $field =~ s/.*://;
    my $error_log_file=$self->{error_log_file};
    my $process_id=$self->{process_id};
    my $process_time=$self->{process_time};
    my $temp='';
    my $temp1='';
    unless (exists $self->{$field}) {
        $temp="$field does not exist in object/class $type";
    }
    print STDERR "Error --> AUTOLOAD : ".$temp."\n";
    exit(1);
}
sub DESTROY {
    my $curdate3=strftime "%F %r %Z(%z)", localtime;
    print STDOUT "\n************************************  $curdate3  ***************************************** --- END\n\n\n";
}
1;

POD in perl

__END__

=head1 NAME

mkdefault - Master configuration and common function file

=head1 DESCRIPTION

This file is used to set some configuration and common functions used in CMS client files.

=head1 SYNOPSIS

    use mkdefault;
    my $dbconnect=mkdefault->new(host => $dbhostname, port => $dbport, username => $dbusername, password => $dbpassword);
    my $dbh=$dbconnect->getDBConnection(dbname=>$dbname);

OR

    use mkdefault;
    my $dbconnect=mkdefault->new(); * Here the host, prot, username and password will be taken from mt_requests.config file
    *$GLOB{settings}{db}{hostname};
    *$GLOB{settings}{db}{port};
    *$GLOB{settings}{db}{username};
    *$GLOB{settings}{db}{password};
    my $dbh=$dbconnect->getDBConnection(dbname=>$dbname); * Here dbname will be taken from the config file(if any)
    *$GLOB{settings}{db}{name};