Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help?? 
package PerlSvc;

$Name        = 'Flexcopy';
$DisplayName = 'Cluster Archive Service by ZeroQuo';

sub Startup {
    my(%param) = &main::init();
    &main::Event_Log("Inicio de Ciclo");
    while(ContinueRun()) {
           &main::Flex_Svc(%param);
    sleep($param{wait});
    }
    &main::Event_Log("Fin de Ciclo");
}
sub Install {
    print "\nService are Installed\n";
}

sub Remove {
    print "\nService are Removed\n";
}

sub Help {
    print "\nPlease consult with System Programer\n\n";
    print "Martin Battiston\n";
    print "Oscar Alarcon Rodriguez\n";
}

package main;

use File::Copy;
use File::Basename;
use Net::SMTP;
use Net::Domain qw(hostname hostfqdn hostdomain);
use Time::localtime;
use Win32::EventLog;
use Win32::EventLog::Message;

my $src = "";
my $prd = "";
my $bkp = "";
my $ndw = "";

sub Flex_Svc {
    &main::Debuging("Inicio de Ciclo") if (uc($param{debug}) eq "Y");
    my(%param)  = (@_);
    if(uc($param{readpar}) eq "Y"){
           (%param)=&main::init();
           &main::Debuging("Lectura forzada de Parametros") if(uc($par
+am{debug}) eq "Y");
           &main::proces(%param);
    }else{
           &main::proces(%param);
    }
}

