bin/mozilla/admin.pl

   1 #=====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (c) 2002
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 #
  16 # This program is free software; you can redistribute it and/or modify
  17 # it under the terms of the GNU General Public License as published by
  18 # the Free Software Foundation; either version 2 of the License, or
  19 # (at your option) any later version.
  20 #
  21 # This program is distributed in the hope that it will be useful,
  22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 # GNU General Public License for more details.
  25 # You should have received a copy of the GNU General Public License
  26 # along with this program; if not, write to the Free Software
  27 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  28 #======================================================================
  29 #
  30 # setup module
  31 # add/edit/delete users
  32 #
  33 #======================================================================
  34
  35 $menufile = "menu.ini";
  36
  37 use DBI;
  38 use CGI;
  39
  40 use SL::Form;
  41 use SL::User;
  42 use SL::Common;
  43 use SL::Inifile;
  44
  45 require "bin/mozilla/common.pl";
  46
  47 our $cgi = new CGI('');
  48
  49 $form = new Form;
  50 $form->{"root"} = "root login";
  51
  52 $locale = new Locale $language, "admin";
  53
  54 # customization
  55 if (-f "bin/mozilla/custom_$form->{script}") {
  56   eval { require "bin/mozilla/custom_$form->{script}"; };
  57   $form->error($@) if ($@);
  58 }
  59
  60 $form->{stylesheet} = "lx-office-erp.css";
  61 $form->{favicon}    = "favicon.ico";
  62
  63 if ($form->{action}) {
  64
  65
  66   $subroutine = $locale->findsub($form->{action});
  67
  68   if ($subroutine eq 'login') {
  69     if ($form->{rpw}) {
  70       $form->{rpw} = crypt $form->{rpw}, "ro";
  71     }
  72   }
  73
  74   check_password();
  75
  76   call_sub($subroutine);
  77
  78 } else {
  79
  80   # if there are no drivers bail out
  81   $form->error($locale->text('No Database Drivers available!'))
  82     unless (User->dbdrivers);
  83
  84   # create memberfile
  85   if (!-f $memberfile) {
  86     open(FH, ">$memberfile") or $form->error("$memberfile : $!");
  87     print FH qq|# SQL-Ledger Accounting members
  88
  89 [root login]
  90 password=
  91
  92 |;
  93     close FH;
  94   }
  95
  96   adminlogin();
  97
  98 }
  99
 100 1;
 101
 102 # end
 103
 104 sub adminlogin {
 105
 106   $form->{title} =
 107     qq|Lx-Office ERP $form->{version} | . $locale->text('Administration');
 108
 109   $form->header();
 110   print $form->parse_html_template('admin/adminlogin');
 111 }
 112
 113 sub login {
 114   list_users();
 115 }
 116
 117 sub list_users {
 118
 119   $form->error($locale->text('File locked!')) if (-f "${memberfile}.LCK");
 120
 121   open(FH, "$memberfile") or $form->error("$memberfile : $!");
 122
 123   my %members;
 124
 125   while (<FH>) {
 126     chomp;
 127
 128     if (/^\[.*\]/) {
 129       $login = $_;
 130       $login =~ s/(\[|\])//g;
 131
 132       $members{$login} = { "login" => $login };
 133     }
 134
 135     if (/^([a-z]+)=(.*)/) {
 136       $members{$login}->{$1} = $2;
 137     }
 138   }
 139
 140   close(FH);
 141
 142   delete $members{"root login"};
 143   map { $_->{templates} =~ s|.*/||; } values %members;
 144
 145   $form->{title}  = "Lx-Office ERP " . $locale->text('Administration');
 146   $form->{LOCKED} = -e "$userspath/nologin";
 147   $form->{MEMBERS} = [ @members{sort { lc $a cmp lc $b } keys %members} ];
 148
 149   $form->header();
 150   print $form->parse_html_template("admin/list_users");
 151 }
 152
 153 sub add_user {
 154
 155   $form->{title} =
 156       "Lx-Office ERP "
 157     . $locale->text('Administration') . " / "
 158     . $locale->text('Add User');
 159
 160   $form->{Oracle_sid}    = $sid;
 161   $form->{Oracle_dbport} = '1521';
 162   $form->{Oracle_dbhost} = `hostname`;
 163
 164   my $myconfig = {
 165     "vclimit"      => 200,
 166     "countrycode"  => "de",
 167     "numberformat" => "1000,00",
 168     "dateformat"   => "dd.mm.yy",
 169     "stylesheet"   => "lx-office-erp.css",
 170     "menustyle"    => "v3",
 171   };
 172
 173   edit_user_form($myconfig);
 174 }
 175
 176 sub edit {
 177
 178   $form->{title} =
 179       "Lx-Office ERP "
 180     . $locale->text('Administration') . " / "
 181     . $locale->text('Edit User');
 182   $form->{edit} = 1;
 183
 184   $form->isblank("login", $locale->text("The login is missing."));
 185
 186   # get user
 187   my $myconfig = new User "$memberfile", "$form->{login}";
 188
 189   $myconfig->{signature} =~ s/\\n/\r\n/g;
 190   $myconfig->{address}   =~ s/\\n/\r\n/g;
 191
 192   # strip basedir from templates directory
 193   $myconfig->{templates} =~ s|.*/||;
 194
 195   edit_user_form($myconfig);
 196 }
 197
 198 sub edit_user_form {
 199   my ($myconfig) = @_;
 200
 201   my @valid_dateformats = qw(mm-dd-yy mm/dd/yy dd-mm-yy dd/mm/yy dd.mm.yy yyyy-mm-dd);
 202   $form->{ALL_DATEFORMATS} = [ map { { "format" => $_, "selected" => $_ eq $myconfig->{dateformat} } } @valid_dateformats ];
 203
 204   my @valid_numberformats = qw(1,000.00 1000.00 1.000,00 1000,00);
 205   $form->{ALL_NUMBERFORMATS} = [ map { { "format" => $_, "selected" => $_ eq $myconfig->{numberformat} } } @valid_numberformats ];
 206
 207   %countrycodes = User->country_codes;
 208   $form->{ALL_COUNTRYCODES} = [];
 209   foreach $countrycode (sort { $countrycodes{$a} cmp $countrycodes{$b} } keys %countrycodes) {
 210     push @{ $form->{ALL_COUNTRYCODES} }, { "value"    => $countrycode,
 211                                            "name"     => $countrycodes{$countrycode},
 212                                            "selected" => $countrycode eq $myconfig->{countrycode} };
 213   }
 214
 215   # is there a templates basedir
 216   if (!-d "$templates") {
 217     $form->error(sprintf($locale->text("The directory %s does not exist."), $templates));
 218   }
 219
 220   opendir TEMPLATEDIR, "$templates/." or $form->error("$templates : $!");
 221   my @all     = readdir(TEMPLATEDIR);
 222   my @alldir  = sort grep { -d "$templates/$_" && !/^\.\.?$/ } @all;
 223   my @allhtml = sort grep { -f "$templates/$_" && /\.html$/ } @all;
 224   closedir TEMPLATEDIR;
 225
 226   @alldir = grep !/\.(html|tex|sty|odt|xml|txb)$/, @alldir;
 227   @alldir = grep !/^(webpages|\.svn)$/, @alldir;
 228
 229   @allhtml = reverse grep !/Default/, @allhtml;
 230   push @allhtml, 'Default';
 231   @allhtml = reverse @allhtml;
 232
 233   $form->{ALL_TEMPLATES} = [ map { { "name", => $_, "selected" => $_ eq $myconfig->{templates} } } @alldir ];
 234
 235   $lastitem = $allhtml[0];
 236   $lastitem =~ s/-.*//g;
 237   $form->{ALL_MASTER_TEMPLATES} = [ { "name" => $lastitem, "selected" => $lastitem eq "German" } ];
 238   foreach $item (@allhtml) {
 239     $item =~ s/-.*//g;
 240     next if ($item eq $lastitem);
 241
 242     push @{ $form->{ALL_MASTER_TEMPLATES} }, { "name" => $item, "selected" => $item eq "German" };
 243     $lastitem = $item;
 244   }
 245
 246   # css dir has styles that are not intended as general layouts.
 247   # reverting to hardcoded list
 248   $form->{ALL_STYLESHEETS} = [ map { { "name" => $_, "selected" => $_ eq $myconfig->{stylesheet} } } qw(lx-office-erp.css Win2000.css) ];
 249
 250   $form->{"menustyle_" . $myconfig->{menustyle} } = 1;
 251
 252   map { $form->{"myc_${_}"} = $myconfig->{$_} } keys %{ $myconfig };
 253
 254   map { $form->{"Pg_${_}"} = $myconfig->{$_} } qw(dbhost dbport dbname dbuser dbpasswd);
 255
 256   # access control
 257   my @acsorder = ();
 258   my %acs      = ();
 259   my %excl     = ();
 260   open(FH, $menufile) or $form->error("$menufile : $!");
 261
 262   while ($item = <FH>) {
 263     next unless $item =~ /\[/;
 264     next if $item =~ /\#/;
 265
 266     $item =~ s/(\[|\])//g;
 267     chomp $item;
 268
 269     my ($level, $menuitem);
 270
 271     if ($item =~ /--/) {
 272       ($level, $menuitem) = split /--/, $item, 2;
 273     } else {
 274       $level    = $item;
 275       $menuitem = $item;
 276       push @acsorder, $item;
 277     }
 278
 279     $acs{$level} ||= [];
 280     push @{ $acs{$level} }, $menuitem;
 281
 282   }
 283
 284   foreach $item (split(/;/, $myconfig->{acs})) {
 285     ($key, $value) = split /--/, $item, 2;
 286     $excl{$key}{$value} = 1;
 287   }
 288
 289   $form->{ACLS}    = [];
 290   $form->{all_acs} = "";
 291
 292   foreach $key (@acsorder) {
 293     my $acl = { "checked" => $form->{login} ? !$excl{$key}->{$key} : 1,
 294                 "name"    => "${key}--${key}",
 295                 "title"   => $key,
 296                 "SUBACLS" => [], };
 297     $form->{all_acs} .= "${key}--${key};";
 298
 299     foreach $item (@{ $acs{$key} }) {
 300       next if ($key eq $item);
 301
 302       my $subacl = { "checked" => $form->{login} ? !$excl{$key}->{$item} : 1,
 303                      "name"    => "${key}--${item}",
 304                      "title"   => $item };
 305       push @{ $acl->{SUBACLS} }, $subacl;
 306       $form->{all_acs} .= "${key}--${item};";
 307     }
 308     push @{ $form->{ACLS} }, $acl;
 309   }
 310
 311   chop $form->{all_acs};
 312
 313   $form->header();
 314   print $form->parse_html_template("admin/edit_user");
 315 }
 316
 317 sub save {
 318
 319   # no driver checked
 320   $form->error($locale->text('Database Driver not checked!'))
 321     unless $form->{dbdriver};
 322
 323   # no spaces allowed in login name
 324   ($form->{login}) = split / /, $form->{login};
 325
 326   $form->isblank("login", $locale->text('Login name missing!'));
 327
 328   # check for duplicates
 329   if (!$form->{edit}) {
 330     $temp = new User "$memberfile", "$form->{login}";
 331
 332     if ($temp->{login}) {
 333       $form->error("$form->{login} " . $locale->text('is already a member!'));
 334     }
 335   }
 336
 337   # no spaces allowed in directories
 338   ($form->{newtemplates}) = split / /, $form->{newtemplates};
 339
 340   if ($form->{newtemplates}) {
 341     $form->{templates} = $form->{newtemplates};
 342   } else {
 343     $form->{templates} =
 344       ($form->{usetemplates}) ? $form->{usetemplates} : $form->{login};
 345   }
 346
 347   # is there a basedir
 348   if (!-d "$templates") {
 349     $form->error(sprintf($locale->text("The directory %s does not exist."), $templates));
 350   }
 351
 352   # add base directory to $form->{templates}
 353   $form->{templates} =~ s|.*/||;
 354   $form->{templates} =  "$templates/$form->{templates}";
 355
 356   $myconfig = new User "$memberfile", "$form->{login}";
 357
 358   # redo acs variable and delete all the acs codes
 359   my @acs;
 360   foreach $item (split m|;|, $form->{all_acs}) {
 361     my $name =  "ACS_${item}";
 362     $name    =~ s| |+|g;
 363     push @acs, $item if !$form->{$name};
 364     delete $form->{$name};
 365   }
 366   $form->{acs} = join ";", @acs;
 367
 368   # check which database was filled in
 369   if ($form->{dbdriver} eq 'Oracle') {
 370     $form->{sid}      = $form->{Oracle_sid},;
 371     $form->{dbhost}   = $form->{Oracle_dbhost},;
 372     $form->{dbport}   = $form->{Oracle_dbport};
 373     $form->{dbpasswd} = $form->{Oracle_dbpasswd};
 374     $form->{dbuser}   = $form->{Oracle_dbuser};
 375     $form->{dbname}   = $form->{Oracle_dbuser};
 376
 377     $form->isblank("dbhost", $locale->text('Hostname missing!'));
 378     $form->isblank("dbport", $locale->text('Port missing!'));
 379     $form->isblank("dbuser", $locale->text('Dataset missing!'));
 380   }
 381   if ($form->{dbdriver} eq 'Pg') {
 382     $form->{dbhost}   = $form->{Pg_dbhost};
 383     $form->{dbport}   = $form->{Pg_dbport};
 384     $form->{dbpasswd} = $form->{Pg_dbpasswd};
 385     $form->{dbuser}   = $form->{Pg_dbuser};
 386     $form->{dbname}   = $form->{Pg_dbname};
 387
 388     $form->isblank("dbname", $locale->text('Dataset missing!'));
 389     $form->isblank("dbuser", $locale->text('Database User missing!'));
 390   }
 391
 392   foreach $item (keys %{$form}) {
 393     $myconfig->{$item} = $form->{$item};
 394   }
 395
 396   delete $myconfig->{stylesheet};
 397   if ($form->{userstylesheet}) {
 398     $myconfig->{stylesheet} = $form->{userstylesheet};
 399   }
 400
 401   $myconfig->save_member($memberfile, $userspath);
 402
 403   if ($webdav) {
 404     @webdavdirs =
 405       qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
 406     foreach $directory (@webdavdirs) {
 407       $file = "webdav/" . $directory . "/webdav-user";
 408       if ($form->{$directory}) {
 409         if (open(HTACCESS, "$file")) {
 410           while (<HTACCESS>) {
 411             ($login, $password) = split(/:/, $_);
 412             if ($login ne $form->{login}) {
 413               $newfile .= $_;
 414             }
 415           }
 416           close(HTACCESS);
 417         }
 418         open(HTACCESS, "> $file") or die "cannot open $file $!\n";
 419         $newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
 420         print(HTACCESS $newfile);
 421         close(HTACCESS);
 422       } else {
 423         $form->{$directory} = 0;
 424         if (open(HTACCESS, "$file")) {
 425           while (<HTACCESS>) {
 426             ($login, $password) = split(/:/, $_);
 427             if ($login ne $form->{login}) {
 428               $newfile .= $_;
 429             }
 430           }
 431           close(HTACCESS);
 432         }
 433         open(HTACCESS, "> $file") or die "cannot open $file $!\n";
 434         print(HTACCESS $newfile);
 435         close(HTACCESS);
 436       }
 437     }
 438   }
 439
 440   $form->{templates}       =~ s|.*/||;
 441   $form->{templates}       =  "${templates}/$form->{templates}";
 442   $form->{mastertemplates} =~ s|.*/||;
 443
 444   # create user template directory and copy master files
 445   if (!-d "$form->{templates}") {
 446     umask(002);
 447
 448     if (mkdir "$form->{templates}", oct("771")) {
 449
 450       umask(007);
 451
 452       # copy templates to the directory
 453       opendir TEMPLATEDIR, "$templates/." or $form - error("$templates : $!");
 454       @templates = grep /$form->{mastertemplates}.*?\.(html|tex|sty|xml|txb)$/,
 455         readdir TEMPLATEDIR;
 456       closedir TEMPLATEDIR;
 457
 458       foreach $file (@templates) {
 459         open(TEMP, "$templates/$file")
 460           or $form->error("$templates/$file : $!");
 461
 462         $file =~ s/$form->{mastertemplates}-//;
 463         open(NEW, ">$form->{templates}/$file")
 464           or $form->error("$form->{templates}/$file : $!");
 465
 466         while ($line = <TEMP>) {
 467           print NEW $line;
 468         }
 469         close(TEMP);
 470         close(NEW);
 471       }
 472     } else {
 473       $form->error("$!: $form->{templates}");
 474     }
 475   }
 476
 477   $form->redirect($locale->text('User saved!'));
 478
 479 }
 480
 481 sub delete {
 482   $form->error($locale->text('File locked!')) if (-f ${memberfile} . LCK);
 483   open(FH, ">${memberfile}.LCK") or $form->error("${memberfile}.LCK : $!");
 484   close(FH);
 485
 486   my $members = Inifile->new($memberfile);
 487   my $templates = $members->{$form->{login}}->{templates};
 488   delete $members->{$form->{login}};
 489   $members->write();
 490   unlink "${memberfile}.LCK";
 491
 492   if ($templates) {
 493     my $templates_in_use = 0;
 494     foreach $login (keys %{ $members }) {
 495       next if $login =~ m/^[A-Z]+$/;
 496       next if $members->{$login}->{templates} ne $templates;
 497       $templates_in_use = 1;
 498       last;
 499     }
 500
 501     if (!$templates_in_use && -d $templates) {
 502       unlink <$templates/*>;
 503       rmdir $templates;
 504     }
 505   }
 506
 507   # delete config file for user
 508   unlink "$userspath/$form->{login}.conf";
 509
 510   $form->redirect($locale->text('User deleted!'));
 511
 512 }
 513
 514 sub login_name {
 515   my $login = shift;
 516
 517   $login =~ s/\[\]//g;
 518   return ($login) ? $login : undef;
 519
 520 }
 521
 522 sub get_value {
 523   my $line = shift;
 524
 525   my ($null, $value) = split(/=/, $line, 2);
 526
 527   # remove comments
 528   $value =~ s/\s#.*//g;
 529
 530   # remove any trailing whitespace
 531   $value =~ s/^\s*(.*?)\s*$/$1/;
 532
 533   $value;
 534 }
 535
 536 sub change_admin_password {
 537
 538   $form->{title} =
 539       qq|Lx-Office ERP |
 540     . $locale->text('Administration') . " / "
 541     . $locale->text('Change Admin Password');
 542
 543   $form->header();
 544   print $form->parse_html_template("admin/change_admin_password");
 545 }
 546
 547 sub change_password {
 548   if ($form->{"password"} ne $form->{"password_again"}) {
 549     $form->{title} =
 550       qq|Lx-Office ERP |
 551       . $locale->text('Administration') . " / "
 552       . $locale->text('Change Admin Password');
 553
 554     $form->header();
 555     $form->error($locale->text("The passwords do not match."));
 556   }
 557
 558   $root->{password} = $form->{password};
 559
 560   $root->{'root login'} = 1;
 561   $root->save_member($memberfile);
 562
 563   $form->{callback} =
 564     "$form->{script}?action=list_users&rpw=$root->{password}";
 565
 566   $form->redirect($locale->text('Password changed!'));
 567 }
 568
 569 sub check_password {
 570   $root = new User "$memberfile", $form->{root};
 571
 572   if (!defined($root->{password}) || ($root->{password} ne $form->{rpw})) {
 573     $form->error($locale->text('Incorrect Password!'));
 574   }
 575
 576 }
 577
 578 sub pg_database_administration {
 579
 580   $form->{dbdriver} = 'Pg';
 581   dbselect_source();
 582
 583 }
 584
 585 sub oracle_database_administration {
 586
 587   $form->{dbdriver} = 'Oracle';
 588   dbselect_source();
 589
 590 }
 591
 592 sub dbdriver_defaults {
 593
 594   # load some defaults for the selected driver
 595   %driverdefaults = (
 596                      'Pg' => { dbport        => '5432',
 597                                dbuser        => 'postgres',
 598                                dbdefault     => 'template1',
 599                                dbhost        => 'localhost',
 600                                connectstring => $locale->text('Connect to')
 601                      },
 602                      'Oracle' => { dbport        => '1521',
 603                                    dbuser        => 'oralin',
 604                                    dbdefault     => $sid,
 605                                    dbhost        => `hostname`,
 606                                    connectstring => 'SID'
 607                      });
 608
 609   map { $form->{$_} = $driverdefaults{ $form->{dbdriver} }{$_} }
 610     keys %{ $driverdefaults{Pg} };
 611
 612 }
 613
 614 sub dbselect_source {
 615
 616   dbdriver_defaults();
 617
 618   $msg{Pg} =
 619     $locale->text(
 620     'Leave host and port field empty unless you want to make a remote connection.'
 621     );
 622   $msg{Oracle} =
 623     $locale->text(
 624            'You must enter a host and port for local and remote connections!');
 625
 626   $form->{title} =
 627     "Lx-Office ERP / " . $locale->text('Database Administration');
 628
 629   $form->header;
 630
 631   print qq|
 632 <body class=admin>
 633
 634
 635 <center>
 636 <h2>$form->{title}</h2>
 637
 638 <form method=post action=$form->{script}>
 639
 640 <table>
 641 <tr><td>
 642
 643 <table>
 644
 645   <tr class=listheading>
 646     <th colspan=4>| . $locale->text('Database') . qq|</th>
 647   </tr>
 648
 649 <input type=hidden name=dbdriver value=$form->{dbdriver}>
 650
 651   <tr><td>
 652    <table>
 653
 654   <tr>
 655
 656     <th align=right>| . $locale->text('Host') . qq|</th>
 657     <td><input name=dbhost size=25 value=$form->{dbhost}></td>
 658     <th align=right>| . $locale->text('Port') . qq|</th>
 659     <td><input name=dbport size=5 value=$form->{dbport}></td>
 660
 661   </tr>
 662
 663   <tr>
 664
 665     <th align=right>| . $locale->text('User') . qq|</th>
 666     <td><input name="dbuser" size="10" value="$form->{dbuser}"></td>
 667     <th align=right>| . $locale->text('Password') . qq|</th>
 668     <td><input type="password" name="dbpasswd" size="10"></td>
 669
 670   </tr>
 671
 672   <tr>
 673
 674     <th align=right>$form->{connectstring}</th>
 675     <td colspan=3><input name=dbdefault size=10 value=$form->{dbdefault}></td>
 676
 677   </tr>
 678
 679 </table>
 680
 681 </td></tr>
 682 </table>
 683
 684 <input name=callback type=hidden value="$form->{script}?action=list_users&rpw=$form->{rpw}">
 685 <input type=hidden name=rpw value=$form->{rpw}>
 686
 687 <br>
 688
 689 <input type=submit class=submit name=action value="|
 690     . $locale->text('Create Dataset') . qq|">|;
 691 # Vorübergehend Deaktiviert
 692 # <input type=submit class=submit name=action value="|
 693 #     . $locale->text('Update Dataset') . qq|">
 694 print qq| <input type=submit class=submit name=action value="|
 695     . $locale->text('Delete Dataset') . qq|">
 696
 697 </form>
 698
 699 </td></tr>
 700 </table>
 701
 702 <p>|
 703     . $locale->text(
 704     'This is a preliminary check for existing sources. Nothing will be created or deleted at this stage!'
 705     )
 706
 707     . qq|
 708 <br>$msg{$form->{dbdriver}}
 709
 710
 711 </body>
 712 </html>
 713 |;
 714
 715 }
 716
 717 sub continue {
 718   call_sub($form->{"nextsub"});
 719 }
 720
 721 sub update_dataset {
 722
 723   %needsupdate = User->dbneedsupdate(\%$form);
 724
 725   $form->{title} =
 726       "Lx-Office ERP "
 727     . $locale->text('Database Administration') . " / "
 728     . $locale->text('Update Dataset');
 729
 730   $form->header;
 731
 732   print qq|
 733 <body class=admin>
 734
 735
 736 <center>
 737 <h2>$form->{title}</h2>
 738 |;
 739   my $field_id = 0;
 740   foreach $key (sort keys %needsupdate) {
 741     if ($needsupdate{$key} ne $form->{dbversion}) {
 742       $upd .= qq|<input id="$field_id" name="db$key" type="checkbox" value="1" checked> $key\n|;
 743       $form->{dbupdate} .= "db$key ";
 744       $field_id++;
 745     }
 746   }
 747
 748   chop $form->{dbupdate};
 749
 750   if ($form->{dbupdate}) {
 751
 752     print qq|
 753 <table width=100%>
 754 <form method=post action=$form->{script}>
 755
 756 <input type=hidden name="dbdriver"  value="$form->{dbdriver}">
 757 <input type=hidden name="dbhost"    value="$form->{dbhost}">
 758 <input type=hidden name="dbport"    value="$form->{dbport}">
 759 <input type=hidden name="dbuser"    value="$form->{dbuser}">
 760 <input type=hidden name="dbpasswd"  value="$form->{dbpasswd}">
 761 <input type=hidden name="dbdefault" value="$form->{dbdefault}">
 762
 763 <tr class=listheading>
 764   <th>| . $locale->text('The following Datasets need to be updated') . qq|</th>
 765 </tr>
 766 <tr>
 767 <td>
 768
 769 $upd
 770
 771 </td>
 772 </tr>
 773 <tr>
 774 <td>
 775
 776 <input name=dbupdate type=hidden value="$form->{dbupdate}">
 777
 778 <input name=callback type=hidden value="$form->{script}?action=list_users&rpw=$form->{rpw}">
 779
 780 <input type=hidden name=rpw value=$form->{rpw}>
 781
 782 <input type=hidden name=nextsub value=dbupdate>
 783
 784 <hr size=3 noshade>
 785
 786 <br>
 787 <input type=submit class=submit name=action value="|
 788       . $locale->text('Continue') . qq|">
 789
 790 </td></tr>
 791 </table>
 792 </form>
 793 |;
 794
 795   } else {
 796
 797     print $locale->text('All Datasets up to date!');
 798
 799   }
 800
 801   print qq|
 802
 803 </body>
 804 </html>
 805 |;
 806
 807 }
 808
 809 sub dbupdate {
 810   $form->{"stylesheet"} = "lx-office-erp.css";
 811   $form->{"title"} = $main::locale->text("Dataset upgrade");
 812   $form->header();
 813   my $dbname =
 814     join(" ",
 815          map({ s/\s//g; s/^db//; $_; }
 816              grep({ $form->{$_} }
 817                   split(/\s+/, $form->{"dbupdate"}))));
 818   print($form->parse_html_template("dbupgrade/header",
 819                                    { "dbname" => $dbname }));
 820
 821   User->dbupdate(\%$form);
 822
 823   print qq|
 824 <hr>
 825
 826 | . $locale->text('Dataset updated!') . qq|
 827
 828 <br>
 829
 830 <a id="enddatasetupdate" href="admin.pl?action=login&| .
 831 join("&", map({ "$_=" . $form->escape($form->{$_}); } qw(rpw))) .
 832 qq|">| . $locale->text("Continue") . qq|</a>|;
 833
 834 }
 835
 836 sub create_dataset {
 837   $form->{dbsources} = join " ", map { "[${_}]" } sort User->dbsources(\%$form);
 838
 839   $form->{CHARTS} = [];
 840
 841   opendir SQLDIR, "sql/." or $form - error($!);
 842   foreach $item (sort grep /-chart\.sql\z/, readdir SQLDIR) {
 843     next if ($item eq 'Default-chart.sql');
 844     $item =~ s/-chart\.sql//;
 845     push @{ $form->{CHARTS} }, { "name"     => $item,
 846                                  "selected" => $item eq "Germany-DATEV-SKR03EU" };
 847   }
 848   closedir SQLDIR;
 849
 850   my $default_charset = $dbcharset;
 851   $default_charset ||= Common::DEFAULT_CHARSET;
 852
 853   $form->{DBENCODINGS} = [];
 854
 855   foreach my $encoding (@Common::db_encodings) {
 856     push @{ $form->{DBENCODINGS} }, { "dbencoding" => $encoding->{dbencoding},
 857                                       "label"      => $encoding->{label},
 858                                       "selected"   => $encoding->{charset} eq $default_charset };
 859   }
 860
 861   $form->{title} =
 862       "Lx-Office ERP "
 863     . $locale->text('Database Administration') . " / "
 864     . $locale->text('Create Dataset');
 865
 866   $form->header();
 867   print $form->parse_html_template("admin/create_dataset");
 868 }
 869
 870 sub dbcreate {
 871   $form->isblank("db", $locale->text('Dataset missing!'));
 872
 873   User->dbcreate(\%$form);
 874
 875   $form->{title} =
 876       "Lx-Office ERP "
 877     . $locale->text('Database Administration') . " / "
 878     . $locale->text('Create Dataset');
 879
 880   $form->header();
 881   print $form->parse_html_template("admin/dbcreate");
 882 }
 883
 884 sub delete_dataset {
 885   @dbsources = User->dbsources_unused(\%$form, $memberfile);
 886   $form->error($locale->text('Nothing to delete!')) unless @dbsources;
 887
 888   $form->{title} =
 889       "Lx-Office ERP "
 890     . $locale->text('Database Administration') . " / "
 891     . $locale->text('Delete Dataset');
 892   $form->{DBSOURCES} = [ map { { "name", $_ } } sort @dbsources ];
 893
 894   $form->header();
 895   print $form->parse_html_template("admin/delete_dataset");
 896 }
 897
 898 sub dbdelete {
 899
 900   if (!$form->{db}) {
 901     $form->error($locale->text('No Dataset selected!'));
 902   }
 903
 904   User->dbdelete(\%$form);
 905
 906   $form->{title} =
 907       "Lx-Office ERP "
 908     . $locale->text('Database Administration') . " / "
 909     . $locale->text('Delete Dataset');
 910
 911   $form->header();
 912   print $form->parse_html_template("admin/dbdelete");
 913 }
 914
 915 sub unlock_system {
 916
 917   unlink "$userspath/nologin";
 918
 919   $form->{callback} =
 920     "$form->{script}?action=list_users&rpw=$root->{password}";
 921
 922   $form->redirect($locale->text('Lockfile removed!'));
 923
 924 }
 925
 926 sub lock_system {
 927
 928   open(FH, ">$userspath/nologin")
 929     or $form->error($locale->text('Cannot create Lock!'));
 930   close(FH);
 931
 932   $form->{callback} =
 933     "$form->{script}?action=list_users&rpw=$root->{password}";
 934
 935   $form->redirect($locale->text('Lockfile created!'));
 936
 937 }