Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Flexcopy

by zeroquo (Novice)
on May 21, 2002 at 12:48 UTC ( #168102=sourcecode: print w/ replies, xml ) Need Help??

Category: Win32 Stuff
Author/Contact Info Oscar Alarcon R.
Description: Flexcopy is a Cluster Service Script, for replicate a simple directory content to 2 recipient, enabling cascade arquitecture on network down.
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}
.

Comment on Flexcopy
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://168102]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2014-09-18 23:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (126 votes), past polls