From 52d66ca0dee62c7ec82cae38d17d5c7d61276f3f Mon Sep 17 00:00:00 2001 From: Rene Krenn Date: Tue, 5 Jul 2016 20:12:06 +0200 Subject: [PATCH] MT#18663 MT#20893 row bulk processing framework WIP #5 +setting to drop duplicate setoptionitems in Feature_Define.cfg +adjust Feature_Define.cfg threads vs block size settings to arrange with a low sqlite busy_timeout +Subscriber_Define.cfg importer +resolve garbage collector problems with log4perl +refactoring to conform with perl module lib/folder structure for installation -runs again Change-Id: I1821cc0085086684c3c1415be4c262453509045a --- NoSqlConnector.pm | 6 - Projects/Migration/IPGallery/Import.pm | 126 -- Projects/Migration/IPGallery/settings.cfg | 7 - Projects/Migration/IPGallery/test.pl | 105 - Projects/Migration/IPGallery/test_count.pl | 62 - {Excel => lib/Excel}/Reader/XLSX.pm | 0 {Excel => lib/Excel}/Reader/XLSX/Cell.pm | 0 .../Reader/XLSX/Package/ContentTypes.pm | 0 .../Reader/XLSX/Package/Relationships.pm | 0 .../Reader/XLSX/Package/SharedStrings.pm | 0 .../Excel}/Reader/XLSX/Package/XMLreader.pm | 0 {Excel => lib/Excel}/Reader/XLSX/Row.pm | 0 {Excel => lib/Excel}/Reader/XLSX/Workbook.pm | 0 {Excel => lib/Excel}/Reader/XLSX/Worksheet.pm | 0 Array.pm => lib/NGCP/BulkProcessor/Array.pm | 12 +- .../BulkProcessor/AttachmentDownloader.pm | 10 +- .../NGCP/BulkProcessor/ConnectorPool.pm | 38 +- .../NGCP/BulkProcessor/DSSorter.pm | 22 +- .../Dao}/Trunk/accounting/cdr.pm | 0 .../Dao}/Trunk/billing/contract_balances.pm | 23 +- .../Downloaders}/IMAPAttachmentDownloader.pm | 20 +- .../NGCP/BulkProcessor/FakeTime.pm | 16 +- .../NGCP/BulkProcessor/FileProcessor.pm | 25 +- .../BulkProcessor/FileProcessors}/CSVFile.pm | 20 +- .../NGCP/BulkProcessor/Globals.pm | 95 +- .../NGCP/BulkProcessor/LoadConfig.pm | 92 +- .../NGCP/BulkProcessor/LogError.pm | 12 +- .../NGCP/BulkProcessor/Logging.pm | 14 +- Mail.pm => lib/NGCP/BulkProcessor/Mail.pm | 24 +- lib/NGCP/BulkProcessor/NoSqlConnector.pm | 6 + .../Migration/IPGallery/Dao/FeatureOption.pm | 18 +- .../IPGallery/Dao/FeatureOptionSet.pm | 22 +- .../Migration/IPGallery/Dao/Subscriber.pm | 133 ++ .../IPGallery/FeaturesDefineParser.pm | 8 +- .../FileProcessors/FeaturesDefineFile.pm | 28 +- .../FileProcessors/SubscriberDefineFile.pm | 66 + .../Projects/Migration/IPGallery/Import.pm | 164 ++ .../IPGallery/ProjectConnectorPool.pm | 28 +- .../Projects}/Migration/IPGallery/Settings.pm | 39 +- .../Projects}/Migration/IPGallery/config.cfg | 0 .../Projects/Migration/IPGallery/process.pl | 64 +- .../Projects/Migration/IPGallery/settings.cfg | 10 + .../Projects}/Migration/IPGallery/test_dsl.pl | 2 + .../Projects/t/ProjectConnectorPool.pm | 0 .../Projects}/t/test_connectors.pl | 33 +- .../BulkProcessor/Projects}/t/test_service.pl | 41 +- .../NGCP/BulkProcessor/RandomString.pm | 4 +- .../NGCP/BulkProcessor/RestConnector.pm | 31 +- .../RestConnectors}/NGCPRestApi.pm | 22 +- .../NGCP/BulkProcessor/Serialization.pm | 14 +- .../NGCP/BulkProcessor/Service.pm | 16 +- .../BulkProcessor/Service}/TestService.pm | 24 +- .../NGCP/BulkProcessor/ServiceProxy.pm | 16 +- .../NGCP/BulkProcessor/SqlConnector.pm | 19 +- .../BulkProcessor/SqlConnectors}/CSVDB.pm | 1700 ++++++++--------- .../BulkProcessor/SqlConnectors}/MySQLDB.pm | 1068 +++++------ .../BulkProcessor/SqlConnectors}/OracleDB.pm | 1064 +++++------ .../SqlConnectors}/PostgreSQLDB.pm | 24 +- .../SqlConnectors}/SQLServerDB.pm | 24 +- .../BulkProcessor/SqlConnectors}/SQLiteDB.pm | 26 +- .../SqlConnectors}/SQLiteVarianceAggregate.pm | 134 +- .../NGCP/BulkProcessor/SqlRecord.pm | 47 +- Table.pm => lib/NGCP/BulkProcessor/Table.pm | 6 +- Utils.pm => lib/NGCP/BulkProcessor/Utils.pm | 5 +- .../NGCP/BulkProcessor/default.cfg | 0 65 files changed, 2861 insertions(+), 2774 deletions(-) delete mode 100644 NoSqlConnector.pm delete mode 100644 Projects/Migration/IPGallery/Import.pm delete mode 100644 Projects/Migration/IPGallery/settings.cfg delete mode 100644 Projects/Migration/IPGallery/test.pl delete mode 100644 Projects/Migration/IPGallery/test_count.pl rename {Excel => lib/Excel}/Reader/XLSX.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Cell.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Package/ContentTypes.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Package/Relationships.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Package/SharedStrings.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Package/XMLreader.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Row.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Workbook.pm (100%) rename {Excel => lib/Excel}/Reader/XLSX/Worksheet.pm (100%) rename Array.pm => lib/NGCP/BulkProcessor/Array.pm (90%) rename AttachmentDownloader.pm => lib/NGCP/BulkProcessor/AttachmentDownloader.pm (94%) rename ConnectorPool.pm => lib/NGCP/BulkProcessor/ConnectorPool.pm (78%) rename DSSorter.pm => lib/NGCP/BulkProcessor/DSSorter.pm (88%) rename {Dao => lib/NGCP/BulkProcessor/Dao}/Trunk/accounting/cdr.pm (100%) rename {Dao => lib/NGCP/BulkProcessor/Dao}/Trunk/billing/contract_balances.pm (78%) rename {Downloaders => lib/NGCP/BulkProcessor/Downloaders}/IMAPAttachmentDownloader.pm (88%) rename FakeTime.pm => lib/NGCP/BulkProcessor/FakeTime.pm (95%) rename FileProcessor.pm => lib/NGCP/BulkProcessor/FileProcessor.pm (96%) rename {FileProcessors => lib/NGCP/BulkProcessor/FileProcessors}/CSVFile.pm (76%) rename Globals.pm => lib/NGCP/BulkProcessor/Globals.pm (89%) rename LoadConfig.pm => lib/NGCP/BulkProcessor/LoadConfig.pm (75%) rename LogError.pm => lib/NGCP/BulkProcessor/LogError.pm (95%) rename Logging.pm => lib/NGCP/BulkProcessor/Logging.pm (95%) rename Mail.pm => lib/NGCP/BulkProcessor/Mail.pm (95%) create mode 100644 lib/NGCP/BulkProcessor/NoSqlConnector.pm rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/Dao/FeatureOption.pm (81%) rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/Dao/FeatureOptionSet.pm (73%) create mode 100644 lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/Subscriber.pm rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/FeaturesDefineParser.pm (90%) rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm (77%) create mode 100644 lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/SubscriberDefineFile.pm create mode 100644 lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Import.pm rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/ProjectConnectorPool.pm (57%) rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/Settings.pm (61%) rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/config.cfg (100%) rename Projects/Migration/IPGallery/narf.pl => lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/process.pl (70%) create mode 100644 lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/settings.cfg rename {Projects => lib/NGCP/BulkProcessor/Projects}/Migration/IPGallery/test_dsl.pl (99%) create mode 100644 lib/NGCP/BulkProcessor/Projects/t/ProjectConnectorPool.pm rename {Projects => lib/NGCP/BulkProcessor/Projects}/t/test_connectors.pl (87%) rename {Projects => lib/NGCP/BulkProcessor/Projects}/t/test_service.pl (89%) rename RandomString.pm => lib/NGCP/BulkProcessor/RandomString.pm (97%) rename RestConnector.pm => lib/NGCP/BulkProcessor/RestConnector.pm (97%) rename {RestConnectors => lib/NGCP/BulkProcessor/RestConnectors}/NGCPRestApi.pm (85%) rename Serialization.pm => lib/NGCP/BulkProcessor/Serialization.pm (94%) rename Service.pm => lib/NGCP/BulkProcessor/Service.pm (93%) rename {Service => lib/NGCP/BulkProcessor/Service}/TestService.pm (69%) rename ServiceProxy.pm => lib/NGCP/BulkProcessor/ServiceProxy.pm (95%) rename SqlConnector.pm => lib/NGCP/BulkProcessor/SqlConnector.pm (94%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/CSVDB.pm (94%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/MySQLDB.pm (94%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/OracleDB.pm (94%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/PostgreSQLDB.pm (93%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/SQLServerDB.pm (93%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/SQLiteDB.pm (96%) rename {SqlConnectors => lib/NGCP/BulkProcessor/SqlConnectors}/SQLiteVarianceAggregate.pm (83%) rename SqlRecord.pm => lib/NGCP/BulkProcessor/SqlRecord.pm (96%) rename Table.pm => lib/NGCP/BulkProcessor/Table.pm (91%) rename Utils.pm => lib/NGCP/BulkProcessor/Utils.pm (95%) rename default.cfg => lib/NGCP/BulkProcessor/default.cfg (100%) diff --git a/NoSqlConnector.pm b/NoSqlConnector.pm deleted file mode 100644 index 3f2e1f6..0000000 --- a/NoSqlConnector.pm +++ /dev/null @@ -1,6 +0,0 @@ -package NoSqlConnector; -use strict; - -## no critic - -1; \ No newline at end of file diff --git a/Projects/Migration/IPGallery/Import.pm b/Projects/Migration/IPGallery/Import.pm deleted file mode 100644 index 4572740..0000000 --- a/Projects/Migration/IPGallery/Import.pm +++ /dev/null @@ -1,126 +0,0 @@ -package Projects::Migration::IPGallery::Import; -use strict; - -## no critic - -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); - -use Globals qw( - $cpucount -); -use Projects::Migration::IPGallery::Settings qw( - $import_multithreading - $feature_define_import_numofthreads - $dry -); -use Logging qw ( - getlogger -); -use LogError qw( - fileprocessingwarn - fileprocessingerror -); - -#use FileProcessors::CSVFile; -use Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile qw(); -use Projects::Migration::IPGallery::FeaturesDefineParser qw(); - -use Projects::Migration::IPGallery::ProjectConnectorPool qw( - get_import_db -); - -use Projects::Migration::IPGallery::Dao::FeatureOption qw(); -use Projects::Migration::IPGallery::Dao::FeatureOptionSet qw(); - -use Array qw(removeduplicates); - -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT_OK = qw( - import_features_define -); - - -sub import_features_define { - - my ($file) = @_; - my $result = Projects::Migration::IPGallery::Dao::FeatureOption::create_table(1); - $result &= Projects::Migration::IPGallery::Dao::FeatureOptionSet::create_table(1); - my $importer = Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile->new($feature_define_import_numofthreads); - $importer->{stoponparseerrors} = !$dry; - return $result && $importer->process($file,sub { - my ($context,$rows,$row_offset) = @_; - my $rownum = $row_offset; - my @featureoption_rows = (); - my @featureoptionset_rows = (); - foreach my $line (@$rows) { - my $row = undef; - if (not $importer->{parselines}) { - eval { - $row = Projects::Migration::IPGallery::FeaturesDefineParser::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++; - foreach my $subscriber_number (keys %$row) { - foreach my $option (@{$row->{$subscriber_number}}) { - if ('HASH' eq ref $option) { - foreach my $setoption (keys %$option) { - foreach my $setoptionitem (@{removeduplicates($option->{$setoption})}) { - push(@featureoptionset_rows,[ $subscriber_number, $setoption, $setoptionitem ]); - } - push(@featureoption_rows,[ $subscriber_number, $setoption ]); - } - } else { - push(@featureoption_rows,[ $subscriber_number, $option ]); - } - } - } - } - - my $import_db = &get_import_db(); - if ((scalar @featureoption_rows) > 0) { - $import_db->db_do_begin( - Projects::Migration::IPGallery::Dao::FeatureOption::getinsertstatement(), - Projects::Migration::IPGallery::Dao::FeatureOption::gettablename(), - #lock - $import_multithreading - ); - $import_db->db_do_rowblock(\@featureoption_rows); - $import_db->db_finish(); - } - if ((scalar @featureoptionset_rows) > 0) { - $import_db->db_do_begin( - Projects::Migration::IPGallery::Dao::FeatureOptionSet::getinsertstatement(), - Projects::Migration::IPGallery::Dao::FeatureOptionSet::gettablename(), - #lock - ); - $import_db->db_do_rowblock(\@featureoptionset_rows); - $import_db->db_finish(); - } - return 1; - }, sub { - my ($context)= @_; - if (not $importer->{parselines}) { - eval { - $context->{grammar} = Projects::Migration::IPGallery::FeaturesDefineParser::create_grammar(); - }; - if ($@) { - fileprocessingerror($context->{filename},$@,getlogger(__PACKAGE__)); - } - } - },$import_multithreading); - -} - - - -1; diff --git a/Projects/Migration/IPGallery/settings.cfg b/Projects/Migration/IPGallery/settings.cfg deleted file mode 100644 index 0822885..0000000 --- a/Projects/Migration/IPGallery/settings.cfg +++ /dev/null @@ -1,7 +0,0 @@ - -features_define_filename = /home/rkrenn/test/Features_Define.cfg - -import_multithreading = 1 -feature_define_import_numofthreads = 10 - -#dry=0 diff --git a/Projects/Migration/IPGallery/test.pl b/Projects/Migration/IPGallery/test.pl deleted file mode 100644 index 5193a45..0000000 --- a/Projects/Migration/IPGallery/test.pl +++ /dev/null @@ -1,105 +0,0 @@ -#!/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 deleted file mode 100644 index 0497086..0000000 --- a/Projects/Migration/IPGallery/test_count.pl +++ /dev/null @@ -1,62 +0,0 @@ - -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/Excel/Reader/XLSX.pm b/lib/Excel/Reader/XLSX.pm similarity index 100% rename from Excel/Reader/XLSX.pm rename to lib/Excel/Reader/XLSX.pm diff --git a/Excel/Reader/XLSX/Cell.pm b/lib/Excel/Reader/XLSX/Cell.pm similarity index 100% rename from Excel/Reader/XLSX/Cell.pm rename to lib/Excel/Reader/XLSX/Cell.pm diff --git a/Excel/Reader/XLSX/Package/ContentTypes.pm b/lib/Excel/Reader/XLSX/Package/ContentTypes.pm similarity index 100% rename from Excel/Reader/XLSX/Package/ContentTypes.pm rename to lib/Excel/Reader/XLSX/Package/ContentTypes.pm diff --git a/Excel/Reader/XLSX/Package/Relationships.pm b/lib/Excel/Reader/XLSX/Package/Relationships.pm similarity index 100% rename from Excel/Reader/XLSX/Package/Relationships.pm rename to lib/Excel/Reader/XLSX/Package/Relationships.pm diff --git a/Excel/Reader/XLSX/Package/SharedStrings.pm b/lib/Excel/Reader/XLSX/Package/SharedStrings.pm similarity index 100% rename from Excel/Reader/XLSX/Package/SharedStrings.pm rename to lib/Excel/Reader/XLSX/Package/SharedStrings.pm diff --git a/Excel/Reader/XLSX/Package/XMLreader.pm b/lib/Excel/Reader/XLSX/Package/XMLreader.pm similarity index 100% rename from Excel/Reader/XLSX/Package/XMLreader.pm rename to lib/Excel/Reader/XLSX/Package/XMLreader.pm diff --git a/Excel/Reader/XLSX/Row.pm b/lib/Excel/Reader/XLSX/Row.pm similarity index 100% rename from Excel/Reader/XLSX/Row.pm rename to lib/Excel/Reader/XLSX/Row.pm diff --git a/Excel/Reader/XLSX/Workbook.pm b/lib/Excel/Reader/XLSX/Workbook.pm similarity index 100% rename from Excel/Reader/XLSX/Workbook.pm rename to lib/Excel/Reader/XLSX/Workbook.pm diff --git a/Excel/Reader/XLSX/Worksheet.pm b/lib/Excel/Reader/XLSX/Worksheet.pm similarity index 100% rename from Excel/Reader/XLSX/Worksheet.pm rename to lib/Excel/Reader/XLSX/Worksheet.pm diff --git a/Array.pm b/lib/NGCP/BulkProcessor/Array.pm similarity index 90% rename from Array.pm rename to lib/NGCP/BulkProcessor/Array.pm index 2291b8e..fdeb0bb 100644 --- a/Array.pm +++ b/lib/NGCP/BulkProcessor/Array.pm @@ -1,9 +1,9 @@ -package Array; +package NGCP::BulkProcessor::Array; use strict; ## no critic -use Table; +use NGCP::BulkProcessor::Table; require Exporter; our @ISA = qw(Exporter); @@ -83,19 +83,19 @@ sub itemcount { sub grouparray { my ($array_ptr,$case_insensitive) = @_; - my $result = new Table(); + my $result = new NGCP::BulkProcessor::Table(); my $reducedarray = removeduplicates($array_ptr,$case_insensitive); my $sort_occurencecount_desc; if ($case_insensitive) { $sort_occurencecount_desc = sub { - return ((lc($Table::b->[1]) <=> lc($Table::a->[1])) or (lc($Table::a->[0]) cmp lc($Table::b->[0]))); + return ((lc($NGCP::BulkProcessor::Table::b->[1]) <=> lc($NGCP::BulkProcessor::Table::a->[1])) or (lc($NGCP::BulkProcessor::Table::a->[0]) cmp lc($NGCP::BulkProcessor::Table::b->[0]))); }; } else { $sort_occurencecount_desc = sub { - return (($Table::b->[1] <=> $Table::a->[1]) or ($Table::a->[0] cmp $Table::b->[0])); + return (($NGCP::BulkProcessor::Table::b->[1] <=> $NGCP::BulkProcessor::Table::a->[1]) or ($NGCP::BulkProcessor::Table::a->[0] cmp $NGCP::BulkProcessor::Table::b->[0])); }; } @@ -381,4 +381,4 @@ sub mapeq { } } -1; \ No newline at end of file +1; diff --git a/AttachmentDownloader.pm b/lib/NGCP/BulkProcessor/AttachmentDownloader.pm similarity index 94% rename from AttachmentDownloader.pm rename to lib/NGCP/BulkProcessor/AttachmentDownloader.pm index bdc247c..7fad98d 100755 --- a/AttachmentDownloader.pm +++ b/lib/NGCP/BulkProcessor/AttachmentDownloader.pm @@ -2,15 +2,15 @@ ## no critic -package AttachmentDownloader; +package NGCP::BulkProcessor::AttachmentDownloader; use strict; -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger attachmentdownloaderdebug attachmentdownloaderinfo ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( fileerror attachmentdownloadererror attachmentdownloaderwarn @@ -25,7 +25,7 @@ use LWP::UserAgent; use HTTP::Request; #use HTTP::Cookies; -use Utils qw(kbytes2gigs changemod); +use NGCP::BulkProcessor::Utils qw(kbytes2gigs changemod); require Exporter; our @ISA = qw(Exporter); @@ -263,4 +263,4 @@ sub DESTROY { $self->logout(); } -1; \ No newline at end of file +1; diff --git a/ConnectorPool.pm b/lib/NGCP/BulkProcessor/ConnectorPool.pm similarity index 78% rename from ConnectorPool.pm rename to lib/NGCP/BulkProcessor/ConnectorPool.pm index 47d9291..2b7fe2f 100644 --- a/ConnectorPool.pm +++ b/lib/NGCP/BulkProcessor/ConnectorPool.pm @@ -1,9 +1,9 @@ -package ConnectorPool; +package NGCP::BulkProcessor::ConnectorPool; use strict; ## no critic -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $accounting_databasename $accounting_username @@ -25,23 +25,23 @@ use Globals qw( ); -use Logging qw(getlogger); -use LogError qw(dbclustererror dbclusterwarn); #nodumpdbset +use NGCP::BulkProcessor::Logging qw(getlogger); +use NGCP::BulkProcessor::LogError qw(dbclustererror dbclusterwarn); #nodumpdbset -use SqlConnectors::MySQLDB; -#use SqlConnectors::OracleDB; -#use SqlConnectors::PostgreSQLDB; -#use SqlConnectors::SQLiteDB qw($staticdbfilemode +use NGCP::BulkProcessor::SqlConnectors::MySQLDB; +#use NGCP::BulkProcessor::SqlConnectors::OracleDB; +#use NGCP::BulkProcessor::SqlConnectors::PostgreSQLDB; +#use NGCP::BulkProcessor::SqlConnectors::SQLiteDB qw($staticdbfilemode # cleanupdbfiles); -use SqlConnectors::CSVDB; -#use SqlConnectors::SQLServerDB; -use RestConnectors::NGCPRestApi; +use NGCP::BulkProcessor::SqlConnectors::CSVDB; +#use NGCP::BulkProcessor::SqlConnectors::SQLServerDB; +use NGCP::BulkProcessor::RestConnectors::NGCPRestApi; -use SqlRecord qw(cleartableinfo); +use NGCP::BulkProcessor::SqlRecord qw(cleartableinfo); -use Utils qw(threadid); +use NGCP::BulkProcessor::Utils qw(threadid); -use Array qw( +use NGCP::BulkProcessor::Array qw( filter mergearrays getroundrobinitem @@ -77,7 +77,7 @@ sub get_accounting_db { my ($instance_name,$reconnect) = @_; my $name = get_connectorinstancename($instance_name); if (!defined $accounting_dbs->{$name}) { - $accounting_dbs->{$name} = SqlConnectors::MySQLDB->new($instance_name); + $accounting_dbs->{$name} = NGCP::BulkProcessor::SqlConnectors::MySQLDB->new($instance_name); if (!defined $reconnect) { $reconnect = 1; } @@ -93,7 +93,7 @@ sub accounting_db_tableidentifier { my ($get_target_db,$tablename) = @_; my $target_db = (ref $get_target_db eq 'CODE') ? &$get_target_db() : $get_target_db; - return $target_db->getsafetablename(SqlConnectors::MySQLDB::get_tableidentifier($tablename,$accounting_databasename)); + return $target_db->getsafetablename(NGCP::BulkProcessor::SqlConnectors::MySQLDB::get_tableidentifier($tablename,$accounting_databasename)); } @@ -103,7 +103,7 @@ sub get_billing_db { my ($instance_name,$reconnect) = @_; my $name = get_connectorinstancename($instance_name); if (!defined $billing_dbs->{$name}) { - $billing_dbs->{$name} = SqlConnectors::MySQLDB->new($instance_name); + $billing_dbs->{$name} = NGCP::BulkProcessor::SqlConnectors::MySQLDB->new($instance_name); if (!defined $reconnect) { $reconnect = 1; } @@ -119,7 +119,7 @@ sub billing_db_tableidentifier { my ($get_target_db,$tablename) = @_; my $target_db = (ref $get_target_db eq 'CODE') ? &$get_target_db() : $get_target_db; - return $target_db->getsafetablename(SqlConnectors::MySQLDB::get_tableidentifier($tablename,$billing_databasename)); + return $target_db->getsafetablename(NGCP::BulkProcessor::SqlConnectors::MySQLDB::get_tableidentifier($tablename,$billing_databasename)); } @@ -128,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,$ngcprestapi_realm); + $ngcp_restapis->{$name} = NGCP::BulkProcessor::RestConnectors::NGCPRestApi->new($instance_name,$ngcprestapi_uri,$ngcprestapi_username,$ngcprestapi_password,$ngcprestapi_realm); } return $ngcp_restapis->{$name}; diff --git a/DSSorter.pm b/lib/NGCP/BulkProcessor/DSSorter.pm similarity index 88% rename from DSSorter.pm rename to lib/NGCP/BulkProcessor/DSSorter.pm index 92b022f..e5894a6 100644 --- a/DSSorter.pm +++ b/lib/NGCP/BulkProcessor/DSSorter.pm @@ -1,4 +1,4 @@ -package DSSorter; +package NGCP::BulkProcessor::DSSorter; use strict; ## no critic @@ -6,15 +6,17 @@ use strict; # guarantee stability, regardless of algorithm use sort 'stable'; -use Logging qw(getlogger); -use LogError qw(sortconfigerror); +use NGCP::BulkProcessor::Logging qw(getlogger); +use NGCP::BulkProcessor::LogError qw(sortconfigerror); -use Table; +use NGCP::BulkProcessor::Table; require Exporter; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(sort_by_config_ids - sort_by_configs); +our @EXPORT_OK = qw( + sort_by_config_ids + sort_by_configs +); #my $logger = getlogger(__PACKAGE__); @@ -22,7 +24,7 @@ sub new { my $class = shift; my $self = {}; - $self->{sortconfig} = Table->new(); + $self->{sortconfig} = NGCP::BulkProcessor::Table->new(); bless($self,$class); return $self; @@ -117,7 +119,7 @@ sub sort_by_config_ids { ref $sortingconfigurations eq 'HASH') { my @sorting_ids = @$sortings; if ((scalar @sorting_ids) > 0) { - my $sorter = DSSorter->new(); + my $sorter = NGCP::BulkProcessor::DSSorter->new(); foreach my $sorting_id (@sorting_ids) { my $sc = $sortingconfigurations->{$sorting_id}; if (defined $sc and ref $sc eq 'HASH') { @@ -156,7 +158,7 @@ sub sort_by_configs { my @scs = @$sortingconfigurations; if ((scalar @scs) > 0) { - my $sorter = DSSorter->new(); + my $sorter = NGCP::BulkProcessor::DSSorter->new(); my $sorting_id = -1; foreach my $sc (@scs) { #my $sc = $sortingconfigurations->{$sorting_id}; @@ -183,4 +185,4 @@ sub sort_by_configs { } -1; \ No newline at end of file +1; diff --git a/Dao/Trunk/accounting/cdr.pm b/lib/NGCP/BulkProcessor/Dao/Trunk/accounting/cdr.pm similarity index 100% rename from Dao/Trunk/accounting/cdr.pm rename to lib/NGCP/BulkProcessor/Dao/Trunk/accounting/cdr.pm diff --git a/Dao/Trunk/billing/contract_balances.pm b/lib/NGCP/BulkProcessor/Dao/Trunk/billing/contract_balances.pm similarity index 78% rename from Dao/Trunk/billing/contract_balances.pm rename to lib/NGCP/BulkProcessor/Dao/Trunk/billing/contract_balances.pm index 2d77f58..1bda5f1 100644 --- a/Dao/Trunk/billing/contract_balances.pm +++ b/lib/NGCP/BulkProcessor/Dao/Trunk/billing/contract_balances.pm @@ -1,22 +1,21 @@ - -package Dao::Trunk::billing::contract_balances; +package NGCP::BulkProcessor::Dao::Trunk::billing::contract_balances; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); - -#use Logging qw(getlogger); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); -use ConnectorPool qw(get_billing_db - billing_db_tableidentifier); +use NGCP::BulkProcessor::ConnectorPool qw( + get_billing_db + billing_db_tableidentifier +); -use SqlRecord qw(checktableinfo); +use NGCP::BulkProcessor::SqlRecord qw(checktableinfo); require Exporter; -our @ISA = qw(Exporter SqlRecord); +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlRecord); our @EXPORT_OK = qw( XX backoffice_client_byboclientid @@ -53,7 +52,7 @@ my $expected_fieldnames = [ sub new { my $class = shift; - my $self = SqlRecord->new($get_db, + my $self = NGCP::BulkProcessor::SqlRecord->new($get_db, gettablename(), $expected_fieldnames); diff --git a/Downloaders/IMAPAttachmentDownloader.pm b/lib/NGCP/BulkProcessor/Downloaders/IMAPAttachmentDownloader.pm similarity index 88% rename from Downloaders/IMAPAttachmentDownloader.pm rename to lib/NGCP/BulkProcessor/Downloaders/IMAPAttachmentDownloader.pm index d33ae38..eddceed 100755 --- a/Downloaders/IMAPAttachmentDownloader.pm +++ b/lib/NGCP/BulkProcessor/Downloaders/IMAPAttachmentDownloader.pm @@ -1,24 +1,24 @@ -package Downloaders::IMAPAttachmentDownloader; +package NGCP::BulkProcessor::Downloaders::IMAPAttachmentDownloader; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger attachmentdownloaderdebug attachmentdownloaderinfo ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( fileerror attachmentdownloadererror attachmentdownloaderwarn ); -use Utils qw(kbytes2gigs); # changemod); +use NGCP::BulkProcessor::Utils qw(kbytes2gigs); # changemod); use IO::Socket::SSL; use Mail::IMAPClient; @@ -29,7 +29,7 @@ use MIME::Base64; #use Authen::SASL qw(Perl); require Exporter; -our @ISA = qw(Exporter AttachmentDownloader); +our @ISA = qw(Exporter NGCP::BulkProcessor::AttachmentDownloader); our @EXPORT_OK = qw(); #my $logger = getlogger(__PACKAGE__); @@ -38,7 +38,7 @@ sub new { my $class = shift; my ($server,$ssl,$user,$pass,$foldername,$checkfilenamecode,$download_urls) = @_; - my $self = AttachmentDownloader->new($class,$server,$ssl,$user,$pass,$foldername,$checkfilenamecode,$download_urls); + my $self = NGCP::BulkProcessor::AttachmentDownloader->new($class,$server,$ssl,$user,$pass,$foldername,$checkfilenamecode,$download_urls); attachmentdownloaderdebug('IMAP attachment downloader object created',getlogger(__PACKAGE__)); return $self; @@ -180,4 +180,4 @@ sub download { } -1; \ No newline at end of file +1; diff --git a/FakeTime.pm b/lib/NGCP/BulkProcessor/FakeTime.pm similarity index 95% rename from FakeTime.pm rename to lib/NGCP/BulkProcessor/FakeTime.pm index a969299..9e1a9c4 100644 --- a/FakeTime.pm +++ b/lib/NGCP/BulkProcessor/FakeTime.pm @@ -1,4 +1,4 @@ -package FakeTime; +package NGCP::BulkProcessor::FakeTime; use strict; ## no critic @@ -9,12 +9,12 @@ use DateTime::TimeZone qw(); use DateTime::Format::Strptime qw(); use DateTime::Format::ISO8601 qw(); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger faketimedebug faketimeinfo); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( faketimeerror restwarn); @@ -32,8 +32,8 @@ our @EXPORT_OK = qw( #my $logger = getlogger(__PACKAGE__); -my $is_fake_time = 0; - +my $is_fake_time = 0; + sub set_time { my ($o) = @_; if (defined $o) { @@ -53,8 +53,8 @@ sub _get_fake_clienttime_now { sub get_now { return _current_local(); -} - +} + sub current_unix { if ($is_fake_time) { return Time::Warp::time; @@ -141,4 +141,4 @@ sub _set_fake_time { } } -1; \ No newline at end of file +1; diff --git a/FileProcessor.pm b/lib/NGCP/BulkProcessor/FileProcessor.pm similarity index 96% rename from FileProcessor.pm rename to lib/NGCP/BulkProcessor/FileProcessor.pm index ff701e3..d9e4963 100644 --- a/FileProcessor.pm +++ b/lib/NGCP/BulkProcessor/FileProcessor.pm @@ -1,4 +1,4 @@ -package FileProcessor; +package NGCP::BulkProcessor::FileProcessor; use strict; ## no critic @@ -9,11 +9,11 @@ use Thread::Queue; use Time::HiRes qw(sleep); -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $enablemultithreading $cpucount ); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger filethreadingdebug fileprocessingstarted @@ -22,19 +22,14 @@ use Logging qw( processing_lines ); - -# fetching_rows -# writing_rows -# processing_rows - -use LogError qw( +use NGCP::BulkProcessor::LogError qw( processzerofilesize fileprocessingfailed fileerror notimplementederror ); -use Utils qw(threadid); +use NGCP::BulkProcessor::Utils qw(threadid); require Exporter; our @ISA = qw(Exporter); @@ -93,7 +88,7 @@ sub process { my $self = shift; - my ($file,$process_code,$init_process_context_code,$multithreading) = @_; + my ($file,$process_code,$init_process_context_code,$uninit_process_context_code,$multithreading) = @_; if (ref $process_code eq 'CODE') { @@ -132,6 +127,7 @@ sub process { filename => $file, process_code => $process_code, init_process_context_code => $init_process_context_code, + uninit_process_context_code => $uninit_process_context_code, instance => $self, }); if (!defined $processor) { @@ -241,6 +237,10 @@ sub process { } close(INPUTFILE); + if ('CODE' eq ref $uninit_process_context_code) { + &$uninit_process_context_code($context); + } + }; if ($@) { @@ -433,6 +433,9 @@ sub _process { sleep($thread_sleep_secs); #2015-01 } } + if ('CODE' eq ref $context->{uninit_process_context_code}) { + &{$context->{uninit_process_context_code}}($context); + } }; filethreadingdebug($@ ? '[' . $tid . '] processor thread error: ' . $@ : '[' . $tid . '] processor thread finished (' . $blockcount . ' blocks)',getlogger(__PACKAGE__)); lock $context->{errorstates}; diff --git a/FileProcessors/CSVFile.pm b/lib/NGCP/BulkProcessor/FileProcessors/CSVFile.pm similarity index 76% rename from FileProcessors/CSVFile.pm rename to lib/NGCP/BulkProcessor/FileProcessors/CSVFile.pm index 0714044..4a3e065 100644 --- a/FileProcessors/CSVFile.pm +++ b/lib/NGCP/BulkProcessor/FileProcessors/CSVFile.pm @@ -1,24 +1,20 @@ -package FileProcessors::CSVFile; +package NGCP::BulkProcessor::FileProcessors::CSVFile; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); -#use Globals qw( -# $cpucount -#); - -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger ); -use FileProcessor; +use NGCP::BulkProcessor::FileProcessor; require Exporter; -our @ISA = qw(Exporter FileProcessor); +our @ISA = qw(Exporter NGCP::BulkProcessor::FileProcessor); our @EXPORT_OK = qw(); my $default_lineseparator = '\\n\\r|\\r|\\n'; @@ -35,7 +31,7 @@ sub new { my $class = shift; - my $self = FileProcessor->new(@_); + my $self = NGCP::BulkProcessor::FileProcessor->new(@_); $self->{numofthreads} = shift // $default_numofthreads; $self->{line_separator} = shift // $default_lineseparator; diff --git a/Globals.pm b/lib/NGCP/BulkProcessor/Globals.pm similarity index 89% rename from Globals.pm rename to lib/NGCP/BulkProcessor/Globals.pm index 53f001b..e4a4f85 100644 --- a/Globals.pm +++ b/lib/NGCP/BulkProcessor/Globals.pm @@ -1,4 +1,4 @@ -package Globals; +package NGCP::BulkProcessor::Globals; use strict; ## no critic @@ -17,13 +17,14 @@ use File::Basename qw(dirname); use File::Temp qw(tempdir); use FindBin qw(); -use Utils qw( - get_ipaddress - get_hostfqdn - get_cpucount - makepath - fixdirpath - $chmod_umask); +use NGCP::BulkProcessor::Utils qw( + get_ipaddress + get_hostfqdn + get_cpucount + makepath + fixdirpath + $chmod_umask +); require Exporter; our @ISA = qw(Exporter); @@ -60,53 +61,45 @@ our @EXPORT_OK = qw( $billing_host $billing_port -$ngcprestapi_uri -$ngcprestapi_username -$ngcprestapi_password -$ngcprestapi_realm + $ngcprestapi_uri + $ngcprestapi_username + $ngcprestapi_password + $ngcprestapi_realm $csv_path $input_path - - $local_db_path - $emailenable - $erroremailrecipient - $warnemailrecipient - $completionemailrecipient - $successemailrecipient - $mailfile_path - - $ismsexchangeserver - $sender_address - $smtp_server - $smtpuser - $smtppasswd - $writefiles - - $logfile_path - $fileloglevel - $screenloglevel - $emailloglevel -$mailprog -$mailtype - - - $defaultconfig - - update_mainconfig - - - - $chmod_umask - - @jobservers - $jobnamespace - - - - ); - + $local_db_path + $emailenable + $erroremailrecipient + $warnemailrecipient + $completionemailrecipient + $successemailrecipient + $mailfile_path + + $ismsexchangeserver + $sender_address + $smtp_server + $smtpuser + $smtppasswd + $writefiles + + $logfile_path + $fileloglevel + $screenloglevel + $emailloglevel + $mailprog + $mailtype + + $defaultconfig + + update_mainconfig + + $chmod_umask + + @jobservers + $jobnamespace +); #set process umask for open and mkdir calls: umask 0000; diff --git a/LoadConfig.pm b/lib/NGCP/BulkProcessor/LoadConfig.pm similarity index 75% rename from LoadConfig.pm rename to lib/NGCP/BulkProcessor/LoadConfig.pm index b094464..a7c15cf 100644 --- a/LoadConfig.pm +++ b/lib/NGCP/BulkProcessor/LoadConfig.pm @@ -1,9 +1,9 @@ -package LoadConfig; +package NGCP::BulkProcessor::LoadConfig; use strict; ## no critic -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $system_name $system_version $system_instance_label @@ -16,19 +16,19 @@ use Globals qw( update_mainconfig ); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger configurationinfo ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( fileerror configurationwarn configurationerror ); use YAML::Tiny; -use Utils qw(format_number); +use NGCP::BulkProcessor::Utils qw(format_number); require Exporter; our @ISA = qw(Exporter); @@ -51,7 +51,7 @@ our $YAML_CONFIG_TYPE = 2; sub load_config { my ($configfile,$process_code,$configtype) = @_; - + my $is_settings = 'CODE' eq ref $process_code; my $data; if (defined $configfile) { @@ -78,7 +78,7 @@ sub load_config { fileerror('no ' . ($is_settings ? 'settings' : 'config') . ' file specified',getlogger(__PACKAGE__)); return 0; } - + if ($is_settings) { my $result = &$process_code($data,$configfile, \&split_tuple, @@ -106,13 +106,13 @@ sub load_config { } 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 { @@ -122,7 +122,7 @@ sub _parse_config { if ($configtype == $SIMPLE_CONFIG_TYPE) { $data = _parse_simple_config($file); } elsif ($configtype == $YAML_CONFIG_TYPE) { - $data = _parse_yaml_config($file); + $data = _parse_yaml_config($file); } else { $data = _parse_simple_config($file); } @@ -163,58 +163,58 @@ sub split_tuple { sub _parse_simple_config { - my $file = shift; + my $file = shift; - my $config = {}; - local *CF; + my $config = {}; + local *CF; - if (not open (CF, '<' . $file)) { - fileerror('parsing simple format - cannot open file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); - return $config; - } + if (not open (CF, '<' . $file)) { + fileerror('parsing simple format - cannot open file ' . $file . ': ' . $!,getlogger(__PACKAGE__)); + return $config; + } - read(CF, my $data, -s $file); - close(CF); + read(CF, my $data, -s $file); + close(CF); - my @lines = split(/\015\012|\012|\015/,$data); - my $count = 0; + my @lines = split(/\015\012|\012|\015/,$data); + my $count = 0; - foreach my $line(@lines) { - $count++; + foreach my $line(@lines) { + $count++; - next if($line =~ /^\s*#/); - next if($line !~ /^\s*\S+\s*=.*$/); + next if($line =~ /^\s*#/); + next if($line !~ /^\s*\S+\s*=.*$/); - #my $cindex = index($line,'#'); - #if ($cindex >= 0) { - # $line = substr($line,0,$cindex); - #} + #my $cindex = index($line,'#'); + #if ($cindex >= 0) { + # $line = substr($line,0,$cindex); + #} - my ($key,$value) = split(/=/,$line,2); + my ($key,$value) = split(/=/,$line,2); - # Remove whitespaces at the beginning and at the end + # Remove whitespaces at the beginning and at the end - $key =~ s/^\s+//g; - $key =~ s/\s+$//g; - $value =~ s/^\s+//g; - $value =~ s/\s+$//g; + $key =~ s/^\s+//g; + $key =~ s/\s+$//g; + $value =~ s/^\s+//g; + $value =~ s/\s+$//g; - if (exists $config->{$key}) { - configurationwarn($file,'parsing simple format - parameter ' . $key . ' defined twice in line ' . $count,getlogger(__PACKAGE__)); - } + if (exists $config->{$key}) { + configurationwarn($file,'parsing simple format - parameter ' . $key . ' defined twice in line ' . $count,getlogger(__PACKAGE__)); + } - $config->{$key} = $value; - #print $key . "\n"; - } + $config->{$key} = $value; + #print $key . "\n"; + } - return $config; + return $config; } sub _parse_yaml_config { my $file = shift; - + my $yaml = undef; eval { $yaml = YAML::Tiny->read($file); @@ -223,9 +223,9 @@ sub _parse_yaml_config { configurationerror($file,'parsing yaml format - error: ' . $!,getlogger(__PACKAGE__)); return $yaml; } - + return $yaml; - + } -1; \ No newline at end of file +1; diff --git a/LogError.pm b/lib/NGCP/BulkProcessor/LogError.pm similarity index 95% rename from LogError.pm rename to lib/NGCP/BulkProcessor/LogError.pm index 32e6ab2..3d5bbc1 100644 --- a/LogError.pm +++ b/lib/NGCP/BulkProcessor/LogError.pm @@ -1,13 +1,9 @@ -package LogError; +package NGCP::BulkProcessor::LogError; use strict; ## no critic -#use threads 1.72; # qw(running); -#use threads::shared; - -#use LoadConfig; -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $system_version $erroremailrecipient $warnemailrecipient @@ -17,7 +13,7 @@ use Globals qw( $root_threadid ); -use Mail qw( +use NGCP::BulkProcessor::Mail qw( send_message send_email $signature @@ -25,7 +21,7 @@ use Mail qw( $lowpriority $normalpriority ); -use Utils qw( +use NGCP::BulkProcessor::Utils qw( threadid create_guid getscriptpath diff --git a/Logging.pm b/lib/NGCP/BulkProcessor/Logging.pm similarity index 95% rename from Logging.pm rename to lib/NGCP/BulkProcessor/Logging.pm index 1c4c2d7..d7d656c 100644 --- a/Logging.pm +++ b/lib/NGCP/BulkProcessor/Logging.pm @@ -1,11 +1,9 @@ -# a verbose logging module - -package Logging; +package NGCP::BulkProcessor::Logging; use strict; ## no critic -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $root_threadid $logfile_path $fileloglevel @@ -18,8 +16,8 @@ use Log::Log4perl qw(get_logger); use File::Basename qw(basename); -use Utils qw(timestampdigits datestampdigits changemod chopstring trim kbytes2gigs); -use Array qw (contains); +use NGCP::BulkProcessor::Utils qw(timestampdigits datestampdigits changemod chopstring trim kbytes2gigs); +use NGCP::BulkProcessor::Array qw (contains); require Exporter; our @ISA = qw(Exporter); @@ -86,7 +84,6 @@ our @EXPORT_OK = qw( servicedebug serviceinfo ); -#abortthread my $logfileextension = '.log'; @@ -96,9 +93,6 @@ our $attachmentlogfile; my $loginitialized = 0; -##eval { -# init_log4perl(); -##}; init_log_default(); sub createlogfile { diff --git a/Mail.pm b/lib/NGCP/BulkProcessor/Mail.pm similarity index 95% rename from Mail.pm rename to lib/NGCP/BulkProcessor/Mail.pm index 5b3522f..3dc022f 100644 --- a/Mail.pm +++ b/lib/NGCP/BulkProcessor/Mail.pm @@ -1,21 +1,15 @@ -# mail module: sending emails with attachments - -package Mail; -#BEGIN { $INC{Mail} ||= __FILE__ }; +package NGCP::BulkProcessor::Mail; use strict; ## no critic -#require Logging; -use Logging qw( -getlogger -emailinfo -emaildebug); -#use LogError qw(fileerror); -#use LogWarn qw(emailwarn); +use NGCP::BulkProcessor::Logging qw( + getlogger + emailinfo + emaildebug +); -#use LoadConfig; -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $system_name $system_instance_label $system_version @@ -33,7 +27,7 @@ use Globals qw( $writefiles ); -use Utils qw(trim file_md5 create_guid wrap_text changemod); +use NGCP::BulkProcessor::Utils qw(trim file_md5 create_guid wrap_text changemod); use File::Basename; #use File::Temp qw(tempfile tempdir); @@ -624,4 +618,4 @@ sub send_email { } -1; \ No newline at end of file +1; diff --git a/lib/NGCP/BulkProcessor/NoSqlConnector.pm b/lib/NGCP/BulkProcessor/NoSqlConnector.pm new file mode 100644 index 0000000..a239802 --- /dev/null +++ b/lib/NGCP/BulkProcessor/NoSqlConnector.pm @@ -0,0 +1,6 @@ +package NGCP::BulkProcessor::NoSqlConnector; +use strict; + +## no critic + +1; diff --git a/Projects/Migration/IPGallery/Dao/FeatureOption.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/FeatureOption.pm similarity index 81% rename from Projects/Migration/IPGallery/Dao/FeatureOption.pm rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/FeatureOption.pm index d981be9..6e8f04a 100644 --- a/Projects/Migration/IPGallery/Dao/FeatureOption.pm +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/FeatureOption.pm @@ -1,21 +1,19 @@ -package Projects::Migration::IPGallery::Dao::FeatureOption; +package NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOption; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); -#use Logging qw(getlogger); - -use Projects::Migration::IPGallery::ProjectConnectorPool qw( +use NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool qw( get_import_db ); #import_db_tableidentifier -use SqlRecord qw( +use NGCP::BulkProcessor::SqlRecord qw( registertableinfo create_targettable checktableinfo @@ -25,7 +23,7 @@ use SqlRecord qw( ); require Exporter; -our @ISA = qw(Exporter SqlRecord); +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlRecord); our @EXPORT_OK = qw( create_table gettablename @@ -55,7 +53,7 @@ my $fixtable_statements = []; sub new { my $class = shift; - my $self = SqlRecord->new($get_db, + my $self = NGCP::BulkProcessor::SqlRecord->new($get_db, $tablename, $expected_fieldnames,$indexes); diff --git a/Projects/Migration/IPGallery/Dao/FeatureOptionSet.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/FeatureOptionSet.pm similarity index 73% rename from Projects/Migration/IPGallery/Dao/FeatureOptionSet.pm rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/FeatureOptionSet.pm index 94c1bc2..8c87891 100644 --- a/Projects/Migration/IPGallery/Dao/FeatureOptionSet.pm +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/FeatureOptionSet.pm @@ -1,21 +1,19 @@ -package Projects::Migration::IPGallery::Dao::FeatureOptionSet; +package NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOptionSet; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); -#use Logging qw(getlogger); - -use Projects::Migration::IPGallery::ProjectConnectorPool qw( +use NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool qw( get_import_db ); #import_db_tableidentifier -use SqlRecord qw( +use NGCP::BulkProcessor::SqlRecord qw( registertableinfo create_targettable checktableinfo @@ -25,7 +23,7 @@ use SqlRecord qw( ); require Exporter; -our @ISA = qw(Exporter SqlRecord); +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlRecord); our @EXPORT_OK = qw( create_table gettablename @@ -47,16 +45,16 @@ my $expected_fieldnames = [ 'subscribernumber', 'option', 'optionsetitem' ]; -my $primarykey_fieldnames = [ 'subscribernumber', 'option', 'optionsetitem' ]; +my $primarykey_fieldnames = []; #[ 'subscribernumber', 'option', 'optionsetitem' ]; -my $indexes = {}; +my $indexes = { $tablename . '_subscribernumber_option_optionsetitem' => ['subscribernumber(11)', 'option(32)', 'optionsetitem(32)'] }; #(25),(27) my $fixtable_statements = []; sub new { my $class = shift; - my $self = SqlRecord->new($get_db, + my $self = NGCP::BulkProcessor::SqlRecord->new($get_db, $tablename, $expected_fieldnames,$indexes); diff --git a/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/Subscriber.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/Subscriber.pm new file mode 100644 index 0000000..d979a8d --- /dev/null +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Dao/Subscriber.pm @@ -0,0 +1,133 @@ +package NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::Subscriber; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); + +use NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool qw( + get_import_db + +); +#import_db_tableidentifier + +use NGCP::BulkProcessor::SqlRecord qw( + registertableinfo + create_targettable + checktableinfo + copy_row + + insert_stmt +); + +require Exporter; +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlRecord); +our @EXPORT_OK = qw( + create_table + gettablename + check_table + getinsertstatement + + test_table_bycolumn1 + test_table_local_select + test_table_source_select + test_table_source_select_temptable +); + +my $tablename = 'subscriber'; +my $get_db = \&get_import_db; +#my $get_tablename = \&import_db_tableidentifier; + + +my $expected_fieldnames = [ + 'country_code', #356 + 'area_code', #None + 'dial_number', #35627883323 + 'rgw_fqdn', #35627883323 + 'port', #None + 'region_name', #None + 'carrier_code', #None + 'time_zone_name', #malta + 'lang_code', #eng + 'barring_profile', #None +]; + +my $primarykey_fieldnames = [ 'country_code', 'area_code', 'dial_number' ]; + +my $indexes = {}; + +my $fixtable_statements = []; + +sub new { + + my $class = shift; + my $self = NGCP::BulkProcessor::SqlRecord->new($get_db, + $tablename, + $expected_fieldnames,$indexes); + + bless($self,$class); + + copy_row($self,shift,$expected_fieldnames); + + return $self; + +} + +sub create_table { + + my ($truncate) = @_; + + my $db = &$get_db(); + + registertableinfo($db,$tablename,$expected_fieldnames,$indexes,$primarykey_fieldnames); + return create_targettable($db,$tablename,$db,$tablename,$truncate,0,undef); + +} + + +sub buildrecords_fromrows { + + my ($rows,$load_recursive) = @_; + + my @records = (); + my $record; + + if (defined $rows and ref $rows eq 'ARRAY') { + foreach my $row (@$rows) { + $record = __PACKAGE__->new($row); + + # transformations go here ... + + push @records,$record; + } + } + + return \@records; + +} + +sub getinsertstatement { + + check_table(); + return insert_stmt($get_db,$tablename); + +} + +sub gettablename { + + return $tablename; + +} + +sub check_table { + + return checktableinfo($get_db, + $tablename, + $expected_fieldnames, + $indexes); + +} + +1; diff --git a/Projects/Migration/IPGallery/FeaturesDefineParser.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FeaturesDefineParser.pm similarity index 90% rename from Projects/Migration/IPGallery/FeaturesDefineParser.pm rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FeaturesDefineParser.pm index 41edaab..b3e693e 100644 --- a/Projects/Migration/IPGallery/FeaturesDefineParser.pm +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FeaturesDefineParser.pm @@ -1,11 +1,11 @@ -package Projects::Migration::IPGallery::FeaturesDefineParser; +package NGCP::BulkProcessor::Projects::Migration::IPGallery::FeaturesDefineParser; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); use Marpa::R2; use Data::Dumper::Concise; diff --git a/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm similarity index 77% rename from Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm index 359a2a2..96b1f46 100644 --- a/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/FeaturesDefineFile.pm @@ -1,32 +1,28 @@ -package Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile; +package NGCP::BulkProcessor::Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); -#use Globals qw( -# $cpucount -#); - -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( fileprocessingerror fileprocessingwarn ); -use FileProcessor; -use Projects::Migration::IPGallery::FeaturesDefineParser qw( +use NGCP::BulkProcessor::FileProcessor; +use NGCP::BulkProcessor::Projects::Migration::IPGallery::FeaturesDefineParser qw( create_grammar parse ); require Exporter; -our @ISA = qw(Exporter FileProcessor); +our @ISA = qw(Exporter NGCP::BulkProcessor::FileProcessor); our @EXPORT_OK = qw(); my $lineseparator = '\\n(?=(?:\d+\\n))'; @@ -34,9 +30,9 @@ my $encoding = 'UTF-8'; my $buffersize = 1400; # 512 * 1024; my $threadqueuelength = 10; -my $default_numofthreads = undef; #3; +my $default_numofthreads = 2; #3; #my $multithreading = 0; -my $blocksize = 200; #2000; +my $blocksize = 1000; #2000; my $stoponparseerrors = 1; #1; my $parselines = 0; @@ -45,7 +41,7 @@ sub new { my $class = shift; - my $self = FileProcessor->new(@_); + my $self = NGCP::BulkProcessor::FileProcessor->new(@_); $self->{numofthreads} = shift // $default_numofthreads; $self->{line_separator} = $lineseparator; diff --git a/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/SubscriberDefineFile.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/SubscriberDefineFile.pm new file mode 100644 index 0000000..61323f1 --- /dev/null +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/FileProcessors/SubscriberDefineFile.pm @@ -0,0 +1,66 @@ +package NGCP::BulkProcessor::Projects::Migration::IPGallery::FileProcessors::SubscriberDefineFile; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); + +use NGCP::BulkProcessor::Logging qw( + getlogger +); +use NGCP::BulkProcessor::LogError qw( + fileprocessingerror + fileprocessingwarn +); + +use NGCP::BulkProcessor::FileProcessor; + +require Exporter; +our @ISA = qw(Exporter NGCP::BulkProcessor::FileProcessor); +our @EXPORT_OK = qw(); + +my $lineseparator = '\\n'; +my $fieldseparator = " +"; +my $encoding = 'UTF-8'; + +my $buffersize = 100 * 1024; +my $threadqueuelength = 10; +my $default_numofthreads = 3; +#my $multithreading = 0; +my $blocksize = 100; + +sub new { + + my $class = shift; + + my $self = NGCP::BulkProcessor::FileProcessor->new(@_); + + $self->{numofthreads} = shift // $default_numofthreads; + $self->{line_separator} = $lineseparator; + $self->{field_separator} = $fieldseparator; + $self->{encoding} = $encoding; + $self->{buffersize} = $buffersize; + $self->{threadqueuelength} = $threadqueuelength; + #$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}; + $$line_ref =~ s/^ +//; + $$line_ref =~ s/ +$//; + my @fields = split(/$separator/,$$line_ref,-1); + return \@fields; +} + +1; diff --git a/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Import.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Import.pm new file mode 100644 index 0000000..80d4259 --- /dev/null +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Import.pm @@ -0,0 +1,164 @@ +package NGCP::BulkProcessor::Projects::Migration::IPGallery::Import; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); + +use NGCP::BulkProcessor::Globals qw( + $cpucount +); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Settings qw( + $import_multithreading + $features_define_import_numofthreads + $skip_duplicate_setoptionitems + $subscriber_define_import_numofthreads + $dry +); +use NGCP::BulkProcessor::Logging qw ( + getlogger +); +use NGCP::BulkProcessor::LogError qw( + fileprocessingwarn + fileprocessingerror +); + +use NGCP::BulkProcessor::Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile qw(); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::FeaturesDefineParser qw(); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::FileProcessors::SubscriberDefineFile qw(); + +use NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool qw( + get_import_db + destroy_dbs +); + +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOption qw(); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOptionSet qw(); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::Subscriber qw(); + +use NGCP::BulkProcessor::Array qw(removeduplicates); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( + import_features_define + import_subscriber_define +); + +sub import_features_define { + + my ($file) = @_; + my $result = NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOption::create_table(1); + $result &= NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOptionSet::create_table(1); + destroy_dbs(); #close all db connections before forking.. + my $importer = NGCP::BulkProcessor::Projects::Migration::IPGallery::FileProcessors::FeaturesDefineFile->new($features_define_import_numofthreads); + $importer->{stoponparseerrors} = !$dry; + return $result && $importer->process($file,sub { + my ($context,$rows,$row_offset) = @_; + my $rownum = $row_offset; + my @featureoption_rows = (); + my @featureoptionset_rows = (); + foreach my $line (@$rows) { + my $row = undef; + if (not $importer->{parselines}) { + eval { + $row = NGCP::BulkProcessor::Projects::Migration::IPGallery::FeaturesDefineParser::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++; + foreach my $subscriber_number (keys %$row) { + foreach my $option (@{$row->{$subscriber_number}}) { + if ('HASH' eq ref $option) { + foreach my $setoption (keys %$option) { + foreach my $setoptionitem (@{$skip_duplicate_setoptionitems ? removeduplicates($option->{$setoption}) : $option->{$setoption}}) { + push(@featureoptionset_rows,[ $subscriber_number, $setoption, $setoptionitem ]); + } + push(@featureoption_rows,[ $subscriber_number, $setoption ]); + } + } else { + push(@featureoption_rows,[ $subscriber_number, $option ]); + } + } + } + } + + if ((scalar @featureoption_rows) > 0) { + $context->{db}->db_do_begin( + NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOption::getinsertstatement(), + NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOption::gettablename(), + #lock - $import_multithreading + ); + $context->{db}->db_do_rowblock(\@featureoption_rows); + $context->{db}->db_finish(); + } + if ((scalar @featureoptionset_rows) > 0) { + $context->{db}->db_do_begin( + NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOptionSet::getinsertstatement(), + NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::FeatureOptionSet::gettablename(), + #lock + ); + $context->{db}->db_do_rowblock(\@featureoptionset_rows); + $context->{db}->db_finish(); + } + return 1; + }, sub { + my ($context)= @_; + if (not $importer->{parselines}) { + eval { + $context->{grammar} = NGCP::BulkProcessor::Projects::Migration::IPGallery::FeaturesDefineParser::create_grammar(); + }; + if ($@) { + fileprocessingerror($context->{filename},$@,getlogger(__PACKAGE__)); + } + } + $context->{db} = &get_import_db(); # keep ref count low.. + }, sub { + my ($context)= @_; + undef $context->{db}; + destroy_dbs(); + },$import_multithreading); + +} + +sub import_subscriber_define { + + my ($file) = @_; + my $result = NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::Subscriber::create_table(1); + my $importer = NGCP::BulkProcessor::Projects::Migration::IPGallery::FileProcessors::SubscriberDefineFile->new($subscriber_define_import_numofthreads); + destroy_dbs(); #close all db connections before forking.. + return $result && $importer->process($file,sub { + my ($context,$rows,$row_offset) = @_; + + if ((scalar @$rows) > 0) { + $context->{db}->db_do_begin( + NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::Subscriber::getinsertstatement(), + NGCP::BulkProcessor::Projects::Migration::IPGallery::Dao::Subscriber::gettablename(), + #lock - $import_multithreading + ); + $context->{db}->db_do_rowblock($rows); + $context->{db}->db_finish(); + } + + return 1; + }, sub { + my ($context)= @_; + $context->{db} = &get_import_db(); # keep ref count low.. + }, sub { + my ($context)= @_; + undef $context->{db}; + destroy_dbs(); + }, $import_multithreading); + +} + +1; diff --git a/Projects/Migration/IPGallery/ProjectConnectorPool.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/ProjectConnectorPool.pm similarity index 57% rename from Projects/Migration/IPGallery/ProjectConnectorPool.pm rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/ProjectConnectorPool.pm index 2f000fe..bb92188 100644 --- a/Projects/Migration/IPGallery/ProjectConnectorPool.pm +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/ProjectConnectorPool.pm @@ -1,4 +1,4 @@ -package Projects::Migration::IPGallery::ProjectConnectorPool; +package NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool; use strict; ## no critic @@ -7,28 +7,26 @@ use File::Basename; use Cwd; use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); -use Projects::Migration::IPGallery::Settings qw( +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Settings qw( $import_db_file ); -use ConnectorPool qw( +use NGCP::BulkProcessor::ConnectorPool qw( get_connectorinstancename ); -#use SqlConnectors::MySQLDB; -#use SqlConnectors::OracleDB; -#use SqlConnectors::PostgreSQLDB; -use SqlConnectors::SQLiteDB qw( +#use NGCP::BulkProcessor::SqlConnectors::MySQLDB; +#use NGCP::BulkProcessor::SqlConnectors::OracleDB; +#use NGCP::BulkProcessor::SqlConnectors::PostgreSQLDB; +use NGCP::BulkProcessor::SqlConnectors::SQLiteDB qw( $staticdbfilemode cleanupdbfiles ); -#use SqlConnectors::CSVDB; -#use SqlConnectors::SQLServerDB; -#use RestConnectors::NGCPRestApi; +#use NGCP::BulkProcessor::SqlConnectors::CSVDB; +#use NGCP::BulkProcessor::SqlConnectors::SQLServerDB; +#use NGCP::BulkProcessor::RestConnectors::NGCPRestApi; -use SqlRecord qw(cleartableinfo); - -#use Utils qw(threadid); +use NGCP::BulkProcessor::SqlRecord qw(cleartableinfo); require Exporter; our @ISA = qw(Exporter); @@ -49,7 +47,7 @@ sub get_import_db { my $name = get_connectorinstancename($instance_name); #threadid(); #shift; if (not defined $import_dbs->{$name}) { - $import_dbs->{$name} = SqlConnectors::SQLiteDB->new($instance_name); #$name); + $import_dbs->{$name} = NGCP::BulkProcessor::SqlConnectors::SQLiteDB->new($instance_name); #$name); if (not defined $reconnect) { $reconnect = 1; } @@ -66,7 +64,7 @@ sub import_db_tableidentifier { my ($get_target_db,$tablename) = @_; my $target_db = (ref $get_target_db eq 'CODE') ? &$get_target_db() : $get_target_db; - return $target_db->getsafetablename(SqlConnectors::SQLiteDB::get_tableidentifier($tablename,$staticdbfilemode,$import_db_file)); + return $target_db->getsafetablename(NGCP::BulkProcessor::SqlConnectors::SQLiteDB::get_tableidentifier($tablename,$staticdbfilemode,$import_db_file)); } diff --git a/Projects/Migration/IPGallery/Settings.pm b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Settings.pm similarity index 61% rename from Projects/Migration/IPGallery/Settings.pm rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Settings.pm index cfc9117..6b3e2a7 100644 --- a/Projects/Migration/IPGallery/Settings.pm +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/Settings.pm @@ -1,20 +1,20 @@ -package Projects::Migration::IPGallery::Settings; +package NGCP::BulkProcessor::Projects::Migration::IPGallery::Settings; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); -use Globals qw( +use NGCP::BulkProcessor::Globals qw( update_working_path $input_path $enablemultithreading $cpucount ); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger scriptinfo ); @@ -26,7 +26,10 @@ our @EXPORT_OK = qw( $defaultsettings $defaultconfig $features_define_filename - $feature_define_import_numofthreads + $features_define_import_numofthreads + $skip_duplicate_setoptionitems + $subscriber_define_filename + $subscriber_define_import_numofthreads $import_multithreading $run_id @@ -40,9 +43,14 @@ our $defaultconfig = 'config.cfg'; our $defaultsettings = 'settings.cfg'; our $features_define_filename = undef; +our $subscriber_define_filename = undef; our $import_multithreading = $enablemultithreading; -our $feature_define_import_numofthreads = $cpucount; +our $features_define_import_numofthreads = $cpucount; + +our $subscriber_define_import_numofthreads = $cpucount; + +our $skip_duplicate_setoptionitems = 0; our $force = 0; our $dry = 1; @@ -71,12 +79,21 @@ sub update_settings { $features_define_filename = $input_path . $features_define_filename unless -e $features_define_filename; } + $subscriber_define_filename = $data->{subscriber_define_filename} if exists $data->{subscriber_define_filename}; + if (defined $subscriber_define_filename and length($subscriber_define_filename) > 0) { + $subscriber_define_filename = $input_path . $subscriber_define_filename unless -e $subscriber_define_filename; + } + $import_multithreading = $data->{import_multithreading} if exists $data->{import_multithreading}; #my $new_working_path = (exists $data->{working_path} ? $data->{working_path} : $working_path); - $feature_define_import_numofthreads = $cpucount; -$feature_define_import_numofthreads = $data->{feature_define_import_numofthreads} if exists $data->{feature_define_import_numofthreads}; - $feature_define_import_numofthreads = $cpucount if $feature_define_import_numofthreads > $cpucount; + $features_define_import_numofthreads = $cpucount; +$features_define_import_numofthreads = $data->{features_define_import_numofthreads} if exists $data->{features_define_import_numofthreads}; + $features_define_import_numofthreads = $cpucount if $features_define_import_numofthreads > $cpucount; + + $subscriber_define_import_numofthreads = $cpucount; +$subscriber_define_import_numofthreads = $data->{subscriber_define_import_numofthreads} if exists $data->{subscriber_define_import_numofthreads}; + $subscriber_define_import_numofthreads = $cpucount if $subscriber_define_import_numofthreads > $cpucount; #return update_working_path($new_working_path,1,$fileerrorcode,$configlogger); $import_db_file = ((defined $run_id and length($run_id) > 0) ? '_' : '') . 'import'; diff --git a/Projects/Migration/IPGallery/config.cfg b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/config.cfg similarity index 100% rename from Projects/Migration/IPGallery/config.cfg rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/config.cfg diff --git a/Projects/Migration/IPGallery/narf.pl b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/process.pl similarity index 70% rename from Projects/Migration/IPGallery/narf.pl rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/process.pl index 53f1f04..6e598b4 100644 --- a/Projects/Migration/IPGallery/narf.pl +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/process.pl @@ -4,52 +4,56 @@ use strict; use File::Basename; use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../'); +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../../'); use Getopt::Long qw(GetOptions); use Fcntl qw(LOCK_EX LOCK_NB); -use Globals qw(); -use Projects::Migration::IPGallery::Settings qw( +use NGCP::BulkProcessor::Globals qw(); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Settings qw( $defaultsettings $defaultconfig update_settings check_dry $run_id $features_define_filename + $subscriber_define_filename $dry $force ); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( init_log getlogger $attachmentlogfile scriptinfo ); -use LogError qw ( +use NGCP::BulkProcessor::LogError qw ( completion success scriptwarn scripterror ); -use LoadConfig qw( +use NGCP::BulkProcessor::LoadConfig qw( load_config $SIMPLE_CONFIG_TYPE $YAML_CONFIG_TYPE ); -use Array qw(removeduplicates); -use Utils qw(getscriptpath prompt); -use Mail qw(wrap_mailbody - $signature - $normalpriority - $lowpriority - $highpriority); - -use ConnectorPool qw(); -use Projects::Migration::IPGallery::ProjectConnectorPool qw(); - -use Projects::Migration::IPGallery::Import qw( +use NGCP::BulkProcessor::Array qw(removeduplicates); +use NGCP::BulkProcessor::Utils qw(getscriptpath prompt); +use NGCP::BulkProcessor::Mail qw( + wrap_mailbody + $signature + $normalpriority + $lowpriority + $highpriority +); + +use NGCP::BulkProcessor::ConnectorPool qw(); +use NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool qw(); + +use NGCP::BulkProcessor::Projects::Migration::IPGallery::Import qw( import_features_define + import_subscriber_define ); scripterror(getscriptpath() . ' already running',getlogger(getscriptpath())) unless flock DATA, LOCK_EX | LOCK_NB; # not tested on windows yet @@ -59,6 +63,8 @@ my @TASK_OPTS = (); my $tasks = []; my $import_features_define_task_opt = 'import_features_define'; push(@TASK_OPTS,$import_features_define_task_opt); +my $import_subscriber_define_task_opt = 'import_subscriber_define'; +push(@TASK_OPTS,$import_subscriber_define_task_opt); if (init()) { main(); @@ -102,6 +108,9 @@ sub main() { if (lc($import_features_define_task_opt) eq lc($task)) { scriptinfo('task: ' . $import_features_define_task_opt,getlogger(getscriptpath())); $result |= import_features_define_task(\@messages); + } elsif (lc($import_subscriber_define_task_opt) eq lc($task)) { + scriptinfo('task: ' . $import_subscriber_define_task_opt,getlogger(getscriptpath())); + $result |= import_subscriber_define_task(\@messages); } elsif (lc('blah') eq lc($task)) { scriptinfo('task: ' . 'balh',getlogger(getscriptpath())); next unless check_dry(); @@ -151,11 +160,26 @@ sub import_features_define_task { } +sub import_subscriber_define_task { + + my ($messages) = shift; + if (import_subscriber_define( + $subscriber_define_filename + )) { + push(@$messages,'sucessfully inserted x records...'); + return 1; + } else { + push(@$messages,'was not executed'); + return 0; + } + +} + END { # this should not be required explicitly, but prevents Log4Perl's # "rootlogger not initialized error upon exit.. - Projects::Migration::IPGallery::ProjectConnectorPool::destroy_dbs(); - ConnectorPool::destroy_dbs(); + NGCP::BulkProcessor::Projects::Migration::IPGallery::ProjectConnectorPool::destroy_dbs(); + NGCP::BulkProcessor::ConnectorPool::destroy_dbs(); } __DATA__ diff --git a/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/settings.cfg b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/settings.cfg new file mode 100644 index 0000000..10a66d6 --- /dev/null +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/settings.cfg @@ -0,0 +1,10 @@ + +features_define_filename = /home/rkrenn/test/Features_Define.cfg + +import_multithreading = 1 +features_define_import_numofthreads = 2 + +subscriber_define_filename = /home/rkrenn/test/Subscriber_Define.cfg +subscriber_define_import_numofthreads = 2 + +#dry=0 diff --git a/Projects/Migration/IPGallery/test_dsl.pl b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/test_dsl.pl similarity index 99% rename from Projects/Migration/IPGallery/test_dsl.pl rename to lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/test_dsl.pl index be4b184..47c3516 100644 --- a/Projects/Migration/IPGallery/test_dsl.pl +++ b/lib/NGCP/BulkProcessor/Projects/Migration/IPGallery/test_dsl.pl @@ -2,6 +2,8 @@ use warnings; use strict; +## no critic + use Marpa::R2; use Data::Dumper; diff --git a/lib/NGCP/BulkProcessor/Projects/t/ProjectConnectorPool.pm b/lib/NGCP/BulkProcessor/Projects/t/ProjectConnectorPool.pm new file mode 100644 index 0000000..e69de29 diff --git a/Projects/t/test_connectors.pl b/lib/NGCP/BulkProcessor/Projects/t/test_connectors.pl similarity index 87% rename from Projects/t/test_connectors.pl rename to lib/NGCP/BulkProcessor/Projects/t/test_connectors.pl index b31ae19..9723cce 100755 --- a/Projects/t/test_connectors.pl +++ b/lib/NGCP/BulkProcessor/Projects/t/test_connectors.pl @@ -1,12 +1,19 @@ -# mysql, oracle, mssql, .. matrix db interconnection test - use strict; ## no critic -use LoadCLIConfig; +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); + +# mysql, oracle, mssql, .. matrix db interconnection test -use ConnectorPool qw( +use NGCP::BulkProcessor::Globals qw($defaultconfig); +use NGCP::BulkProcessor::LoadConfig qw( + load_config +); + +use NGCP::BulkProcessor::ConnectorPool qw( destroy_dbs get_sqlserver_test_db get_postgres_test_db @@ -25,6 +32,8 @@ use test::postgres_table; use test::sqlite_table; use test::sqlserver_table; +load_config($defaultconfig); + my $sort_config = [ { numeric => 1, dir => 1, column => 'column1', @@ -150,20 +159,20 @@ sub test_select_source_mysql { } sub test_select_local { - $ConnectorPool::test_db = 'sqlserver'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'sqlserver'; _table_local_selects(); - $ConnectorPool::test_db = 'postgres'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'postgres'; _table_local_selects(); - $ConnectorPool::test_db = 'oracle'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'oracle'; _table_local_selects(); - $ConnectorPool::test_db = 'sqlite'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'sqlite'; _table_local_selects(); - $ConnectorPool::test_db = 'mysql'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'mysql'; _table_local_selects(); - $ConnectorPool::test_db = 'csv'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'csv'; _table_local_selects(); - $ConnectorPool::test_db = 'mysql'; + $NGCP::BulkProcessor::ConnectorPool::test_db = 'mysql'; } sub _table_local_selects { my $result = test::sqlserver_table::test_table_local_select('column1 is not null',2,1,$sort_config); @@ -232,4 +241,4 @@ run_suite(); destroy_dbs(); -exit; \ No newline at end of file +exit; diff --git a/Projects/t/test_service.pl b/lib/NGCP/BulkProcessor/Projects/t/test_service.pl similarity index 89% rename from Projects/t/test_service.pl rename to lib/NGCP/BulkProcessor/Projects/t/test_service.pl index 09ce996..14dff36 100755 --- a/Projects/t/test_service.pl +++ b/lib/NGCP/BulkProcessor/Projects/t/test_service.pl @@ -1,19 +1,26 @@ -# gearman service layer test - use strict; ## no critic -use LoadCLIConfig; +use File::Basename; +use Cwd; +use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../../../../'); -use Logging; +# gearman service layer test + +use NGCP::BulkProcessor::Globals qw($defaultconfig); +use NGCP::BulkProcessor::LoadConfig qw( + load_config +); + +use NGCP::BulkProcessor::Logging; use Test::Unit::Procedural; -use Service::TestService; -use ServiceProxy qw(new_async_do); +use NGCP::BulkProcessor::Service::TestService; +use NGCP::BulkProcessor::ServiceProxy qw(new_async_do); -use Serialization qw( +use NGCP::BulkProcessor::Serialization qw( $format_xml $format_yaml $format_json @@ -21,16 +28,18 @@ use Serialization qw( $format_perl ); + +load_config($defaultconfig); + my $service1; my $service2; my $service3; - my $service = test::TestService->new(); - my $proxy = ServiceProxy->new(); - #$service1 = test::TestService->new(); - #$service2 = test::TestService->new(); - #$service3 = test::TestService->new(); - +my $service = NGCP::BulkProcessor::Service::TestService->new(); +my $proxy = NGCP::BulkProcessor::ServiceProxy->new(); +#$service1 = test::TestService->new(); +#$service2 = test::TestService->new(); +#$service3 = test::TestService->new(); sub set_up { @@ -191,7 +200,7 @@ sub test_exception_do { sub test_sleep_roundtrip_do { - my $proxy = ServiceProxy->new(undef,1.5); + my $proxy = NGCP::BulkProcessor::ServiceProxy->new(undef,1.5); my $data = {}; @@ -208,7 +217,7 @@ sub test_sleep_roundtrip_do { sub test_sleep_roundtrip_do_async1 { #my $service = test::TestService->new(); - my $proxy = ServiceProxy->new(); + my $proxy = NGCP::BulkProcessor::ServiceProxy->new(); my $data = {}; my $output = undef; @@ -344,4 +353,4 @@ run_suite(); undef $service; undef $proxy; -exit; \ No newline at end of file +exit; diff --git a/RandomString.pm b/lib/NGCP/BulkProcessor/RandomString.pm similarity index 97% rename from RandomString.pm rename to lib/NGCP/BulkProcessor/RandomString.pm index 85cbd6c..28c2564 100644 --- a/RandomString.pm +++ b/lib/NGCP/BulkProcessor/RandomString.pm @@ -1,4 +1,4 @@ -package RandomString; +package NGCP::BulkProcessor::RandomString; use strict; ## no critic @@ -284,4 +284,4 @@ sub createtmpstring { } -1; \ No newline at end of file +1; diff --git a/RestConnector.pm b/lib/NGCP/BulkProcessor/RestConnector.pm similarity index 97% rename from RestConnector.pm rename to lib/NGCP/BulkProcessor/RestConnector.pm index d2917ee..e3dd8a4 100644 --- a/RestConnector.pm +++ b/lib/NGCP/BulkProcessor/RestConnector.pm @@ -1,4 +1,4 @@ -package RestConnector; +package NGCP::BulkProcessor::RestConnector; use strict; ## no critic @@ -6,19 +6,18 @@ use strict; use URI; use LWP::UserAgent qw(); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger restdebug restinfo); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( resterror restwarn restrequesterror restresponseerror notimplementederror); -use Utils qw(threadid); -#use Array qw(arrayeq); +use NGCP::BulkProcessor::Utils qw(threadid); require Exporter; our @ISA = qw(Exporter); @@ -39,7 +38,7 @@ sub new { $self->{netloc} = undef; $self->{ua} = undef; - + $self->{req} = undef; $self->{res} = undef; $self->{requestdata} = undef; @@ -58,7 +57,7 @@ sub connectidentifier { } sub baseuri { - + my $self = shift; if (@_) { my $uri = shift; @@ -75,7 +74,7 @@ sub baseuri { } } return (defined $self->{uri} ? $self->{uri}->clone() : undef); - + } sub _clearrequestdata { @@ -130,7 +129,7 @@ sub _ua_request { } sub _add_headers { - my ($req,$headers) = @_; + my ($req,$headers) = @_; foreach my $headername (keys %$headers) { $req->header($headername => $headers->{$headername}); } @@ -220,7 +219,7 @@ sub post { restresponseerror($self,'error decoding POST response content: ' . $@,$self->{res},getlogger(__PACKAGE__)); } return $self->{res}; - + } sub _add_get_headers { @@ -250,9 +249,9 @@ sub get { }; if ($@) { restresponseerror($self,'error decoding GET response content: ' . $@,$self->{res},getlogger(__PACKAGE__)); - } + } return $self->{res}; - + } sub _add_patch_headers { @@ -297,7 +296,7 @@ sub patch { restresponseerror($self,'error decoding PATCH response content: ' . $@,$self->{res},getlogger(__PACKAGE__)); } return $self->{res}; - + } sub _add_put_headers { @@ -342,7 +341,7 @@ sub put { restresponseerror($self,'error decoding PUT response content: ' . $@,$self->{res},getlogger(__PACKAGE__)); } return $self->{res}; - + } sub _add_delete_headers { @@ -374,7 +373,7 @@ sub delete { restresponseerror($self,'error decoding DELETE response content: ' . $@,$self->{res},getlogger(__PACKAGE__)); } return $self->{res}; - + } sub instanceidentifier { @@ -407,4 +406,4 @@ sub responsedata { return $self->{responsedata}; } -1; \ No newline at end of file +1; diff --git a/RestConnectors/NGCPRestApi.pm b/lib/NGCP/BulkProcessor/RestConnectors/NGCPRestApi.pm similarity index 85% rename from RestConnectors/NGCPRestApi.pm rename to lib/NGCP/BulkProcessor/RestConnectors/NGCPRestApi.pm index 749e392..8b3ab5b 100644 --- a/RestConnectors/NGCPRestApi.pm +++ b/lib/NGCP/BulkProcessor/RestConnectors/NGCPRestApi.pm @@ -1,30 +1,30 @@ -package RestConnectors::NGCPRestApi; +package NGCP::BulkProcessor::RestConnectors::NGCPRestApi; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); use JSON qw(); -use Globals qw($LongReadLen_limit); -use Logging qw( +use NGCP::BulkProcessor::Globals qw($LongReadLen_limit); +use NGCP::BulkProcessor::Logging qw( getlogger restdebug restinfo ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( resterror restwarn restrequesterror restresponseerror); -use RestConnector; +use NGCP::BulkProcessor::RestConnector; require Exporter; -our @ISA = qw(Exporter RestConnector); +our @ISA = qw(Exporter NGCP::BulkProcessor::RestConnector); our @EXPORT_OK = qw(); my $defaulturi = 'https://127.0.0.1:443'; @@ -41,7 +41,7 @@ sub new { my $class = shift; - my $self = RestConnector->new(@_); + my $self = NGCP::BulkProcessor::RestConnector->new(@_); baseuri(shift // $defaulturi); $self->{username} = shift; @@ -138,4 +138,4 @@ sub _add_delete_headers { $self->SUPER::_add_delete_headers($req,$headers); } -1; \ No newline at end of file +1; diff --git a/Serialization.pm b/lib/NGCP/BulkProcessor/Serialization.pm similarity index 94% rename from Serialization.pm rename to lib/NGCP/BulkProcessor/Serialization.pm index 0d5dec0..a234380 100755 --- a/Serialization.pm +++ b/lib/NGCP/BulkProcessor/Serialization.pm @@ -1,4 +1,4 @@ -package Serialization; +package NGCP::BulkProcessor::Serialization; use strict; ## no critic @@ -22,7 +22,7 @@ our @EXPORT_OK = qw( deserialize_perl serialize_storable_base64 deserialize_storable_base64 - + $format_xml $format_yaml $format_json @@ -113,10 +113,10 @@ sub deserialize { } elsif ($format == $format_perl) { return deserialize_perl($input_ref); } elsif ($format == $format_storable_base64) { - return deserialize_storable_base64($input_ref); + return deserialize_storable_base64($input_ref); } else { #$format_storable return deserialize_storable($input_ref); - } + } } sub serialize_storable { @@ -150,7 +150,7 @@ sub _get_xml_dumper { $xml_dumper = XML::Dumper->new(%xml_parser_params); #$xml_dumper->{xml_parser_params} = \%xml_parser_params; $xml_dumper->dtd(); - + return $xml_dumper; } @@ -208,6 +208,6 @@ sub deserialize_perl { } else { return $data; } -} +} -1; \ No newline at end of file +1; diff --git a/Service.pm b/lib/NGCP/BulkProcessor/Service.pm similarity index 93% rename from Service.pm rename to lib/NGCP/BulkProcessor/Service.pm index be4542f..0460fc1 100755 --- a/Service.pm +++ b/lib/NGCP/BulkProcessor/Service.pm @@ -1,6 +1,4 @@ -# service layer backend - -package Service; +package NGCP::BulkProcessor::Service; use strict; ## no critic @@ -8,24 +6,24 @@ use strict; use threads qw(yield); use threads::shared; -use Globals qw( +use NGCP::BulkProcessor::Globals qw( @jobservers $jobnamespace ); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger servicedebug serviceinfo ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( serviceerror servicewarn notimplementederror ); -use Utils qw(threadid); -use Serialization qw(serialize deserialize); +use NGCP::BulkProcessor::Utils qw(threadid); +use NGCP::BulkProcessor::Serialization qw(serialize deserialize); use Encode qw(encode_utf8); @@ -290,4 +288,4 @@ sub _is_create_thread { return $self->{create_tid} == threadid(); } -1; \ No newline at end of file +1; diff --git a/Service/TestService.pm b/lib/NGCP/BulkProcessor/Service/TestService.pm similarity index 69% rename from Service/TestService.pm rename to lib/NGCP/BulkProcessor/Service/TestService.pm index 23e59f9..fc65c94 100755 --- a/Service/TestService.pm +++ b/lib/NGCP/BulkProcessor/Service/TestService.pm @@ -1,15 +1,15 @@ -package Service::TestService; +package NGCP::BulkProcessor::Service::TestService; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); -use Logging qw(getlogger servicedebug); +use NGCP::BulkProcessor::Logging qw(getlogger servicedebug); -use Service; +use NGCP::BulkProcessor::Service; #use test::csv_table; # qw(test_table_bycolumn1); #use test::mysql_table; @@ -18,10 +18,10 @@ use Service; #use test::sqlite_table; #use test::sqlserver_table; -use Utils; # qw(create_guid); +use NGCP::BulkProcessor::Utils; # qw(create_guid); require Exporter; -our @ISA = qw(Exporter Service); +our @ISA = qw(Exporter NGCP::BulkProcessor::Service); our @EXPORT_OK = qw( roundtrip sleep_seconds @@ -32,7 +32,7 @@ our @EXPORT_OK = qw( #my $logger = getlogger(__PACKAGE__); my $functions = { - create_uuid => \&Utils::create_guid, + create_uuid => \&NGCP::BulkProcessor::Utils::create_guid, roundtrip => \&roundtrip, noop => \&noop, exception => \&exception, @@ -47,13 +47,13 @@ my $functions = { sub new { #my $class = shift; - #my $self = Service->new($functions,$class); + #my $self = NGCP::BulkProcessor::Service->new($functions,$class); #bless($self,$class); #return $self; - my $self = Service->new($functions,@_); + my $self = NGCP::BulkProcessor::Service->new($functions,@_); servicedebug($self,__PACKAGE__ . ' service created',getlogger(__PACKAGE__)); return $self; @@ -94,4 +94,4 @@ sub exception { # print "_on_fail\n"; #} -1; \ No newline at end of file +1; diff --git a/ServiceProxy.pm b/lib/NGCP/BulkProcessor/ServiceProxy.pm similarity index 95% rename from ServiceProxy.pm rename to lib/NGCP/BulkProcessor/ServiceProxy.pm index 01573ef..ac16850 100755 --- a/ServiceProxy.pm +++ b/lib/NGCP/BulkProcessor/ServiceProxy.pm @@ -1,6 +1,4 @@ -# service layer backend - -package ServiceProxy; +package NGCP::BulkProcessor::ServiceProxy; use strict; ## no critic @@ -11,24 +9,24 @@ use Thread::Queue; use Time::HiRes qw(sleep); -use Globals qw( +use NGCP::BulkProcessor::Globals qw( @jobservers $jobnamespace ); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger servicedebug serviceinfo ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( serviceerror servicewarn notimplementederror ); -use Utils qw(threadid); -use Serialization qw(serialize deserialize); +use NGCP::BulkProcessor::Utils qw(threadid); +use NGCP::BulkProcessor::Serialization qw(serialize deserialize); use Encode qw(encode_utf8); require Exporter; @@ -504,4 +502,4 @@ sub _is_create_thread { return $self->{create_tid} == threadid(); } -1; \ No newline at end of file +1; diff --git a/SqlConnector.pm b/lib/NGCP/BulkProcessor/SqlConnector.pm similarity index 94% rename from SqlConnector.pm rename to lib/NGCP/BulkProcessor/SqlConnector.pm index cee3478..07db0bb 100644 --- a/SqlConnector.pm +++ b/lib/NGCP/BulkProcessor/SqlConnector.pm @@ -1,18 +1,15 @@ -package SqlConnector; +package NGCP::BulkProcessor::SqlConnector; use strict; ## no critic -#use threads; -#use threads::shared; +use NGCP::BulkProcessor::Globals qw($enablemultithreading); -use Globals qw($enablemultithreading); - -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger dbdebug dbinfo); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( dberror dbwarn notimplementederror @@ -20,9 +17,9 @@ use LogError qw( use DBI; -use Utils qw(threadid); -use Array qw(arrayeq); -use RandomString qw(createtmpstring); +use NGCP::BulkProcessor::Utils qw(threadid); +use NGCP::BulkProcessor::Array qw(arrayeq); +use NGCP::BulkProcessor::RandomString qw(createtmpstring); require Exporter; our @ISA = qw(Exporter); @@ -869,4 +866,4 @@ sub db_finish { } -1; \ No newline at end of file +1; diff --git a/SqlConnectors/CSVDB.pm b/lib/NGCP/BulkProcessor/SqlConnectors/CSVDB.pm similarity index 94% rename from SqlConnectors/CSVDB.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/CSVDB.pm index d6c10b3..1d2da4b 100644 --- a/SqlConnectors/CSVDB.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/CSVDB.pm @@ -1,851 +1,851 @@ -package SqlConnectors::CSVDB; -use strict; - -## no critic - +package NGCP::BulkProcessor::SqlConnectors::CSVDB; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); + +use NGCP::BulkProcessor::Globals qw( + $LongReadLen_limit + $csv_path); + +use NGCP::BulkProcessor::Logging qw( + getlogger + dbdebug + dbinfo + xls2csvinfo + texttablecreated + indexcreated + tabletruncated + tabledropped); + +use NGCP::BulkProcessor::LogError qw( + dberror + dbwarn + fieldnamesdiffer + fileerror + filewarn + xls2csverror + xls2csvwarn); + +use NGCP::BulkProcessor::Array qw(contains setcontains); + +use NGCP::BulkProcessor::Utils qw(makepath changemod chopstring); + +use NGCP::BulkProcessor::SqlConnector; + +use DBI; +use DBD::CSV 0.26; +use File::Path qw(remove_tree); +use Locale::Recode; +use Spreadsheet::ParseExcel; +use Spreadsheet::ParseExcel::FmtUnicode; +use Excel::Reader::XLSX; +use Text::CSV_XS; use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); - -use Globals qw( - $LongReadLen_limit - $csv_path); - -use Logging qw( - getlogger - dbdebug - dbinfo - xls2csvinfo - texttablecreated - indexcreated - tabletruncated - tabledropped); - -use LogError qw( - dberror - dbwarn - fieldnamesdiffer - fileerror - filewarn - xls2csverror - xls2csvwarn); - -use Array qw(contains setcontains); - -use Utils qw(makepath changemod chopstring); - -use SqlConnector; - -use DBI; -use DBD::CSV 0.26; -use File::Path qw(remove_tree); -use Locale::Recode; -use Spreadsheet::ParseExcel; -use Spreadsheet::ParseExcel::FmtUnicode; -use Excel::Reader::XLSX; -use Text::CSV_XS; -use File::Basename; -use MIME::Parser; -use HTML::PullParser qw(); -use HTML::Entities qw(decode_entities); -use IO::Uncompress::Unzip qw(unzip $UnzipError); - -use DateTime::Format::Excel; - -require Exporter; -our @ISA = qw(Exporter SqlConnector); -our @EXPORT_OK = qw( - cleanupcvsdirs - xlsbin2csv - xlsxbin2csv - sanitize_column_name - sanitize_spreadsheet_name - excel_to_timestamp - excel_to_date - get_tableidentifier - $csvextension); - -our $csvextension = '.csv'; - -my $default_csv_config = { eol => "\r\n", - sep_char => ';', - quote_char => '"', - escape_char => '"', - }; - -my @TABLE_TAGS = qw(table tr td); - -my $LongReadLen = $LongReadLen_limit; #bytes -my $LongTruncOk = 0; - -#my $logger = getlogger(__PACKAGE__); - -my $lock_do_chunk = 0; -my $lock_get_chunk = 0; - -my $invalid_excel_spreadsheet_chars_pattern = '[' . quotemeta('[]:*?/\\') . ']'; - -sub sanitize_spreadsheet_name { #Invalid character []:*?/\ in worksheet name - my $spreadsheet_name = shift; - $spreadsheet_name =~ s/$invalid_excel_spreadsheet_chars_pattern//g; - return chopstring($spreadsheet_name,31); #Sheetname eventually inconsistent etc. must be <= 31 chars -} - -sub sanitize_column_name { - my $column_name = shift; - $column_name =~ s/\W/_/g; - return $column_name; -} - -sub excel_to_date { - my $excel_date_value = shift; - if ($excel_date_value > 0) { - my $datetime = DateTime::Format::Excel->parse_datetime($excel_date_value); - return $datetime->ymd('-'); # prints 1992-02-28 - } - return undef; -} - -sub excel_to_timestamp { - my $excel_datetime_value = shift; - if ($excel_datetime_value > 0) { - my $datetime = DateTime::Format::Excel->parse_datetime($excel_datetime_value); - return $datetime->ymd('-') . ' ' . $datetime->hms(':'); - } - return undef; -} - -sub new { - - my $class = shift; - - my $self = SqlConnector->new(@_); - - $self->{db_dir} = undef; - $self->{f_dir} = undef; - $self->{csv_tables} = undef; - $self->{files} = undef; - - $self->{drh} = DBI->install_driver('CSV'); - - bless($self,$class); - - dbdebug($self,__PACKAGE__ . ' connector created',getlogger(__PACKAGE__)); - - return $self; - -} - -sub _connectidentifier { - - my $self = shift; - return $self->{f_dir}; - -} - -sub tableidentifier { - - my $self = shift; - my $tablename = shift; - return $tablename; - -} - -sub columnidentifier { - - my $self = shift; - my $columnname = shift; - - return sanitize_column_name($columnname); #actually happens automatically by dbd::csv - -} - -sub get_tableidentifier { - - my ($tablename,$db_dir) = @_; - if (defined $db_dir) { - return $db_dir . '.' . $tablename; - } else { - return $tablename; - } - -} - -sub getsafetablename { - - my $self = shift; - my $tableidentifier = shift; - return lc($self->SUPER::getsafetablename($tableidentifier)); - -} - -sub getdatabases { - - my $self = shift; - - local *DBDIR; - if (not opendir(DBDIR, $csv_path)) { - fileerror('cannot opendir ' . $csv_path . ': ' . $!,getlogger(__PACKAGE__)); - return []; - } - my @dirs = grep { $_ ne '.' && $_ ne '..' && -d $csv_path . $_ } readdir(DBDIR); - closedir DBDIR; - my @databases = (); - foreach my $dir (@dirs) { - push @databases,$dir; - } - return \@databases; - -} - -sub _createdatabase { - - my $self = shift; - my ($db_dir) = @_; - - my $f_dir; # = _get_f_dir($db_dir); - if (length($db_dir) > 0) { - $f_dir = $csv_path . $db_dir . '/'; - } else { - $f_dir = $csv_path; - } - - dbinfo($self,'opening csv folder',getlogger(__PACKAGE__)); - - #mkdir $f_dir; - makepath($f_dir,\&fileerror,getlogger(__PACKAGE__)); - - #if (not -d $f_dir) { - # fileerror('cannot opendir ' . $f_dir . ': ' . $!,getlogger(__PACKAGE__)); - # return; - #} - - #local *DBDIR; - #if (not opendir(DBDIR, $f_dir)) { - # fileerror('cannot opendir ' . $f_dir . ': ' . $!,getlogger(__PACKAGE__)); - # return; - #} - #closedir DBDIR; - - #changemod($f_dir); - - return $f_dir; -} - -sub db_connect { - - my $self = shift; - - my ($db_dir,$csv_tables) = @_; - - $self->SUPER::db_connect($db_dir,$csv_tables); - - $self->{db_dir} = $db_dir; - $self->{csv_tables} = $csv_tables; - $self->{f_dir} = $self->_createdatabase($db_dir); - - my $dbh_config = { - f_schema => undef, - #f_lock => 0, n/a in 0.26 yet? - cvs_eol => $default_csv_config->{eol}, - cvs_sep_char => $default_csv_config->{sep_char}, - cvs_quote_char => $default_csv_config->{quote_char}, - cvs_escape_char => $default_csv_config->{escape_char}, - PrintError => 0, - RaiseError => 0, - }; - my $usetabledef = 0; - if (defined $csv_tables and ref $csv_tables eq 'HASH') { - $usetabledef = 1; - } else { - $dbh_config->{f_dir} = $self->{f_dir}; - $dbh_config->{f_ext} = $csvextension . '/r'; - } - - my $dbh = DBI->connect ('dbi:CSV:','','',$dbh_config) or - dberror($self,'error connecting: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); - - $dbh->{InactiveDestroy} = 1; - - $dbh->{LongReadLen} = $LongReadLen; - $dbh->{LongTruncOk} = $LongTruncOk; - - $self->{dbh} = $dbh; - - if ($usetabledef) { - my @files = (); - foreach my $tablename (keys %$csv_tables) { - $dbh->{csv_tables}->{$tablename} = $csv_tables->{$tablename}; - push @files,$csv_tables->{$tablename}->{file}; - dbinfo($self,'using ' . $csv_tables->{$tablename}->{file},getlogger(__PACKAGE__)); - } - $self->{files} = \@files; - } else { - my @tablenames = $self->_list_tables(); - foreach my $tablename (@tablenames) { - $dbh->{csv_tables}->{$tablename} = { eol => $default_csv_config->{eol}, - sep_char => $default_csv_config->{sep_char}, - quote_char => $default_csv_config->{quote_char}, - escape_char => $default_csv_config->{escape_char}, - } - } - } - - dbinfo($self,'connected',getlogger(__PACKAGE__)); - -} - - -sub _list_tables { - my $self = shift; - my @table_list; - - eval { - @table_list = map { local $_ = $_; s/^\.\///g; $_; } $self->{dbh}->func('list_tables'); - }; - if ($@) { - my @tables; - eval { - @tables = $self->{dbh}->func("get_avail_tables") or return; - }; - if ($@) { - dberror($self,'error listing csv tables: ' . $@,getlogger(__PACKAGE__)); - } else { - foreach my $ref (@tables) { - if (defined $ref) { - if (ref $ref eq 'ARRAY') { - push @table_list, $ref->[2]; - #} else { - # push @table_list, $ref; - } - } - } - } - } - - return @table_list; #removeduplicates(\@table_list); -} - -sub _db_disconnect { - - my $self = shift; - - $self->SUPER::_db_disconnect(); - -} - -sub vacuum { - - my $self = shift; - my $tablename = shift; - -} - -sub cleanupcvsdirs { - - my (@remainingdbdirs) = @_; - local *DBDIR; - if (not opendir(DBDIR, $csv_path)) { - fileerror('cannot opendir ' . $csv_path . ': ' . $!,getlogger(__PACKAGE__)); - return; - } - my @dirs = grep { $_ ne '.' && $_ ne '..' && -d $csv_path . $_ } readdir(DBDIR); - closedir DBDIR; - my @remainingdbdirectories = (); - foreach my $dirname (@remainingdbdirs) { - push @remainingdbdirectories,$csv_path . $dirname . '/'; - } - foreach my $dir (@dirs) { - #print $file; - my $dirpath = $csv_path . $dir . '/'; - if (not contains($dirpath,\@remainingdbdirectories)) { - #if (remove_tree($dirpath) == 0) { - # filewarn('cannot remove ' . $dirpath . ': ' . $!,getlogger(__PACKAGE__)); - #} - remove_tree($dirpath, { - keep_root => 0, - error => \my $err }); - if (@$err) { - for my $diag (@$err) { - my ($file, $message) = %$diag; - if ($file eq '') { - filewarn("general error: $message",getlogger(__PACKAGE__)); - } else { - filewarn("problem unlinking $file: $message",getlogger(__PACKAGE__)); - } - } - } - } - } - -} - -sub getfieldnames { - - my $self = shift; - my $tablename = shift; - - my $fieldnames = []; - - if (defined $self->{dbh}) { - - my $query = 'SELECT * FROM ' . $self->tableidentifier($tablename) . ' LIMIT 1'; - dbdebug($self,'getfieldnames: ' . $query,getlogger(__PACKAGE__)); - my $sth = $self->{dbh}->prepare($query) or $self->_prepare_error($query); - $sth->execute() or $self->_execute_error($query,$sth,()); - $fieldnames = $sth->{NAME}; - $sth->finish(); - - } - - return $fieldnames; - -} - -sub getprimarykeycols { - - my $self = shift; - my $tablename = shift; - return []; - -} - -sub create_primarykey { - - my $self = shift; - my ($tablename,$keycols,$fieldnames) = @_; - - return 0; -} -sub create_indexes { - - my $self = shift; - my ($tablename,$indexes,$keycols) = @_; - - return 0; -} - -sub _gettablefilename { - - my $self = shift; - my $tablename = shift; - return $self->{f_dir} . $tablename . $csvextension; - -} - -sub create_texttable { - - my $self = shift; - my ($tablename,$fieldnames,$keycols,$indexes,$truncate) = @_; - - if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { - - my $created = 0; - if ($self->table_exists($tablename) == 0) { - - if (not exists $self->{dbh}->{csv_tables}->{$tablename}) { - $self->{dbh}->{csv_tables}->{$tablename} = { eol => $default_csv_config->{eol}, - sep_char => $default_csv_config->{sep_char}, - quote_char => $default_csv_config->{quote_char}, - escape_char => $default_csv_config->{escape_char}, - }; - } - - my $statement = 'CREATE TABLE ' . $self->tableidentifier($tablename) . ' ('; - $statement .= join(' TEXT, ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$fieldnames) . ' TEXT'; - $statement .= ')'; - - $self->db_do($statement); - - changemod($self->_gettablefilename($tablename)); - - texttablecreated($self,$tablename,getlogger(__PACKAGE__)); - - $created = 1; - } else { - my $fieldnamesfound = $self->getfieldnames($tablename); - if (not setcontains($fieldnames,$fieldnamesfound,1)) { - fieldnamesdiffer($self,$tablename,$fieldnames,$fieldnamesfound,getlogger(__PACKAGE__)); - return 0; - } - } - - if (not $created and $truncate) { - $self->truncate_table($tablename); - } - return 1; - } else { - return 0; - } - -} - -sub multithreading_supported { - - my $self = shift; - return 0; - -} - -sub truncate_table { - - my $self = shift; - my $tablename = shift; - - $self->db_do('DELETE FROM ' . $self->tableidentifier($tablename)); - tabletruncated($self,$tablename,getlogger(__PACKAGE__)); - -} - -sub table_exists { - - my $self = shift; - my $tablename = shift; - - if (defined $self->{dbh}) { - my @tables = $self->_list_tables(); - return contains($tablename,\@tables); - } - - return undef; - -} - -sub drop_table { - - my $self = shift; - my $tablename = shift; - - if ($self->table_exists($tablename) > 0) { - $self->db_do('DROP TABLE ' . $self->tableidentifier($tablename)); - delete $self->{dbh}->{csv_tables}->{$tablename}; - tabledropped($self,$tablename,getlogger(__PACKAGE__)); - return 1; - } - return 0; - -} - -sub db_begin { - - my $self = shift; - if (defined $self->{dbh}) { - dbdebug($self, "transactions not supported",getlogger(__PACKAGE__)); - } - -} - -sub db_commit { - - my $self = shift; - if (defined $self->{dbh}) { - dbdebug($self, "transactions not supported",getlogger(__PACKAGE__)); - } - -} - -sub db_rollback { - - my $self = shift; - if (defined $self->{dbh}) { - dbdebug($self, "transactions not supported",getlogger(__PACKAGE__)); - } - -} - -sub db_do_begin { - - my $self = shift; - my $query = shift; - my $tablename = shift; - - $self->SUPER::db_do_begin($query,$tablename,$lock_do_chunk,@_); - -} - -sub db_get_begin { - - my $self = shift; - my $query = shift; - my $tablename = shift; - - $self->SUPER::db_get_begin($query,$tablename,$lock_get_chunk,@_); - -} - -sub db_finish { - - my $self = shift; - - $self->SUPER::db_finish($lock_do_chunk | $lock_get_chunk); - -} - -sub xlsbin2csv { - - my ($inputfile,$outputfile,$worksheetname,$sourcecharset) = @_; - - return _convert_xlsbin2csv($inputfile, - $worksheetname, - $sourcecharset, - $outputfile, - 'UTF-8', - $default_csv_config->{quote_char}, - $default_csv_config->{escape_char}, - $default_csv_config->{sep_char}, - $default_csv_config->{eol}); - -} - -sub _convert_xlsbin2csv { - - my ($SourceFilename,$worksheet,$SourceCharset,$DestFilename,$DestCharset,$quote_char,$escape_char,$sep_char,$eol) = @_; - - my $csvlinecount = 0; - - xls2csvinfo('start converting ' . $SourceFilename . ' (worksheet ' . $worksheet . ') to ' . $DestFilename . ' ...',getlogger(__PACKAGE__)); - - $SourceCharset = 'UTF-8' unless $SourceCharset; - $DestCharset = $SourceCharset unless $DestCharset; - - xls2csvinfo('reading ' . $SourceFilename . ' as ' . $SourceCharset,getlogger(__PACKAGE__)); - - my $XLS = new IO::File; - if (not $XLS->open('<' . $SourceFilename)) { - fileerror('cannot open file ' . $SourceFilename . ': ' . $!,getlogger(__PACKAGE__)); - return 0; - } - - my $Formatter = Spreadsheet::ParseExcel::FmtUnicode->new(Unicode_Map => $SourceCharset); - - my $parser = Spreadsheet::ParseExcel->new(); - my $Book = $parser->parse($XLS,$Formatter); #$SourceFilename - - if ( !defined $Book ) { - xls2csverror($parser->error(),getlogger(__PACKAGE__)); - #die $parser->error(), ".\n"; - $XLS->close(); - return 0; - } - - #my $Book = Spreadsheet::ParseExcel::Workbook->Parse($XLS, $Formatter) or xls2csverror('can\'t read spreadsheet',getlogger(__PACKAGE__)); - - my $Sheet; - if ($worksheet) { - - #my $test = $Book->GetContent(); - - $Sheet = $Book->Worksheet($worksheet); - if (!defined $Sheet) { - xls2csverror('invalid spreadsheet',getlogger(__PACKAGE__)); - return 0; - } - #unless ($O{'q'}) - #{ - # print qq|Converting the "$Sheet->{Name}" worksheet.\n|; - #} - xls2csvinfo('converting the ' . $Sheet->{Name} . ' worksheet',getlogger(__PACKAGE__)); - } else { - ($Sheet) = @{$Book->{Worksheet}}; - if ($Book->{SheetCount}>1) { - #print qq|Multiple worksheets found. Will convert the "$Sheet->{Name}" worksheet.\n|; - xls2csvinfo('multiple worksheets found, converting ' . $Sheet->{Name},getlogger(__PACKAGE__)); - } - } - - unlink $DestFilename; - local *CSV; - if (not open(CSV,'>' . $DestFilename)) { - fileerror('cannot open file ' . $DestFilename . ': ' . $!,getlogger(__PACKAGE__)); - $XLS->close(); - return 0; - } - binmode CSV; - - my $Csv = Text::CSV_XS->new({ - 'quote_char' => $quote_char, - 'escape_char' => $escape_char, - 'sep_char' => $sep_char, - 'binary' => 1, - }); - - my $Recoder; - if ($DestCharset) { - $Recoder = Locale::Recode->new(from => $SourceCharset, to => $DestCharset); - } - - for (my $Row = $Sheet->{MinRow}; defined $Sheet->{MaxRow} && $Row <= $Sheet->{MaxRow}; $Row++) { - my @Row; - for (my $Col = $Sheet->{MinCol}; defined $Sheet->{MaxCol} && $Col <= $Sheet->{MaxCol}; $Col++) { - my $Cell = $Sheet->{Cells}[$Row][$Col]; - - my $Value = ""; - if ($Cell) { - $Value = $Cell->Value; - if ($Value eq 'GENERAL') { - # Sometimes numbers are read incorrectly as "GENERAL". - # In this case, the correct value should be in ->{Val}. - $Value = $Cell->{Val}; - } - if ($DestCharset) { - $Recoder->recode($Value); - } - } - - # We assume the line is blank if there is nothing in the first column. - last if $Col == $Sheet->{MinCol} and !$Value; - - push(@Row,$Value); - } - - next unless @Row; - - my $Status = $Csv->combine(@Row); - - if (!defined $Status) { - xls2csvwarn('csv error: ' . $Csv->error_input(),getlogger(__PACKAGE__)); - } - - if (defined $Status) { - print CSV $Csv->string(); - if ($Row < $Sheet->{MaxRow}) { - print CSV $eol; - } - $csvlinecount++; - } - } - - close CSV; - $XLS->close; - - xls2csvinfo($csvlinecount . ' line(s) converted',getlogger(__PACKAGE__)); - - return $csvlinecount; - -} - -sub xlsxbin2csv { - - my ($inputfile,$outputfile,$worksheetname) = @_; - - return _convert_xlsxbin2csv($inputfile, - $worksheetname, - $outputfile, - 'UTF-8', - $default_csv_config->{quote_char}, - $default_csv_config->{escape_char}, - $default_csv_config->{sep_char}, - $default_csv_config->{eol}); - -} - -sub _convert_xlsxbin2csv { - my ($SourceFilename,$worksheet,$DestFilename,$DestCharset,$quote_char,$escape_char,$sep_char,$eol) = @_; - - my $csvlinecount = 0; - - xls2csvinfo('start converting ' . $SourceFilename . ' (worksheet ' . $worksheet . ') to ' . $DestFilename . ' ...',getlogger(__PACKAGE__)); - - - my $XLS = new IO::File; - if (not $XLS->open('<' . $SourceFilename)) { - fileerror('cannot open file ' . $SourceFilename . ': ' . $!,getlogger(__PACKAGE__)); - return 0; - } else { - $XLS->close(); - } - - #my $Formatter = Spreadsheet::ParseExcel::FmtUnicode->new(Unicode_Map => $SourceCharset); - - my $reader = Excel::Reader::XLSX->new(); - my $workbook = $reader->read_file($SourceFilename); #->parse($XLS,$Formatter); #$SourceFilename - - my $SourceCharset = $workbook->{_reader}->encoding(); - $DestCharset = $SourceCharset unless $DestCharset; - - xls2csvinfo('reading ' . $SourceFilename . ' as ' . $SourceCharset,getlogger(__PACKAGE__)); - - if ( !defined $workbook ) { - xls2csverror($reader->error(),getlogger(__PACKAGE__)); - #die $parser->error(), ".\n"; - #$XLS->close(); - return 0; - } - - #my $Book = Spreadsheet::ParseExcel::Workbook->Parse($XLS, $Formatter) or xls2csverror('can\'t read spreadsheet',getlogger(__PACKAGE__)); - - my $sheet; - if ($worksheet) { - - #my $test = $Book->GetContent(); - - $sheet = $workbook->worksheet($worksheet); - if (!defined $sheet) { - xls2csverror('invalid spreadsheet',getlogger(__PACKAGE__)); - return 0; - } - #unless ($O{'q'}) - #{ - # print qq|Converting the "$Sheet->{Name}" worksheet.\n|; - #} - xls2csvinfo('converting the ' . $sheet->name() . ' worksheet',getlogger(__PACKAGE__)); - } else { - $sheet = $workbook->worksheet(0); - if (@{$workbook->worksheets()} > 1) { - #print qq|Multiple worksheets found. Will convert the "$Sheet->{Name}" worksheet.\n|; - xls2csvinfo('multiple worksheets found, converting ' . $sheet->name(),getlogger(__PACKAGE__)); - } - } - - unlink $DestFilename; - local *CSV; - if (not open(CSV,'>' . $DestFilename)) { - fileerror('cannot open file ' . $DestFilename . ': ' . $!,getlogger(__PACKAGE__)); - #$XLS->close(); - return 0; - } - binmode CSV; - - my $csv = Text::CSV_XS->new({ - 'quote_char' => $quote_char, - 'escape_char' => $escape_char, - 'sep_char' => $sep_char, - 'binary' => 1, - }); - - my $Recoder; - if ($DestCharset) { - $Recoder = Locale::Recode->new(from => $SourceCharset, to => $DestCharset); - } - - while ( my $row = $sheet->next_row() ) { - - foreach my $value ($row->values()) { - $Recoder->recode($value); - } - - my $status = $csv->combine($row->values()); - - if (!defined $status) { - xls2csvwarn('csv error: ' . $csv->error_input(),getlogger(__PACKAGE__)); - } - - if (defined $status) { - if ($row->row_number() > 0) { - print CSV $eol; - } - print CSV $csv->string(); - $csvlinecount++; - } - } - - close CSV; - #$XLS->close; - - xls2csvinfo($csvlinecount . ' line(s) converted',getlogger(__PACKAGE__)); - - return $csvlinecount; - -} - -1; \ No newline at end of file +use MIME::Parser; +use HTML::PullParser qw(); +use HTML::Entities qw(decode_entities); +use IO::Uncompress::Unzip qw(unzip $UnzipError); + +use DateTime::Format::Excel; + +require Exporter; +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlConnector); +our @EXPORT_OK = qw( + cleanupcvsdirs + xlsbin2csv + xlsxbin2csv + sanitize_column_name + sanitize_spreadsheet_name + excel_to_timestamp + excel_to_date + get_tableidentifier + $csvextension); + +our $csvextension = '.csv'; + +my $default_csv_config = { eol => "\r\n", + sep_char => ';', + quote_char => '"', + escape_char => '"', + }; + +my @TABLE_TAGS = qw(table tr td); + +my $LongReadLen = $LongReadLen_limit; #bytes +my $LongTruncOk = 0; + +#my $logger = getlogger(__PACKAGE__); + +my $lock_do_chunk = 0; +my $lock_get_chunk = 0; + +my $invalid_excel_spreadsheet_chars_pattern = '[' . quotemeta('[]:*?/\\') . ']'; + +sub sanitize_spreadsheet_name { #Invalid character []:*?/\ in worksheet name + my $spreadsheet_name = shift; + $spreadsheet_name =~ s/$invalid_excel_spreadsheet_chars_pattern//g; + return chopstring($spreadsheet_name,31); #Sheetname eventually inconsistent etc. must be <= 31 chars +} + +sub sanitize_column_name { + my $column_name = shift; + $column_name =~ s/\W/_/g; + return $column_name; +} + +sub excel_to_date { + my $excel_date_value = shift; + if ($excel_date_value > 0) { + my $datetime = DateTime::Format::Excel->parse_datetime($excel_date_value); + return $datetime->ymd('-'); # prints 1992-02-28 + } + return undef; +} + +sub excel_to_timestamp { + my $excel_datetime_value = shift; + if ($excel_datetime_value > 0) { + my $datetime = DateTime::Format::Excel->parse_datetime($excel_datetime_value); + return $datetime->ymd('-') . ' ' . $datetime->hms(':'); + } + return undef; +} + +sub new { + + my $class = shift; + + my $self = NGCP::BulkProcessor::SqlConnector->new(@_); + + $self->{db_dir} = undef; + $self->{f_dir} = undef; + $self->{csv_tables} = undef; + $self->{files} = undef; + + $self->{drh} = DBI->install_driver('CSV'); + + bless($self,$class); + + dbdebug($self,__PACKAGE__ . ' connector created',getlogger(__PACKAGE__)); + + return $self; + +} + +sub _connectidentifier { + + my $self = shift; + return $self->{f_dir}; + +} + +sub tableidentifier { + + my $self = shift; + my $tablename = shift; + return $tablename; + +} + +sub columnidentifier { + + my $self = shift; + my $columnname = shift; + + return sanitize_column_name($columnname); #actually happens automatically by dbd::csv + +} + +sub get_tableidentifier { + + my ($tablename,$db_dir) = @_; + if (defined $db_dir) { + return $db_dir . '.' . $tablename; + } else { + return $tablename; + } + +} + +sub getsafetablename { + + my $self = shift; + my $tableidentifier = shift; + return lc($self->SUPER::getsafetablename($tableidentifier)); + +} + +sub getdatabases { + + my $self = shift; + + local *DBDIR; + if (not opendir(DBDIR, $csv_path)) { + fileerror('cannot opendir ' . $csv_path . ': ' . $!,getlogger(__PACKAGE__)); + return []; + } + my @dirs = grep { $_ ne '.' && $_ ne '..' && -d $csv_path . $_ } readdir(DBDIR); + closedir DBDIR; + my @databases = (); + foreach my $dir (@dirs) { + push @databases,$dir; + } + return \@databases; + +} + +sub _createdatabase { + + my $self = shift; + my ($db_dir) = @_; + + my $f_dir; # = _get_f_dir($db_dir); + if (length($db_dir) > 0) { + $f_dir = $csv_path . $db_dir . '/'; + } else { + $f_dir = $csv_path; + } + + dbinfo($self,'opening csv folder',getlogger(__PACKAGE__)); + + #mkdir $f_dir; + makepath($f_dir,\&fileerror,getlogger(__PACKAGE__)); + + #if (not -d $f_dir) { + # fileerror('cannot opendir ' . $f_dir . ': ' . $!,getlogger(__PACKAGE__)); + # return; + #} + + #local *DBDIR; + #if (not opendir(DBDIR, $f_dir)) { + # fileerror('cannot opendir ' . $f_dir . ': ' . $!,getlogger(__PACKAGE__)); + # return; + #} + #closedir DBDIR; + + #changemod($f_dir); + + return $f_dir; +} + +sub db_connect { + + my $self = shift; + + my ($db_dir,$csv_tables) = @_; + + $self->SUPER::db_connect($db_dir,$csv_tables); + + $self->{db_dir} = $db_dir; + $self->{csv_tables} = $csv_tables; + $self->{f_dir} = $self->_createdatabase($db_dir); + + my $dbh_config = { + f_schema => undef, + #f_lock => 0, n/a in 0.26 yet? + cvs_eol => $default_csv_config->{eol}, + cvs_sep_char => $default_csv_config->{sep_char}, + cvs_quote_char => $default_csv_config->{quote_char}, + cvs_escape_char => $default_csv_config->{escape_char}, + PrintError => 0, + RaiseError => 0, + }; + my $usetabledef = 0; + if (defined $csv_tables and ref $csv_tables eq 'HASH') { + $usetabledef = 1; + } else { + $dbh_config->{f_dir} = $self->{f_dir}; + $dbh_config->{f_ext} = $csvextension . '/r'; + } + + my $dbh = DBI->connect ('dbi:CSV:','','',$dbh_config) or + dberror($self,'error connecting: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); + + $dbh->{InactiveDestroy} = 1; + + $dbh->{LongReadLen} = $LongReadLen; + $dbh->{LongTruncOk} = $LongTruncOk; + + $self->{dbh} = $dbh; + + if ($usetabledef) { + my @files = (); + foreach my $tablename (keys %$csv_tables) { + $dbh->{csv_tables}->{$tablename} = $csv_tables->{$tablename}; + push @files,$csv_tables->{$tablename}->{file}; + dbinfo($self,'using ' . $csv_tables->{$tablename}->{file},getlogger(__PACKAGE__)); + } + $self->{files} = \@files; + } else { + my @tablenames = $self->_list_tables(); + foreach my $tablename (@tablenames) { + $dbh->{csv_tables}->{$tablename} = { eol => $default_csv_config->{eol}, + sep_char => $default_csv_config->{sep_char}, + quote_char => $default_csv_config->{quote_char}, + escape_char => $default_csv_config->{escape_char}, + } + } + } + + dbinfo($self,'connected',getlogger(__PACKAGE__)); + +} + + +sub _list_tables { + my $self = shift; + my @table_list; + + eval { + @table_list = map { local $_ = $_; s/^\.\///g; $_; } $self->{dbh}->func('list_tables'); + }; + if ($@) { + my @tables; + eval { + @tables = $self->{dbh}->func("get_avail_tables") or return; + }; + if ($@) { + dberror($self,'error listing csv tables: ' . $@,getlogger(__PACKAGE__)); + } else { + foreach my $ref (@tables) { + if (defined $ref) { + if (ref $ref eq 'ARRAY') { + push @table_list, $ref->[2]; + #} else { + # push @table_list, $ref; + } + } + } + } + } + + return @table_list; #removeduplicates(\@table_list); +} + +sub _db_disconnect { + + my $self = shift; + + $self->SUPER::_db_disconnect(); + +} + +sub vacuum { + + my $self = shift; + my $tablename = shift; + +} + +sub cleanupcvsdirs { + + my (@remainingdbdirs) = @_; + local *DBDIR; + if (not opendir(DBDIR, $csv_path)) { + fileerror('cannot opendir ' . $csv_path . ': ' . $!,getlogger(__PACKAGE__)); + return; + } + my @dirs = grep { $_ ne '.' && $_ ne '..' && -d $csv_path . $_ } readdir(DBDIR); + closedir DBDIR; + my @remainingdbdirectories = (); + foreach my $dirname (@remainingdbdirs) { + push @remainingdbdirectories,$csv_path . $dirname . '/'; + } + foreach my $dir (@dirs) { + #print $file; + my $dirpath = $csv_path . $dir . '/'; + if (not contains($dirpath,\@remainingdbdirectories)) { + #if (remove_tree($dirpath) == 0) { + # filewarn('cannot remove ' . $dirpath . ': ' . $!,getlogger(__PACKAGE__)); + #} + remove_tree($dirpath, { + keep_root => 0, + error => \my $err }); + if (@$err) { + for my $diag (@$err) { + my ($file, $message) = %$diag; + if ($file eq '') { + filewarn("general error: $message",getlogger(__PACKAGE__)); + } else { + filewarn("problem unlinking $file: $message",getlogger(__PACKAGE__)); + } + } + } + } + } + +} + +sub getfieldnames { + + my $self = shift; + my $tablename = shift; + + my $fieldnames = []; + + if (defined $self->{dbh}) { + + my $query = 'SELECT * FROM ' . $self->tableidentifier($tablename) . ' LIMIT 1'; + dbdebug($self,'getfieldnames: ' . $query,getlogger(__PACKAGE__)); + my $sth = $self->{dbh}->prepare($query) or $self->_prepare_error($query); + $sth->execute() or $self->_execute_error($query,$sth,()); + $fieldnames = $sth->{NAME}; + $sth->finish(); + + } + + return $fieldnames; + +} + +sub getprimarykeycols { + + my $self = shift; + my $tablename = shift; + return []; + +} + +sub create_primarykey { + + my $self = shift; + my ($tablename,$keycols,$fieldnames) = @_; + + return 0; +} +sub create_indexes { + + my $self = shift; + my ($tablename,$indexes,$keycols) = @_; + + return 0; +} + +sub _gettablefilename { + + my $self = shift; + my $tablename = shift; + return $self->{f_dir} . $tablename . $csvextension; + +} + +sub create_texttable { + + my $self = shift; + my ($tablename,$fieldnames,$keycols,$indexes,$truncate) = @_; + + if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { + + my $created = 0; + if ($self->table_exists($tablename) == 0) { + + if (not exists $self->{dbh}->{csv_tables}->{$tablename}) { + $self->{dbh}->{csv_tables}->{$tablename} = { eol => $default_csv_config->{eol}, + sep_char => $default_csv_config->{sep_char}, + quote_char => $default_csv_config->{quote_char}, + escape_char => $default_csv_config->{escape_char}, + }; + } + + my $statement = 'CREATE TABLE ' . $self->tableidentifier($tablename) . ' ('; + $statement .= join(' TEXT, ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$fieldnames) . ' TEXT'; + $statement .= ')'; + + $self->db_do($statement); + + changemod($self->_gettablefilename($tablename)); + + texttablecreated($self,$tablename,getlogger(__PACKAGE__)); + + $created = 1; + } else { + my $fieldnamesfound = $self->getfieldnames($tablename); + if (not setcontains($fieldnames,$fieldnamesfound,1)) { + fieldnamesdiffer($self,$tablename,$fieldnames,$fieldnamesfound,getlogger(__PACKAGE__)); + return 0; + } + } + + if (not $created and $truncate) { + $self->truncate_table($tablename); + } + return 1; + } else { + return 0; + } + +} + +sub multithreading_supported { + + my $self = shift; + return 0; + +} + +sub truncate_table { + + my $self = shift; + my $tablename = shift; + + $self->db_do('DELETE FROM ' . $self->tableidentifier($tablename)); + tabletruncated($self,$tablename,getlogger(__PACKAGE__)); + +} + +sub table_exists { + + my $self = shift; + my $tablename = shift; + + if (defined $self->{dbh}) { + my @tables = $self->_list_tables(); + return contains($tablename,\@tables); + } + + return undef; + +} + +sub drop_table { + + my $self = shift; + my $tablename = shift; + + if ($self->table_exists($tablename) > 0) { + $self->db_do('DROP TABLE ' . $self->tableidentifier($tablename)); + delete $self->{dbh}->{csv_tables}->{$tablename}; + tabledropped($self,$tablename,getlogger(__PACKAGE__)); + return 1; + } + return 0; + +} + +sub db_begin { + + my $self = shift; + if (defined $self->{dbh}) { + dbdebug($self, "transactions not supported",getlogger(__PACKAGE__)); + } + +} + +sub db_commit { + + my $self = shift; + if (defined $self->{dbh}) { + dbdebug($self, "transactions not supported",getlogger(__PACKAGE__)); + } + +} + +sub db_rollback { + + my $self = shift; + if (defined $self->{dbh}) { + dbdebug($self, "transactions not supported",getlogger(__PACKAGE__)); + } + +} + +sub db_do_begin { + + my $self = shift; + my $query = shift; + my $tablename = shift; + + $self->SUPER::db_do_begin($query,$tablename,$lock_do_chunk,@_); + +} + +sub db_get_begin { + + my $self = shift; + my $query = shift; + my $tablename = shift; + + $self->SUPER::db_get_begin($query,$tablename,$lock_get_chunk,@_); + +} + +sub db_finish { + + my $self = shift; + + $self->SUPER::db_finish($lock_do_chunk | $lock_get_chunk); + +} + +sub xlsbin2csv { + + my ($inputfile,$outputfile,$worksheetname,$sourcecharset) = @_; + + return _convert_xlsbin2csv($inputfile, + $worksheetname, + $sourcecharset, + $outputfile, + 'UTF-8', + $default_csv_config->{quote_char}, + $default_csv_config->{escape_char}, + $default_csv_config->{sep_char}, + $default_csv_config->{eol}); + +} + +sub _convert_xlsbin2csv { + + my ($SourceFilename,$worksheet,$SourceCharset,$DestFilename,$DestCharset,$quote_char,$escape_char,$sep_char,$eol) = @_; + + my $csvlinecount = 0; + + xls2csvinfo('start converting ' . $SourceFilename . ' (worksheet ' . $worksheet . ') to ' . $DestFilename . ' ...',getlogger(__PACKAGE__)); + + $SourceCharset = 'UTF-8' unless $SourceCharset; + $DestCharset = $SourceCharset unless $DestCharset; + + xls2csvinfo('reading ' . $SourceFilename . ' as ' . $SourceCharset,getlogger(__PACKAGE__)); + + my $XLS = new IO::File; + if (not $XLS->open('<' . $SourceFilename)) { + fileerror('cannot open file ' . $SourceFilename . ': ' . $!,getlogger(__PACKAGE__)); + return 0; + } + + my $Formatter = Spreadsheet::ParseExcel::FmtUnicode->new(Unicode_Map => $SourceCharset); + + my $parser = Spreadsheet::ParseExcel->new(); + my $Book = $parser->parse($XLS,$Formatter); #$SourceFilename + + if ( !defined $Book ) { + xls2csverror($parser->error(),getlogger(__PACKAGE__)); + #die $parser->error(), ".\n"; + $XLS->close(); + return 0; + } + + #my $Book = Spreadsheet::ParseExcel::Workbook->Parse($XLS, $Formatter) or xls2csverror('can\'t read spreadsheet',getlogger(__PACKAGE__)); + + my $Sheet; + if ($worksheet) { + + #my $test = $Book->GetContent(); + + $Sheet = $Book->Worksheet($worksheet); + if (!defined $Sheet) { + xls2csverror('invalid spreadsheet',getlogger(__PACKAGE__)); + return 0; + } + #unless ($O{'q'}) + #{ + # print qq|Converting the "$Sheet->{Name}" worksheet.\n|; + #} + xls2csvinfo('converting the ' . $Sheet->{Name} . ' worksheet',getlogger(__PACKAGE__)); + } else { + ($Sheet) = @{$Book->{Worksheet}}; + if ($Book->{SheetCount}>1) { + #print qq|Multiple worksheets found. Will convert the "$Sheet->{Name}" worksheet.\n|; + xls2csvinfo('multiple worksheets found, converting ' . $Sheet->{Name},getlogger(__PACKAGE__)); + } + } + + unlink $DestFilename; + local *CSV; + if (not open(CSV,'>' . $DestFilename)) { + fileerror('cannot open file ' . $DestFilename . ': ' . $!,getlogger(__PACKAGE__)); + $XLS->close(); + return 0; + } + binmode CSV; + + my $Csv = Text::CSV_XS->new({ + 'quote_char' => $quote_char, + 'escape_char' => $escape_char, + 'sep_char' => $sep_char, + 'binary' => 1, + }); + + my $Recoder; + if ($DestCharset) { + $Recoder = Locale::Recode->new(from => $SourceCharset, to => $DestCharset); + } + + for (my $Row = $Sheet->{MinRow}; defined $Sheet->{MaxRow} && $Row <= $Sheet->{MaxRow}; $Row++) { + my @Row; + for (my $Col = $Sheet->{MinCol}; defined $Sheet->{MaxCol} && $Col <= $Sheet->{MaxCol}; $Col++) { + my $Cell = $Sheet->{Cells}[$Row][$Col]; + + my $Value = ""; + if ($Cell) { + $Value = $Cell->Value; + if ($Value eq 'GENERAL') { + # Sometimes numbers are read incorrectly as "GENERAL". + # In this case, the correct value should be in ->{Val}. + $Value = $Cell->{Val}; + } + if ($DestCharset) { + $Recoder->recode($Value); + } + } + + # We assume the line is blank if there is nothing in the first column. + last if $Col == $Sheet->{MinCol} and !$Value; + + push(@Row,$Value); + } + + next unless @Row; + + my $Status = $Csv->combine(@Row); + + if (!defined $Status) { + xls2csvwarn('csv error: ' . $Csv->error_input(),getlogger(__PACKAGE__)); + } + + if (defined $Status) { + print CSV $Csv->string(); + if ($Row < $Sheet->{MaxRow}) { + print CSV $eol; + } + $csvlinecount++; + } + } + + close CSV; + $XLS->close; + + xls2csvinfo($csvlinecount . ' line(s) converted',getlogger(__PACKAGE__)); + + return $csvlinecount; + +} + +sub xlsxbin2csv { + + my ($inputfile,$outputfile,$worksheetname) = @_; + + return _convert_xlsxbin2csv($inputfile, + $worksheetname, + $outputfile, + 'UTF-8', + $default_csv_config->{quote_char}, + $default_csv_config->{escape_char}, + $default_csv_config->{sep_char}, + $default_csv_config->{eol}); + +} + +sub _convert_xlsxbin2csv { + my ($SourceFilename,$worksheet,$DestFilename,$DestCharset,$quote_char,$escape_char,$sep_char,$eol) = @_; + + my $csvlinecount = 0; + + xls2csvinfo('start converting ' . $SourceFilename . ' (worksheet ' . $worksheet . ') to ' . $DestFilename . ' ...',getlogger(__PACKAGE__)); + + + my $XLS = new IO::File; + if (not $XLS->open('<' . $SourceFilename)) { + fileerror('cannot open file ' . $SourceFilename . ': ' . $!,getlogger(__PACKAGE__)); + return 0; + } else { + $XLS->close(); + } + + #my $Formatter = Spreadsheet::ParseExcel::FmtUnicode->new(Unicode_Map => $SourceCharset); + + my $reader = Excel::Reader::XLSX->new(); + my $workbook = $reader->read_file($SourceFilename); #->parse($XLS,$Formatter); #$SourceFilename + + my $SourceCharset = $workbook->{_reader}->encoding(); + $DestCharset = $SourceCharset unless $DestCharset; + + xls2csvinfo('reading ' . $SourceFilename . ' as ' . $SourceCharset,getlogger(__PACKAGE__)); + + if ( !defined $workbook ) { + xls2csverror($reader->error(),getlogger(__PACKAGE__)); + #die $parser->error(), ".\n"; + #$XLS->close(); + return 0; + } + + #my $Book = Spreadsheet::ParseExcel::Workbook->Parse($XLS, $Formatter) or xls2csverror('can\'t read spreadsheet',getlogger(__PACKAGE__)); + + my $sheet; + if ($worksheet) { + + #my $test = $Book->GetContent(); + + $sheet = $workbook->worksheet($worksheet); + if (!defined $sheet) { + xls2csverror('invalid spreadsheet',getlogger(__PACKAGE__)); + return 0; + } + #unless ($O{'q'}) + #{ + # print qq|Converting the "$Sheet->{Name}" worksheet.\n|; + #} + xls2csvinfo('converting the ' . $sheet->name() . ' worksheet',getlogger(__PACKAGE__)); + } else { + $sheet = $workbook->worksheet(0); + if (@{$workbook->worksheets()} > 1) { + #print qq|Multiple worksheets found. Will convert the "$Sheet->{Name}" worksheet.\n|; + xls2csvinfo('multiple worksheets found, converting ' . $sheet->name(),getlogger(__PACKAGE__)); + } + } + + unlink $DestFilename; + local *CSV; + if (not open(CSV,'>' . $DestFilename)) { + fileerror('cannot open file ' . $DestFilename . ': ' . $!,getlogger(__PACKAGE__)); + #$XLS->close(); + return 0; + } + binmode CSV; + + my $csv = Text::CSV_XS->new({ + 'quote_char' => $quote_char, + 'escape_char' => $escape_char, + 'sep_char' => $sep_char, + 'binary' => 1, + }); + + my $Recoder; + if ($DestCharset) { + $Recoder = Locale::Recode->new(from => $SourceCharset, to => $DestCharset); + } + + while ( my $row = $sheet->next_row() ) { + + foreach my $value ($row->values()) { + $Recoder->recode($value); + } + + my $status = $csv->combine($row->values()); + + if (!defined $status) { + xls2csvwarn('csv error: ' . $csv->error_input(),getlogger(__PACKAGE__)); + } + + if (defined $status) { + if ($row->row_number() > 0) { + print CSV $eol; + } + print CSV $csv->string(); + $csvlinecount++; + } + } + + close CSV; + #$XLS->close; + + xls2csvinfo($csvlinecount . ' line(s) converted',getlogger(__PACKAGE__)); + + return $csvlinecount; + +} + +1; diff --git a/SqlConnectors/MySQLDB.pm b/lib/NGCP/BulkProcessor/SqlConnectors/MySQLDB.pm similarity index 94% rename from SqlConnectors/MySQLDB.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/MySQLDB.pm index d8c5271..ec813b6 100644 --- a/SqlConnectors/MySQLDB.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/MySQLDB.pm @@ -1,534 +1,534 @@ -package SqlConnectors::MySQLDB; -use strict; - -## no critic - -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); - -use Globals qw($LongReadLen_limit); -use Logging qw( - getlogger - dbinfo - dbdebug - texttablecreated - temptablecreated - indexcreated - primarykeycreated - tabletruncated - tabledropped); -use LogError qw(dberror fieldnamesdiffer); - -use DBI; -use DBD::mysql 4.014; - -use Array qw(arrayeq itemcount contains setcontains); - -use SqlConnector; - -require Exporter; -our @ISA = qw(Exporter SqlConnector); -our @EXPORT_OK = qw(get_tableidentifier); - -my $defaulthost = '127.0.0.1'; -my $defaultport = '3306'; -my $defaultusername = 'root'; -my $defaultpassword = ''; -my $defaultdatabasename = 'test'; - -my $varcharsize = 256; - -my $texttable_charset = 'latin1'; -my $texttable_collation = 'latin1_swedish_ci'; -my $default_texttable_engine = 'MyISAM'; #InnoDB'; # ... provide transactions y/n? - -my $session_charset = 'latin1'; - -my $LongReadLen = $LongReadLen_limit; #bytes -my $LongTruncOk = 0; - -#my $logger = getlogger(__PACKAGE__); - -my $lock_do_chunk = 1; -my $lock_get_chunk = 0; - -my $serialization_level = ''; #'SERIALIZABLE' - -sub new { - - my $class = shift; - - my $self = SqlConnector->new(@_); - - $self->{host} = undef; - $self->{port} = undef; - $self->{databasename} = undef; - $self->{username} = undef; - $self->{password} = undef; - - $self->{drh} = DBI->install_driver('mysql'); - - bless($self,$class); - - dbdebug($self,__PACKAGE__ . ' connector created',getlogger(__PACKAGE__)); - - return $self; - -} - -sub _connectidentifier { - - my $self = shift; - if (defined $self->{databasename}) { - return $self->{username} . '@' . $self->{host} . ':' . $self->{port} . '.' . $self->{databasename}; - } else { - return undef; - } - -} - -sub tableidentifier { - - my $self = shift; - my $tablename = shift; - - if (defined $self->{databasename}) { - return '`' . $self->{databasename} . '`.`' . $tablename . '`'; - } else { - return '`' . $tablename . '`'; - } - -} - -sub columnidentifier { - - my $self = shift; - my $columnname = shift; - - return '`' . $columnname . '`'; - -} - -sub get_tableidentifier { - - my ($tablename,$databasename) = @_; - - if (defined $databasename) { - return $databasename . '.' . $tablename; - } else { - return $tablename; - } - -} - -sub getsafetablename { - - my $self = shift; - my $tableidentifier = shift; - - return lc($self->SUPER::getsafetablename($tableidentifier)); - -} - -sub _force_numeric_column { - my $self = shift; - my $column = shift; - return '(' . $column . ' + 0.0)'; -} - -sub getdatabases { - - my $self = shift; - - my @dbs = $self->{drh}->func($self->{host}, - $self->{port}, - $self->{username}, - $self->{password}, - '_ListDBs') or - dberror($self,'error listing databases: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); - - return \@dbs; - -} - -sub _createdatabase { - - my $self = shift; - my ($databasename) = @_; - - if ($self->{drh}->func('createdb', - $databasename, - 'host=' . $self->{host} . ';port=' . $self->{port}, - $self->{username}, - $self->{password}, - 'admin')) { - dbinfo($self,'database \'' . $databasename . '\' created',getlogger(__PACKAGE__)); - } -} - -sub db_connect { - - my $self = shift; - - my ($databasename,$username,$password,$host,$port) = @_; - - $self->SUPER::db_connect($databasename,$username,$password,$host,$port); - - $host = $defaulthost if (not $host); - $port = $defaultport if (not $port); - $databasename = $defaultdatabasename if (not $databasename); - $username = $defaultusername if (not $username); - $password = $defaultpassword if (not $password); - - $self->{host} = $host; - $self->{port} = $port; - $self->{databasename} = $databasename; - $self->{username} = $username; - $self->{password} = $password; - - if (not contains($databasename,$self->getdatabases(),0)) { - $self->_createdatabase($databasename); - } - - dbdebug($self,'connecting',getlogger(__PACKAGE__)); - - my $dbh = DBI->connect( - 'dbi:mysql:database=' . $databasename . ';host=' . $host . ';port=' . $port,$username,$password, - { - PrintError => 0, - RaiseError => 0, - AutoCommit => 1, - #AutoCommit => 0, - } - ) or dberror($self,'error connecting: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); - - $dbh->{InactiveDestroy} = 1; - - $dbh->{LongReadLen} = $LongReadLen; - $dbh->{LongTruncOk} = $LongTruncOk; - - $self->{dbh} = $dbh; - - my $server_version = substr($self->db_get_all_hashref('SHOW VARIABLES LIKE \'version\'','Variable_name')->{version}->{Value},0,2); - if ($server_version ge '4.1') { - # $self->db_do('SET SESSION character_set_client = \'utf8\''); - # $self->db_do('SET SESSION character_set_connection = \'utf8\''); - # $self->db_do('SET SESSION character_set_results = \'utf8\''); - $self->db_do('SET CHARACTER SET ' . $session_charset . ''); - dbdebug($self,'session charset ' . $session_charset . ' applied',getlogger(__PACKAGE__)); - } else { - # $self->db_do('SET SESSION CHARACTER SET = \'utf8\''); - #$self->db_do('SET SESSION CHARACTER SET = \'latin1\''); - - #$self->db_do('SET SESSION CHARACTER SET \'cp1251_koi8\''); # the only valid if convert.cc on server is not modified - } - - - #$self->db_do('SET character_set_client = \'utf8\''); - #$self->db_do('SET character_set_connection = \'utf8\''); - #$self->db_do('SET character_set_results = \'utf8\''); - #$self->db_do('SET SESSION NAMES = \'utf8\''); - #$self->db_do('SET character_set_connection = \'utf8\''); - #$self->db_do('SET character_set_results = \'utf8\''); - - #$self->db_do('SET SESSION date_format = \'%Y-%m-%d\''); - #$self->db_do('SET SESSION time_format = \'%H:%i:%s\''); - #$self->db_do('SET SESSION time_zone = \'Europe/Paris\''); - #$self->db_do('SET SESSION datetime_format = \'%Y-%m-%d %H:%i:%s\''); - - if (length($serialization_level) > 0) { - $self->db_do('SET SESSION TRANSACTION ISOLATION LEVEL ' . $serialization_level); - } - - dbinfo($self,'connected',getlogger(__PACKAGE__)); - -} - -sub vacuum { - - my $self = shift; - my $tablename = shift; - - $self->db_do('OPTIMIZE TABLE ' . $self->tableidentifier($tablename)); - -} - -sub _db_disconnect { - - my $self = shift; - - $self->SUPER::_db_disconnect(); - -} - -sub getfieldnames { - - my $self = shift; - my $tablename = shift; - return $self->db_get_col('SHOW FIELDS FROM ' . $self->tableidentifier($tablename)); - -} - -sub getprimarykeycols { - - my $self = shift; - my $tablename = shift; - my $fieldinfo = $self->db_get_all_hashref('SHOW FIELDS FROM ' . $self->tableidentifier($tablename),'Field'); - my @keycols = (); - foreach my $fieldname (keys %$fieldinfo) { - if (uc($fieldinfo->{$fieldname}->{'Key'}) eq 'PRI') { - push @keycols,$fieldname; - } - } - return \@keycols; - -} - -sub create_temptable { - - my $self = shift; - my $select_stmt = shift; - my $indexes = shift; - - my $index_tablename = $self->_gettemptablename(); - my $temp_tablename = $self->tableidentifier($index_tablename); - - $self->db_do('CREATE TEMPORARY TABLE ' . $temp_tablename . ' AS ' . $select_stmt); - temptablecreated($self,$index_tablename,getlogger(__PACKAGE__)); - - if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - foreach my $indexname (keys %$indexes) { - #my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); - #if (not arrayeq($indexcols,$keycols,1)) { - #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; - my $temptable_indexname = lc($index_tablename) . '_' . $indexname; - $self->db_do('CREATE INDEX ' . $temptable_indexname . ' ON ' . $temp_tablename . ' (' . join(', ', map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @{$indexes->{$indexname}}) . ')'); - indexcreated($self,$index_tablename,$indexname,getlogger(__PACKAGE__)); - #} - } - } - - return $temp_tablename; - -} - -sub create_primarykey { - - my $self = shift; - my ($tablename,$keycols,$fieldnames) = @_; - - if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { - - if (defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { - my $statement = 'ALTER TABLE ' . $self->tableidentifier($tablename) . ' ADD PRIMARY KEY (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @$keycols) . ')'; - $self->db_do($statement); - primarykeycreated($self,$tablename,$keycols,getlogger(__PACKAGE__)); - return 1; - } - - } - - return 0; -} - -sub create_indexes { - - my $self = shift; - my ($tablename,$indexes,$keycols) = @_; - - my $index_count = 0; - if (length($tablename) > 0) { - - if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - foreach my $indexname (keys %$indexes) { - if (not arrayeq($self->_extract_indexcols($indexes->{$indexname}),$keycols,1)) { - my $statement = 'CREATE INDEX ' . $indexname . ' ON ' . $self->tableidentifier($tablename) . ' (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @{$indexes->{$indexname}}) . ')'; - $self->db_do($statement); - indexcreated($self,$tablename,$indexname,getlogger(__PACKAGE__)); - $index_count++; - } - } - } - - } - - return $index_count; -} - -sub create_texttable { - - my $self = shift; - my ($tablename,$fieldnames,$keycols,$indexes,$truncate,$defer_indexes,$texttable_engine) = @_; - - #my $tablename = $self->getsafetablename($tableidentifier); - #my ($tableidentifier,$fieldnames,$keycols,$indexes,$truncate) = @_; - - #my $tablename = $self->getsafetablename($tableidentifier); - - if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { - - my $created = 0; - if ($self->table_exists($tablename) == 0) { - my $statement = 'CREATE TABLE ' . $self->tableidentifier($tablename) . ' ('; - #$statement .= join(' TEXT, ',@$fieldnames) . ' TEXT'; - - my @fieldspecs = (); - foreach my $fieldname (@$fieldnames) { - if (contains($fieldname,$keycols,1)) { - push @fieldspecs,$self->columnidentifier($fieldname) . ' VARCHAR(' . $varcharsize . ')'; - #$statement .= $fieldname . ' VARCHAR(256)'; - } else { - push @fieldspecs,$self->columnidentifier($fieldname) . ' TEXT'; - #$statement .= $fieldname . ' TEXT'; - } - } - $statement .= join(', ',@fieldspecs); - - - #if (defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { - if (not $defer_indexes and defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { - $statement .= ', PRIMARY KEY (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @$keycols) . ')'; - } - if (not $defer_indexes and defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - foreach my $indexname (keys %$indexes) { - if (not arrayeq($self->_extract_indexcols($indexes->{$indexname}),$keycols,1)) { - $statement .= ', INDEX ' . $indexname . ' (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @{$indexes->{$indexname}}) . ')'; - } - } - } - if (length($texttable_engine) == 0) { - $texttable_engine = $default_texttable_engine; - } - $statement .= ') CHARACTER SET ' . $texttable_charset . ', COLLATE ' . $texttable_collation . ', ENGINE ' . $texttable_engine; - - $self->db_do($statement); - texttablecreated($self,$tablename . ' (' . $texttable_engine . ')',getlogger(__PACKAGE__)); - $created = 1; - } else { - my $fieldnamesfound = $self->getfieldnames($tablename); - if (not setcontains($fieldnames,$fieldnamesfound,1)) { - fieldnamesdiffer($self,$tablename,$fieldnames,$fieldnamesfound,getlogger(__PACKAGE__)); - return 0; - } - } - - if (not $created and $truncate) { - $self->truncate_table($tablename); - } - return 1; - } else { - return 0; - } - -} - -sub multithreading_supported { - - my $self = shift; - return 1; - -} - -sub truncate_table { - - my $self = shift; - my $tablename = shift; - - $self->db_do('TRUNCATE ' . $self->tableidentifier($tablename)); - tabletruncated($self,$tablename,getlogger(__PACKAGE__)); - -} - -sub table_exists { - - my $self = shift; - my $tablename = shift; - - # ... again, avoid using mysql's information_schema table, - # since its availability is obviously user/version dependent. - return itemcount($tablename,$self->db_get_col('SHOW TABLES')); #,1); - -} - -sub drop_table { - - my $self = shift; - my $tablename = shift; - - if ($self->table_exists($tablename) > 0) { - $self->db_do('DROP TABLE ' . $self->tableidentifier($tablename)); - tabledropped($self,$tablename,getlogger(__PACKAGE__)); - return 1; - } - return 0; - -} - - -sub lock_tables { - - my $self = shift; - my $tablestolock = shift; - - if (defined $self->{dbh} and defined $tablestolock and ref $tablestolock eq 'HASH') { - - my $locks = join(', ',map { local $_ = $_; $_ = $self->tableidentifier($_) . ' ' . $tablestolock->{$_}; $_; } keys %$tablestolock); - dbdebug($self,"lock_tables:\n" . $locks,getlogger(__PACKAGE__)); - $self->db_do('LOCK TABLES ' . $locks); - - } - -} - -sub unlock_tables { - - my $self = shift; - if (defined $self->{dbh}) { - - dbdebug($self,'unlock_tables',getlogger(__PACKAGE__)); - $self->db_do('UNLOCK TABLES'); - - } - -} - -sub db_do_begin { - - my $self = shift; - my $query = shift; - my $tablename = shift; - - $self->SUPER::db_do_begin($query,$tablename,$lock_do_chunk,@_); - -} - -sub db_get_begin { - - my $self = shift; - my $query = shift; - my $tablename = shift; - #my $lock = shift; - - $self->SUPER::db_get_begin($query,$tablename,$lock_get_chunk,@_); - -} - -sub db_finish { - - my $self = shift; - #my $unlock = shift; - - $self->SUPER::db_finish($lock_do_chunk | $lock_get_chunk); - -} - -sub _split_indexcol { - my $indexcol = shift; - if ($indexcol =~ /(.+)(\(\d+\))/g) { - return ($1,$2); - } - return ($indexcol, ''); -} - -1; \ No newline at end of file +package NGCP::BulkProcessor::SqlConnectors::MySQLDB; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); + +use NGCP::BulkProcessor::Globals qw($LongReadLen_limit); +use NGCP::BulkProcessor::Logging qw( + getlogger + dbinfo + dbdebug + texttablecreated + temptablecreated + indexcreated + primarykeycreated + tabletruncated + tabledropped); +use NGCP::BulkProcessor::LogError qw(dberror fieldnamesdiffer); + +use DBI; +use DBD::mysql 4.014; + +use NGCP::BulkProcessor::Array qw(arrayeq itemcount contains setcontains); + +use NGCP::BulkProcessor::SqlConnector; + +require Exporter; +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlConnector); +our @EXPORT_OK = qw(get_tableidentifier); + +my $defaulthost = '127.0.0.1'; +my $defaultport = '3306'; +my $defaultusername = 'root'; +my $defaultpassword = ''; +my $defaultdatabasename = 'test'; + +my $varcharsize = 256; + +my $texttable_charset = 'latin1'; +my $texttable_collation = 'latin1_swedish_ci'; +my $default_texttable_engine = 'MyISAM'; #InnoDB'; # ... provide transactions y/n? + +my $session_charset = 'latin1'; + +my $LongReadLen = $LongReadLen_limit; #bytes +my $LongTruncOk = 0; + +#my $logger = getlogger(__PACKAGE__); + +my $lock_do_chunk = 1; +my $lock_get_chunk = 0; + +my $serialization_level = ''; #'SERIALIZABLE' + +sub new { + + my $class = shift; + + my $self = NGCP::BulkProcessor::SqlConnector->new(@_); + + $self->{host} = undef; + $self->{port} = undef; + $self->{databasename} = undef; + $self->{username} = undef; + $self->{password} = undef; + + $self->{drh} = DBI->install_driver('mysql'); + + bless($self,$class); + + dbdebug($self,__PACKAGE__ . ' connector created',getlogger(__PACKAGE__)); + + return $self; + +} + +sub _connectidentifier { + + my $self = shift; + if (defined $self->{databasename}) { + return $self->{username} . '@' . $self->{host} . ':' . $self->{port} . '.' . $self->{databasename}; + } else { + return undef; + } + +} + +sub tableidentifier { + + my $self = shift; + my $tablename = shift; + + if (defined $self->{databasename}) { + return '`' . $self->{databasename} . '`.`' . $tablename . '`'; + } else { + return '`' . $tablename . '`'; + } + +} + +sub columnidentifier { + + my $self = shift; + my $columnname = shift; + + return '`' . $columnname . '`'; + +} + +sub get_tableidentifier { + + my ($tablename,$databasename) = @_; + + if (defined $databasename) { + return $databasename . '.' . $tablename; + } else { + return $tablename; + } + +} + +sub getsafetablename { + + my $self = shift; + my $tableidentifier = shift; + + return lc($self->SUPER::getsafetablename($tableidentifier)); + +} + +sub _force_numeric_column { + my $self = shift; + my $column = shift; + return '(' . $column . ' + 0.0)'; +} + +sub getdatabases { + + my $self = shift; + + my @dbs = $self->{drh}->func($self->{host}, + $self->{port}, + $self->{username}, + $self->{password}, + '_ListDBs') or + dberror($self,'error listing databases: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); + + return \@dbs; + +} + +sub _createdatabase { + + my $self = shift; + my ($databasename) = @_; + + if ($self->{drh}->func('createdb', + $databasename, + 'host=' . $self->{host} . ';port=' . $self->{port}, + $self->{username}, + $self->{password}, + 'admin')) { + dbinfo($self,'database \'' . $databasename . '\' created',getlogger(__PACKAGE__)); + } +} + +sub db_connect { + + my $self = shift; + + my ($databasename,$username,$password,$host,$port) = @_; + + $self->SUPER::db_connect($databasename,$username,$password,$host,$port); + + $host = $defaulthost if (not $host); + $port = $defaultport if (not $port); + $databasename = $defaultdatabasename if (not $databasename); + $username = $defaultusername if (not $username); + $password = $defaultpassword if (not $password); + + $self->{host} = $host; + $self->{port} = $port; + $self->{databasename} = $databasename; + $self->{username} = $username; + $self->{password} = $password; + + if (not contains($databasename,$self->getdatabases(),0)) { + $self->_createdatabase($databasename); + } + + dbdebug($self,'connecting',getlogger(__PACKAGE__)); + + my $dbh = DBI->connect( + 'dbi:mysql:database=' . $databasename . ';host=' . $host . ';port=' . $port,$username,$password, + { + PrintError => 0, + RaiseError => 0, + AutoCommit => 1, + #AutoCommit => 0, + } + ) or dberror($self,'error connecting: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); + + $dbh->{InactiveDestroy} = 1; + + $dbh->{LongReadLen} = $LongReadLen; + $dbh->{LongTruncOk} = $LongTruncOk; + + $self->{dbh} = $dbh; + + my $server_version = substr($self->db_get_all_hashref('SHOW VARIABLES LIKE \'version\'','Variable_name')->{version}->{Value},0,2); + if ($server_version ge '4.1') { + # $self->db_do('SET SESSION character_set_client = \'utf8\''); + # $self->db_do('SET SESSION character_set_connection = \'utf8\''); + # $self->db_do('SET SESSION character_set_results = \'utf8\''); + $self->db_do('SET CHARACTER SET ' . $session_charset . ''); + dbdebug($self,'session charset ' . $session_charset . ' applied',getlogger(__PACKAGE__)); + } else { + # $self->db_do('SET SESSION CHARACTER SET = \'utf8\''); + #$self->db_do('SET SESSION CHARACTER SET = \'latin1\''); + + #$self->db_do('SET SESSION CHARACTER SET \'cp1251_koi8\''); # the only valid if convert.cc on server is not modified + } + + + #$self->db_do('SET character_set_client = \'utf8\''); + #$self->db_do('SET character_set_connection = \'utf8\''); + #$self->db_do('SET character_set_results = \'utf8\''); + #$self->db_do('SET SESSION NAMES = \'utf8\''); + #$self->db_do('SET character_set_connection = \'utf8\''); + #$self->db_do('SET character_set_results = \'utf8\''); + + #$self->db_do('SET SESSION date_format = \'%Y-%m-%d\''); + #$self->db_do('SET SESSION time_format = \'%H:%i:%s\''); + #$self->db_do('SET SESSION time_zone = \'Europe/Paris\''); + #$self->db_do('SET SESSION datetime_format = \'%Y-%m-%d %H:%i:%s\''); + + if (length($serialization_level) > 0) { + $self->db_do('SET SESSION TRANSACTION ISOLATION LEVEL ' . $serialization_level); + } + + dbinfo($self,'connected',getlogger(__PACKAGE__)); + +} + +sub vacuum { + + my $self = shift; + my $tablename = shift; + + $self->db_do('OPTIMIZE TABLE ' . $self->tableidentifier($tablename)); + +} + +sub _db_disconnect { + + my $self = shift; + + $self->SUPER::_db_disconnect(); + +} + +sub getfieldnames { + + my $self = shift; + my $tablename = shift; + return $self->db_get_col('SHOW FIELDS FROM ' . $self->tableidentifier($tablename)); + +} + +sub getprimarykeycols { + + my $self = shift; + my $tablename = shift; + my $fieldinfo = $self->db_get_all_hashref('SHOW FIELDS FROM ' . $self->tableidentifier($tablename),'Field'); + my @keycols = (); + foreach my $fieldname (keys %$fieldinfo) { + if (uc($fieldinfo->{$fieldname}->{'Key'}) eq 'PRI') { + push @keycols,$fieldname; + } + } + return \@keycols; + +} + +sub create_temptable { + + my $self = shift; + my $select_stmt = shift; + my $indexes = shift; + + my $index_tablename = $self->_gettemptablename(); + my $temp_tablename = $self->tableidentifier($index_tablename); + + $self->db_do('CREATE TEMPORARY TABLE ' . $temp_tablename . ' AS ' . $select_stmt); + temptablecreated($self,$index_tablename,getlogger(__PACKAGE__)); + + if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + foreach my $indexname (keys %$indexes) { + #my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); + #if (not arrayeq($indexcols,$keycols,1)) { + #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; + my $temptable_indexname = lc($index_tablename) . '_' . $indexname; + $self->db_do('CREATE INDEX ' . $temptable_indexname . ' ON ' . $temp_tablename . ' (' . join(', ', map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @{$indexes->{$indexname}}) . ')'); + indexcreated($self,$index_tablename,$indexname,getlogger(__PACKAGE__)); + #} + } + } + + return $temp_tablename; + +} + +sub create_primarykey { + + my $self = shift; + my ($tablename,$keycols,$fieldnames) = @_; + + if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { + + if (defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { + my $statement = 'ALTER TABLE ' . $self->tableidentifier($tablename) . ' ADD PRIMARY KEY (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @$keycols) . ')'; + $self->db_do($statement); + primarykeycreated($self,$tablename,$keycols,getlogger(__PACKAGE__)); + return 1; + } + + } + + return 0; +} + +sub create_indexes { + + my $self = shift; + my ($tablename,$indexes,$keycols) = @_; + + my $index_count = 0; + if (length($tablename) > 0) { + + if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + foreach my $indexname (keys %$indexes) { + if (not arrayeq($self->_extract_indexcols($indexes->{$indexname}),$keycols,1)) { + my $statement = 'CREATE INDEX ' . $indexname . ' ON ' . $self->tableidentifier($tablename) . ' (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @{$indexes->{$indexname}}) . ')'; + $self->db_do($statement); + indexcreated($self,$tablename,$indexname,getlogger(__PACKAGE__)); + $index_count++; + } + } + } + + } + + return $index_count; +} + +sub create_texttable { + + my $self = shift; + my ($tablename,$fieldnames,$keycols,$indexes,$truncate,$defer_indexes,$texttable_engine) = @_; + + #my $tablename = $self->getsafetablename($tableidentifier); + #my ($tableidentifier,$fieldnames,$keycols,$indexes,$truncate) = @_; + + #my $tablename = $self->getsafetablename($tableidentifier); + + if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { + + my $created = 0; + if ($self->table_exists($tablename) == 0) { + my $statement = 'CREATE TABLE ' . $self->tableidentifier($tablename) . ' ('; + #$statement .= join(' TEXT, ',@$fieldnames) . ' TEXT'; + + my @fieldspecs = (); + foreach my $fieldname (@$fieldnames) { + if (contains($fieldname,$keycols,1)) { + push @fieldspecs,$self->columnidentifier($fieldname) . ' VARCHAR(' . $varcharsize . ')'; + #$statement .= $fieldname . ' VARCHAR(256)'; + } else { + push @fieldspecs,$self->columnidentifier($fieldname) . ' TEXT'; + #$statement .= $fieldname . ' TEXT'; + } + } + $statement .= join(', ',@fieldspecs); + + + #if (defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { + if (not $defer_indexes and defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { + $statement .= ', PRIMARY KEY (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @$keycols) . ')'; + } + if (not $defer_indexes and defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + foreach my $indexname (keys %$indexes) { + if (not arrayeq($self->_extract_indexcols($indexes->{$indexname}),$keycols,1)) { + $statement .= ', INDEX ' . $indexname . ' (' . join(', ',map { local $_ = $_; my @indexcol = _split_indexcol($_); $_ = $self->columnidentifier($indexcol[0]) . $indexcol[1]; $_; } @{$indexes->{$indexname}}) . ')'; + } + } + } + if (length($texttable_engine) == 0) { + $texttable_engine = $default_texttable_engine; + } + $statement .= ') CHARACTER SET ' . $texttable_charset . ', COLLATE ' . $texttable_collation . ', ENGINE ' . $texttable_engine; + + $self->db_do($statement); + texttablecreated($self,$tablename . ' (' . $texttable_engine . ')',getlogger(__PACKAGE__)); + $created = 1; + } else { + my $fieldnamesfound = $self->getfieldnames($tablename); + if (not setcontains($fieldnames,$fieldnamesfound,1)) { + fieldnamesdiffer($self,$tablename,$fieldnames,$fieldnamesfound,getlogger(__PACKAGE__)); + return 0; + } + } + + if (not $created and $truncate) { + $self->truncate_table($tablename); + } + return 1; + } else { + return 0; + } + +} + +sub multithreading_supported { + + my $self = shift; + return 1; + +} + +sub truncate_table { + + my $self = shift; + my $tablename = shift; + + $self->db_do('TRUNCATE ' . $self->tableidentifier($tablename)); + tabletruncated($self,$tablename,getlogger(__PACKAGE__)); + +} + +sub table_exists { + + my $self = shift; + my $tablename = shift; + + # ... again, avoid using mysql's information_schema table, + # since its availability is obviously user/version dependent. + return itemcount($tablename,$self->db_get_col('SHOW TABLES')); #,1); + +} + +sub drop_table { + + my $self = shift; + my $tablename = shift; + + if ($self->table_exists($tablename) > 0) { + $self->db_do('DROP TABLE ' . $self->tableidentifier($tablename)); + tabledropped($self,$tablename,getlogger(__PACKAGE__)); + return 1; + } + return 0; + +} + + +sub lock_tables { + + my $self = shift; + my $tablestolock = shift; + + if (defined $self->{dbh} and defined $tablestolock and ref $tablestolock eq 'HASH') { + + my $locks = join(', ',map { local $_ = $_; $_ = $self->tableidentifier($_) . ' ' . $tablestolock->{$_}; $_; } keys %$tablestolock); + dbdebug($self,"lock_tables:\n" . $locks,getlogger(__PACKAGE__)); + $self->db_do('LOCK TABLES ' . $locks); + + } + +} + +sub unlock_tables { + + my $self = shift; + if (defined $self->{dbh}) { + + dbdebug($self,'unlock_tables',getlogger(__PACKAGE__)); + $self->db_do('UNLOCK TABLES'); + + } + +} + +sub db_do_begin { + + my $self = shift; + my $query = shift; + my $tablename = shift; + + $self->SUPER::db_do_begin($query,$tablename,$lock_do_chunk,@_); + +} + +sub db_get_begin { + + my $self = shift; + my $query = shift; + my $tablename = shift; + #my $lock = shift; + + $self->SUPER::db_get_begin($query,$tablename,$lock_get_chunk,@_); + +} + +sub db_finish { + + my $self = shift; + #my $unlock = shift; + + $self->SUPER::db_finish($lock_do_chunk | $lock_get_chunk); + +} + +sub _split_indexcol { + my $indexcol = shift; + if ($indexcol =~ /(.+)(\(\d+\))/g) { + return ($1,$2); + } + return ($indexcol, ''); +} + +1; diff --git a/SqlConnectors/OracleDB.pm b/lib/NGCP/BulkProcessor/SqlConnectors/OracleDB.pm similarity index 94% rename from SqlConnectors/OracleDB.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/OracleDB.pm index fb762a5..2af3e54 100644 --- a/SqlConnectors/OracleDB.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/OracleDB.pm @@ -1,532 +1,532 @@ -package SqlConnectors::OracleDB; -use strict; - -## no critic - -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); - -use Globals qw($LongReadLen_limit); -use Logging qw( - getlogger - dbinfo - dbdebug - texttablecreated - temptablecreated - indexcreated - primarykeycreated - tabletruncated - tabledropped); -use LogError qw(dberror dbwarn fieldnamesdiffer); - -use DBI; -use DBD::Oracle 1.21; - -use Array qw(contains arrayeq setcontains); - -use SqlConnector; - -require Exporter; -our @ISA = qw(Exporter SqlConnector); -our @EXPORT_OK = qw(get_tableidentifier); - -my $defaultport = '1521'; - -#$NLS_LANG = 'GERMAN_AUSTRIA.WE8ISO8859P1'; - -my $connNLS_LANGUAGE = 'GERMAN'; -my $connNLS_TERRITORY = 'AUSTRIA'; - -#my $connNLS_CHARACTERSET = 'WE8ISO8859P1'; - -my $varcharsize = 4000; -my $max_identifier_length = 30; - -my $LongReadLen = $LongReadLen_limit; #bytes -my $LongTruncOk = 0; - -#my $logger = getlogger(__PACKAGE__); - -my $lock_do_chunk = 0; -my $lock_get_chunk = 0; - -my $isolation_level = ''; #'SERIALIZABLE' - -my $enable_numeric_sorting = 0; - -sub new { - - my $class = shift; - - my $self = SqlConnector->new(@_); - - $self->{host} = undef; - $self->{port} = undef; - $self->{servicename} = undef; - $self->{sid} = undef; - $self->{username} = undef; - $self->{password} = undef; - $self->{schema} = undef; - - $self->{drh} = DBI->install_driver('Oracle'); - - bless($self,$class); - - dbdebug($self,__PACKAGE__ . ' connector created',getlogger(__PACKAGE__)); - - return $self; - -} - -sub _connectidentifier { - - my $self = shift; - if (defined $self->{schema}) { - if ($self->{servicename}) { - return $self->{username} . '@' . $self->{host} . ':' . $self->{port} . '/' . $self->{servicename} . '.' . $self->{schema}; - } elsif ($self->{sid}) { - return $self->{username} . '@' . $self->{host} . ':' . $self->{port} . '/SID ' . $self->{sid} . '.' . $self->{schema}; - } else { - return undef; - } - } else { - return undef; - } - - -} - -sub tableidentifier { - - my $self = shift; - my $tablename = shift; - return get_tableidentifier($tablename,$self->{schema}); - -} - -sub columnidentifier { - - my $self = shift; - my $columnname = shift; - - return $columnname; - -} - -sub _chopidentifier { - my $identifier = shift; - return substr($identifier,0,$max_identifier_length); -} - -sub get_tableidentifier { - - my ($tablename,$schema,$servicename,$sid) = @_; - my $tableidentifier = $tablename; - if (defined $schema) { - $tableidentifier = $schema . '.' . $tableidentifier; - } - if ($servicename) { - $tableidentifier = $servicename . '.' . $tableidentifier; - } elsif ($sid) { - $tableidentifier = $sid . '.' . $tableidentifier; - } - return $tableidentifier; - -} - -sub getsafetablename { - - my $self = shift; - my $tableidentifier = shift; - return uc($self->SUPER::getsafetablename($tableidentifier)); - #if (defined $self->{schema}) { - # return $self->{schema} . '.' . $tablename; - #} else { - # return $tablename; - #} - -} - -sub paginate_sort_query { - - my $self = shift; - my $statement = shift; - my $offset = shift; - my $limit = shift; - my $sortingconfigurations = shift; - - my $orderby = $self->_orderby_columns($sortingconfigurations); - if (length($orderby) > 0) { - $statement .= ' ORDER BY ' . $orderby; - } - if (defined $offset and defined $limit) { - $statement = 'SELECT * FROM (SELECT p.*, rownum rnum FROM (' . $statement . ') p WHERE rownum < ' . ($offset + $limit + 1) . ') WHERE rnum >= ' . ($offset + 1); - } - return $statement; - -} - -sub _force_numeric_column { - my $self = shift; - my $column = shift; - return 'try_to_number(' . $column . ')'; -} - -sub getdatabases { - - my $self = shift; - return $self->db_get_col('SELECT DISTINCT owner FROM all_objects'); - -} - -#sub _createdatabase { -# -# my $self = shift; -# my ($schema) = @_; -# -# #SQL> create tablespace test datafile 'C:\oraclexe\app\oracle\oradata\XE\test.dbf' size 10M autoextend on; -# #Tablespace created. -# #SQL> create user test identified by test default tablespace test; -# #User created. -# #alter user test quota unlimited on test -# -# $self->db_do('CREATE SCHEMA AUTHORIZATION ' . $schema); -# dbinfo($self,'schema \'' . $schema . '\' created',getlogger(__PACKAGE__)); -# -#} - -sub db_connect { - - my $self = shift; - - my ($servicename,$sid,$schema,$username,$password,$host,$port) = @_; - - $self->SUPER::db_connect($servicename,$sid,$schema,$username,$password,$host,$port); - - $port = $defaultport if (not $port); - - $self->{host} = $host; - $self->{port} = $port; - $self->{servicename} = $servicename; - $self->{sid} = $sid; - $self->{username} = $username; - $self->{password} = $password; - $self->{schema} = $schema; - - dbdebug($self,'connecting',getlogger(__PACKAGE__)); - - my $dbh; - if ($servicename) { - $dbh = DBI->connect( - 'dbi:Oracle:host=' . $host . ';service_name=' . $servicename . ';port=' . $port,$username,$password, - { - PrintError => 0, - RaiseError => 0, - AutoCommit => 1, - #AutoCommit => 0, - } - ) or dberror($self,'error connecting - service name: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); - } elsif ($sid) { - $dbh = DBI->connect( - 'dbi:Oracle:host=' . $host . ';sid=' . $sid . ';port=' . $port,$username,$password, - { - PrintError => 0, - RaiseError => 0, - AutoCommit => 1, - } - ) or dberror($self,'error connecting - sid: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); - } else { - dberror($self,'neither service name nor sid specified',getlogger(__PACKAGE__)); - } - - $self->{dbh} = $dbh; - - if (not contains($schema,$self->getdatabases(),0)) { - $self->_createdatabase($schema); #notimplemented error... - } - - $dbh->{InactiveDestroy} = 1; - - $dbh->{LongReadLen} = $LongReadLen; - $dbh->{LongTruncOk} = $LongTruncOk; - - $self->db_do('ALTER SESSION SET NLS_LANGUAGE = \'' . $connNLS_LANGUAGE . '\''); - $self->db_do('ALTER SESSION SET NLS_TERRITORY = \'' . $connNLS_TERRITORY . '\''); - #$self->db_do('ALTER SESSION SET NLS_CHARACTERSET = \'' . $connNLS_CHARACTERSET . '\''); - $self->db_do('ALTER SESSION SET NLS_NUMERIC_CHARACTERS = \'.,\''); - $self->db_do('ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD HH24:MI:SS\''); - - if (length($isolation_level) > 0) { - $self->db_do('ALTER SESSION SET ISOLATION_LEVEL = ' . $isolation_level); - } - - if ($enable_numeric_sorting) { - #http://stackoverflow.com/questions/6470819/sql-if-cannot-convert-to-number-set-as-null - eval { - $self->db_do("CREATE OR REPLACE FUNCTION try_to_number( p_str IN VARCHAR2 )\n" . - " RETURN NUMBER\n" . - "IS\n" . - " l_num NUMBER;\n" . - "BEGIN\n" . - " BEGIN\n" . - " l_num := to_number( p_str );\n" . - " EXCEPTION\n" . - " WHEN others THEN\n" . - " l_num := null;\n" . - " END;\n" . - " RETURN l_num;\n" . - "END;"); - }; - if ($@) { - dbwarn($self,'numeric sorting not supported',getlogger(__PACKAGE__)); - } - } else { - dbdebug($self,'numeric sorting not enabled',getlogger(__PACKAGE__)); - } - - dbinfo($self,'connected',getlogger(__PACKAGE__)); - -} - -sub vacuum { - - my $self = shift; - my $tablename = shift; - -} - -sub _db_disconnect { - - my $self = shift; - - $self->SUPER::_db_disconnect(); - -} - -sub getfieldnames { - - my $self = shift; - my $tablename = shift; - return $self->db_get_col('SELECT column_name FROM all_tab_columns WHERE CONCAT(CONCAT(owner,\'.\'),table_name) = ?',$self->tableidentifier($tablename)); - -} - -sub getprimarykeycols { - - my $self = shift; - my $tablename = shift; - return $self->db_get_col('SELECT cols.column_name FROM all_constraints cons, all_cons_columns cols WHERE - CONCAT(CONCAT(cols.owner,\'.\'),cols.table_name) = ? AND - cons.constraint_type = \'P\' AND - cons.constraint_name = cols.constraint_name AND - cons.owner = cols.owner - ORDER BY cols.table_name, cols.position',$self->tableidentifier($tablename)); - -} - -sub create_temptable { - - my $self = shift; - my $select_stmt = shift; - my $indexes = shift; - - my $index_tablename = $self->_gettemptablename(); - my $temp_tablename = $self->tableidentifier($index_tablename); - - #$self->db_do('CREATE GLOBAL TEMPORARY TABLE ' . $temp_tablename . ' ON COMMIT PRESERVE ROWS AS ' . $select_stmt); - $self->db_do('CREATE TABLE ' . $temp_tablename . ' AS ' . $select_stmt); - push(@{$self->{temp_tables}},$index_tablename); - - temptablecreated($self,$index_tablename,getlogger(__PACKAGE__)); - - #$self->{temp_table_count} += 1; - - if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - foreach my $indexname (keys %$indexes) { - my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); - #if (not arrayeq($indexcols,$keycols,1)) { - #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; - $indexname = _chopidentifier(lc($index_tablename) . '_' . $indexname); - $self->db_do('CREATE INDEX ' . $indexname . ' ON ' . $temp_tablename . ' (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$indexcols) . ')'); - indexcreated($self,$index_tablename,$indexname,getlogger(__PACKAGE__)); - #} - } - } - - return $temp_tablename; - -} - -sub create_primarykey { - - my $self = shift; - my ($tablename,$keycols,$fieldnames) = @_; - - if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { - - if (defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { - my $statement = 'ALTER TABLE ' . $self->tableidentifier($tablename) . ' ADD PRIMARY KEY (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$keycols) . ')'; - $self->db_do($statement); - primarykeycreated($self,$tablename,$keycols,getlogger(__PACKAGE__)); - return 1; - } - - } - - return 0; -} - -sub create_indexes { - - my $self = shift; - my ($tablename,$indexes,$keycols) = @_; - - my $index_count = 0; - if (length($tablename) > 0) { - - if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - foreach my $indexname (keys %$indexes) { - my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); - if (not arrayeq($indexcols,$keycols,1)) { - #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; - $indexname = _chopidentifier($indexname); - $self->db_do('CREATE INDEX ' . $indexname . ' ON ' . $self->tableidentifier($tablename) . ' (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$indexcols) . ')'); - indexcreated($self,$tablename,$indexname,getlogger(__PACKAGE__)); - } - } - } - - } - - return $index_count; -} - -sub create_texttable { - - my $self = shift; - my ($tablename,$fieldnames,$keycols,$indexes,$truncate,$defer_indexes) = @_; - #my ($tableidentifier,$fieldnames,$keycols,$indexes,$truncate) = @_; - - #my $tablename = $self->getsafetablename($tableidentifier); - - if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { - - my $created = 0; - if ($self->table_exists($tablename) == 0) { - my $statement = 'CREATE TABLE ' . $self->tableidentifier($tablename) . ' ('; - $statement .= join(' VARCHAR2(' . $varcharsize . '), ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$fieldnames) . ' VARCHAR2(' . $varcharsize . ')'; - if (not $defer_indexes and defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { - #$statement .= ', CONSTRAINT ' . $tablename . '_pk PRIMARY KEY (' . join(', ',@$keycols) . ')'; - $statement .= ', CONSTRAINT PRIMARY KEY (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$keycols) . ')'; - } - #if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - # foreach my $indexname (keys %$indexes) { - # $statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; - # } - #} - $statement .= ')'; - - $self->db_do($statement); - texttablecreated($self,$tablename,getlogger(__PACKAGE__)); - - if (not $defer_indexes and defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { - foreach my $indexname (keys %$indexes) { - my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); - if (not arrayeq($indexcols,$keycols,1)) { - #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; - $indexname = _chopidentifier($indexname); - $self->db_do('CREATE INDEX ' . $indexname . ' ON ' . $self->tableidentifier($tablename) . ' (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$indexcols) . ')'); - indexcreated($self,$tablename,$indexname,getlogger(__PACKAGE__)); - } - } - } - $created = 1; - } else { - my $fieldnamesfound = $self->getfieldnames($tablename); - if (not setcontains($fieldnames,$fieldnamesfound,1)) { - fieldnamesdiffer($self,$tablename,$fieldnames,$fieldnamesfound,getlogger(__PACKAGE__)); - return 0; - } - } - - if (not $created and $truncate) { - $self->truncate_table($tablename); - } - return 1; - } else { - return 0; - } - -} - -sub multithreading_supported { - - my $self = shift; - return 1; - -} - -sub truncate_table { - - my $self = shift; - my $tablename = shift; - - $self->db_do('TRUNCATE ' . $self->tableidentifier($tablename)); - tabletruncated($self,$tablename,getlogger(__PACKAGE__)); - -} - -sub table_exists { - - my $self = shift; - my $tablename = shift; - - return $self->db_get_value('SELECT COUNT(*) FROM all_tables WHERE CONCAT(CONCAT(owner,\'.\'),table_name) = ?',$self->tableidentifier($tablename)); - -} - -sub drop_table { - - my $self = shift; - my $tablename = shift; - - if ($self->table_exists($tablename) > 0) { - $self->db_do('DROP TABLE ' . $self->tableidentifier($tablename) . ' PURGE'); #CASCADE CONSTRAINTS PURGE'); - tabledropped($self,$tablename,getlogger(__PACKAGE__)); - return 1; - } - return 0; - -} - -sub db_do_begin { - - my $self = shift; - my $query = shift; - my $tablename = shift; - - $self->SUPER::db_do_begin($query,$tablename,0,@_); - -} - -sub db_get_begin { - - my $self = shift; - my $query = shift; - my $tablename = shift; - - $self->SUPER::db_get_begin($query,$tablename,0,@_); - -} - -sub db_finish { - - my $self = shift; - #my $unlock = shift; - - $self->SUPER::db_finish($lock_do_chunk | $lock_get_chunk); - -} - -1; \ No newline at end of file +package NGCP::BulkProcessor::SqlConnectors::OracleDB; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); + +use NGCP::BulkProcessor::Globals qw($LongReadLen_limit); +use NGCP::BulkProcessor::Logging qw( + getlogger + dbinfo + dbdebug + texttablecreated + temptablecreated + indexcreated + primarykeycreated + tabletruncated + tabledropped); +use NGCP::BulkProcessor::LogError qw(dberror dbwarn fieldnamesdiffer); + +use DBI; +use DBD::Oracle 1.21; + +use NGCP::BulkProcessor::Array qw(contains arrayeq setcontains); + +use NGCP::BulkProcessor::SqlConnector; + +require Exporter; +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlConnector); +our @EXPORT_OK = qw(get_tableidentifier); + +my $defaultport = '1521'; + +#$NLS_LANG = 'GERMAN_AUSTRIA.WE8ISO8859P1'; + +my $connNLS_LANGUAGE = 'GERMAN'; +my $connNLS_TERRITORY = 'AUSTRIA'; + +#my $connNLS_CHARACTERSET = 'WE8ISO8859P1'; + +my $varcharsize = 4000; +my $max_identifier_length = 30; + +my $LongReadLen = $LongReadLen_limit; #bytes +my $LongTruncOk = 0; + +#my $logger = getlogger(__PACKAGE__); + +my $lock_do_chunk = 0; +my $lock_get_chunk = 0; + +my $isolation_level = ''; #'SERIALIZABLE' + +my $enable_numeric_sorting = 0; + +sub new { + + my $class = shift; + + my $self = NGCP::BulkProcessor::SqlConnector->new(@_); + + $self->{host} = undef; + $self->{port} = undef; + $self->{servicename} = undef; + $self->{sid} = undef; + $self->{username} = undef; + $self->{password} = undef; + $self->{schema} = undef; + + $self->{drh} = DBI->install_driver('Oracle'); + + bless($self,$class); + + dbdebug($self,__PACKAGE__ . ' connector created',getlogger(__PACKAGE__)); + + return $self; + +} + +sub _connectidentifier { + + my $self = shift; + if (defined $self->{schema}) { + if ($self->{servicename}) { + return $self->{username} . '@' . $self->{host} . ':' . $self->{port} . '/' . $self->{servicename} . '.' . $self->{schema}; + } elsif ($self->{sid}) { + return $self->{username} . '@' . $self->{host} . ':' . $self->{port} . '/SID ' . $self->{sid} . '.' . $self->{schema}; + } else { + return undef; + } + } else { + return undef; + } + + +} + +sub tableidentifier { + + my $self = shift; + my $tablename = shift; + return get_tableidentifier($tablename,$self->{schema}); + +} + +sub columnidentifier { + + my $self = shift; + my $columnname = shift; + + return $columnname; + +} + +sub _chopidentifier { + my $identifier = shift; + return substr($identifier,0,$max_identifier_length); +} + +sub get_tableidentifier { + + my ($tablename,$schema,$servicename,$sid) = @_; + my $tableidentifier = $tablename; + if (defined $schema) { + $tableidentifier = $schema . '.' . $tableidentifier; + } + if ($servicename) { + $tableidentifier = $servicename . '.' . $tableidentifier; + } elsif ($sid) { + $tableidentifier = $sid . '.' . $tableidentifier; + } + return $tableidentifier; + +} + +sub getsafetablename { + + my $self = shift; + my $tableidentifier = shift; + return uc($self->SUPER::getsafetablename($tableidentifier)); + #if (defined $self->{schema}) { + # return $self->{schema} . '.' . $tablename; + #} else { + # return $tablename; + #} + +} + +sub paginate_sort_query { + + my $self = shift; + my $statement = shift; + my $offset = shift; + my $limit = shift; + my $sortingconfigurations = shift; + + my $orderby = $self->_orderby_columns($sortingconfigurations); + if (length($orderby) > 0) { + $statement .= ' ORDER BY ' . $orderby; + } + if (defined $offset and defined $limit) { + $statement = 'SELECT * FROM (SELECT p.*, rownum rnum FROM (' . $statement . ') p WHERE rownum < ' . ($offset + $limit + 1) . ') WHERE rnum >= ' . ($offset + 1); + } + return $statement; + +} + +sub _force_numeric_column { + my $self = shift; + my $column = shift; + return 'try_to_number(' . $column . ')'; +} + +sub getdatabases { + + my $self = shift; + return $self->db_get_col('SELECT DISTINCT owner FROM all_objects'); + +} + +#sub _createdatabase { +# +# my $self = shift; +# my ($schema) = @_; +# +# #SQL> create tablespace test datafile 'C:\oraclexe\app\oracle\oradata\XE\test.dbf' size 10M autoextend on; +# #Tablespace created. +# #SQL> create user test identified by test default tablespace test; +# #User created. +# #alter user test quota unlimited on test +# +# $self->db_do('CREATE SCHEMA AUTHORIZATION ' . $schema); +# dbinfo($self,'schema \'' . $schema . '\' created',getlogger(__PACKAGE__)); +# +#} + +sub db_connect { + + my $self = shift; + + my ($servicename,$sid,$schema,$username,$password,$host,$port) = @_; + + $self->SUPER::db_connect($servicename,$sid,$schema,$username,$password,$host,$port); + + $port = $defaultport if (not $port); + + $self->{host} = $host; + $self->{port} = $port; + $self->{servicename} = $servicename; + $self->{sid} = $sid; + $self->{username} = $username; + $self->{password} = $password; + $self->{schema} = $schema; + + dbdebug($self,'connecting',getlogger(__PACKAGE__)); + + my $dbh; + if ($servicename) { + $dbh = DBI->connect( + 'dbi:Oracle:host=' . $host . ';service_name=' . $servicename . ';port=' . $port,$username,$password, + { + PrintError => 0, + RaiseError => 0, + AutoCommit => 1, + #AutoCommit => 0, + } + ) or dberror($self,'error connecting - service name: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); + } elsif ($sid) { + $dbh = DBI->connect( + 'dbi:Oracle:host=' . $host . ';sid=' . $sid . ';port=' . $port,$username,$password, + { + PrintError => 0, + RaiseError => 0, + AutoCommit => 1, + } + ) or dberror($self,'error connecting - sid: ' . $self->{drh}->errstr(),getlogger(__PACKAGE__)); + } else { + dberror($self,'neither service name nor sid specified',getlogger(__PACKAGE__)); + } + + $self->{dbh} = $dbh; + + if (not contains($schema,$self->getdatabases(),0)) { + $self->_createdatabase($schema); #notimplemented error... + } + + $dbh->{InactiveDestroy} = 1; + + $dbh->{LongReadLen} = $LongReadLen; + $dbh->{LongTruncOk} = $LongTruncOk; + + $self->db_do('ALTER SESSION SET NLS_LANGUAGE = \'' . $connNLS_LANGUAGE . '\''); + $self->db_do('ALTER SESSION SET NLS_TERRITORY = \'' . $connNLS_TERRITORY . '\''); + #$self->db_do('ALTER SESSION SET NLS_CHARACTERSET = \'' . $connNLS_CHARACTERSET . '\''); + $self->db_do('ALTER SESSION SET NLS_NUMERIC_CHARACTERS = \'.,\''); + $self->db_do('ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD HH24:MI:SS\''); + + if (length($isolation_level) > 0) { + $self->db_do('ALTER SESSION SET ISOLATION_LEVEL = ' . $isolation_level); + } + + if ($enable_numeric_sorting) { + #http://stackoverflow.com/questions/6470819/sql-if-cannot-convert-to-number-set-as-null + eval { + $self->db_do("CREATE OR REPLACE FUNCTION try_to_number( p_str IN VARCHAR2 )\n" . + " RETURN NUMBER\n" . + "IS\n" . + " l_num NUMBER;\n" . + "BEGIN\n" . + " BEGIN\n" . + " l_num := to_number( p_str );\n" . + " EXCEPTION\n" . + " WHEN others THEN\n" . + " l_num := null;\n" . + " END;\n" . + " RETURN l_num;\n" . + "END;"); + }; + if ($@) { + dbwarn($self,'numeric sorting not supported',getlogger(__PACKAGE__)); + } + } else { + dbdebug($self,'numeric sorting not enabled',getlogger(__PACKAGE__)); + } + + dbinfo($self,'connected',getlogger(__PACKAGE__)); + +} + +sub vacuum { + + my $self = shift; + my $tablename = shift; + +} + +sub _db_disconnect { + + my $self = shift; + + $self->SUPER::_db_disconnect(); + +} + +sub getfieldnames { + + my $self = shift; + my $tablename = shift; + return $self->db_get_col('SELECT column_name FROM all_tab_columns WHERE CONCAT(CONCAT(owner,\'.\'),table_name) = ?',$self->tableidentifier($tablename)); + +} + +sub getprimarykeycols { + + my $self = shift; + my $tablename = shift; + return $self->db_get_col('SELECT cols.column_name FROM all_constraints cons, all_cons_columns cols WHERE + CONCAT(CONCAT(cols.owner,\'.\'),cols.table_name) = ? AND + cons.constraint_type = \'P\' AND + cons.constraint_name = cols.constraint_name AND + cons.owner = cols.owner + ORDER BY cols.table_name, cols.position',$self->tableidentifier($tablename)); + +} + +sub create_temptable { + + my $self = shift; + my $select_stmt = shift; + my $indexes = shift; + + my $index_tablename = $self->_gettemptablename(); + my $temp_tablename = $self->tableidentifier($index_tablename); + + #$self->db_do('CREATE GLOBAL TEMPORARY TABLE ' . $temp_tablename . ' ON COMMIT PRESERVE ROWS AS ' . $select_stmt); + $self->db_do('CREATE TABLE ' . $temp_tablename . ' AS ' . $select_stmt); + push(@{$self->{temp_tables}},$index_tablename); + + temptablecreated($self,$index_tablename,getlogger(__PACKAGE__)); + + #$self->{temp_table_count} += 1; + + if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + foreach my $indexname (keys %$indexes) { + my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); + #if (not arrayeq($indexcols,$keycols,1)) { + #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; + $indexname = _chopidentifier(lc($index_tablename) . '_' . $indexname); + $self->db_do('CREATE INDEX ' . $indexname . ' ON ' . $temp_tablename . ' (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$indexcols) . ')'); + indexcreated($self,$index_tablename,$indexname,getlogger(__PACKAGE__)); + #} + } + } + + return $temp_tablename; + +} + +sub create_primarykey { + + my $self = shift; + my ($tablename,$keycols,$fieldnames) = @_; + + if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { + + if (defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { + my $statement = 'ALTER TABLE ' . $self->tableidentifier($tablename) . ' ADD PRIMARY KEY (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$keycols) . ')'; + $self->db_do($statement); + primarykeycreated($self,$tablename,$keycols,getlogger(__PACKAGE__)); + return 1; + } + + } + + return 0; +} + +sub create_indexes { + + my $self = shift; + my ($tablename,$indexes,$keycols) = @_; + + my $index_count = 0; + if (length($tablename) > 0) { + + if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + foreach my $indexname (keys %$indexes) { + my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); + if (not arrayeq($indexcols,$keycols,1)) { + #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; + $indexname = _chopidentifier($indexname); + $self->db_do('CREATE INDEX ' . $indexname . ' ON ' . $self->tableidentifier($tablename) . ' (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$indexcols) . ')'); + indexcreated($self,$tablename,$indexname,getlogger(__PACKAGE__)); + } + } + } + + } + + return $index_count; +} + +sub create_texttable { + + my $self = shift; + my ($tablename,$fieldnames,$keycols,$indexes,$truncate,$defer_indexes) = @_; + #my ($tableidentifier,$fieldnames,$keycols,$indexes,$truncate) = @_; + + #my $tablename = $self->getsafetablename($tableidentifier); + + if (length($tablename) > 0 and defined $fieldnames and ref $fieldnames eq 'ARRAY') { + + my $created = 0; + if ($self->table_exists($tablename) == 0) { + my $statement = 'CREATE TABLE ' . $self->tableidentifier($tablename) . ' ('; + $statement .= join(' VARCHAR2(' . $varcharsize . '), ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$fieldnames) . ' VARCHAR2(' . $varcharsize . ')'; + if (not $defer_indexes and defined $keycols and ref $keycols eq 'ARRAY' and scalar @$keycols > 0 and setcontains($keycols,$fieldnames,1)) { + #$statement .= ', CONSTRAINT ' . $tablename . '_pk PRIMARY KEY (' . join(', ',@$keycols) . ')'; + $statement .= ', CONSTRAINT PRIMARY KEY (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$keycols) . ')'; + } + #if (defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + # foreach my $indexname (keys %$indexes) { + # $statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; + # } + #} + $statement .= ')'; + + $self->db_do($statement); + texttablecreated($self,$tablename,getlogger(__PACKAGE__)); + + if (not $defer_indexes and defined $indexes and ref $indexes eq 'HASH' and scalar keys %$indexes > 0) { + foreach my $indexname (keys %$indexes) { + my $indexcols = $self->_extract_indexcols($indexes->{$indexname}); + if (not arrayeq($indexcols,$keycols,1)) { + #$statement .= ', INDEX ' . $indexname . ' (' . join(', ',@{$indexes->{$indexname}}) . ')'; + $indexname = _chopidentifier($indexname); + $self->db_do('CREATE INDEX ' . $indexname . ' ON ' . $self->tableidentifier($tablename) . ' (' . join(', ',map { local $_ = $_; $_ = $self->columnidentifier($_); $_; } @$indexcols) . ')'); + indexcreated($self,$tablename,$indexname,getlogger(__PACKAGE__)); + } + } + } + $created = 1; + } else { + my $fieldnamesfound = $self->getfieldnames($tablename); + if (not setcontains($fieldnames,$fieldnamesfound,1)) { + fieldnamesdiffer($self,$tablename,$fieldnames,$fieldnamesfound,getlogger(__PACKAGE__)); + return 0; + } + } + + if (not $created and $truncate) { + $self->truncate_table($tablename); + } + return 1; + } else { + return 0; + } + +} + +sub multithreading_supported { + + my $self = shift; + return 1; + +} + +sub truncate_table { + + my $self = shift; + my $tablename = shift; + + $self->db_do('TRUNCATE ' . $self->tableidentifier($tablename)); + tabletruncated($self,$tablename,getlogger(__PACKAGE__)); + +} + +sub table_exists { + + my $self = shift; + my $tablename = shift; + + return $self->db_get_value('SELECT COUNT(*) FROM all_tables WHERE CONCAT(CONCAT(owner,\'.\'),table_name) = ?',$self->tableidentifier($tablename)); + +} + +sub drop_table { + + my $self = shift; + my $tablename = shift; + + if ($self->table_exists($tablename) > 0) { + $self->db_do('DROP TABLE ' . $self->tableidentifier($tablename) . ' PURGE'); #CASCADE CONSTRAINTS PURGE'); + tabledropped($self,$tablename,getlogger(__PACKAGE__)); + return 1; + } + return 0; + +} + +sub db_do_begin { + + my $self = shift; + my $query = shift; + my $tablename = shift; + + $self->SUPER::db_do_begin($query,$tablename,0,@_); + +} + +sub db_get_begin { + + my $self = shift; + my $query = shift; + my $tablename = shift; + + $self->SUPER::db_get_begin($query,$tablename,0,@_); + +} + +sub db_finish { + + my $self = shift; + #my $unlock = shift; + + $self->SUPER::db_finish($lock_do_chunk | $lock_get_chunk); + +} + +1; diff --git a/SqlConnectors/PostgreSQLDB.pm b/lib/NGCP/BulkProcessor/SqlConnectors/PostgreSQLDB.pm similarity index 93% rename from SqlConnectors/PostgreSQLDB.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/PostgreSQLDB.pm index dad364a..57c41df 100644 --- a/SqlConnectors/PostgreSQLDB.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/PostgreSQLDB.pm @@ -1,14 +1,14 @@ -package SqlConnectors::PostgreSQLDB; +package NGCP::BulkProcessor::SqlConnectors::PostgreSQLDB; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); -use Globals qw($LongReadLen_limit); -use Logging qw( +use NGCP::BulkProcessor::Globals qw($LongReadLen_limit); +use NGCP::BulkProcessor::Logging qw( getlogger dbinfo dbdebug @@ -18,17 +18,17 @@ use Logging qw( primarykeycreated tabletruncated tabledropped); -use LogError qw(dberror dbwarn fieldnamesdiffer); +use NGCP::BulkProcessor::LogError qw(dberror dbwarn fieldnamesdiffer); use DBI; use DBD::Pg 2.17.2; -use Array qw(arrayeq itemcount contains setcontains); +use NGCP::BulkProcessor::Array qw(arrayeq itemcount contains setcontains); -use SqlConnector; +use NGCP::BulkProcessor::SqlConnector; require Exporter; -our @ISA = qw(Exporter SqlConnector); +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlConnector); our @EXPORT_OK = qw(get_tableidentifier); my $defaulthost = '127.0.0.1'; @@ -63,7 +63,7 @@ sub new { my $class = shift; - my $self = SqlConnector->new(@_); + my $self = NGCP::BulkProcessor::SqlConnector->new(@_); $self->{host} = undef; $self->{port} = undef; @@ -533,4 +533,4 @@ sub db_finish { } -1; \ No newline at end of file +1; diff --git a/SqlConnectors/SQLServerDB.pm b/lib/NGCP/BulkProcessor/SqlConnectors/SQLServerDB.pm similarity index 93% rename from SqlConnectors/SQLServerDB.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/SQLServerDB.pm index d845330..2074280 100644 --- a/SqlConnectors/SQLServerDB.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/SQLServerDB.pm @@ -1,14 +1,14 @@ -package SqlConnectors::SQLServerDB; +package NGCP::BulkProcessor::SqlConnectors::SQLServerDB; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); -use Globals qw($LongReadLen_limit); -use Logging qw( +use NGCP::BulkProcessor::Globals qw($LongReadLen_limit); +use NGCP::BulkProcessor::Logging qw( getlogger dbinfo dbdebug @@ -18,7 +18,7 @@ use Logging qw( primarykeycreated tabletruncated tabledropped); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( dberror fieldnamesdiffer); @@ -28,12 +28,12 @@ use DBD::ODBC 1.50; #https://blog.afoolishmanifesto.com/posts/install-and-configure-the-ms-odbc-driver-on-debian/ #http://community.spiceworks.com/how_to/show/78224-install-the-ms-sql-odbc-driver-on-debian-7 -use Array qw(arrayeq itemcount contains setcontains removeduplicates mergearrays); +use NGCP::BulkProcessor::Array qw(arrayeq itemcount contains setcontains removeduplicates mergearrays); -use SqlConnector; +use NGCP::BulkProcessor::SqlConnector; require Exporter; -our @ISA = qw(Exporter SqlConnector); +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlConnector); our @EXPORT_OK = qw(get_tableidentifier); my $defaulthost = '127.0.0.1'; @@ -64,7 +64,7 @@ sub new { my $class = shift; - my $self = SqlConnector->new(@_); + my $self = NGCP::BulkProcessor::SqlConnector->new(@_); $self->{host} = undef; $self->{port} = undef; @@ -524,4 +524,4 @@ sub db_finish { } -1; \ No newline at end of file +1; diff --git a/SqlConnectors/SQLiteDB.pm b/lib/NGCP/BulkProcessor/SqlConnectors/SQLiteDB.pm similarity index 96% rename from SqlConnectors/SQLiteDB.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/SQLiteDB.pm index 95ec32f..af1a8e9 100644 --- a/SqlConnectors/SQLiteDB.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/SQLiteDB.pm @@ -1,16 +1,16 @@ -package SqlConnectors::SQLiteDB; +package NGCP::BulkProcessor::SqlConnectors::SQLiteDB; use strict; ## no critic -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); -use Globals qw( +use NGCP::BulkProcessor::Globals qw( $local_db_path $LongReadLen_limit); -use Logging qw( +use NGCP::BulkProcessor::Logging qw( getlogger dbinfo dbdebug @@ -19,7 +19,7 @@ use Logging qw( indexcreated tabletruncated tabledropped); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( dberror fieldnamesdiffer dbwarn @@ -28,19 +28,19 @@ use LogError qw( use DBI 1.608 qw(:sql_types); use DBD::SQLite 1.29; -use Array qw(arrayeq contains setcontains); +use NGCP::BulkProcessor::Array qw(arrayeq contains setcontains); -use Utils qw( +use NGCP::BulkProcessor::Utils qw( tempfilename timestampdigits timestamp); -use SqlConnectors::SQLiteVarianceAggregate; +use NGCP::BulkProcessor::SqlConnectors::SQLiteVarianceAggregate; -use SqlConnector; +use NGCP::BulkProcessor::SqlConnector; require Exporter; -our @ISA = qw(Exporter SqlConnector); +our @ISA = qw(Exporter NGCP::BulkProcessor::SqlConnector); our @EXPORT_OK = qw($staticdbfilemode $timestampdbfilemode $temporarydbfilemode @@ -87,7 +87,7 @@ sub new { my $class = shift; - my $self = SqlConnector->new(@_); + my $self = NGCP::BulkProcessor::SqlConnector->new(@_); $self->{filemode} = undef; $self->{dbfilename} = undef; diff --git a/SqlConnectors/SQLiteVarianceAggregate.pm b/lib/NGCP/BulkProcessor/SqlConnectors/SQLiteVarianceAggregate.pm similarity index 83% rename from SqlConnectors/SQLiteVarianceAggregate.pm rename to lib/NGCP/BulkProcessor/SqlConnectors/SQLiteVarianceAggregate.pm index 5a207e8..14fcc2e 100644 --- a/SqlConnectors/SQLiteVarianceAggregate.pm +++ b/lib/NGCP/BulkProcessor/SqlConnectors/SQLiteVarianceAggregate.pm @@ -1,67 +1,67 @@ -# helper module to implement variance aggregate function with SQLite -# adamk@cpan.org -# 2009 - -# used only for testing custom functions ... - -package SqlConnectors::SQLiteVarianceAggregate; -use strict; - -## no critic - -use File::Basename; -use Cwd; -use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); - - #sub new { bless [], shift; } - # - #sub step { - # my ( $self, $value ) = @_; - # - # push @$self, $value; - #} - # - #sub finalize { - # my $self = $_[0]; - # - # my $n = @$self; - # - # # Variance is NULL unless there is more than one row - # return undef unless $n || $n == 1; - # - # my $mu = 0; - # foreach my $v ( @$self ) { - # $mu += $v; - # } - # $mu /= $n; - # - # my $sigma = 0; - # foreach my $v ( @$self ) { - # #$sigma += ($x - $mu)**2; - # $sigma += ($v - $mu)**2; - # } - # $sigma = $sigma / ($n - 1); - # - # return $sigma; - #} - -my $mu = 0; -my $count = 0; -my $S = 0; - -sub new { bless [], shift; } - -sub step { - my ( $self, $value ) = @_; - $count++; - my $delta = $value - $mu; - $mu += $delta / $count; - $S += $delta * ($value - $mu); -} - -sub finalize { - my $self = $_[0]; - return $S / ($count - 1); -} - -1; \ No newline at end of file +# helper module to implement variance aggregate function with SQLite +# adamk@cpan.org +# 2009 + +# used only for testing custom functions ... + +package NGCP::BulkProcessor::SqlConnectors::SQLiteVarianceAggregate; +use strict; + +## no critic + +#use File::Basename; +#use Cwd; +#use lib Cwd::abs_path(File::Basename::dirname(__FILE__) . '/../'); + + #sub new { bless [], shift; } + # + #sub step { + # my ( $self, $value ) = @_; + # + # push @$self, $value; + #} + # + #sub finalize { + # my $self = $_[0]; + # + # my $n = @$self; + # + # # Variance is NULL unless there is more than one row + # return undef unless $n || $n == 1; + # + # my $mu = 0; + # foreach my $v ( @$self ) { + # $mu += $v; + # } + # $mu /= $n; + # + # my $sigma = 0; + # foreach my $v ( @$self ) { + # #$sigma += ($x - $mu)**2; + # $sigma += ($v - $mu)**2; + # } + # $sigma = $sigma / ($n - 1); + # + # return $sigma; + #} + +my $mu = 0; +my $count = 0; +my $S = 0; + +sub new { bless [], shift; } + +sub step { + my ( $self, $value ) = @_; + $count++; + my $delta = $value - $mu; + $mu += $delta / $count; + $S += $delta * ($value - $mu); +} + +sub finalize { + my $self = $_[0]; + return $S / ($count - 1); +} + +1; diff --git a/SqlRecord.pm b/lib/NGCP/BulkProcessor/SqlRecord.pm similarity index 96% rename from SqlRecord.pm rename to lib/NGCP/BulkProcessor/SqlRecord.pm index 4988882..7726a50 100644 --- a/SqlRecord.pm +++ b/lib/NGCP/BulkProcessor/SqlRecord.pm @@ -1,21 +1,23 @@ -# record base object - -package SqlRecord; +package NGCP::BulkProcessor::SqlRecord; use strict; ## no critic -#use Thread qw(async yield); -#use Thread::Queue; use threads qw(yield); use threads::shared; use Thread::Queue; #use Thread::Semaphore; -#use POSIX qw(ceil); use Time::HiRes qw(sleep); -use Logging qw( +use NGCP::BulkProcessor::Globals qw( + $enablemultithreading + $cpucount + $cells_transfer_memory_limit + $transfer_defer_indexes +); + +use NGCP::BulkProcessor::Logging qw( getlogger fieldnamesaquired primarykeycolsaquired @@ -46,7 +48,7 @@ use Logging qw( tablethreadingdebug ); -use LogError qw( +use NGCP::BulkProcessor::LogError qw( fieldnamesdiffer transferzerorowcount processzerorowcount @@ -54,22 +56,10 @@ use LogError qw( tabletransferfailed tableprocessingfailed ); -#use LogWarn qw(calendarwarn); - -use Table qw(get_rowhash); -use Array qw(setcontains contains); -use Utils qw(round threadid); -#use SQLiteDB qw(sqlitetablename); -#use ConnectorPool qw(destroy_dbs_thread); -#use LoadConfig; -use Globals qw( -$enablemultithreading -$cpucount -$cells_transfer_memory_limit -$transfer_defer_indexes); - -#use Terminate qw(setsigkill); +use NGCP::BulkProcessor::Table qw(get_rowhash); +use NGCP::BulkProcessor::Array qw(setcontains contains); +use NGCP::BulkProcessor::Utils qw(round threadid); require Exporter; our @ISA = qw(Exporter); @@ -387,7 +377,7 @@ sub delete_records { (defined $keyfields and ref $keyfields eq 'ARRAY') and (defined $vals_table and - ref $vals_table eq 'Table')) { + ref $vals_table eq 'NGCP::BulkProcessor::Table')) { my @fields = @$keyfields; my $field_cnt = scalar @fields; @@ -993,7 +983,7 @@ sub transfer_table { sub process_table { - my ($get_db,$tablename,$process_code,$init_process_context_code,$multithreading,$selectcount,$select,@values) = @_; + my ($get_db,$tablename,$process_code,$init_process_context_code,$uninit_process_context_code,$multithreading,$selectcount,$select,@values) = @_; if (ref $get_db eq 'CODE') { @@ -1086,6 +1076,7 @@ sub process_table { #processorerrorstate_ref => \$processorerrorstate, process_code => $process_code, init_process_context_code => $init_process_context_code, + uninit_process_context_code => $uninit_process_context_code, blocksize => $blocksize, rowcount => $rowcount, #logger => $logger, @@ -1179,6 +1170,9 @@ sub process_table { } $db->db_finish(); + if ('CODE' eq ref $uninit_process_context_code) { + &$uninit_process_context_code($context); + } }; if ($@) { @@ -1481,6 +1475,9 @@ sub _process { sleep($thread_sleep_secs); #2015-01 } } + if ('CODE' eq ref $context->{uninit_process_context_code}) { + &{$context->{uninit_process_context_code}}($context); + } }; #if (defined $writer_db) { # $writer_db->db_disconnect(); diff --git a/Table.pm b/lib/NGCP/BulkProcessor/Table.pm similarity index 91% rename from Table.pm rename to lib/NGCP/BulkProcessor/Table.pm index b96d70e..44cca99 100644 --- a/Table.pm +++ b/lib/NGCP/BulkProcessor/Table.pm @@ -1,6 +1,4 @@ -# table module: a 2D array object = array of arrays = fetchall_arrayref result - -package Table; +package NGCP::BulkProcessor::Table; use strict; ## no critic @@ -233,4 +231,4 @@ sub tostring { } -1; \ No newline at end of file +1; diff --git a/Utils.pm b/lib/NGCP/BulkProcessor/Utils.pm similarity index 95% rename from Utils.pm rename to lib/NGCP/BulkProcessor/Utils.pm index dcf3f5f..0957d0b 100644 --- a/Utils.pm +++ b/lib/NGCP/BulkProcessor/Utils.pm @@ -1,4 +1,4 @@ -package Utils; +package NGCP::BulkProcessor::Utils; use strict; ## no critic @@ -8,7 +8,6 @@ use threads; #use POSIX qw(strtod); use POSIX qw(strtod locale_h); setlocale(LC_NUMERIC, 'C'); -#use Logging qw(fileerror); use Data::UUID; @@ -321,7 +320,7 @@ sub tempfilename { sub file_md5 { my ($filepath,$fileerrorcode,$logger) = @_; - #use Logging qw(fileerror); + local *MD5FILE; if (not open (MD5FILE, '<' . $filepath)) { diff --git a/default.cfg b/lib/NGCP/BulkProcessor/default.cfg similarity index 100% rename from default.cfg rename to lib/NGCP/BulkProcessor/default.cfg