From f593fd87df697e132d92330c4e22584a614454e5 Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Sat, 21 Jul 2007 18:11:04 +0000 Subject: * base work towards utf8-cleanness (it is now possible to handle vendor-OSes whose name contain UTF8-characters * fixed problem with locale-specific number format being used during DB- creation (fixes the problem that database access would only work once for de_DE-locales [reported by Detlef Schulz]) git-svn-id: http://svn.openslx.org/svn/openslx/trunk@1266 95ad53e4-c205-0410-b2fa-d234c58c8868 --- config-db/OpenSLX/MetaDB/SQLite.pm | 8 ++++---- config-db/OpenSLX/MetaDB/mysql.pm | 8 ++++---- config-db/slxconfig | 2 +- config-db/slxconfig-demuxer | 2 +- installer/slxos-export | 2 +- installer/slxos-setup | 2 +- lib/OpenSLX/Basics.pm | 27 +++++++++++++++++---------- os-plugins/slxos-plugin | 2 +- 8 files changed, 30 insertions(+), 23 deletions(-) diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm index f6b395d0..558aebf9 100644 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -49,10 +49,10 @@ sub connect ## no critic (ProhibitBuiltinHomonyms) $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; } vlog(1, "trying to connect to SQLite-database <$dbSpec>"); - $self->{'dbh'} = - DBI->connect("dbi:SQLite:$dbSpec", undef, undef, - {PrintError => 0, AutoCommit => 1}) - or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); + $self->{'dbh'} = DBI->connect( + "dbi:SQLite:$dbSpec", undef, undef, + {PrintError => 0, AutoCommit => 1, unicode => 1} + ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); return 1; } diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm index 661b744d..8206ec2a 100644 --- a/config-db/OpenSLX/MetaDB/mysql.pm +++ b/config-db/OpenSLX/MetaDB/mysql.pm @@ -46,10 +46,10 @@ sub connect ## no critic (ProhibitBuiltinHomonyms) } my $user = (getpwuid($>))[0]; vlog(1, "trying to connect user <$user> to mysql-database <$dbSpec>"); - $self->{'dbh'} = - DBI->connect("dbi:mysql:$dbSpec", $user, '', {PrintError => 0}) - or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); - return; + $self->{'dbh'} = DBI->connect( + "dbi:mysql:$dbSpec", $user, 'secret', {PrintError => 0} + ) or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); + return 1; } sub schemaConvertTypeDescrToNative diff --git a/config-db/slxconfig b/config-db/slxconfig index 88eb2769..2887d3fa 100755 --- a/config-db/slxconfig +++ b/config-db/slxconfig @@ -1,4 +1,4 @@ -#! /usr/bin/perl +#! /usr/bin/perl -CLADS # ----------------------------------------------------------------------------- # Copyright (c) 2006, 2007 - OpenSLX GmbH # diff --git a/config-db/slxconfig-demuxer b/config-db/slxconfig-demuxer index 91a79849..bff7436e 100755 --- a/config-db/slxconfig-demuxer +++ b/config-db/slxconfig-demuxer @@ -1,4 +1,4 @@ -#! /usr/bin/perl +#! /usr/bin/perl -CLADS # ----------------------------------------------------------------------------- # Copyright (c) 2006, 2007 - OpenSLX GmbH # diff --git a/installer/slxos-export b/installer/slxos-export index 8f763185..2533aa1f 100755 --- a/installer/slxos-export +++ b/installer/slxos-export @@ -1,4 +1,4 @@ -#! /usr/bin/perl +#! /usr/bin/perl -CLADS # ----------------------------------------------------------------------------- # Copyright (c) 2006, 2007 - OpenSLX GmbH # diff --git a/installer/slxos-setup b/installer/slxos-setup index 0ef0fc2e..1d323738 100755 --- a/installer/slxos-setup +++ b/installer/slxos-setup @@ -1,4 +1,4 @@ -#! /usr/bin/perl +#! /usr/bin/perl -CLADS # ----------------------------------------------------------------------------- # Copyright (c) 2006, 2007 - OpenSLX GmbH # diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm index 6f61c7a7..dfcb27b1 100644 --- a/lib/OpenSLX/Basics.pm +++ b/lib/OpenSLX/Basics.pm @@ -31,11 +31,14 @@ $VERSION = 1.01; &checkFlags &instantiateClass &addCleanupFunction &removeCleanupFunction + &glob ); our (%openslxConfig, %cmdlineConfig, %openslxPath); -use subs qw(die warn); +use subs qw(die warn glob); + +use open ':utf8'; ################################################################################ ### Module implementation @@ -47,6 +50,8 @@ use Carp::Heavy; # use it here to have it loaded immediately, not at # be at a point in time where the script executes in # a chrooted environment, such that the module can't # be loaded anymore). +use Encode; +require File::Glob; use FindBin; use Getopt::Long; use POSIX qw(locale_h); @@ -149,7 +154,7 @@ sub openslxInit { # evaluate cmdline arguments: Getopt::Long::Configure('no_pass_through'); - GetOptions(%openslxCmdlineArgs) or return 0; + GetOptions(%openslxCmdlineArgs); # try to read and evaluate config files: my $configPath = $cmdlineConfig{'config-path'} @@ -220,25 +225,19 @@ sub openslxInit # ------------------------------------------------------------------------------ sub trInit { - - # set the specified locale... - setlocale(LC_ALL, $openslxConfig{'locale'}); - - # ...and activate automatic charset conversion on all I/O streams: + # activate automatic charset conversion on all the standard I/O streams, + # just to give *some* support to shells in other charsets: binmode(STDIN, ":encoding($openslxConfig{'locale-charmap'})"); binmode(STDOUT, ":encoding($openslxConfig{'locale-charmap'})"); binmode(STDERR, ":encoding($openslxConfig{'locale-charmap'})"); - use open ':locale'; my $locale = $openslxConfig{'locale'}; if (lc($locale) eq 'c') { - # treat locale 'c' as equivalent for 'posix': $locale = 'posix'; } if (lc($locale) ne 'posix') { - # parse locale and canonicalize it (e.g. to 'de_DE') and generate # two filenames from it (language+country and language only): if ($locale !~ m{^\s*([^_]+)(?:_(\w+))?}) { @@ -474,6 +473,14 @@ sub _doThrowOrWarn return; } +# ------------------------------------------------------------------------------ +sub glob +{ + return map { + decode('utf8', $_); + } File::Glob::bsd_glob(@_); +} + # ------------------------------------------------------------------------------ sub checkFlags { diff --git a/os-plugins/slxos-plugin b/os-plugins/slxos-plugin index ad203383..077719a6 100644 --- a/os-plugins/slxos-plugin +++ b/os-plugins/slxos-plugin @@ -1,4 +1,4 @@ -#! /usr/bin/perl +#! /usr/bin/perl -CLADS # ----------------------------------------------------------------------------- # Copyright (c) 2007 - OpenSLX GmbH # -- cgit v1.2.3-55-g7522