diff --git a/ConnectorPool.pm b/ConnectorPool.pm index 534e59d2..03d1fa78 100644 --- a/ConnectorPool.pm +++ b/ConnectorPool.pm @@ -22,6 +22,7 @@ use Globals qw( $ngcprestapi_uri $ngcprestapi_username $ngcprestapi_password + $ngcprestapi_realm ); @@ -36,6 +37,7 @@ use SqlConnectors::MySQLDB; # cleanupdbfiles); use SqlConnectors::CSVDB; #use SqlConnectors::SQLServerDB; +use RestConnectors::NGCPRestApi; use SqlRecord qw(cleartableinfo); @@ -126,7 +128,7 @@ sub get_ngcp_restapi { my ($instance_name) = @_; my $name = _get_connectorinstancename($instance_name); if (!defined $ngcp_restapis->{$name}) { - $ngcp_restapis->{$name} = RestConnectors::NGCPRestApi->new($instance_name,$ngcprestapi_uri,$ngcprestapi_username,$ngcprestapi_password); + $ngcp_restapis->{$name} = RestConnectors::NGCPRestApi->new($instance_name,$ngcprestapi_uri,$ngcprestapi_username,$ngcprestapi_password,$ngcprestapi_realm); } return $ngcp_restapis->{$name}; diff --git a/FileProcessor.pm b/FileProcessor.pm new file mode 100644 index 00000000..ff701e35 --- /dev/null +++ b/FileProcessor.pm @@ -0,0 +1,494 @@ +package FileProcessor; +use strict; + +## no critic + +use threads qw(yield); +use threads::shared; +use Thread::Queue; + +use Time::HiRes qw(sleep); + +use Globals qw( + $enablemultithreading + $cpucount +); +use Logging qw( + getlogger + filethreadingdebug + fileprocessingstarted + fileprocessingdone + fetching_lines + processing_lines +); + + +# fetching_rows +# writing_rows +# processing_rows + +use LogError qw( + processzerofilesize + fileprocessingfailed + fileerror + notimplementederror +); + +use Utils qw(threadid); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(); + +my $thread_sleep_secs = 0.1; + +my $RUNNING = 1; +my $COMPLETED = 2; +my $ERROR = 4; + +sub new { + + my $class = shift; + my $self = bless {}, $class; + + $self->{encoding} = undef; + $self->{buffersize} = undef; + $self->{threadqueuelength} = undef; + $self->{numofthreads} = undef; + #$self->{multithreading} = undef; + $self->{blocksize} = undef; + + $self->{line_separator} = undef; + + return $self; + +} + +sub init_reader_context { + + my $self = shift; + my ($context) = @_; + # init stuff available to the reader loop + # invoked after thread was forked, as + # required by e.g. Marpa R2 + +} + +sub _extractlines { + my ($context,$buffer_ref,$lines) = @_; + my $separator = $context->{instance}->{line_separator}; + my $last_line; + foreach my $line (split(/$separator/,$$buffer_ref,-1)) { + $last_line = $line; + push(@$lines,$line); + } + #$count--; + $$buffer_ref = $last_line; + pop @$lines; + + return 1; +} + +sub process { + + my $self = shift; + + my ($file,$process_code,$init_process_context_code,$multithreading) = @_; + + if (ref $process_code eq 'CODE') { + + if (-s $file > 0) { + fileprocessingstarted($file,getlogger(__PACKAGE__)); + } else { + processzerofilesize($file,getlogger(__PACKAGE__)); + return; + } + + my $errorstate = $RUNNING; + my $tid = threadid(); + + if ($enablemultithreading and $multithreading and $cpucount > 1) { # and $multithreaded) { # definitely no multithreading when CSVDB is involved + + my $reader; + my %processors = (); + my %errorstates :shared = (); + my $queue = Thread::Queue->new(); + + filethreadingdebug('starting reader thread',getlogger(__PACKAGE__)); + + $reader = threads->create(\&_reader, + { queue => $queue, + errorstates => \%errorstates, + instance => $self, + filename => $file, + }); + + for (my $i = 0; $i < $self->{numofthreads}; $i++) { + filethreadingdebug('starting processor thread ' . ($i + 1) . ' of ' . $self->{numofthreads},getlogger(__PACKAGE__)); + my $processor = threads->create(\&_process, + { queue => $queue, + errorstates => \%errorstates, + readertid => $reader->tid(), + filename => $file, + process_code => $process_code, + init_process_context_code => $init_process_context_code, + instance => $self, + }); + if (!defined $processor) { + filethreadingdebug('processor thread ' . ($i + 1) . ' of ' . $self->{numofthreads} . ' NOT started',getlogger(__PACKAGE__)); + } + $processors{$processor->tid()} = $processor; + } + + $reader->join(); + filethreadingdebug('reader thread joined',getlogger(__PACKAGE__)); + while ((scalar keys %processors) > 0) { + foreach my $processor (values %processors) { + if (defined $processor and $processor->is_joinable()) { + $processor->join(); + delete $processors{$processor->tid()}; + filethreadingdebug('processor thread tid ' . $processor->tid() . ' joined',getlogger(__PACKAGE__)); + } + } + sleep($thread_sleep_secs); + } + + $errorstate = (_get_other_threads_state(\%errorstates,$tid) & ~$RUNNING); + + } else { + + my $context = { instance => $self, + filename => $file,}; + my $rowblock_result = 1; + eval { + + my $init_reader_context_code = $self->can('init_reader_context'); + if (defined $init_reader_context_code) { + &$init_reader_context_code($self,$context); + } + if ('CODE' eq ref $init_process_context_code) { + &$init_process_context_code($context); + } + my $extractlines_code = (ref $self)->can('extractlines'); + if (!defined $extractlines_code) { + if (defined $self->{line_separator}) { + $extractlines_code = \&_extractlines; + } else { + notimplementederror((ref $self) . ': ' . 'extractlines class method not implemented and line separator pattern not defined',getlogger(__PACKAGE__)); + } + } + my $extractfields_code = (ref $self)->can('extractfields'); + if (!defined $extractfields_code) { + notimplementederror((ref $self) . ': ' . 'extractfields class method not implemented',getlogger(__PACKAGE__)); + } + + local *INPUTFILE; + if (not open (INPUTFILE, '<:encoding(' . $self->{encoding} . ')', $file)) { + fileerror('processing file - cannot open file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); + return; + } + binmode INPUTFILE; + + my $buffer = undef; + my $chunk = undef; + my $n = 0; + $context->{charsread} = 0; + $context->{linesread} = 0; + + my $i = 0; + while (1) { + fetching_lines($file,$i,$self->{blocksize},getlogger(__PACKAGE__)); + my @lines = (); + while ((scalar @lines) < $self->{blocksize} and defined ($n = read(INPUTFILE,$chunk,$self->{buffersize})) and $n != 0) { + if (defined $buffer) { + $buffer .= $chunk; + } else { + $buffer = $chunk; + } + $context->{charsread} += $n; + last unless &$extractlines_code($context,\$buffer,\@lines); + } + + if (not defined $n) { + fileerror('processing file - error reading file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); + close(INPUTFILE); + last; + } else { + if ($n == 0 && defined $buffer) { + push(@lines,$buffer); + } + my @rowblock = (); + foreach my $line (@lines) { + $context->{linesread} += 1; + my $row = &$extractfields_code($context,\$line); + push(@rowblock,$row) if defined $row; + } + my $realblocksize = scalar @rowblock; + if ($realblocksize > 0) { + processing_lines($tid,$i,$realblocksize,getlogger(__PACKAGE__)); + #processing_rows($tid,$i,$realblocksize,$rowcount,getlogger(__PACKAGE__)); + + $rowblock_result = &$process_code($context,\@rowblock,$i); + + $i += $realblocksize; + if ($n == 0 || not $rowblock_result) { + last; + } + } else { + last; + } + } + } + close(INPUTFILE); + + }; + + if ($@) { + $errorstate = $ERROR; + } else { + $errorstate = (not $rowblock_result) ? $ERROR : $COMPLETED; + } + + } + + if ($errorstate == $COMPLETED) { + fileprocessingdone($file,getlogger(__PACKAGE__)); + return 1; + } else { + fileprocessingfailed($file,getlogger(__PACKAGE__)); + } + + } + + return 0; + +} + +sub _reader { + + my $context = shift; + + my $tid = threadid(); + { + lock $context->{errorstates}; + $context->{errorstates}->{$tid} = $RUNNING; + } + + filethreadingdebug('[' . $tid . '] reader thread tid ' . $tid . ' started',getlogger(__PACKAGE__)); + + my $blockcount = 0; + eval { + + my $init_reader_context_code = $context->{instance}->can('init_reader_context'); + if (defined $init_reader_context_code) { + &$init_reader_context_code($context->{instance},$context); + } + my $extractlines_code = (ref $context->{instance})->can('extractlines'); + if (!defined $extractlines_code) { + if (defined $context->{instance}->{line_separator}) { + $extractlines_code = \&_extractlines; + } else { + notimplementederror((ref $context->{instance}) . ': ' . 'extractlines class method not implemented and line separator pattern not defined',getlogger(__PACKAGE__)); + } + } + + my $extractfields_code = (ref $context->{instance})->can('extractfields'); + if (!defined $extractfields_code) { + notimplementederror((ref $context->{instance}) . ': ' . 'extractfields class method not implemented',getlogger(__PACKAGE__)); + } + + local *INPUTFILE_READER; + if (not open (INPUTFILE_READER, '<:encoding(' . $context->{instance}->{encoding} . ')', $context->{filename})) { + fileerror('processing file - cannot open file ' . $context->{filename} . ': ' . $!,getlogger(__PACKAGE__)); + return; + } + binmode INPUTFILE_READER; + + filethreadingdebug('[' . $tid . '] reader thread waiting for consumer threads',getlogger(__PACKAGE__)); + while ((_get_other_threads_state($context->{errorstates},$tid) & $RUNNING) == 0) { #wait on cosumers to come up + #yield(); + sleep($thread_sleep_secs); + } + + my $buffer = undef; + my $chunk = undef; + my $n = 0; + $context->{charsread} = 0; + $context->{linesread} = 0; + + my $i = 0; + my $state = $RUNNING; #start at first + while (($state & $RUNNING) == $RUNNING and ($state & $ERROR) == 0) { #as long there is one running consumer and no defunct consumer + fetching_lines($context->{filename},$i,$context->{instance}->{blocksize},getlogger(__PACKAGE__)); + my @lines = (); + while ((scalar @lines) < $context->{instance}->{blocksize} and defined ($n = read(INPUTFILE_READER,$chunk,$context->{instance}->{buffersize})) and $n != 0) { + if (defined $buffer) { + $buffer .= $chunk; + } else { + $buffer = $chunk; + } + $context->{charsread} += 1; + last unless &$extractlines_code($context,\$buffer,\@lines); + yield(); + } + if (not defined $n) { + fileerror('processing file - error reading file ' . $context->{filename} . ': ' . $!,getlogger(__PACKAGE__)); + close(INPUTFILE_READER); + last; + } else { + if ($n == 0 && defined $buffer) { + push(@lines,$buffer); + } + my @rowblock :shared = (); + foreach my $line (@lines) { + $context->{linesread} += 1; + my $row = &$extractfields_code($context,\$line); + push(@rowblock,shared_clone($row)) if defined $row; + yield(); + } + my $realblocksize = scalar @rowblock; + my %packet :shared = (); + $packet{rows} = \@rowblock; + $packet{size} = $realblocksize; + $packet{row_offset} = $i; + if ($realblocksize > 0) { + $context->{queue}->enqueue(\%packet); #$packet); + $blockcount++; + #wait if thequeue is full and there there is one running consumer + while (((($state = _get_other_threads_state($context->{errorstates},$tid)) & $RUNNING) == $RUNNING) and $context->{queue}->pending() >= $context->{instance}->{threadqueuelength}) { + #yield(); + sleep($thread_sleep_secs); + } + $i += $realblocksize; + if ($n == 0) { + filethreadingdebug('[' . $tid . '] reader thread is shutting down (end of data) ...',getlogger(__PACKAGE__)); + last; + } + } else { + $context->{queue}->enqueue(\%packet); #$packet); + filethreadingdebug('[' . $tid . '] reader thread is shutting down (end of data - empty block) ...',getlogger(__PACKAGE__)); + last; + } + } + } + if (not (($state & $RUNNING) == $RUNNING and ($state & $ERROR) == 0)) { + filethreadingdebug('[' . $tid . '] reader thread is shutting down (' . + (($state & $RUNNING) == $RUNNING ? 'still running consumer threads' : 'no running consumer threads') . ', ' . + (($state & $ERROR) == 0 ? 'no defunct thread(s)' : 'defunct thread(s)') . ') ...' + ,getlogger(__PACKAGE__)); + } + close(INPUTFILE_READER); + }; + + filethreadingdebug($@ ? '[' . $tid . '] reader thread error: ' . $@ : '[' . $tid . '] reader thread finished (' . $blockcount . ' blocks)',getlogger(__PACKAGE__)); + lock $context->{errorstates}; + if ($@) { + $context->{errorstates}->{$tid} = $ERROR; + } else { + $context->{errorstates}->{$tid} = $COMPLETED; + } + return $context->{errorstates}->{$tid}; +} + +sub _process { + + my $context = shift; + + my $rowblock_result = 1; + my $tid = threadid(); + { + lock $context->{errorstates}; + $context->{errorstates}->{$tid} = $RUNNING; + } + + filethreadingdebug('[' . $tid . '] processor thread tid ' . $tid . ' started',getlogger(__PACKAGE__)); + + my $blockcount = 0; + eval { + if ('CODE' eq ref $context->{init_process_context_code}) { + &{$context->{init_process_context_code}}($context); + } + while (not _get_stop_consumer_thread($context,$tid)) { + my $packet = $context->{queue}->dequeue_nb(); + if (defined $packet) { + if ($packet->{size} > 0) { + + processing_lines($tid,$packet->{row_offset},$packet->{size},getlogger(__PACKAGE__)); + + $rowblock_result = &{$context->{process_code}}($context, $packet->{rows},$packet->{row_offset}); + + $blockcount++; + + if (not $rowblock_result) { + filethreadingdebug('[' . $tid . '] shutting down processor thread (processing block NOK) ...',getlogger(__PACKAGE__)); + last; + } + + } else { + filethreadingdebug('[' . $tid . '] shutting down processor thread (end of data - empty block) ...',getlogger(__PACKAGE__)); + last; + } + } else { + #yield(); + sleep($thread_sleep_secs); #2015-01 + } + } + }; + filethreadingdebug($@ ? '[' . $tid . '] processor thread error: ' . $@ : '[' . $tid . '] processor thread finished (' . $blockcount . ' blocks)',getlogger(__PACKAGE__)); + lock $context->{errorstates}; + if ($@) { + $context->{errorstates}->{$tid} = $ERROR; + } else { + $context->{errorstates}->{$tid} = (not $rowblock_result) ? $ERROR : $COMPLETED; + } + return $context->{errorstates}->{$tid}; +} + +sub _get_other_threads_state { + my ($errorstates,$tid) = @_; + my $result = 0; + if (!defined $tid) { + $tid = threadid(); + } + if (defined $errorstates and ref $errorstates eq 'HASH') { + lock $errorstates; + foreach my $threadid (keys %$errorstates) { + if ($threadid != $tid) { + $result |= $errorstates->{$threadid}; + } + } + } + return $result; +} + +sub _get_stop_consumer_thread { + my ($context,$tid) = @_; + my $result = 1; + my $other_threads_state; + my $reader_state; + my $queuesize; + { + my $errorstates = $context->{errorstates}; + lock $errorstates; + $other_threads_state = _get_other_threads_state($errorstates,$tid); + $reader_state = $errorstates->{$context->{readertid}}; + } + $queuesize = $context->{queue}->pending(); + if (($other_threads_state & $ERROR) == 0 and ($queuesize > 0 or $reader_state == $RUNNING)) { + $result = 0; + #keep the consumer thread running if there is no defunct thread and queue is not empty or reader is still running + } + + if ($result) { + filethreadingdebug('[' . $tid . '] consumer thread is shutting down (' . + (($other_threads_state & $ERROR) == 0 ? 'no defunct thread(s)' : 'defunct thread(s)') . ', ' . + ($queuesize > 0 ? 'blocks pending' : 'no blocks pending') . ', ' . + ($reader_state == $RUNNING ? 'reader thread running' : 'reader thread not running') . ') ...' + ,getlogger(__PACKAGE__)); + } + + return $result; + +} + +1; diff --git a/FileProcessors/CSVFile.pm b/FileProcessors/CSVFile.pm new file mode 100644 index 00000000..7771ad77 --- /dev/null +++ b/FileProcessors/CSVFile.pm @@ -0,0 +1,64 @@ +package FileProcessors::CSVFile; +use strict; + +## no critic + +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); + +use Globals qw( + $cpucount +); + +use Logging qw( + getlogger +); + +use FileProcessor; + +require Exporter; +our @ISA = qw(Exporter FileProcessor); +our @EXPORT_OK = qw(); + +my $default_lineseparator = '\\n\\r|\\r|\\n'; +my $default_fieldseparator = ","; +my $default_encoding = 'UTF-8'; + +my $buffersize = 100 * 1024; +my $threadqueuelength = 10; +my $numofthreads = $cpucount; #3; +#my $multithreading = 0; +my $blocksize = 100; + +sub new { + + my $class = shift; + + my $self = FileProcessor->new(@_); + + $self->{line_separator} = shift // $default_lineseparator; + $self->{field_separator} = shift // $default_fieldseparator; + $self->{encoding} = shift // $default_encoding; + $self->{buffersize} = $buffersize; + $self->{threadqueuelength} = $threadqueuelength; + $self->{numofthreads} = $numofthreads; + #$self->{multithreading} = $multithreading; + $self->{blocksize} = $blocksize; + + bless($self,$class); + + #restdebug($self,__PACKAGE__ . ' file processor created',getlogger(__PACKAGE__)); + + return $self; + +} + +sub extractfields { + my ($context,$line_ref) = @_; + my $separator = $context->{instance}->{field_separator}; + my @fields = split(/$separator/,$$line_ref,-1); + return \@fields; +} + +1; diff --git a/Globals.pm b/Globals.pm index 71ca68df..51b737b7 100644 --- a/Globals.pm +++ b/Globals.pm @@ -12,9 +12,10 @@ use Time::HiRes qw(time); use Tie::IxHash; -use Cwd 'abs_path'; +use Cwd 'abs_path'; use File::Basename qw(dirname); use File::Temp qw(tempdir); +use FindBin qw(); use Utils qw( get_ipaddress @@ -27,21 +28,22 @@ use Utils qw( require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw( - $system_name - $system_version - $system_abbreviation - $system_instance - $system_instance_label + $system_name + $system_version + $system_abbreviation + $system_instance + $system_instance_label $local_ip $local_fqdn $application_path + $executable_path $working_path update_working_path $appstartsecs $enablemultithreading $root_threadid $cpucount - + $cells_transfer_memory_limit $LongReadLen_limit $defer_indexes @@ -51,26 +53,28 @@ our @EXPORT_OK = qw( $accounting_password $accounting_host $accounting_port - + $billing_databasename $billing_username $billing_password $billing_host - $billing_port + $billing_port $ngcprestapi_uri $ngcprestapi_username $ngcprestapi_password +$ngcprestapi_realm $csv_path - + $input_path + $local_db_path $emailenable $erroremailrecipient $warnemailrecipient $completionemailrecipient - $successemailrecipient + $successemailrecipient $mailfile_path $ismsexchangeserver @@ -87,38 +91,39 @@ $ngcprestapi_password $mailprog $mailtype - + $defaultconfig update_mainconfig - log_mainconfig - - + + + $chmod_umask - - @jobservers + + @jobservers $jobnamespace - - - + + + ); #set process umask for open and mkdir calls: -umask oct($chmod_umask); +umask 0000; # general constants our $system_name = 'Sipwise Bulk Processing Framework'; our $system_version = '0.0.1'; #keep this filename-save our $system_abbreviation = 'sbpf'; #keep this filename-, dbname-save our $system_instance = 'initial'; #'test'; #'2014'; #dbname-save 0-9a-z_ -our $system_instance_label = 'test'; +our $system_instance_label = 'test'; our $local_ip = get_ipaddress(); our $local_fqdn = get_hostfqdn(); our $application_path = get_applicationpath(); +our $executable_path = $FindBin::Bin . '/'; #my $remotefilesystem = "MSWin32"; -our $system_username = 'system'; +#our $system_username = 'system'; our $enablemultithreading; if ($^O eq 'MSWin32') { @@ -155,8 +160,11 @@ our $billing_port = '3306'; our $ngcprestapi_uri = 'https://127.0.0.1:443'; our $ngcprestapi_username = 'administrator'; our $ngcprestapi_password = 'administrator'; +our $ngcprestapi_realm = 'api_admin_http'; + +our $working_path = tempdir(CLEANUP => 0) . '/'; #'/var/sipwise/'; -our $working_path = fixdirpath(tempdir(CLEANUP => 0)); #'/var/sipwise/'; +our $input_path = $working_path . 'input/'; # csv our $csv_path = $working_path . 'csv/'; @@ -167,7 +175,7 @@ our $logfile_path = $working_path . 'log/'; #mkdir $logfile_path; our $fileloglevel = 'OFF'; #'DEBUG'; -our $screenloglevel = 'OFF'; #'DEBUG'; +our $screenloglevel = 'INFO'; #'DEBUG'; our $emailloglevel = 'OFF'; #'INFO'; @@ -226,75 +234,78 @@ our $defaultconfig = 'default.cfg'; sub update_mainconfig { - - my ($config,$configfile, + + my ($data,$configfile, $split_tuplecode, - $parse_floatcode, + $format_number, + $configurationinfocode, $configurationwarncode, $configurationerrorcode, + $fileerrorcode, $configlogger) = @_; - - if (defined $config) { + + if (defined $data) { # databases - dsp - $accounting_host = $config->{accounting_host} if exists $config->{accounting_host}; - $accounting_port = $config->{accounting_port} if exists $config->{accounting_port}; - $accounting_databasename = $config->{accounting_databasename} if exists $config->{accounting_databasename}; - $accounting_username = $config->{accounting_username} if exists $config->{accounting_username}; - $accounting_password = $config->{accounting_password} if exists $config->{accounting_password}; - - $billing_host = $config->{billing_host} if exists $config->{billing_host}; - $billing_port = $config->{billing_port} if exists $config->{billing_port}; - $billing_databasename = $config->{billing_databasename} if exists $config->{billing_databasename}; - $billing_username = $config->{billing_username} if exists $config->{billing_username}; - $billing_password = $config->{billing_password} if exists $config->{billing_password}; - - $ngcprestapi_uri = $config->{ngcprestapi_uri} if exists $config->{ngcprestapi_uri}; - $ngcprestapi_username = $config->{ngcprestapi_username} if exists $config->{ngcprestapi_username}; - $ngcprestapi_password = $config->{ngcprestapi_password} if exists $config->{ngcprestapi_password}; - - $enablemultithreading = $config->{enablemultithreading} if exists $config->{enablemultithreading}; - $cells_transfer_memory_limit = $config->{cells_transfer_memory_limit} if exists $config->{cells_transfer_memory_limit}; - $defer_indexes = $config->{defer_indexes} if exists $config->{defer_indexes}; - - + $accounting_host = $data->{accounting_host} if exists $data->{accounting_host}; + $accounting_port = $data->{accounting_port} if exists $data->{accounting_port}; + $accounting_databasename = $data->{accounting_databasename} if exists $data->{accounting_databasename}; + $accounting_username = $data->{accounting_username} if exists $data->{accounting_username}; + $accounting_password = $data->{accounting_password} if exists $data->{accounting_password}; + + $billing_host = $data->{billing_host} if exists $data->{billing_host}; + $billing_port = $data->{billing_port} if exists $data->{billing_port}; + $billing_databasename = $data->{billing_databasename} if exists $data->{billing_databasename}; + $billing_username = $data->{billing_username} if exists $data->{billing_username}; + $billing_password = $data->{billing_password} if exists $data->{billing_password}; + + $ngcprestapi_uri = $data->{ngcprestapi_uri} if exists $data->{ngcprestapi_uri}; + $ngcprestapi_username = $data->{ngcprestapi_username} if exists $data->{ngcprestapi_username}; + $ngcprestapi_password = $data->{ngcprestapi_password} if exists $data->{ngcprestapi_password}; + $ngcprestapi_realm = $data->{ngcprestapi_realm} if exists $data->{ngcprestapi_realm}; + + $enablemultithreading = $data->{enablemultithreading} if exists $data->{enablemultithreading}; + $cells_transfer_memory_limit = $data->{cells_transfer_memory_limit} if exists $data->{cells_transfer_memory_limit}; + $defer_indexes = $data->{defer_indexes} if exists $data->{defer_indexes}; + + if (defined $split_tuplecode and ref $split_tuplecode eq 'CODE') { - @jobservers = &$split_tuplecode($config->{jobservers}) if exists $config->{jobservers}; + @jobservers = &$split_tuplecode($data->{jobservers}) if exists $data->{jobservers}; } else { - @jobservers = ($config->{jobservers}) if exists $config->{jobservers}; + @jobservers = ($data->{jobservers}) if exists $data->{jobservers}; } - - if (defined $parse_floatcode and ref $parse_floatcode eq 'CODE') { + + if (defined $format_number and ref $format_number eq 'CODE') { } - - $emailenable = $config->{emailenable} if exists $config->{emailenable}; - $erroremailrecipient = $config->{erroremailrecipient} if exists $config->{erroremailrecipient}; - $warnemailrecipient = $config->{warnemailrecipient} if exists $config->{warnemailrecipient}; - $completionemailrecipient = $config->{completionemailrecipient} if exists $config->{completionemailrecipient}; - $successemailrecipient = $config->{successemailrecipient} if exists $config->{successemailrecipient}; - - $ismsexchangeserver = $config->{ismsexchangeserver} if exists $config->{ismsexchangeserver}; - $smtp_server = $config->{smtp_server} if exists $config->{smtp_server}; - $smtpuser = $config->{smtpuser} if exists $config->{smtpuser}; - $smtppasswd = $config->{smtppasswd} if exists $config->{smtppasswd}; - - $fileloglevel = $config->{fileloglevel} if exists $config->{fileloglevel}; - $screenloglevel = $config->{screenloglevel} if exists $config->{screenloglevel}; - $emailloglevel = $config->{emailloglevel} if exists $config->{emailloglevel}; - - my $new_working_path = (exists $config->{working_path} ? $config->{working_path} : $working_path); - - return update_working_path($new_working_path,1,$configurationerrorcode,$configlogger); - + + $emailenable = $data->{emailenable} if exists $data->{emailenable}; + $erroremailrecipient = $data->{erroremailrecipient} if exists $data->{erroremailrecipient}; + $warnemailrecipient = $data->{warnemailrecipient} if exists $data->{warnemailrecipient}; + $completionemailrecipient = $data->{completionemailrecipient} if exists $data->{completionemailrecipient}; + $successemailrecipient = $data->{successemailrecipient} if exists $data->{successemailrecipient}; + + $ismsexchangeserver = $data->{ismsexchangeserver} if exists $data->{ismsexchangeserver}; + $smtp_server = $data->{smtp_server} if exists $data->{smtp_server}; + $smtpuser = $data->{smtpuser} if exists $data->{smtpuser}; + $smtppasswd = $data->{smtppasswd} if exists $data->{smtppasswd}; + + $fileloglevel = $data->{fileloglevel} if exists $data->{fileloglevel}; + $screenloglevel = $data->{screenloglevel} if exists $data->{screenloglevel}; + $emailloglevel = $data->{emailloglevel} if exists $data->{emailloglevel}; + + my $new_working_path = (exists $data->{working_path} ? $data->{working_path} : $working_path); + + return update_working_path($new_working_path,1,$fileerrorcode,$configlogger); + } return 0; - + } sub update_working_path { - + my ($new_working_path,$create,$fileerrorcode,$logger) = @_; my $result = 1; if (defined $new_working_path and length($new_working_path) > 0) { @@ -315,7 +326,7 @@ sub update_working_path { } } } - + my $new_csv_path = $working_path . 'csv/'; if (-d $new_csv_path) { $csv_path = $new_csv_path; @@ -333,7 +344,25 @@ sub update_working_path { } } } - + + my $new_input_path = $working_path . 'input/'; + if (-d $new_input_path) { + $input_path = $new_input_path; + } else { + if ($create) { + if (makepath($new_input_path,$fileerrorcode,$logger)) { + $input_path = $new_input_path; + } else { + $result = 0; + } + } else { + $result = 0; + if (defined $fileerrorcode and ref $fileerrorcode eq 'CODE') { + &$fileerrorcode("input path '$new_input_path' does not exist",$logger); + } + } + } + my $new_logfile_path = $working_path . 'log/'; if (-d $new_logfile_path) { $logfile_path = $new_logfile_path; @@ -350,8 +379,8 @@ sub update_working_path { &$fileerrorcode("logfile path '$new_logfile_path' does not exist",$logger); } } - } - + } + my $new_local_db_path = $working_path . 'db/'; if (-d $new_local_db_path) { $local_db_path = $new_local_db_path; @@ -368,7 +397,7 @@ sub update_working_path { &$fileerrorcode("local db path '$new_local_db_path' does not exist",$logger); } } - } + } my $new_mailfile_path = $working_path . 'mails/'; if (-d $new_mailfile_path) { @@ -387,30 +416,18 @@ sub update_working_path { } } } - + } else { $result = 0; if (defined $fileerrorcode and ref $fileerrorcode eq 'CODE') { &$fileerrorcode("empty working path",$logger); - } + } } + #print "working path result: " . $result; return $result; } -sub log_mainconfig { - - my ($logconfigcode,$configlogger) = @_; - if (defined $logconfigcode and ref $logconfigcode eq 'CODE') { - &$logconfigcode($system_name . ' ' . $system_version . ' (' . $system_instance_label . ') [' . $local_fqdn . ']',$configlogger); - &$logconfigcode('application path ' . $application_path,$configlogger); - &$logconfigcode('working path ' . $working_path,$configlogger); - &$logconfigcode($cpucount . ' cpu(s), multithreading ' . ($enablemultithreading ? 'enabled' : 'disabled'),$configlogger); - } - -} - - sub get_applicationpath { return dirname(abs_path(__FILE__)) . '/'; @@ -418,4 +435,3 @@ sub get_applicationpath { } 1; - diff --git a/LoadConfig.pm b/LoadConfig.pm index 1edc94ce..b0944640 100644 --- a/LoadConfig.pm +++ b/LoadConfig.pm @@ -4,23 +4,27 @@ use strict; ## no critic use Globals qw( + $system_name + $system_version + $system_instance_label + $local_fqdn $application_path + $working_path + $executable_path + $cpucount + $enablemultithreading update_mainconfig - log_mainconfig ); use Logging qw( getlogger - mainconfigurationloaded - configinfo + configurationinfo ); use LogError qw( fileerror - yamlerror configurationwarn configurationerror - parameterdefinedtwice ); use YAML::Tiny; @@ -29,67 +33,96 @@ use Utils qw(format_number); require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw( - $loadedmainconfigfile load_config + $SIMPLE_CONFIG_TYPE + $YAML_CONFIG_TYPE ); -our $loadedmainconfigfile = undef; - my $tuplesplitpattern = join('|',(quotemeta(','), quotemeta(';'), quotemeta('/') ) ); +our $SIMPLE_CONFIG_TYPE = 1; +our $YAML_CONFIG_TYPE = 2; #my $logger = getlogger(__PACKAGE__); sub load_config { my ($configfile,$process_code,$configtype) = @_; + my $is_settings = 'CODE' eq ref $process_code; my $data; if (defined $configfile) { if (-e $configfile) { $data = _parse_config($configfile,$configtype); } else { - $configfile = $application_path . $configfile; - if (-e $configfile) { + my $relative_configfile = $executable_path . $configfile; + if (-e $relative_configfile) { + $configfile = $relative_configfile; $data = _parse_config($configfile,$configtype); } else { - fileerror('cannot find config file ' . $configfile,getlogger(__PACKAGE__)); + configurationwarn($configfile,'no project ' . ($is_settings ? 'settings' : 'config') . ' file ' . $relative_configfile,getlogger(__PACKAGE__)); + $relative_configfile = $application_path . $configfile; + if (-e $relative_configfile) { + $configfile = $relative_configfile; + $data = _parse_config($configfile,$configtype); + } else { + configurationerror($configfile,'no global ' . ($is_settings ? 'settings' : 'config') . ' file ' . $relative_configfile,getlogger(__PACKAGE__)); + return 0; + } } } } else { - configurationerror('no config file specified',getlogger(__PACKAGE__)); + fileerror('no ' . ($is_settings ? 'settings' : 'config') . ' file specified',getlogger(__PACKAGE__)); + return 0; } - if ('CODE' eq ref $process_code) { - my $result = &$process_code($data); - configinfo('configuration file ' . $configfile . ' loaded',getlogger(__PACKAGE__)); + if ($is_settings) { + my $result = &$process_code($data,$configfile, + \&split_tuple, + \&format_number, + \&configurationinfo, + \&configurationwarn, + \&configurationerror, + \&fileerror, + getlogger(__PACKAGE__)); + configurationinfo('settings file ' . $configfile . ' loaded',getlogger(__PACKAGE__)); return $result; } else { - if (update_mainconfig($data,$configfile, + my $result = update_mainconfig($data,$configfile, \&split_tuple, \&format_number, + \&configurationinfo, \&configurationwarn, \&configurationerror, - getlogger(__PACKAGE__))) { - $loadedmainconfigfile = $configfile; - mainconfigurationloaded($configfile,getlogger(__PACKAGE__)); - return 1; - } - log_mainconfig(\&configinfo,getlogger(__PACKAGE__)); - return 0; + \&fileerror, + getlogger(__PACKAGE__)); + _splashinfo(); + return $result; } } +sub _splashinfo { + + configurationinfo($system_name . ' ' . $system_version . ' (' . $system_instance_label . ') [' . $local_fqdn . ']',getlogger(__PACKAGE__)); + configurationinfo('application path ' . $application_path,getlogger(__PACKAGE__)); + configurationinfo('working path ' . $working_path,getlogger(__PACKAGE__)); + #configurationinfo('executable path ' . $executable_path,getlogger(__PACKAGE__)); + configurationinfo($cpucount . ' cpu(s), multithreading ' . ($enablemultithreading ? 'enabled' : 'disabled'),getlogger(__PACKAGE__)); + +} + sub _parse_config { my ($file,$configtype) = @_; my $data; if (defined $configtype) { - if ($configtype == 1) { - $data = _parse_yaml_config($file); + if ($configtype == $SIMPLE_CONFIG_TYPE) { + $data = _parse_simple_config($file); + } elsif ($configtype == $YAML_CONFIG_TYPE) { + $data = _parse_yaml_config($file); } else { $data = _parse_simple_config($file); } @@ -136,7 +169,7 @@ sub _parse_simple_config { local *CF; if (not open (CF, '<' . $file)) { - fileerror('parse simple config - cannot open file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); + fileerror('parsing simple format - cannot open file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); return $config; } @@ -167,7 +200,7 @@ sub _parse_simple_config { $value =~ s/\s+$//g; if (exists $config->{$key}) { - parameterdefinedtwice('parse simple config - parameter ' . $key . ' defined twice in line ' . $count . ' of configuration file ' . $file,getlogger(__PACKAGE__)); + configurationwarn($file,'parsing simple format - parameter ' . $key . ' defined twice in line ' . $count,getlogger(__PACKAGE__)); } $config->{$key} = $value; @@ -187,7 +220,7 @@ sub _parse_yaml_config { $yaml = YAML::Tiny->read($file); }; if ($@) { - yamlerror('parse yaml config - error reading file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); + configurationerror($file,'parsing yaml format - error: ' . $!,getlogger(__PACKAGE__)); return $yaml; } diff --git a/LogError.pm b/LogError.pm index f23ea8bc..688d7864 100644 --- a/LogError.pm +++ b/LogError.pm @@ -36,9 +36,12 @@ use Utils qw( use POSIX qw(ceil); # locale_h); #setlocale(LC_NUMERIC, 'C'); ->utils +use File::Basename qw(basename); + use Time::HiRes qw(time); use Carp qw(carp cluck croak confess); +#$Carp::Verbose = 1; require Exporter; our @ISA = qw(Exporter); @@ -54,12 +57,19 @@ our @EXPORT_OK = qw( tabletransferfailed tableprocessingfailed + resterror + restwarn + restrequesterror + restresponseerror + fileerror filewarn - - yamlerror - parameterdefinedtwice + processzerofilesize + fileprocessingfailed + fileprocessingerror + fileprocessingwarn + emailwarn configurationwarn configurationerror @@ -261,7 +271,7 @@ sub notimplementederror { sub dberror { my ($db, $message, $logger) = @_; - $message = _getconnectorinstanceprefix($db) . _getconnectidentifiermessage($db,$message); + $message = _getsqlconnectorinstanceprefix($db) . _getsqlconnectidentifiermessage($db,$message); if (defined $logger) { $logger->error($message); } @@ -275,7 +285,35 @@ sub dberror { sub dbwarn { my ($db, $message, $logger) = @_; - $message = _getconnectorinstanceprefix($db) . _getconnectidentifiermessage($db,$message); + $message = _getsqlconnectorinstanceprefix($db) . _getsqlconnectidentifiermessage($db,$message); + if (defined $logger) { + $logger->warn($message); + } + + #die(); + warning($message, $logger, 1); + +} + + +sub resterror { + + my ($restapi, $message, $logger) = @_; + $message = _getrestconnectorinstanceprefix($restapi) . _getrestconnectidentifiermessage($restapi,$message); + if (defined $logger) { + $logger->error($message); + } + + terminate($message, $logger); + #terminatethreads(); + #die(); + +} + +sub restwarn { + + my ($restapi, $message, $logger) = @_; + $message = _getrestconnectorinstanceprefix($restapi) . _getrestconnectidentifiermessage($restapi,$message); if (defined $logger) { $logger->warn($message); } @@ -285,10 +323,38 @@ sub dbwarn { } +sub restrequesterror { + + my ($restapi, $message, $request, $logger) = @_; + $message = _getrestconnectorinstanceprefix($restapi) . _getrestconnectidentifiermessage($restapi,$message); + if (defined $logger) { + $logger->error($message); + } + + terminate($message, $logger); + #terminatethreads(); + #die(); + +} + +sub restresponseerror { + + my ($restapi, $message, $response, $logger) = @_; + $message = _getrestconnectorinstanceprefix($restapi) . _getrestconnectidentifiermessage($restapi,$message); + if (defined $logger) { + $logger->error($message); + } + + terminate($message, $logger); + #terminatethreads(); + #die(); + +} + sub fieldnamesdiffer { my ($db,$tablename,$expectedfieldnames,$fieldnamesfound,$logger) = @_; - my $message = _getconnectorinstanceprefix($db) . 'wrong table fieldnames (v ' . $system_version . '): [' . $db->connectidentifier() . '].' . $tablename . ":\nexpected: " . ((defined $expectedfieldnames) ? join(', ',@$expectedfieldnames) : '') . "\nfound: " . ((defined $fieldnamesfound) ? join(', ',@$fieldnamesfound) : ''); + my $message = _getsqlconnectorinstanceprefix($db) . 'wrong table fieldnames (v ' . $system_version . '): [' . $db->connectidentifier() . '].' . $tablename . ":\nexpected: " . ((defined $expectedfieldnames) ? join(', ',@$expectedfieldnames) : '') . "\nfound: " . ((defined $fieldnamesfound) ? join(', ',@$fieldnamesfound) : ''); if (defined $logger) { $logger->error($message); } @@ -327,7 +393,7 @@ sub dbclusterwarn { sub transferzerorowcount { my ($db,$tablename,$target_db,$targettablename,$numofrows,$logger) = @_; - my $message = _getconnectorinstanceprefix($db) . '[' . $db->connectidentifier() . '].' . $tablename . ' has 0 rows'; + my $message = _getsqlconnectorinstanceprefix($db) . '[' . $db->connectidentifier() . '].' . $tablename . ' has 0 rows'; if (defined $logger) { $logger->error($message); } @@ -355,7 +421,7 @@ sub processzerorowcount { sub deleterowserror { my ($db,$tablename,$message,$logger) = @_; - $message = _getconnectorinstanceprefix($db) . '[' . $db->connectidentifier() . '].' . $tablename . ' - ' . $message; + $message = _getsqlconnectorinstanceprefix($db) . '[' . $db->connectidentifier() . '].' . $tablename . ' - ' . $message; if (defined $logger) { $logger->error($message); } @@ -369,7 +435,7 @@ sub deleterowserror { sub tabletransferfailed { my ($db,$tablename,$target_db,$targettablename,$numofrows,$logger) = @_; - my $message = _getconnectorinstanceprefix($db) . 'table transfer failed: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename; + my $message = _getsqlconnectorinstanceprefix($db) . 'table transfer failed: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename; if (defined $logger) { $logger->error($message); } @@ -401,9 +467,23 @@ sub fileerror { } -sub yamlerror { - - my ($message, $logger) = @_; +#sub yamlerror { +# +# my ($message, $logger) = @_; +# if (defined $logger) { +# $logger->error($message); +# } +# +# terminate($message, $logger); +# #terminatethreads(); +# #die(); +# +#} + +sub processzerofilesize { + + my ($file,$logger) = @_; + my $message = basename($file) . ' has 0 bytes'; if (defined $logger) { $logger->error($message); } @@ -414,6 +494,39 @@ sub yamlerror { } +sub fileprocessingfailed { + + my ($file,$logger) = @_; + my $message = 'file processing failed: ' . basename($file); + if (defined $logger) { + $logger->error($message); + } + terminate($message, $logger); + +} + +sub fileprocessingerror { + + my ($file,$message,$logger) = @_; + my $message = basename($file) . ': ' . $message; + if (defined $logger) { + $logger->error($message); + } + terminate($message, $logger); + +} + +sub fileprocessingwarn { + + my ($file,$message,$logger) = @_; + my $message = basename($file) . ': ' . $message; + if (defined $logger) { + $logger->error($message); + } + warning($message, $logger); + +} + sub xls2csverror { my ($message, $logger) = @_; @@ -472,14 +585,14 @@ sub webarchivexls2csvwarn { warning($message, $logger, 1); } -sub parameterdefinedtwice { - - my ($message,$logger) = @_; - if (defined $logger) { - $logger->warn($message); - } - warning($message, $logger, 1); -} +#sub parameterdefinedtwice { +# +# my ($message,$logger) = @_; +# if (defined $logger) { +# $logger->warn($message); +# } +# warning($message, $logger, 1); +#} sub emailwarn { @@ -561,7 +674,7 @@ sub servicewarn { } -sub _getconnectorinstanceprefix { +sub _getsqlconnectorinstanceprefix { my ($db) = @_; my $instancestring = $db->instanceidentifier(); if (length($instancestring) > 0) { @@ -576,7 +689,7 @@ sub _getconnectorinstanceprefix { return ''; } -sub _getconnectidentifiermessage { +sub _getsqlconnectidentifiermessage { my ($db,$message) = @_; my $result = $db->connectidentifier(); my $connectidentifier = $db->_connectidentifier(); @@ -589,4 +702,32 @@ sub _getconnectidentifiermessage { return $result . $message; } -1; \ No newline at end of file +sub _getrestconnectorinstanceprefix { + my ($restapi) = @_; + my $instancestring = $restapi->instanceidentifier(); + if (length($instancestring) > 0) { + if ($restapi->{tid} != $root_threadid) { + return '[' . $restapi->{tid} . '/' . $instancestring . '] '; + } else { + return '[' . $instancestring . '] '; + } + } elsif ($restapi->{tid} != $root_threadid) { + return '[' . $restapi->{tid} . '] '; + } + return ''; +} + +sub _getrestconnectidentifiermessage { + my ($restapi,$message) = @_; + my $result = $restapi->connectidentifier(); + my $connectidentifier = $restapi->_connectidentifier(); + if (length($result) > 0 and length($connectidentifier) > 0) { + $result .= '->' . $connectidentifier; + } + if (length($result) > 0) { + $result .= ' - '; + } + return $result . $message; +} + +1; diff --git a/Logging.pm b/Logging.pm index a407e346..caa813c6 100644 --- a/Logging.pm +++ b/Logging.pm @@ -11,13 +11,14 @@ use Globals qw( $fileloglevel $emailloglevel $screenloglevel - log_mainconfig $enablemultithreading ); use Log::Log4perl qw(get_logger); -use Utils qw(timestampdigits datestampdigits changemod chopstring trim); +use File::Basename qw(basename); + +use Utils qw(timestampdigits datestampdigits changemod chopstring trim kbytes2gigs); use Array qw (contains); require Exporter; @@ -25,16 +26,18 @@ our @ISA = qw(Exporter); our @EXPORT_OK = qw( getlogger - + cleanuplogfiles emailinfo emaildebug dbdebug dbinfo - + restdebug + restinfo + attachmentdownloaderdebug - attachmentdownloaderinfo + attachmentdownloaderinfo fieldnamesaquired primarykeycolsaquired @@ -63,8 +66,8 @@ our @EXPORT_OK = qw( writing_rows processing_rows - mainconfigurationloaded - configinfo + + configurationinfo init_log $currentlogfile $attachmentlogfile @@ -73,6 +76,12 @@ our @EXPORT_OK = qw( xls2csvinfo tablethreadingdebug + filethreadingdebug + fileprocessingstarted + fileprocessingdone + fetching_lines + processing_lines + tablefixed servicedebug serviceinfo @@ -115,8 +124,8 @@ sub init_log_default { #"log4perl.appender.ScreenApp = Log::Log4perl::Appender::ScreenColoredLevels\n" . "log4perl.appender.ScreenApp.Threshold = INFO\n" . "log4perl.appender.ScreenApp.stderr = 0\n" . - "log4perl.appender.ScreenApp.layout = Log::Log4perl::Layout::SimpleLayout\n" . - 'log4perl.appender.ScreenApp.layout.ConversionPattern = %d> %m%n'; + "log4perl.appender.ScreenApp.layout = Log::Log4perl::Layout::PatternLayout\n" . + 'log4perl.appender.ScreenApp.layout.ConversionPattern = %m%n'; # Initialize logging behaviour Log::Log4perl->init( \$conf ); @@ -165,9 +174,9 @@ sub init_log { # Initialize logging behaviour Log::Log4perl->init( \$conf ); - + $loginitialized = 1; - + get_logger(__PACKAGE__)->debug('log4perl configuration loaded'); } @@ -252,7 +261,7 @@ sub dbdebug { my ($db, $message, $logger) = @_; if (defined $logger) { - $logger->debug(_getconnectorinstanceprefix($db) . _getconnectidentifiermessage($db,$message)); + $logger->debug(_getsqlconnectorinstanceprefix($db) . _getsqlconnectidentifiermessage($db,$message)); } #die(); @@ -263,7 +272,29 @@ sub dbinfo { my ($db, $message, $logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . _getconnectidentifiermessage($db,$message)); + $logger->info(_getsqlconnectorinstanceprefix($db) . _getsqlconnectidentifiermessage($db,$message)); + } + + #die(); + +} + +sub restdebug { + + my ($restatpi, $message, $logger) = @_; + if (defined $logger) { + $logger->debug(_getrestconnectorinstanceprefix($restatpi) . _getrestconnectidentifiermessage($restatpi,$message)); + } + + #die(); + +} + +sub restinfo { + + my ($restatpi, $message, $logger) = @_; + if (defined $logger) { + $logger->info(_getrestconnectorinstanceprefix($restatpi) . _getrestconnectidentifiermessage($restatpi,$message)); } #die(); @@ -271,21 +302,21 @@ sub dbinfo { } sub attachmentdownloaderdebug { - + my ($message, $logger) = @_; if (defined $logger) { $logger->debug($message); } - + } sub attachmentdownloaderinfo { - + my ($message, $logger) = @_; if (defined $logger) { $logger->info($message); } - + } sub xls2csvinfo { @@ -301,7 +332,7 @@ sub fieldnamesaquired { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'fieldnames aquired and OK: [' . $db->connectidentifier() . '].' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'fieldnames aquired and OK: [' . $db->connectidentifier() . '].' . $tablename); } } @@ -310,7 +341,7 @@ sub primarykeycolsaquired { my ($db,$tablename,$keycols,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'primary key columns aquired for [' . $db->connectidentifier() . '].' . $tablename . ': ' . ((defined $keycols and scalar @$keycols > 0) ? join(', ',@$keycols) : '')); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'primary key columns aquired for [' . $db->connectidentifier() . '].' . $tablename . ': ' . ((defined $keycols and scalar @$keycols > 0) ? join(', ',@$keycols) : '')); } } @@ -319,7 +350,7 @@ sub tableinfoscleared { my ($db,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'table infos cleared for ' . $db->connectidentifier()); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'table infos cleared for ' . $db->connectidentifier()); } } @@ -328,7 +359,7 @@ sub tabletransferstarted { my ($db,$tablename,$target_db,$targettablename,$numofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'table transfer started: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'table transfer started: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); } } @@ -355,7 +386,7 @@ sub rowtransferstarted { my ($db,$tablename,$target_db,$targettablename,$numofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'row transfer started: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'row transfer started: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); } } @@ -364,7 +395,7 @@ sub texttablecreated { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'text table created: ' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'text table created: ' . $tablename); } } @@ -373,7 +404,7 @@ sub indexcreated { my ($db,$tablename,$indexname,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'index created: ' . $indexname . ' on ' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'index created: ' . $indexname . ' on ' . $tablename); } } @@ -382,7 +413,7 @@ sub primarykeycreated { my ($db,$tablename,$keycols,$logger) = @_; if (defined $logger and (defined $keycols and scalar @$keycols > 0)) { - $logger->info(_getconnectorinstanceprefix($db) . 'primary key created: ' . join(', ',@$keycols) . ' on ' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'primary key created: ' . join(', ',@$keycols) . ' on ' . $tablename); } } @@ -391,7 +422,7 @@ sub temptablecreated { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'temporary table created: ' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'temporary table created: ' . $tablename); } } @@ -400,7 +431,7 @@ sub tabletruncated { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'table truncated: ' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'table truncated: ' . $tablename); } } @@ -409,7 +440,7 @@ sub tabledropped { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'table dropped: ' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'table dropped: ' . $tablename); } } @@ -418,7 +449,7 @@ sub rowtransferred { my ($db,$tablename,$target_db,$targettablename,$i,$numofrows,$logger) = @_; if (defined $logger) { - $logger->debug(_getconnectorinstanceprefix($db) . 'row ' . $i . '/' . $numofrows . ' transferred'); + $logger->debug(_getsqlconnectorinstanceprefix($db) . 'row ' . $i . '/' . $numofrows . ' transferred'); } } @@ -427,7 +458,7 @@ sub rowskipped { my ($db,$tablename,$target_db,$targettablename,$i,$numofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'row ' . $i . '/' . $numofrows . ' skipped'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'row ' . $i . '/' . $numofrows . ' skipped'); } } @@ -436,7 +467,7 @@ sub rowinserted { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->debug(_getconnectorinstanceprefix($db) . 'row inserted'); + $logger->debug(_getsqlconnectorinstanceprefix($db) . 'row inserted'); } } @@ -445,7 +476,7 @@ sub rowupdated { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->debug(_getconnectorinstanceprefix($db) . 'row updated'); + $logger->debug(_getsqlconnectorinstanceprefix($db) . 'row updated'); } } @@ -455,9 +486,9 @@ sub rowsdeleted { my ($db,$tablename,$rowcount,$initial_rowcount,$logger) = @_; if (defined $logger) { if (defined $initial_rowcount) { - $logger->debug(_getconnectorinstanceprefix($db) . $rowcount . ' of ' . $initial_rowcount . ' row(s) deleted'); + $logger->debug(_getsqlconnectorinstanceprefix($db) . $rowcount . ' of ' . $initial_rowcount . ' row(s) deleted'); } else { - $logger->debug(_getconnectorinstanceprefix($db) . $rowcount . ' row(s) deleted'); + $logger->debug(_getsqlconnectorinstanceprefix($db) . $rowcount . ' row(s) deleted'); } } @@ -467,7 +498,7 @@ sub totalrowsdeleted { my ($db,$tablename,$rowcount_total,$initial_rowcount,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . $rowcount_total . ' of ' . $initial_rowcount . ' row(s) deleted from [' . $db->connectidentifier() . '].' . $tablename); + $logger->info(_getsqlconnectorinstanceprefix($db) . $rowcount_total . ' of ' . $initial_rowcount . ' row(s) deleted from [' . $db->connectidentifier() . '].' . $tablename); } } @@ -476,7 +507,7 @@ sub rowinsertskipped { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'row insert skipped'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'row insert skipped'); } } @@ -485,7 +516,7 @@ sub rowupdateskipped { my ($db,$tablename,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'row update skipped'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'row update skipped'); } } @@ -494,7 +525,7 @@ sub tabletransferdone { my ($db,$tablename,$target_db,$targettablename,$numofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'table transfer done: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'table transfer done: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); } } @@ -503,7 +534,7 @@ sub tablefixed { my ($target_db,$targettablename,$statement,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($target_db) . 'table fix applied to ' . $targettablename . ': ' . chopstring(trim($statement),90)); + $logger->info(_getsqlconnectorinstanceprefix($target_db) . 'table fix applied to ' . $targettablename . ': ' . chopstring(trim($statement),90)); } } @@ -521,7 +552,7 @@ sub rowtransferdone { my ($db,$tablename,$target_db,$targettablename,$numofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'row transfer done: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'row transfer done: [' . $db->connectidentifier() . '].' . $tablename . ' > ' . $targettablename . ': ' . $numofrows . ' row(s)'); } } @@ -530,7 +561,7 @@ sub fetching_rows { my ($db,$tablename,$start,$blocksize,$totalnumofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'fetching rows from [' . $db->connectidentifier() . '].' . $tablename . ': ' . ($start + 1) . '-' . ($start + $blocksize) . ' of ' . $totalnumofrows); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'fetching rows from [' . $db->connectidentifier() . '].' . $tablename . ': ' . ($start + 1) . '-' . ($start + $blocksize) . ' of ' . $totalnumofrows); } } @@ -539,7 +570,7 @@ sub writing_rows { my ($db,$tablename,$start,$blocksize,$totalnumofrows,$logger) = @_; if (defined $logger) { - $logger->info(_getconnectorinstanceprefix($db) . 'writing rows to ' . $tablename . ': ' . ($start + 1) . '-' . ($start + $blocksize) . ' of ' . $totalnumofrows); + $logger->info(_getsqlconnectorinstanceprefix($db) . 'writing rows to ' . $tablename . ': ' . ($start + 1) . '-' . ($start + $blocksize) . ' of ' . $totalnumofrows); } } @@ -553,17 +584,63 @@ sub processing_rows { } -sub mainconfigurationloaded { - my ($configfile,$logger) = @_; +sub filethreadingdebug { + + my ($message,$logger) = @_; + if (defined $logger) { + $logger->debug($message); + } + +} + +sub fileprocessingstarted { + + my ($file,$logger) = @_; + if (defined $logger) { + $logger->info('file processing started: ' . basename($file) . ' (' . kbytes2gigs(int((-s $file)/ 1024)) . ')'); + } + +} + +sub fileprocessingdone { + + my ($file,$logger) = @_; if (defined $logger) { - $logger->info('system configuration file ' . $configfile . ' loaded'); + $logger->info('file processing done: ' . basename($file)); } - log_mainconfig(\&configinfo,$logger); } -sub configinfo { +sub fetching_lines { + + my ($file,$start,$blocksize,$logger) = @_; + if (defined $logger) { + $logger->info('fetching lines from ' . basename($file) . ': ' . ($start + 1) . '~' . ($start + $blocksize)); + } + +} + +sub processing_lines { + + my ($tid, $start,$blocksize,$logger) = @_; + if (defined $logger) { + $logger->info(($enablemultithreading ? '[' . $tid . '] ' : '') . 'processing lines: ' . ($start + 1) . '-' . ($start + $blocksize)); + } + +} + +#sub mainconfigurationloaded { +# +# my ($configfile,$logger) = @_; +# if (defined $logger) { +# $logger->info('system configuration file ' . $configfile . ' loaded'); +# } +# log_mainconfig(\&configinfo,$logger); +# +#} + +sub configurationinfo { my ($message,$logger) = @_; if (defined $logger) { @@ -605,7 +682,7 @@ sub serviceinfo { } -sub _getconnectorinstanceprefix { +sub _getsqlconnectorinstanceprefix { my ($db) = @_; my $instancestring = $db->instanceidentifier(); if (length($instancestring) > 0) { @@ -620,7 +697,7 @@ sub _getconnectorinstanceprefix { return ''; } -sub _getconnectidentifiermessage { +sub _getsqlconnectidentifiermessage { my ($db,$message) = @_; my $result = $db->connectidentifier(); my $connectidentifier = $db->_connectidentifier(); @@ -633,4 +710,32 @@ sub _getconnectidentifiermessage { return $result . $message; } -1; \ No newline at end of file +sub _getrestconnectorinstanceprefix { + my ($restapi) = @_; + my $instancestring = $restapi->instanceidentifier(); + if (length($instancestring) > 0) { + if ($restapi->{tid} != $root_threadid) { + return '[' . $restapi->{tid} . '/' . $instancestring . '] '; + } else { + return '[' . $instancestring . '] '; + } + } elsif ($restapi->{tid} != $root_threadid) { + return '[' . $restapi->{tid} . '] '; + } + return ''; +} + +sub _getrestconnectidentifiermessage { + my ($restapi,$message) = @_; + my $result = $restapi->connectidentifier(); + my $connectidentifier = $restapi->_connectidentifier(); + if (length($result) > 0 and length($connectidentifier) > 0) { + $result .= '->' . $connectidentifier; + } + if (length($result) > 0) { + $result .= ' - '; + } + return $result . $message; +} + +1; diff --git a/Projects/Migration/IPGallery/FeaturesDefineParser.pm b/Projects/Migration/IPGallery/FeaturesDefineParser.pm new file mode 100644 index 00000000..3e13025b --- /dev/null +++ b/Projects/Migration/IPGallery/FeaturesDefineParser.pm @@ -0,0 +1,96 @@ +package Projects::Migration::IPGallery::FeaturesDefineParser; +use strict; + +## no critic + +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); + +use Marpa::R2; +use Data::Dumper::Concise; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( + create_grammar + parse +); + +my $grammar = << '__GRAMMAR__'; +lexeme default = latm => 1 + +:start ::= Record +:default ::= action => ::first + +Record ::= SubscriberNumber '{' Options '}' action => _build_record +Options ::= Option+ action => _build_options +Option ::= OptionName action => _build_option + | OptionName '{' OptionValues '}' action => _build_setoption +OptionValues ::= OptionValue+ action => _build_setoptionitems + +SubscriberNumber ~ [0-9]+ +OptionName ~ [-a-zA-Z_0-9]+ +OptionValue ~ [-a-zA-Z_0-9]+ +whitespace ~ [\s]+ +:discard ~ whitespace +__GRAMMAR__ + +sub _build_record { + + my ($closure,$subscribernumber,$leftcb,$options,$rightcb) = @_; + return { $subscribernumber => $options }; + +} + +sub _build_options { + + my ($closure,@options) = @_; + return \@options; + +} + +sub _build_option { + + my ($closure,$optionname) = @_; + return $optionname; + +} + +sub _build_setoption { + + my ($closure,$optionname,$leftcb,$optionvalues,$rightcb) = @_; + return { $optionname => $optionvalues }; + +} + +sub _build_setoptionitems { + + my ($closure,@optionvalues) = @_; + return \@optionvalues; + +} + +sub create_grammar { + + return Marpa::R2::Scanless::G->new({ + source => \$grammar, + }); + +} + +sub parse { + + my ($input_ref,$grammar) = @_; + my $recce = Marpa::R2::Scanless::R->new({ + grammar => $grammar, + semantics_package => __PACKAGE__, + }); + $recce->read($input_ref); + my $closure = {}; + my $value_ref = $recce->value($closure); + return $value_ref ? ${$value_ref} : undef; + +} + +1; diff --git a/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm b/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm new file mode 100644 index 00000000..dddf951c --- /dev/null +++ b/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm @@ -0,0 +1,108 @@ +package Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile; +use strict; + +## no critic + +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); + +use Globals qw( + $cpucount +); + +use Logging qw( + getlogger +); +use LogError qw( + fileprocessingerror + fileprocessingwarn +); + +use FileProcessor; +use Projects::Migration::IPGallery::FeaturesDefineParser qw( + create_grammar + parse +); + +require Exporter; +our @ISA = qw(Exporter FileProcessor); +our @EXPORT_OK = qw(); + +my $lineseparator = '\\n(?=(?:\d+\\n))'; +my $encoding = 'UTF-8'; + +my $buffersize = 1400; # 512 * 1024; +my $threadqueuelength = 10; +my $numofthreads = $cpucount; #3; +#my $multithreading = 0; +my $blocksize = 2000; + +my $stoponparseerrors = 0; #1; +my $parselines = 0; + +sub new { + + my $class = shift; + + my $self = FileProcessor->new(@_); + + $self->{line_separator} = $lineseparator; + $self->{encoding} = $encoding; + $self->{buffersize} = $buffersize; + $self->{threadqueuelength} = $threadqueuelength; + $self->{numofthreads} = $numofthreads; + #$self->{multithreading} = $multithreading; + $self->{blocksize} = $blocksize; + $self->{parselines} = $parselines; + $self->{stoponparseerrors} = $stoponparseerrors; + + bless($self,$class); + + #restdebug($self,__PACKAGE__ . ' file processor created',getlogger(__PACKAGE__)); + + return $self; + +} + +sub init_reader_context { + + my $self = shift; + my ($context) = @_; + + if ($self->{parselines}) { + eval { + $context->{grammar} = create_grammar(); + }; + if ($@) { + fileprocessingerror($context->{filename},$@,getlogger(__PACKAGE__)); + } + } + +} + +sub extractfields { + my ($context,$line_ref) = @_; + + return undef if length($$line_ref) == 0; + + if ($context->{instance}->{parselines}) { + my $row = undef; + eval { + $row = parse($line_ref,$context->{grammar}); + }; + if ($@) { + if ($context->{instance}->{stoponparseerrors}) { + fileprocessingerror($context->{filename},'record ' . $context->{linesread} . ' - ' . $@,getlogger(__PACKAGE__)); + } else { + fileprocessingwarn($context->{filename},'record ' . $context->{linesread} . ' - ' . $@,getlogger(__PACKAGE__)); + } + } + return $row; + } else { + return $$line_ref; + } + +} + +1; diff --git a/Projects/Migration/IPGallery/Import.pm b/Projects/Migration/IPGallery/Import.pm new file mode 100644 index 00000000..ac8d4f8e --- /dev/null +++ b/Projects/Migration/IPGallery/Import.pm @@ -0,0 +1,79 @@ +package Projects::Migration::IPGallery::Import; +use strict; + +## no critic + +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); + +use Projects::Migration::IPGallery::Settings qw( + $defaultsettings + update_settings +); +use Logging qw ( + getlogger +); +use LogError qw( + fileprocessingwarn + fileprocessingerror +); + +#use FileProcessors::CSVFile; +use Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile; +use Projects::Migration::IPGallery::FeaturesDefineParser qw( + create_grammar + parse +); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( + import_features_define +); + + +sub import_features_define { + + my ($file) = @_; + my $multithreading = 1; + my $importer = Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile->new(); + return $importer->process($file,sub { + my ($context,$rows,$row_offset) = @_; + my $rownum = $row_offset; + foreach my $line (@$rows) { + my $row = undef; + if (not $importer->{parselines}) { + eval { + $row = parse(\$line,$context->{grammar}); + }; + if ($@) { + if ($importer->{stoponparseerrors}) { + fileprocessingerror($context->{filename},'record ' . ($rownum + 1) . ' - ' . $@,getlogger(__PACKAGE__)); + } else { + fileprocessingwarn($context->{filename},'record ' . ($rownum + 1) . ' - ' . $@,getlogger(__PACKAGE__)); + } + } + } + next unless defined $row; + $rownum++; + # continue to write to sqlite ... + } + return 1; + }, sub { + my ($context)= @_; + if (not $importer->{parselines}) { + eval { + $context->{grammar} = create_grammar(); + }; + if ($@) { + fileprocessingerror($context->{filename},$@,getlogger(__PACKAGE__)); + } + } + },$multithreading); + +} + + + +1; diff --git a/Projects/Migration/IPGallery/Settings.pm b/Projects/Migration/IPGallery/Settings.pm new file mode 100644 index 00000000..9c51e9ca --- /dev/null +++ b/Projects/Migration/IPGallery/Settings.pm @@ -0,0 +1,50 @@ +package Projects::Migration::IPGallery::Settings; +use strict; + +## no critic + +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( + update_settings + $defaultsettings +); + +our $defaultsettings = 'settings.cfg'; + + + + + + +sub update_settings { + + my ($data,$configfile, + $split_tuplecode, + $format_number, + $configurationinfocode, + $configurationwarncode, + $configurationerrorcode, + $fileerrorcode, + $configlogger) = @_; + + if (defined $data) { + +print "$configlogger narf"; + &$configurationinfocode("testinfomessage",$configlogger); + # databases - dsp + #$accounting_host = $config->{accounting_host} if exists $config->{accounting_host}; + + return 1; + + } + return 0; + +} + + +1; \ No newline at end of file diff --git a/Projects/Migration/IPGallery/default.cfg b/Projects/Migration/IPGallery/default.cfg new file mode 100644 index 00000000..50866fb3 --- /dev/null +++ b/Projects/Migration/IPGallery/default.cfg @@ -0,0 +1 @@ +working_path = /var/sipwise/Migration/IPGallery \ No newline at end of file diff --git a/Projects/Migration/IPGallery/narf.pl b/Projects/Migration/IPGallery/narf.pl new file mode 100644 index 00000000..b7b2f031 --- /dev/null +++ b/Projects/Migration/IPGallery/narf.pl @@ -0,0 +1,119 @@ +use strict; + +## no critic + +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); + +use Getopt::Long; + +use Globals qw( + $defaultconfig +); +use Projects::Migration::IPGallery::Settings qw( + $defaultsettings + update_settings +); +use Logging qw( + init_log + getlogger + $attachmentlogfile +); +use LogError qw ( + completion + success +); +use LoadConfig qw( + load_config + $SIMPLE_CONFIG_TYPE + $YAML_CONFIG_TYPE +); +use Utils qw(getscriptpath); +use Mail qw(wrap_mailbody + $signature + $normalpriority + $lowpriority + $highpriority); + +#use ConnectorPool qw(); + +use Projects::Migration::IPGallery::Import qw( + import_features_define +); + +my @MODES = (); + +if (init() && main()) { + exit(0); +} else { + exit(1); +} + +sub init { + + #GetOptions ("host=s" => \$host, + # "port=i" => \$port, + # "file=s" => \$output_filename, + # "dir=s" => \$output_dir, + # "user=s" => \$user, + # "pass=s" => \$pass, + # "period=s" => \$period, + # 'verbose+' => \$verbose) or fatal("Error in command line arguments"); + my $configfile = $defaultconfig; + my $settingsfile = $defaultsettings; + + my $result = load_config($configfile); + init_log(); + $result &= load_config($settingsfile,\&update_settings,$SIMPLE_CONFIG_TYPE); + #update_working_path('/var/sipwise'); +#my $logger = getlogger(getscriptpath()); + return $result; + +} + + +sub main() { + + my @messages = (); + my @attachmentfiles = (); + my $result = 0; + my $completion = 0; + + if (1 or ('xx' eq "mode")) { #$mode) { + $result = import_features_define_task(\@messages); + $completion = 1; + } else { + push(@messages,'unknow option yy, must be one of' . @MODES); + } + + push(@attachmentfiles,$attachmentlogfile); + if ($completion) { + completion(join("\n\n",@messages),\@attachmentfiles,getlogger(getscriptpath())); + } else { + success(join("\n\n",@messages),\@attachmentfiles,getlogger(getscriptpath())); + } + + #ConnectorPool::destroy_dbs(); + + return $result; +} + +sub cleanup_task { + +} + +sub import_features_define_task { + + my ($messages) = shift; + if (import_features_define( + '/home/rkrenn/test/Features_Define.cfg' + )) { + push(@$messages,'sucessfully inserted x records...'); + return 1; + } else { + push(@$messages,'some error happened'); + return 0; + } + +} diff --git a/Projects/Migration/IPGallery/settings.cfg b/Projects/Migration/IPGallery/settings.cfg new file mode 100644 index 00000000..7349a498 --- /dev/null +++ b/Projects/Migration/IPGallery/settings.cfg @@ -0,0 +1 @@ +x = y \ No newline at end of file diff --git a/Projects/Migration/IPGallery/test.pl b/Projects/Migration/IPGallery/test.pl new file mode 100644 index 00000000..5193a454 --- /dev/null +++ b/Projects/Migration/IPGallery/test.pl @@ -0,0 +1,105 @@ +#!/usr/bin/perl +use warnings; +use strict; + +use Marpa::R2; +use Data::Dumper; + + +my $input = do { local $/; }; + +my $dsl = << '__GRAMMAR__'; + +lexeme default = latm => 1 + +:start ::= List +:default ::= action => ::first + +List ::= Hash+ action => list +Hash ::= String '{' Pairs '}' action => hash +Pairs ::= Pair+ action => list +Pair ::= String Value ';' action => pair + | Hash +Value ::= Simple + | Bracketed +Bracketed ::= '[' String ']' action => second +Simple ::= String + +String ~ [-a-zA-Z_0-9]+ +whitespace ~ [\s] + +:discard ~ whitespace + +__GRAMMAR__ + +sub hash { +{ $_[1] => $_[3] } } + +sub pair { +{ $_[1] => $_[2] } } + +sub second { [ @_[ 2 .. $#_-1 ] ] } + +sub list { shift; \@_ } + +my $grammar = Marpa::R2::Scanless::G->new( { source => \$dsl } ); +my $recce = Marpa::R2::Scanless::R->new( + { grammar => $grammar, semantics_package => 'main' } ); +#my $input = '42 * 1 + 7'; +$recce->read( \$input ); + +my $value_ref = $recce->value; +my $value = $value_ref ? ${$value_ref} : 'No Parse'; + +print Dumper $value; + +#my $parser = 'Marpa::R2::Scanless::G'->new({ source => \$grammar }); + +#print Dumper $parser->parse(\$input, 'main', { trace_terminals => 1 }); + +__DATA__ +bob { + ed { + larry { + rule5 { + option { + disable-server-response-inspection no; + } + tag [ some_tag ]; + from [ prod-L3 ]; + to [ corp-L3 ]; + source [ any ]; + destination [ any ]; + source-user [ any ]; + category [ any ]; + application [ any ]; + service [ any ]; + hip-profiles [ any ]; + log-start no; + log-end yes; + negate-source no; + negate-destination no; + action allow; + log-setting orion_log; + } + rule6 { + option { + disable-server-response-inspection no; + } + tag [ some_tag ]; + from [ prod-L3 ]; + to [ corp-L3 ]; + source [ any ]; + destination [ any ]; + source-user [ any ]; + category [ any ]; + application [ any ]; + service [ any ]; + hip-profiles [ any ]; + log-start no; + log-end yes; + negate-source no; + negate-destination no; + action allow; + log-setting orion_log; + } + } + } +} diff --git a/Projects/Migration/IPGallery/test_count.pl b/Projects/Migration/IPGallery/test_count.pl new file mode 100644 index 00000000..04970866 --- /dev/null +++ b/Projects/Migration/IPGallery/test_count.pl @@ -0,0 +1,62 @@ + +use strict; + +my $buffersize = 100 * 1024; +my $default_encoding = 'UTF-8'; + +_get_linecount('/home/rkrenn/test/Features_Define.cfg',$default_encoding,\&breaklines); + +exit; + +sub breaklines { + my ($buffer_ref) = @_; + my $spearator = "\n"; + my $count = 0; + my $last_record; + my $records = []; + foreach my $record (split(/$spearator(?=(?:\d+$spearator))/,$$buffer_ref)) { + $count++; + $last_record = $record; + push(@$records,$record); + } + #if ($last_record =~ /$spearator\}\s*$/) { + # $$buffer_ref = ''; + #} else { + $count--; + $$buffer_ref = $last_record; + pop @$records; + #} + return $count; +} + +sub _get_linecount { + + my ($file,$encoding,$breaklines_code) = @_; + + #local $/ = $lineseparator; + local *INPUTFILE_LINECOUNT; + if (not open (INPUTFILE_LINECOUNT, '<:encoding(' . $encoding . ')', $file)) { + print('get line count - cannot open file ' . $file . ': ' . $!); + return undef; + } + binmode INPUTFILE_LINECOUNT; + + my $linecount = 0; + + my $buffer = ''; + my $chunk = undef; + my $n = 0; + while (defined ($n = read(INPUTFILE_LINECOUNT,$chunk,$buffersize)) && $n != 0) { + $buffer .= $chunk; + $linecount += &$breaklines_code(\$buffer); + } + if (not defined $n) { + print('get line count - error reading file ' . $file . ': ' . $!); + close(INPUTFILE_LINECOUNT); + return undef; + } + close(INPUTFILE_LINECOUNT); + + return $linecount; + +} diff --git a/Projects/Migration/IPGallery/test_dsl.pl b/Projects/Migration/IPGallery/test_dsl.pl new file mode 100644 index 00000000..be4b1841 --- /dev/null +++ b/Projects/Migration/IPGallery/test_dsl.pl @@ -0,0 +1,215 @@ +#!/usr/bin/perl +use warnings; +use strict; + +use Marpa::R2; +use Data::Dumper; + + +my $input = do { local $/; }; + +my $dsl = << '__GRAMMAR__'; +lexeme default = latm => 1 + +:start ::= Records +:default ::= action => ::first + +Records ::= Record+ action => list +Record ::= SubscriberNumber '{' Options '}' +Options ::= Option+ action => list +Option ::= OptionName | OptionName '{' OptionValues '}' +OptionValues ::= OptionValue+ action => list + +SubscriberNumber ~ [0-9]+ +OptionName ~ [-a-zA-Z_0-9]+ +OptionValue ~ [-a-zA-Z_0-9]+ +whitespace ~ [\s]+ +:discard ~ whitespace +__GRAMMAR__ + +sub hash { + print "hash"; + +{ $_[1] => $_[3] } + } + +sub pair { + print "pair"; + +{ $_[1] => $_[2] } + } + +sub second { + print "second"; + [ @_[ 2 .. $#_-1 ] ] + } + +sub list { + shift; + print "list"; + \@_ + } + +my $grammar = Marpa::R2::Scanless::G->new( { source => \$dsl } ); +my $recce = Marpa::R2::Scanless::R->new( + { grammar => $grammar, semantics_package => 'main' } ); +#my $input = '42 * 1 + 7'; +$recce->read( \$input ); + +my $value_ref = $recce->value; +my $value = $value_ref ? ${$value_ref} : 'No Parse'; + +print Dumper $value; + +#my $parser = 'Marpa::R2::Scanless::G'->new({ source => \$grammar }); + +#print Dumper $parser->parse(\$input, 'main', { trace_terminals => 1 }); + +__DATA__ +35627883323 +{ + RegisteredIC + { + Selective_Call_Waiting + Selective_Ring + Ring_By_DayTime + Ring_By_Call_Origin + ReAnswer + Selective_CW_Ring + Ic_Selective_Barring + Ic_Day_Time_Barring + Ic_Date_Barring + Ic_No_Answer + Ic_Default_Ring + Malicious + Display_Calling_Party_CLI + Call_Waiting_for_all_calls + Cancel_Call_Waiting + Hunting + Leading_Number + Block_Anonymous_Call + Do_Not_Disturb + Restrict_Automatic_Recall + Restrict_Automatic_CallBack + Ic_Cancel_All_Forwards + Ic_On-Line_Malicious + Ic_Barring_Pattern + } + RegisteredOG + { + Speed_Dial_one_Digit + Speed_Dial_two_Digits + Save_Dialed_Number + Og_Selective_Barring + Og_Day_Time_Barring + Og_Date_Barring + Og_Display_Name + Feature_Keys + Pre_Paid + Metering + Block_CLI + Confidential_Number + Automatic_CallBack + Automatic_Recall + Force_CLI + Last_Number_Redial + Og_Three_Way_Calling + Og_Hold + Og_Barring_Pattern + } + Log_Malicious_Calls + Display_Calling_Party_CLI + Cancel_Call_Waiting + On_Line_Malicious + Block_CLI + Automatic_CallBack + Automatic_Recall + Force_CLI + Last_Number_Redial + Hold + Default_Ring + { + 1 + } + Display_Name + { + O + } +} +35627464746 +{ + RegisteredIC + { + Selective_Call_Waiting + Selective_Ring + Ring_By_DayTime + Ring_By_Call_Origin + ReAnswer + Forward_All_Calls + Forward_On_Busy + Forward_on_No_Answer + Forward_Unavailable + Selective_CW_Ring + Ic_Selective_Barring + Ic_Day_Time_Barring + Ic_Date_Barring + Ic_No_Answer + Ic_Default_Ring + Malicious + Display_Calling_Party_CLI + Call_Waiting_for_all_calls + Cancel_Call_Waiting + Hunting + Leading_Number + Block_Anonymous_Call + Do_Not_Disturb + Restrict_Automatic_Recall + Restrict_Automatic_CallBack + Ic_Cancel_All_Forwards + Ic_On-Line_Malicious + Ic_Barring_Pattern + } + RegisteredOG + { + Speed_Dial_one_Digit + Speed_Dial_two_Digits + Save_Dialed_Number + Og_Selective_Barring + Og_Day_Time_Barring + Og_Date_Barring + Og_Display_Name + Og_Web_Access + Feature_Keys + Pre_Paid + Metering + Block_CLI + Confidential_Number + Automatic_CallBack + Automatic_Recall + Force_CLI + Last_Number_Redial + Og_Three_Way_Calling + Og_Hold + Og_Barring_Pattern + } + Log_Malicious_Calls + Display_Calling_Party_CLI + Cancel_Call_Waiting + On_Line_Malicious + Block_CLI + Automatic_CallBack + Automatic_Recall + Force_CLI + Last_Number_Redial + Hold + Default_Ring + { + 1 + } + Web_Password + { + 27464746 + } + Display_Name + { + 27464746 + } +} diff --git a/RestConnector.pm b/RestConnector.pm index f586aaf5..d2917eea 100644 --- a/RestConnector.pm +++ b/RestConnector.pm @@ -93,7 +93,7 @@ sub _create_ua { if (!defined $self->{uri}) { resterror($self,'base URL not set',getlogger(__PACKAGE__)); } - $ua = LWP::UserAgent->new(); + my $ua = LWP::UserAgent->new(); $self->_setup_ua($ua,$self->{netloc}); return $ua; @@ -130,7 +130,7 @@ sub _ua_request { } sub _add_headers { - my ($reg,$headers) = @_; + my ($req,$headers) = @_; foreach my $headername (keys %$headers) { $req->header($headername => $headers->{$headername}); } @@ -184,7 +184,7 @@ sub _log_request() { my $self = shift; my ($req) = @_; if ($req) { - restdebug($self,$request->method . ' ' . $request->uri,getlogger(__PACKAGE__)); + restdebug($self,$req->method . ' ' . $req->uri,getlogger(__PACKAGE__)); } } @@ -192,7 +192,7 @@ sub _log_response() { my $self = shift; my ($res) = @_; if ($res) { - restdebug($self,$request->code . ' ' . $request->message,getlogger(__PACKAGE__)); + restdebug($self,$res->code . ' ' . $res->message,getlogger(__PACKAGE__)); } } diff --git a/RestConnectors/NGCPRestApi.pm b/RestConnectors/NGCPRestApi.pm index b195eabe..749e3920 100644 --- a/RestConnectors/NGCPRestApi.pm +++ b/RestConnectors/NGCPRestApi.pm @@ -30,10 +30,10 @@ our @EXPORT_OK = qw(); my $defaulturi = 'https://127.0.0.1:443'; my $defaultusername = 'administrator'; my $defaultpassword = 'administrator'; +my $defaultrealm = 'api_admin_http'; my $contenttype = 'application/json'; my $patchcontenttype = 'application/json-patch+json'; -my $realm = 'api_admin_http'; #my $logger = getlogger(__PACKAGE__); @@ -46,7 +46,7 @@ sub new { baseuri(shift // $defaulturi); $self->{username} = shift; $self->{password} = shift; - $self->{realm} = shift // $realm; + $self->{realm} = shift // $defaultrealm; bless($self,$class); diff --git a/SqlRecord.pm b/SqlRecord.pm index 37d3e219..dab93c70 100644 --- a/SqlRecord.pm +++ b/SqlRecord.pm @@ -108,6 +108,10 @@ my $reader_connection_name = 'reader'; my $thread_sleep_secs = 0.1; +my $RUNNING = 1; +my $COMPLETED = 2; +my $ERROR = 4; + sub new { my $class = shift; @@ -748,7 +752,7 @@ sub transfer_table { return; } - my $errorstate = 1; + my $errorstate = $RUNNING; # 1; $create_indexes = ((defined $create_indexes) ? $create_indexes : $defer_indexes); @@ -891,9 +895,9 @@ sub transfer_table { }; if ($@) { - $errorstate = 4; + $errorstate = $ERROR; } else { - $errorstate = 2; + $errorstate = $COMPLETED; } $db->db_disconnect(); @@ -906,7 +910,7 @@ sub transfer_table { #$db = &$get_db($controller_name,1); #$target_db = &$get_target_db($controller_name,1); - if ($errorstate == 2 and ref $fixtable_statements eq 'ARRAY' and (scalar @$fixtable_statements) > 0) { + if ($errorstate == $COMPLETED and ref $fixtable_statements eq 'ARRAY' and (scalar @$fixtable_statements) > 0) { eval { foreach my $fixtable_statement (@$fixtable_statements) { if (ref $fixtable_statement eq '') { @@ -921,13 +925,13 @@ sub transfer_table { } }; if ($@) { - $errorstate = 4; + $errorstate = $ERROR; #} else { - # $errorstate = 2; + # $errorstate = $COMPLETED; } } - if ($errorstate == 2 and $create_indexes) { + if ($errorstate == $COMPLETED and $create_indexes) { eval { $target_db->create_primarykey($targettablename, @@ -947,15 +951,15 @@ sub transfer_table { }; if ($@) { - $errorstate = 4; + $errorstate = $ERROR; #} else { - # $errorstate = 2; + # $errorstate = $COMPLETED; } } } - if ($errorstate == 2) { + if ($errorstate == $COMPLETED) { tabletransferdone($db,$tablename,$target_db,$targettablename,$rowcount,getlogger(__PACKAGE__)); #$db->db_disconnect(); #$target_db->db_disconnect(); @@ -974,7 +978,7 @@ sub transfer_table { sub process_table { - my ($get_db,$tablename,$process_code,$multithreading,$selectcount,$select,@values) = @_; + my ($get_db,$tablename,$process_code,$init_process_context_code,$multithreading,$selectcount,$select,@values) = @_; if (ref $get_db eq 'CODE') { @@ -996,7 +1000,7 @@ sub process_table { return; } - my $errorstate = 1; + my $errorstate = $RUNNING; my $connectidentifier = $db->connectidentifier(); my $tid = threadid(); @@ -1066,6 +1070,7 @@ sub process_table { #readererrorstate_ref => \$readererrorstate, #processorerrorstate_ref => \$processorerrorstate, process_code => $process_code, + init_process_context_code => $init_process_context_code, blocksize => $blocksize, rowcount => $rowcount, #logger => $logger, @@ -1111,7 +1116,7 @@ sub process_table { } #$errorstate = $readererrorstate | $processorerrorstate; - $errorstate = (_get_other_threads_state(\%errorstates,$tid) & ~1); + $errorstate = (_get_other_threads_state(\%errorstates,$tid) & ~$RUNNING); tablethreadingdebug('restoring db connections ...',getlogger(__PACKAGE__)); @@ -1126,9 +1131,13 @@ sub process_table { #$db->db_disconnect(); #undef $db; #$db = &$get_db($reader_connection_name); - + my $context = {}; my $rowblock_result = 1; eval { + if ('CODE' eq ref $init_process_context_code) { + &$init_process_context_code($context); + } + $db->db_get_begin($selectstatement,$tablename,@values); my $i = 0; @@ -1139,7 +1148,7 @@ sub process_table { if ($realblocksize > 0) { processing_rows($tid,$i,$realblocksize,$rowcount,getlogger(__PACKAGE__)); - $rowblock_result = &$process_code($rowblock,$i); + $rowblock_result = &$process_code($context,$rowblock,$i); #$target_db->db_do_begin($insertstatement,$targettablename); #$target_db->db_do_rowblock($rowblock); @@ -1158,9 +1167,9 @@ sub process_table { }; if ($@) { - $errorstate = 4; + $errorstate = $ERROR; } else { - $errorstate = (not $rowblock_result) ? 4 : 2; + $errorstate = (not $rowblock_result) ? $ERROR : $COMPLETED; } $db->db_disconnect(); @@ -1170,7 +1179,7 @@ sub process_table { #$db = &$get_db($controller_name,1); - if ($errorstate == 2) { + if ($errorstate == $COMPLETED) { tableprocessingdone($db,$tablename,$rowcount,getlogger(__PACKAGE__)); #$db->db_disconnect(); return 1; @@ -1254,16 +1263,16 @@ sub _get_stop_consumer_thread { $reader_state = $errorstates->{$context->{readertid}}; } $queuesize = $context->{queue}->pending(); - if (($other_threads_state & 4) == 0 and ($queuesize > 0 or $reader_state == 1)) { + if (($other_threads_state & $ERROR) == 0 and ($queuesize > 0 or $reader_state == $RUNNING)) { $result = 0; #keep the consumer thread running if there is no defunct thread and queue is not empty or reader is still running } if ($result) { tablethreadingdebug('[' . $tid . '] consumer thread is shutting down (' . - (($other_threads_state & 4) == 0 ? 'no defunct thread(s)' : 'defunct thread(s)') . ', ' . + (($other_threads_state & $ERROR) == 0 ? 'no defunct thread(s)' : 'defunct thread(s)') . ', ' . ($queuesize > 0 ? 'blocks pending' : 'no blocks pending') . ', ' . - ($reader_state == 1 ? 'reader thread running' : 'reader thread not running') . ') ...' + ($reader_state == $RUNNING ? 'reader thread running' : 'reader thread not running') . ') ...' ,getlogger(__PACKAGE__)); } @@ -1280,7 +1289,7 @@ sub _reader { my $tid = threadid(); { lock $context->{errorstates}; - $context->{errorstates}->{$tid} = 1; + $context->{errorstates}->{$tid} = $RUNNING; } tablethreadingdebug('[' . $tid . '] reader thread tid ' . $tid . ' started',getlogger(__PACKAGE__)); @@ -1289,21 +1298,21 @@ sub _reader { eval { $reader_db = &{$context->{get_db}}(); #$reader_connection_name); $reader_db->db_get_begin($context->{selectstatement},$context->{tablename},@{$context->{values_ref}}); - my $i = 0; tablethreadingdebug('[' . $tid . '] reader thread waiting for consumer threads',getlogger(__PACKAGE__)); - while ((_get_other_threads_state($context->{errorstates},$tid) & 1) == 0) { #wait on cosumers to come up + while ((_get_other_threads_state($context->{errorstates},$tid) & $RUNNING) == 0) { #wait on cosumers to come up #yield(); sleep($thread_sleep_secs); } - my $state = 1; #start at first - while (($state & 1) == 1 and ($state & 4) == 0) { #as long there is one running consumer and no defunct consumer + my $i = 0; + my $state = $RUNNING; #start at first + while (($state & $RUNNING) == $RUNNING and ($state & $ERROR) == 0) { #as long there is one running consumer and no defunct consumer fetching_rows($reader_db,$context->{tablename},$i,$context->{blocksize},$context->{rowcount},getlogger(__PACKAGE__)); my $rowblock = $reader_db->db_get_rowblock($context->{blocksize}); my $realblocksize = scalar @$rowblock; - my $packet = {rows => $rowblock, - size => $realblocksize, - #block => $i, - row_offset => $i}; + #my $packet = {rows => $rowblock, + # size => $realblocksize, + # #block => $i, + # row_offset => $i}; my %packet :shared = (); $packet{rows} = $rowblock; $packet{size} = $realblocksize; @@ -1312,7 +1321,7 @@ sub _reader { $context->{queue}->enqueue(\%packet); #$packet); $blockcount++; #wait if thequeue is full and there there is one running consumer - while (((($state = _get_other_threads_state($context->{errorstates},$tid)) & 1) == 1) and $context->{queue}->pending() >= $context->{threadqueuelength}) { + while (((($state = _get_other_threads_state($context->{errorstates},$tid)) & $RUNNING) == $RUNNING) and $context->{queue}->pending() >= $context->{threadqueuelength}) { #yield(); sleep($thread_sleep_secs); } @@ -1327,10 +1336,10 @@ sub _reader { last; } } - if (not (($state & 1) == 1 and ($state & 4) == 0)) { + if (not (($state & $RUNNING) == $RUNNING and ($state & $ERROR) == 0)) { tablethreadingdebug('[' . $tid . '] reader thread is shutting down (' . - (($state & 1) == 1 ? 'still running consumer threads' : 'no running consumer threads') . ', ' . - (($state & 4) == 0 ? 'no defunct thread(s)' : 'defunct thread(s)') . ') ...' + (($state & $RUNNING) == $RUNNING ? 'still running consumer threads' : 'no running consumer threads') . ', ' . + (($state & $ERROR) == 0 ? 'no defunct thread(s)' : 'defunct thread(s)') . ') ...' ,getlogger(__PACKAGE__)); } $reader_db->db_finish(); @@ -1344,9 +1353,9 @@ sub _reader { tablethreadingdebug($@ ? '[' . $tid . '] reader thread error: ' . $@ : '[' . $tid . '] reader thread finished (' . $blockcount . ' blocks)',getlogger(__PACKAGE__)); lock $context->{errorstates}; if ($@) { - $context->{errorstates}->{$tid} = 4; + $context->{errorstates}->{$tid} = $ERROR; } else { - $context->{errorstates}->{$tid} = 2; + $context->{errorstates}->{$tid} = $COMPLETED; } return $context->{errorstates}->{$tid}; } @@ -1360,7 +1369,7 @@ sub _writer { my $tid = threadid(); { lock $context->{errorstates}; - $context->{errorstates}->{$tid} = 1; + $context->{errorstates}->{$tid} = $RUNNING; } tablethreadingdebug('[' . $tid . '] writer thread tid ' . $tid . ' started',getlogger(__PACKAGE__)); @@ -1395,9 +1404,9 @@ sub _writer { tablethreadingdebug($@ ? '[' . $tid . '] writer thread error: ' . $@ : '[' . $tid . '] writer thread finished (' . $blockcount . ' blocks)',getlogger(__PACKAGE__)); lock $context->{errorstates}; if ($@) { - $context->{errorstates}->{$tid} = 4; + $context->{errorstates}->{$tid} = $ERROR; } else { - $context->{errorstates}->{$tid} = 2; + $context->{errorstates}->{$tid} = $COMPLETED; } return $context->{errorstates}->{$tid}; } @@ -1411,13 +1420,16 @@ sub _process { my $tid = threadid(); { lock $context->{errorstates}; - $context->{errorstates}->{$tid} = 1; + $context->{errorstates}->{$tid} = $RUNNING; } tablethreadingdebug('[' . $tid . '] processor thread tid ' . $tid . ' started',getlogger(__PACKAGE__)); my $blockcount = 0; eval { + if ('CODE' eq ref $context->{init_process_context_code}) { + &{$context->{init_process_context_code}}($context); + } #$writer_db = &{$context->{get_target_db}}($writer_connection_name); while (not _get_stop_consumer_thread($context,$tid)) { my $packet = $context->{queue}->dequeue_nb(); @@ -1434,7 +1446,7 @@ sub _process { processing_rows($tid,$packet->{row_offset},$packet->{size},$context->{rowcount},getlogger(__PACKAGE__)); - $rowblock_result = &{$context->{process_code}}($packet->{rows},$packet->{row_offset}); + $rowblock_result = &{$context->{process_code}}($context,$packet->{rows},$packet->{row_offset}); $blockcount++; @@ -1461,9 +1473,9 @@ sub _process { tablethreadingdebug($@ ? '[' . $tid . '] processor thread error: ' . $@ : '[' . $tid . '] processor thread finished (' . $blockcount . ' blocks)',getlogger(__PACKAGE__)); lock $context->{errorstates}; if ($@) { - $context->{errorstates}->{$tid} = 4; + $context->{errorstates}->{$tid} = $ERROR; } else { - $context->{errorstates}->{$tid} = (not $rowblock_result) ? 4 : 2; + $context->{errorstates}->{$tid} = (not $rowblock_result) ? $ERROR : $COMPLETED; } return $context->{errorstates}->{$tid}; } @@ -1501,4 +1513,4 @@ sub copy_row { return $record; } -1; \ No newline at end of file +1; diff --git a/Utils.pm b/Utils.pm index 4e6b4cf0..37cb8e8b 100644 --- a/Utils.pm +++ b/Utils.pm @@ -100,7 +100,7 @@ our @EXPORT_OK = qw( ); -our $chmod_umask = '0777'; +our $chmod_umask = 0644; my $default_epsilon = 1e-3; #float comparison tolerance @@ -578,6 +578,8 @@ sub fixdirpath { sub makepath { my ($dirpath,$fileerrorcode,$logger) = @_; + #print $chmod_umask ."\n"; + #changemod($dirpath); make_path($dirpath,{ 'chmod' => $chmod_umask, 'error' => \my $err }); @@ -588,7 +590,7 @@ sub makepath { if ($file eq '') { &$fileerrorcode("general error: $message",$logger); } else { - &$fileerrorcode("problem unlinking $file: $message",$logger); + &$fileerrorcode("problem creating $file: $message",$logger); } } } @@ -612,7 +614,7 @@ sub makepath { sub changemod { my ($filepath) = @_; - chmod oct($chmod_umask),$filepath; + chmod $chmod_umask,$filepath; } sub threadid { diff --git a/default.cfg b/default.cfg index 4288a5fe..5c546e32 100644 --- a/default.cfg +++ b/default.cfg @@ -1 +1 @@ -working_path = /var/sipwise \ No newline at end of file +#working_path = /var/sipwise \ No newline at end of file diff --git a/test.pl b/test.pl deleted file mode 100644 index 4ce7d22f..00000000 --- a/test.pl +++ /dev/null @@ -1,60 +0,0 @@ -use strict; - -## no critic - -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__)); - -use Getopt::Long; - -use Globals qw( - $defaultconfig -); -use Logging qw( - init_log - getlogger - $attachmentlogfile -); -use LogError qw ( - completion - success -); -use LoadConfig qw(load_config); -use Utils qw(getscriptpath zerofill changemod timestampdigits); -use Mail qw(wrap_mailbody - $signature - $normalpriority - $lowpriority - $highpriority); -use ConnectorPool qw(destroy_dbs); - -init(); - -exit(main()); - -sub init { - - #GetOptions ("host=s" => \$host, - # "port=i" => \$port, - # "file=s" => \$output_filename, - # "dir=s" => \$output_dir, - # "user=s" => \$user, - # "pass=s" => \$pass, - # "period=s" => \$period, - # 'verbose+' => \$verbose) or fatal("Error in command line arguments"); -my $configfile = $defaultconfig; - - load_config($configfile); - init_log(); - #update_working_path('/var/sipwise'); -#my $logger = getlogger(getscriptpath()); - return 0; #blah; - -} - - -sub main() { - - return 0; -} \ No newline at end of file