sub init {
    open(CFG, "< c:\\flexcopy\\flexcopy.ini") || &main::Event_Log("Err
+or en acceso a archivo de configuración");
    while(<CFG>){
           chomp($_);
           if(!($_ =~ /\[/)){
                 if(!($_ =~ /\#/)){
                       my($key, $content)=split(/=/, $_);
                       if($key){
                           $param{$key}=$content;
                       }
                 }
           }
    }
    close(CFG);
    if (!$param{error_class}){
        if (!$param{mailhost}){
            &main::Event_Log("Error en archivo de parametros");
            print "Error in CFG file\nPlease consult MANIFEST.TXT\n";
            exit;
        }
        if (!$param{admin_mail}){
            &main::Event_Log("Error en archivo de parametros");
            print "Error in CFG file\nPlease consult MANIFEST.TXT\n";
            exit;
        }
    }else{
        if (lc($param{error_class}) eq "default"){
            if (!$param{mailhost}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
            if (!$param{admin_mail}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
    }elsif(lc($param{error_class}) eq "tivoli"){
            if (!$param{tivoli_host}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
            if (!$param{tivoli_aplicacion}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
            if (!$param{tivoli_instancia}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
            if (!$param{tivoli_clase}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
            if (!$param{tivoli_source}){
                &main::Event_Log("Error en archivo de parametros");
                print "Error in CFG file\nPlease consult MANIFEST.TXT\
+n";
                exit;
            }
      }else{
           &main::Event_Log("Error en archivo de parametros");
           print "Error in CFG file\nPlease consult MANIFEST.TXT\n";
           exit;
      }
      }
      if(!$param{readpar}){
           $param{readpar} = "Y";
      }
      if(!$param{debug}){
           $param{debug} = "N";
      }
      $param{hostname}=hostname();
      &main::logging(%param);
      return(%param);
}

sub logging {
      my(%param) = (@_);
      &main::Debuging("Generacion de Log") if (uc($param{debug}) eq "Y
+");
      if(uc($param{log}) eq "Y"){
            open(LOG, ">$param{log_name}");
            print LOG "Cluster Archive Service 1.0\n";
            print LOG "Realizado por Arquitectura Tecnologica - Banco 
+Rio.\n";
            print LOG "-----------------------------------------------
+----\n\n";
            print LOG "".ctime()."\n";
            print LOG "for $param{tailn} tails\n";
            print LOG "Wait Time       = $param{wait} seg.\n\n";
            print LOG "Logging...\n";
            print LOG "-----------------------------------------------
+---------------------------------------------------------------------
+------------------------------------------------------------------\n"
+;
            print LOG "Archive:                 Fecha:                
+          Accion:                         Origen:                    
+     Destino:                        Hostname:\n";
            print LOG "-----------------------------------------------
+---------------------------------------------------------------------
+------------------------------------------------------------------\n"
+;
            close(LOG);
      }
      return();
}

sub proces {
      my(%param) = (@_);
      &main::Debuging("Inicio de rutina Proceso") if (uc($param{debug}
+) eq "Y");
      open(LOG, ">> $param{log_name}");
      my $tail = 1;
      while ($tail < ($param{tailn}+1)){
            $src = "src_tail_".$tail;
            $prd = "prd_tail_".$tail;
            $bkp = "bkp_tail_".$tail;
            $ndw = "ndw_tail_".$tail;
            opendir(DIR, $param{$ndw}) || &main::Event_Log("Error en a
+cceso a Cola NDW") | exit;
            &main::Debuging("Lectura de Cola de NDW ".$param{$ndw}) if
+ (uc($param{debug}) eq "Y");
            foreach (readdir(DIR)){
                  chomp($_);
                  if($_){
                        if($_ eq "."){
                        }elsif($_ eq ".."){
                        }else{
                              &main::Debuging("Llamada a rutina replic
+a con parametro ".$_) if (uc($param{debug}) eq "Y");
                              &main::replica($_);
                        }
                  }
            }
            closedir DIR;
            opendir(DIR, $param{$src}) || &main::Event_Log("Error en a
+cceso a Cola SRC") | exit;
            &main::Debuging("Lectura de Cola de SRC ".$param{$src}) if
+ (uc($param{debug}) eq "Y");
            foreach (readdir(DIR)){
                  chomp($_);
                  if($_){
                        if($_ eq "."){
                        }elsif($_ eq ".."){
                        }else{
                              &main::Debuging("Llamada a rutina master
+ con parametro ".$_) if (uc($param{debug}) eq "Y");
                              &main::master($_);
                        }
                  }
            }
            closedir DIR;
            $tail = $tail + 1;
      }
      close(LOG);
      return();
}
sub master {
      my ($file)     = (@_);
      &main::Debuging("Inicio de rutina master con parametro ".$file) 
+if (uc($param{debug}) eq "Y");
      my $control_fx = 0;
      my $origen     = $param{$src};
      my $destino    = $param{$prd};
      my $accion     = "COPY";
      my ($fecha)    = &main::fecha_log();
      write(LOG) if(uc($param{log}) eq "Y");
      my $source     = $param{$src}."\\".$file;
      &main::Debuging("Generacion de parametro Source ".$source) if (u
+c($param{debug}) eq "Y");
      if (-e $param{$prd}){
            &main::Debuging("Copiando ".$source." a ".$param{$prd}) if
+ (uc($param{debug}) eq "Y");
            copy($source,$param{$prd}) or $control_fx=1;
      }
      my $contador = 0;
      while ($control_fx eq 1){
            $control_fx = 0;
            &main::Error_msg("1");
            $wait_error = ($param{wait}/2);
            sleep($wait_error);
            &main::Debuging("Copiando ".$source." a ".$param{$prd}) if
+ (uc($param{debug}) eq "Y");
            copy($source,$param{$prd}) or $control_fx=1;
            $contador = ++$contador;
            if ($contador eq 11){
                  return();
            }
      }
      $origen  = $param{$src};
      $destino = $param{$bkp};
      $accion  = "COPY";
      ($fecha)=&main::fecha_log();
      write(LOG) if(uc($param{log}) eq "Y");
      if (-e $param{$bkp}){
            $control_fx = 0;
            &main::Debuging("Copiando ".$source." a ".$param{$bkp}) if
+ (uc($param{debug}) eq "Y");
            copy($source,$param{$bkp}) or $control_fx=1;
      }
      if ($control_fx eq 0){
            $origen  = $param{$src};
            $destino = "";
            $accion  = "REMOVE";
            ($fecha)=&main::fecha_log();
            write(LOG) if(uc($param{log}) eq "Y");
            &main::Debuging("Borrando ".$source) if (uc($param{debug})
+ eq "Y");
            unlink($source);
      }else{
            &main::Error_msg("2");
            $origen  = $param{$src};
            $destino = $param{$nwd};
            $accion  = "COPY";
            ($fecha)=&main::fecha_log();
            write(LOG) if(uc($param{log}) eq "Y");
            &main::Debuging("Moviendo ".$source." a ".$param{$ndw}) if
+ (uc($param{debug}) eq "Y");
            move($source,$param{$ndw});
      }
      return();
}
sub replica {
      my ($file)=(@_);
      &main::Debuging("Inicio de rutina replica con parametros ".$file
+) if (uc($param{debug}) eq "Y");
      my $source  = $param{$ndw}."\\".$file;
      &main::Debuging("Generacion de parametro Source ".$source) if (u
+c($param{debug}) eq "Y");
      my $origen  = $param{$nwd};
      my $destino = $param{$bkp};
      my $accion  = "COPY";
      my($fecha)  = &main::fecha_log();
      write(LOG) if(uc($param{log}) eq "Y");
      my $control_fx = 0;
      if (-e $param{$bkp}){
            &main::Debuging("Copiando ".$source." a ".$param{$bkp}) if
+ (uc($param{debug}) eq "Y");
            copy($source,$param{$bkp}) or $control_fx=1;
      }
      if ($control_fx eq 0){
            $origen  = $param{$src};
            $destino = "";
            $accion  = "REMOVE";
            ($fecha)=&main::fecha_log();
            write(LOG) if(uc($param{log}) eq "Y");
            &main::Debuging("Borrando ".$source) if (uc($param{debug})
+ eq "Y");
            unlink($source);
      }else{
            &main::Error_msg("3");
            $origen  = $param{$src};
            $destino = $param{$ndw};
            $accion  = "MOVE";
            ($fecha)=&main::fecha_log();
            write(LOG) if(uc($param{log}) eq "Y");
            &main::Debuging("Moviendo ".$source." a ".$param{$ndw}) if
+ (uc($param{debug}) eq "Y");
            move($source,$param{$ndw});
      }
      return();
}
sub fecha_log {
      my ($wday, $hour, $min, $sec, $year,$mon, $mday)=(localtime->wda
+y, localtime->hour, localtime->min, localtime->sec, localtime->year+1
+900,localtime->mon+1,localtime->mday);
      my $out = sprintf "%02.0f\/%02.0f\/%0004.0f %02.0f\:%02.0f\:%02.
+0f",$mday,$mon,$year,$hour,$min,$sec;
      return($out);
}
sub Error_msg {
      my $message  = "";
      my $status = "";
      if (!$param{ermsg_host}){
            $param{ermsg_host} = "localhost";
      }else{
            $param{ermsg_host} = lc($param{ermsg_host});
      }
      if (!$param{error_class}){
            $param{error_class} = "default";
      }else{
            $param{error_class} = lc($param{error_class});
      }
      if (!$param{ermsg_warning1}){
            $param{ermsg_warning1} = "Warning in Copy to BKP";
      }else{
            $param{ermsg_warning1} = lc($param{ermsg_warning1});
      }
      if (!$param{ermsg_warning2}){
            $param{ermsg_warning2} = "Warning in Copy to BKP over";
      }else{
            $param{ermsg_warning2} = lc($param{ermsg_warning2});
      }
      if (!$param{ermsg_critical}){
            $param{ermsg_critical} = "Critical in Copy to PRD";
      }else{
            $param{ermsg_critical} = lc($param{ermsg_critical});
      }
      if ($_[0] eq 1){
            $message = $param{ermsg_critical};
            $status = "CRITICAL";
      }elsif($_[0] eq 2){
            $message = $param{ermsg_warning2};
            $status = "HARMLESS";
      }elsif($_[0] eq 3){
            $message = $param{ermsg_warning1};
            $status = "HARMLESS";
      }
      if ($param{error_class} eq "default"){
            &main::Event_Log("Envio de mail a Administrador");
            my $smtp = Net::SMTP->new($param{mailhost});
            $smtp->mail("Flexcopy");
            $smtp->to($param{admin_mail});
            $smtp->data();
            $smtp->datasend("To: $param{admin_mail}\n");
            $smtp->datasend("\n");
            $smtp->datasend($message."\n");
            $smtp->dataend();
            $smtp->quit;
      }elsif ($param{error_class} eq "tivoli"){
            &main::Event_Log("Envio de mensaje a Tivoli");
            my $tivmsg = "postemsg -S $param{tivoli_host} -r $status -
+m \"".$message."\" hostname=$param{hostname} aplicacion=$param{tivoli
+_aplicacion} instancia=$param{tivoli_instancia} $param{tivoli_clase} 
+$param{tivoli_source}";
            system($tivmsg);
      }
      return();
}
sub Event_Log {
      &main::Debuging("Generacion de Evento en EventLog ".$_[0]) if (u
+c($param{debug}) eq "Y");
      my $PerlSource = "Flexcopy Agent";
      my $SourceLog  = "Application";
      Win32::EventLog::Message::RegisterSource( $SourceLog, $PerlSourc
+e );
      my $Event = Win32::EventLog->new( $SourceLog ) || die;
      my $Result = $Event->Report(
              {
              "Computer"     =>         $ENV{computername},
              "Source"       =>         $PerlSource,
              "EventType"    =>         'EVENTLOG_SUCCESS_TYPE',
              "EventID"      =>         'EVENT_ID',
              "Strings"      =>         $_[0],
              }
              );
      return();
}
sub Debuging {
      my ($message) = (@_);
      open(DBG, ">> c:\\flexcopy\\flexsvc.dbg");
      print DBG "$message\n";
      close(DBG);
      return();
}

format LOG =
@<<<<<<<<<<<<<<<<<<<<<   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<   ^<<<<<<<<<<<<
+<<<<<<<<<<<<<<<<   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<   ^<<<<<<<<<<<<<<<<<
+<<<<<<<<<<<   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$file,$fecha,$accion,$origen,$destino,$param{hostname}
.

[download]

In reply to Flexcopy by zeroquo

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2024-04-25 23:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found