123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553 |
- #!/usr/bin/perl
- # config script by lighta
- #TODO list :
- #- don't always override import/file, sed grep ?
- use CPAN;
- use strict;
- use constant {
- SERV_UID => "Serv_userid",
- SERV_PW => "Serv_userpass",
- SERV_WAN_IP => "Serv_wan_ip",
- MAP_PORT => "Map_port",
- CHAR_PORT => "Char_port",
- LOGIN_PORT => "Login_port",
- MD5_ENABLE => "enable_MD5",
- SQL_HOST => "SQL_host",
- SQL_PORT => "SQL_port",
- SQL_UID => "SQL_userid",
- SQL_PW => "SQL_userpass",
- SQL_MAIN_DB => "SQL_maindb",
- SQL_LOG_DB => ,"SQL_logdb",
- MAP_CONF_FILE => "map_conf.txt",
- CHAR_CONF_FILE => "char_conf.txt",
- LOGIN_CONF_FILE => "login_conf.txt",
- INTER_CONF_FILE => "inter_conf.txt",
- DESD_CONF_FILE => ".tmp-desd_conf.yml",
- MIN_PORT => 2000, #below are usually reserved for system
- MAX_PORT => 65535,
- };
- BEGIN { #check and install module
- my @aCheckModule = ("File::Basename","DBI","DBD::mysql","YAML","YAML::XS","Cwd","Getopt::Long","Net::Ping");
- my @aMarkInst = ();
- foreach(@aCheckModule) { eval "require $_" or push(@aMarkInst,$_); }
- CPAN::install("@aMarkInst") if(@aMarkInst > 0);
- foreach(@aCheckModule) { $_->import(); }
- }
- # setup my defaults option
- my $sDsdFile = DESD_CONF_FILE;
- my $sAutoyes = 0;
- my $sForce = 0;
- my $sClean = 0;
- my $sTarget = "All";
- my $sHelp = 0;
- GetArgs();
- Main();
- sub GetArgs {
- GetOptions(
- 'f=s' => \$sDsdFile, #give desired conf file
- 'auto=i' => \$sAutoyes, #Force (auto-yes)
- 'C=i' => \$sClean, #Clean (like force but remove before adding)
- 'target=s' => \$sTarget, #Target (wich setup to run)
- 'Force=i' => \$sForce, #Force (bypass verification)
- 'help!' => \$sHelp,
- ) or $sHelp=1; #display help if invalid option
- my $sValidTarget = "All|Conf|DB|Inst";
- if( $sHelp ) {
- print "Incorect option specified, available option are:\n"
- ."\t --f filename => file (specify desiredconf to use)\n"
- ."\t --auto => auto-yes to question ? \n"
- ."\t --C => Clean (remove file, db, user before adding new)\n"
- ."\t --target => target (specify wich setup to run [$sValidTarget])\n"
- ."\t --Force => Force (bypass verification)\n";
- exit;
- }
- unless($sTarget =~ /$sValidTarget/i){
- print "Incorect target specified, available target are:\n"
- ."\t --target => target (specify wich setup to run [(default)$sValidTarget])\n";
- exit;
- }
- if($sDsdFile ne DESD_CONF_FILE && !(-e -r $sDsdFile)){
- print "Incorect file specified: '$sDsdFile'\n"
- ."\t this file doesn't seem to appear on filesystem or unable to read\n";
- exit;
- }
- }
- sub Main {
- my($filename, $dir, $suffix) = fileparse($0);
- chdir $dir; #put ourself like was called in tools
- print "Welcome to athena config-tool\n";
- #default conf
- my %hDefConf = ( SERV_UID => "s1",
- SERV_PW => "p1",
- SERV_WAN_IP => "localhost",
- MAP_PORT => "5121",
- CHAR_PORT => "6121",
- LOGIN_PORT => "6900",
- MD5_ENABLE => "yes",
- SQL_HOST => "localhost",
- SQL_PORT => "3306",
- SQL_UID => "ragnarok",
- SQL_PW => "ragnarok",
- SQL_MAIN_DB => "ragnarok",
- SQL_LOG_DB => ,"ragnarok",
- );
- my $sBasedir = getcwd; #for setupdb
- if($sTarget =~ /All|Inst/i){ InstallSoft(); }
- if($sTarget =~ /All|Conf/i) { ConfigConf(\%hDefConf); chdir "$sBasedir"; }
- if($sTarget =~ /All|DB/i) { ConfigDB(\%hDefConf); chdir "$sBasedir"; }
- print "Config done, you should be able to launch and connect server now\n";
- print "NB : Don't forget to update your client clieninfo.xml to match change\n";
- }
- sub InstallSoft {
- print "\n Starting InstallSoft \n";
- print "This autoinstall feature is experimental, package name varies from distri and version, couldn't support them all\n";
- #yes we could $^0 or uname -r but $^0 only give perl binary build OS and uname hmm...
- my @aSupportedOS = ("Debian","Ubuntu","Fedora","CentOs","FreeBSD");
- my $sOSregex = join("|",@aSupportedOS);
- my $sOS;
- until($sOS =~ /$sOSregex/i){
- print "Please enter your OS:[$sOSregex] or enter 'quit' to exit\n";
- $sOS = <>; chomp($sOS);
- last if($sOS eq "quit");
- }
- if($sOS eq "quit"){ print "Skipping Software installation\n"; return; }
- elsif($sOS =~ /Ubuntu|Debian/i) { #tested on ubuntu 12.10
- my @aListSoft = ("gcc","gdb","zlibc","zlib1g-dev","make","subversion","mysql-client","mysql-server","mysql-common","libmysqlclient-dev","phpmyadmin","libpcre3-dev");
- print "Going to install: @aListSoft\n";
- system("sudo apt-get install @aListSoft");
- }
- elsif($sOS =~ /Fedora|CentOs/i){ #tested on fedora 18
- my @aListSoft = ("gcc","gdb","zlib","zlib-devel","make","subversion","mysql-server","mysql-devel","phpmyadmin","pcre-devel");
- system("sudo yum install @aListSoft");
- }
- elsif($sOS =~ /FreeBSD/i){ #tested on FreeBSD 9.01
- system("portsnap fetch extract && portsnap update"); #fetch port lib and extract
- my @aDevel = ("binutils","subversion","autoconf","pcre","gmake","gdb");
- foreach(@aDevel){
- system("cd /usr/ports/devel/$_ && make install clean"); #install devels
- }
- # system("cd /usr/ports/lang/gcc46 && make install"); #gcc4.6 use latest ? 4.8 ?
- system("cd /usr/ports/databases/mysql55-server && make install clean");
- #other utils ?
- system("cd /usr/ports/www/wget && make install clean");
- system("cd /usr/ports/archivers/unrar && make install clean");
- }
- }
- sub ConfigConf { my ($rhDefConf) = @_;
- print "\n Starting ConfigConf \n";
- my $rhUserConf;
- while(1) {
- $rhUserConf = GetDesiredConf($rhDefConf);
- print "SetupConf using conf : \n";
- ShowConfig($rhUserConf);
- last if($sForce || AutoCheckConf($rhUserConf));
- }
- ApplySetupConf($rhUserConf);
- }
- sub ConfigDB { my ($rhDefConf) = @_;
- print "\n Starting ConfigDB \n";
- my $rhUserConf;
- while(1) {
- $rhUserConf = GetDesiredConf($rhDefConf);
- print "SetupDb using conf : \n";
- ShowConfig($rhUserConf);
- last if($sForce || AutoCheckConf($rhUserConf));
- }
- ApplySetupDB($rhUserConf);
- }
- #conf function
- sub ApplySetupConf { my ($rhConfig) = @_;
- print "\nApplying conf \n";
- my @aTargetfile = (MAP_CONF_FILE,CHAR_CONF_FILE,LOGIN_CONF_FILE,INTER_CONF_FILE);
- my $sConfDir = "conf";
- my $sUserConfDir = "import";
- die "$sConfDir doesn't seem to exist or coudldn't be read/writte" unless(-d -r -w "../$sConfDir");
- chdir "../$sConfDir";
- print "Saving tmp user-conf \n";
- YAML::XS::DumpFile(DESD_CONF_FILE,$rhConfig);
- unless(-d "$sUserConfDir") {
- print "conf/import directory doesn't exist, create it ? [y/n] (will be generated by compilation otherwise) \n";
- if(GetValidAnwser("y|o|n") =~ /n/i) { die "Couldn't apply conf without import folder\n"; }
- mkdir "$sUserConfDir";
- }
- chdir $sUserConfDir;
- if($sClean){ unlink @aTargetfile; } #deleting file before applying conf if clean
- opendir(DIR, ".") or die $!;
- my @aDirfile = grep { /\.txt/ && -f "$_" } readdir(DIR);
- close DIR;
- print "Current file in directory = [@aDirfile] target = [@aTargetfile] \n";
- foreach my $sCurfile(@aTargetfile) {
- print "Checking if target file: [$sCurfile] exist ? ";
- if(-e -r $sCurfile) {
- print "Yes\n";
- print "$sCurfile seem to exist, overwritte it [y/n] ?\n";
- if(GetValidAnwser("y|o|n") =~ /n/i) {
- print "Only overwritte option supported atm skip file\n\n";
- next;
- }
- }
- else { print "No\n" };
- print "\t Writting file $sCurfile \n";
- if($sCurfile eq MAP_CONF_FILE) { ApplyMapConf($rhConfig,$sCurfile); }
- elsif($sCurfile eq CHAR_CONF_FILE) { ApplyCharConf($rhConfig,$sCurfile); }
- elsif($sCurfile eq LOGIN_CONF_FILE) { ApplyLoginConf($rhConfig,$sCurfile); }
- elsif($sCurfile eq INTER_CONF_FILE) { ApplyInterConf($rhConfig,$sCurfile); }
- }
- }
- sub ApplyMapConf { my ($rhUserConf,$sCurfile) = @_;
- open FILE, "> $sCurfile" || die "couldn't openfile/create $sCurfile \n";
- print FILE "userid: " . $$rhUserConf{SERV_UID}."\n";
- print FILE "passwd: " . $$rhUserConf{SERV_PW}."\n\n";
- print FILE "map_ip: " . $$rhUserConf{SERV_WAN_IP}."\n";
- print FILE "map_port: " . $$rhUserConf{MAP_PORT}."\n";
- print FILE "char_port: " . $$rhUserConf{CHAR_PORT}."\n";
- }
- sub ApplyCharConf { my ($rhUserConf,$sCurfile) = @_;
- open FILE, "> $sCurfile" || die "couldn't openfile $sCurfile \n";
- print FILE "userid: " . $$rhUserConf{SERV_UID}."\n";
- print FILE "passwd: " . $$rhUserConf{SERV_PW}."\n\n";
- print FILE "char_ip: " . $$rhUserConf{SERV_WAN_IP}."\n";
- print FILE "char_port: " . $$rhUserConf{CHAR_PORT}."\n";
- print FILE "login_port: " . $$rhUserConf{LOGIN_PORT}."\n";
- }
- sub ApplyLoginConf { my ($rhUserConf,$sCurfile) = @_;
- open FILE, "> $sCurfile" || die "couldn't openfile $sCurfile \n";
- print FILE "login_port: " . $$rhUserConf{LOGIN_PORT}."\n";
- print FILE "use_MD5_passwords: " . $$rhUserConf{MD5_ENABLE}."\n";
- }
- sub ApplyInterConf { my ($rhUserConf,$sCurfile) = @_;
- open FILE, "> $sCurfile" || die "couldn't openfile $sCurfile \n";
- print FILE "sql.db_hostname: " . $$rhUserConf{SQL_HOST}."\n";
- print FILE "sql.db_port: " . $$rhUserConf{SQL_PORT}."\n";
- print FILE "sql.db_username: " . $$rhUserConf{SQL_UID}."\n";
- print FILE "sql.db_password: " . $$rhUserConf{SQL_PW}."\n";
- print FILE "sql.db_database: " . $$rhUserConf{SQL_MAIN_DB}."\n\n";
- print FILE "char_server_ip: " . $$rhUserConf{SQL_HOST}."\n";
- print FILE "char_server_port: " . $$rhUserConf{SQL_PORT}."\n";
- print FILE "char_server_id: " . $$rhUserConf{SQL_UID}."\n";
- print FILE "char_server_pw: " . $$rhUserConf{SQL_PW}."\n";
- print FILE "char_server_db: " . $$rhUserConf{SQL_MAIN_DB}."\n\n";
- print FILE "sql.map_server_ip: " . $$rhUserConf{SQL_HOST}."\n";
- print FILE "sql.map_server_port: " . $$rhUserConf{SQL_PORT}."\n";
- print FILE "map_server_id: " . $$rhUserConf{SQL_UID}."\n";
- print FILE "map_server_pw: " . $$rhUserConf{SQL_PW}."\n";
- print FILE "map_server_db: " . $$rhUserConf{SQL_MAIN_DB}."\n\n";
- #todo may we want 2 schema ??
- print FILE "log_db_ip: " . $$rhUserConf{SQL_HOST} ."\n";
- print FILE "log_db_port: " . $$rhUserConf{SQL_PORT}."\n";
- print FILE "log_db_id: " . $$rhUserConf{SQL_UID}."\n";
- print FILE "log_db_pw: " . $$rhUserConf{SQL_PW}."\n";
- print FILE "log_db_db: " . $$rhUserConf{SQL_LOG_DB}."\n\n";
- }
- sub AutoCheckConf { my ($rhConfig) = @_;
- print "\n AutoCheckConf, \n you can use option --force=1 to bypass this \n";
- foreach my $sKeys (keys %$rhConfig){
- my $sVal = $$rhConfig{$sKeys};
- if($sKeys =~ /PORT/) { #chek if valid port
- if(($sVal<MIN_PORT) && ($sVal>MAX_PORT)) {
- warn "Invalid port specified for $sKeys => $sVal, must be in [".MIN_PORT.":".MAX_PORT."]\n";
- return 0;
- }
- elsif(!($sKeys =~ /SQL/) && CheckUsedPort($sVal)) { #skip SQL service
- warn "Port:$sVal seem to be already in use by system \n";
- return 0;
- }
- elsif(CheckDupPort($rhConfig,$sKeys)) {
- warn "Port:$sVal seem to be already used by other key in config \n";
- return 0;
- }
- }
- elsif($sKeys =~ /IP|HOST/){ #chek if ip valid, can we reach it ? trough SYN ACK
- my $p = Net::Ping->new("syn");
- my $sTest = $p->ping($sVal);
- $p->close();
- unless($sTest) {
- print "Invalide IP/Host, ping couldn't reach $sKeys => $sVal \n NB : ICMP may just be unallowed\n";
- return 0;
- }
- }
- }
- return 1;
- }
- sub CheckDupPort { my ($rhConfig,$sChkKeys) = @_;
- my $sChkport = $$rhConfig{$sChkKeys};
- foreach my $sKeys (keys %$rhConfig){
- next if($sKeys eq $sChkKeys); #skip ourself
- my $sVal = $$rhConfig{$sKeys};
- return 1 if($sChkport eq $sVal);
- }
- return 0;
- }
- sub CheckUsedPort { my($sPort) = @_;
- open PIPE,"netstat -nat |" or die $!;
- my @line = grep { /$sPort/ } <PIPE>;
- return scalar(@line);
- }
- #Db function
- sub ApplySetupDB { my($rhConfig) = @_;
- my $sDbH; #db handle
- my $sHost = $$rhConfig{SQL_HOST};
- my $sPort = $$rhConfig{SQL_PORT};
- my $sDsn = "dbi:mysql::$sHost:$sPort"; #don't try to auto connect to db
- $$rhConfig{"Dsn"} = $sDsn;
- $sDbH = RootCo($rhConfig);
- CreateDB($sDbH,$rhConfig); #create db if not exist
- $sDbH = CreateUser($sDbH,$rhConfig); #loged as user now
- LoadSqlFile($sDbH,$rhConfig); #Load .sql file into db
- CreateServUser($sDbH,$rhConfig);
- print "SetupDb done \n";
- }
- sub RootCo { my($rhConfig) = @_;
- print "\n Entering RootCo \n";
- my $sDbH;
- my $sDsn = $$rhConfig{"Dsn"}; #mysql server dest
- my $sUser = $$rhConfig{SQL_UID}; #verify desired user
- print "My dsn = $sDsn \n";
- if($sUser eq "root"){
- my $sPw = $$rhConfig{SQL_PW};
- $sDbH = DBI->connect($sDsn, "root", $sPw);
- unless($sDbH) { warn "Your root password doesn't seem valid for mysql, your desired-conf is wrong \n"; }
- }
- while($sDbH == 0) { #if can't use user to connect user root
- print "Please inser DB root passeword (this won't be saved in any configuration file, needed to create dbs and user)\n";
- my $sRPw = <>; chop($sRPw);
- $sDbH = DBI->connect($sDsn, "root", $sRPw);
- }
- return $sDbH;
- }
- sub CreateDB { my($sDbH,$rhConfig) = @_;
- print "\n Entering CreateDB \n";
- my $sDBn = $$rhConfig{SQL_MAIN_DB};
- my $sLogDBn = $$rhConfig{SQL_LOG_DB};
- my @aQuery = ("create database IF NOT EXISTS $sDBn;","create database IF NOT EXISTS $sLogDBn;");
- if($sClean){ #deleting database if clean
- unshift(@aQuery,"drop database IF EXISTS $sDBn;");
- unshift(@aQuery,"drop database IF EXISTS $sLogDBn;");
- }
- else {
- my $sRes = $sDbH->selectcol_arrayref('show databases');
- foreach my $db (@$sRes){ #relevant later for import
- if($db eq "$sDBn") { ValidateDBMerge($db); } #may exit here
- elsif ($db eq "$sLogDBn") { ValidateDBMerge($db); } #may exit here
- }
- }
- ExeQuery($sDbH,@aQuery);
- }
- sub ValidateDBMerge { my($sDBn) = @_;
- warn "Database: '$sDBn' seem to already exist exiting\n";
- warn "Continue will load data in existing db would you like to continue ? [y/n] \n";
- if(GetValidAnwser("y|o|n") =~ /n/i) {
- print "Exiting setup, please either setup with another dbname or manually\n";
- exit;
- }
- }
- sub CreateUser { my($sDbH,$rhConfig) = @_;
- print "\n Entering CreateUser \n";
- my $sDsn = $$rhConfig{"Dsn"};
- print "My dsn = $sDsn \n";
- my $sHost = $$rhConfig{SQL_HOST};
- my $sPw = $$rhConfig{SQL_PW};
- my $sUser = $$rhConfig{SQL_UID};
- my $sDBn = $$rhConfig{SQL_MAIN_DB};
- my $sLogDBn = $$rhConfig{SQL_LOG_DB};
- my @aQuery= ("GRANT ALL PRIVILEGES ON $sDBn.* TO $sUser\@'$sHost' IDENTIFIED BY '$sPw' WITH GRANT OPTION", #maindb
- "GRANT ALL PRIVILEGES ON $sLogDBn.* TO $sUser\@'$sHost' IDENTIFIED BY '$sPw' WITH GRANT OPTION"); #logdb
- my $sUserDbh = DBI->connect($sDsn, $sUser, $sPw, {"PrintError" => 0}); #try connect with user
- if($sUserDbh && !$sClean) {
- print "User : $sUser seem to already exist, skipping creation\n"
- ."NB please check if you have correct privilege set for db: $sDBn \n";
- }
- else { #create user only if not exist (or mode clean)
- if($sClean && $sUser ne "root"){ unshift(@aQuery,"DELETE FROM mysql.user WHERE User = '$sUser';"); }
- print "Creating user $sUser for dbs : $sDBn and $sLogDBn on $sHost \n";
- ExeQuery($sDbH,@aQuery);
- $sUserDbh = DBI->connect($sDsn, $sUser, $sPw);
- }
- return $sUserDbh; #drop old co and connect with user now
- }
- sub LoadSqlFile { my($sDbH,$rhConfig) = @_;
- print "\n Entering LoadSqlFile \n";
- my $sDBn = $$rhConfig{SQL_MAIN_DB};
- my $sLogDBn = $$rhConfig{SQL_LOG_DB};
- my $sSqldir = "sql-files";
- my @aMainFiles = ("main.sql"); #add other file to load for main db here
- my @aLogFiles = ("logs.sql"); #add other file to load for log db here
- die "$sSqldir doesn't seem to exist or coudldn't be read" unless(-d -r "../$sSqldir");
- chdir "../$sSqldir";
- print "Checking if target files exist :\n\tMain: [@aMainFiles]\n\tLog: [@aLogFiles]\n";
- CheckAndLoad(\@aMainFiles,$rhConfig,$sDBn);
- CheckAndLoad(\@aLogFiles,$rhConfig,$sLogDBn);
- # my $raMainQuerys = CheckAndAddQuery(\@aMainFiles,$rhConfig);
- # my $raLogQuerys = CheckAndAddQuery(\@aLogFiles,$rhConfig);
- # ExeQuery($sDbH,"use $sDBn;",@$raMainQuerys,"use $sLogDBn;", @$raLogQuerys);
- }
- sub CheckAndLoad { my ($raFiles,$rhConfig,$sDBn) = @_;
- my $sHost = $$rhConfig{SQL_HOST};
- my $sPw = $$rhConfig{SQL_PW};
- my $sUser = $$rhConfig{SQL_UID};
- foreach(@$raFiles) {
- unless(-f -r $_){
- print "File : $_ doesn't seem to exist or was unreadable skipped\n";
- next;
- }
- my $sFileFullPath = Cwd::abs_path($_);
- system("mysql -u $sUser --password=$sPw -h $sHost $sDBn < $sFileFullPath");
- }
- }
- # query failure atm (shitty perl)
- #sub CheckAndAddQuery { my ($raFiles) = @_;
- # my @aQuery = ();
- # foreach(@$raFiles) {
- # unless(-f -r $_){
- # print "File : $_ doesn't seem to exist or was unreadable skipped\n";
- # next;
- # }
- # my $sFileFullPath = Cwd::abs_path($_);
- # my $sInfileQuery = "source $sFileFullPath";
- # #my $sInfileQuery = "\\. $sFileFullPath;";
- # push(@aQuery,$sInfileQuery);
- #
- # }
- # return \@aQuery;
- #}
- sub CreateServUser { my($sDbH,$rhConfig) = @_;
- my $sUid = $$rhConfig{SERV_UID};
- my $sUpw = $$rhConfig{SERV_PW};
- my $sMD5 = $$rhConfig{MD5_ENABLE};
- my $sDBn = $$rhConfig{SQL_MAIN_DB};
- my @aQuery = ("use $sDBn;","DELETE FROM login WHERE sex='S';");
- if($sMD5){ push(@aQuery,"INSERT INTO login(account_id, userid, user_pass, sex) values(1,'$sUid',MD5('$sUpw'),'S');"); }
- else { push(@aQuery,"INSERT INTO login(account_id, userid, user_pass, sex) values(1,'$sUid','$sUpw','S');"); }
- ExeQuery($sDbH,@aQuery);
- }
- sub ExeQuery { my $sDbH = shift;
- my @aQuery = @_;
- print "my querys are = [ @aQuery ]\n";
- foreach(@aQuery) {
- unless($sDbH->do($_)){ print "Failed to execute query : $_ => $DBI::errstr \n"; }
- }
- }
- #Common
- sub GetValidateConf { my($rhConfig) = @_;
- my $rhUserConf;
- while (1) {
- $rhUserConf = GetUserConf($rhConfig);
- print "\n Please Check desired conf \n";
- ShowConfig($rhUserConf);
- print "Would you like to apply those setting ? [y/n] ";
- last if(GetValidAnwser("y|o|n") =~ /y|o/i);
- print "\n Restarting configuration sequence \n";
- }
- return $rhUserConf;
- }
- sub GetUserConf { my ($rhDefConf) = @_;
- my %hConf;
- my @sortedkeys = sort keys (%$rhDefConf);
- foreach my $sKey (@sortedkeys){
- my $sVal = $$rhDefConf{$sKey};
- print "$sKey : [$sVal] ";
- my $sAnwser = <>; chop($sAnwser);
- $hConf{"$sKey"} = $sAnwser || $sVal;
- }
- return \%hConf;
- }
- sub ShowConfig { my ($rhUserConf) = @_;
- my @sortedkeys = sort keys (%$rhUserConf);
- foreach my $sKey (@sortedkeys){
- my $sVal = $$rhUserConf{$sKey};
- if(ref($sVal) eq 'ARRAY') { print " $sKey => [@$sVal] \n";}
- else { print " $sKey => [$sVal] \n"; }
- }
- }
- sub GetValidAnwser { my($sOptReg) = @_;
- my $sAnwser = "";
- if($sAutoyes) { $sAnwser="y"; print "\n"; }
- else {
- while(!($sAnwser =~ /$sOptReg/i)) {
- $sAnwser = <>; chop($sAnwser);
- print "Please enter a valid option : $sOptReg " unless($sAnwser =~ /$sOptReg/i);
- }
- }
- return $sAnwser;
- }
- sub GetDesiredConf { my ($rhDefConf) = @_;
- print "Please enter desired confiration\n";
- my $rhUserConf;
- my $sDesdConfFile = $sDsdFile;
- #if default search in conf otherwise get specified name with cwd
- if($sDsdFile eq DESD_CONF_FILE) { $sDesdConfFile = "../conf/".$sDsdFile; }
- print "Checking if there an Desiredconf file \n";
- if(-e -r $sDesdConfFile) {
- print "Found Desiredconf \n";
- $rhUserConf = YAML::XS::LoadFile($sDesdConfFile);
- if(!($rhUserConf)){
- print "Desiredconf seem invalid or empty, please check file and relaunch setup or entry Config\n";
- $rhUserConf=GetValidateConf($rhDefConf);
- }
- else {
- ShowConfig($rhUserConf);
- print "Would you like to apply those setting ? [y/n] ";
- if(GetValidAnwser("y|o|n") =~ /n/i) { #no take user entry
- print "DesiredConf not applyed, please enter config\n";
- $rhUserConf=GetValidateConf($rhDefConf);
- }
- }
- }
- else { #no files take user entry
- print "No Desiredconf found, please enter config \n";
- $rhUserConf=GetValidateConf($rhDefConf);
- }
- return $rhUserConf;
- }
|