package Admin::LangControl;
use strict;
#################################################################################
# Ikonboard v3 by Jarvis Entertainment Group, Inc.
#
# No part of this script can be used outside Ikonboard without prior consent.
#
# More information available from <ib-license@jarvisgroup.net>
# (c)2001-2002 Jarvis Entertainment Group, Inc.
# 
# http://www.ikonboard.com | http://www.jarvisgroup.net
#
# Please read the license for more information
#
# 
#
#################################################################################

BEGIN {
    require 'Lib/FUNC.pm';
    require 'Lib/ADMIN.pm';
    require 'Admin/SKIN.pm';
    require 'Boardinfo.pm' or die "Cannot load Module: $!";
}

use File::Path;
use File::Copy;
use Archive::Tar;

my $SKIN  = Admin::SKIN->new();
my $std   = FUNC::STD->new();
my $ADMIN = FUNC::ADMIN->new();
my $INFO  = Boardinfo->new();



sub new {
    my $pkg = shift;
    my $obj = {};
    bless $obj, $pkg;
    return $obj;
}


sub splash {
    my ($obj, $db) = @_;

    $obj->display( CODE   => 'list',
                   SUBMIT => 'Edit this Language Pack',
                   TEXT   => 'You may choose a language pack to edit.',
                   DB     => $db,
                   A_TXT  => "Please Choose from one of the installed language packs"
                 );
}

sub remove {
    my ($obj, $db) = @_;

    $obj->display( CODE   => 'do_remove',
                   SUBMIT => 'REMOVE this Language Pack',
                   TEXT   => 'You may choose a language pack to REMOVE.',
                   DB     => $db,
                   A_TXT  => "Please Choose a language pack to remove"
                 );
}

sub new_splash {
    my ($obj, $db) = @_;

    $obj->display( CODE   => 'do_new',
                   SUBMIT => 'Create new Language Pack',
                   TEXT   => 'Create a new Language Pack',
                   DB     => $db,
                   A_TXT  => "Base the new pack on which current pack?"
                 );
}

sub export {
    my ($obj, $db) = @_;

    $obj->display( CODE   => 'do_export',
                   SUBMIT => 'Export a Language Pack',
                   TEXT   => 'Export a Language Pack',
                   DB     => $db,
                   A_TXT  => "Export which pack?"
                 );
}



sub do_list {
    my ($obj, $db) = @_;

    $obj->list_components( CODE   => 'view',
                           SUBMIT => 'Edit this Language File',
                           TEXT   => 'You may choose a language file to edit.',
                           DB     => $db,
                           A_TXT  => "Please Choose from one of the  language files"
                         );
}

sub do_view {
    my ($obj, $db) = @_;

    $obj->list_entries( CODE   => 'apply_edit',
                        SUBMIT => 'Edit this Language File',
                        TEXT   => 'You may edit all of the words here',
                        DB     => $db,
                        A_TXT  => "Current values"
                         );
}

sub import {
    my ($obj, $db) = @_;

    # Get a list of avilable .tar files
    # Rule 1: They must end in .tar
    # Rule 2: They must start with LANG-

    opendir (DIR, $iB::INFO->{'IKON_DIR'}.'INCOMING') or die  "Cannot Open the Directory!";
    my @tar_files =  grep  {   !/^\./ && /^LANG-(?:[\w\d]+)\.tar$/   } readdir DIR;
    closedir DIR;

    my @list_of_tar_files;

    for (@tar_files) {
        push @list_of_tar_files, { NAME => $_, VALUE => $_ };
    }

    my $html  = $SKIN->title( TITLE => 'Language Control', TEXT => "Import a language package. The package must be uploaded into the 'INCOMING' directory." );
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'lang',
                                        CODE  => 'do_import'
                                      } );

    $html .= $SKIN->section_header( TITLE => "Choose a .tar file to install");

    $html .= $SKIN->td_select( TEXT     => "Valid archives ready for installation",
                               NAME     => 'INSTALL_NAME',
                               REQ      => 1,
                               VALUES   => '',
                               DATA     => \@list_of_tar_files
                             );

    $html .= $SKIN->td_input ( TEXT => 'Viewable Language Name<br>&nbsp;&nbsp;&nbsp;&nbsp;(Example "English")', NAME => 'PACK_NAME', VALUE=> '', REQ => 1);


    $html .= $SKIN->td_submit(   NAME => '', VALUE => "Import this language file" );

    $html .= $SKIN->form_end();
    $html .= $SKIN->end_table();

    $ADMIN->Output( WHERE => 'LANGUAGES', NAV_ONE => "Language Control", PRINT => $html);
}


sub display {
    my $obj = shift;

    my %IN = ( CODE    => "",
               SUBMIT  => "",
               TEXT    => "",
               DB      => "",
               A_TXT   => "",
               B_TXT   => "",
               @_,
              );

    my $db = $IN{'DB'};

    # Override HTML tag formatting...
    $SKIN->{'_allow_html'} = 1;

    my @sorted_lang_files;

    for my $l ( split( /\|\&\|/, $iB::INFO->{'LANGUAGES'} ) ) {
        my ($dir, $name) = split /:/, $l;
        if ($IN{CODE} eq 'do_remove') {
            next if $dir eq 'en';
        }
        push @sorted_lang_files, { NAME => $name, VALUE => $dir };
    }

    my $html  = $SKIN->title( TITLE => 'Language Control', TEXT => $IN{'TEXT'} );
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'lang',
                                        CODE  => $IN{'CODE'}
                                      } );

    $html .= $SKIN->section_header( TITLE => $IN{'A_TXT'}, TEXT => $IN{'B_TXT'});

    $html .= $SKIN->td_select( TEXT     => "Current Installed Languages",
                               NAME     => 'LANG',
                               REQ      => 1,
                               VALUES   => '',
                               DATA     => \@sorted_lang_files
                             );

    if ($IN{'CODE'} eq 'do_new') {

        $html .= $SKIN->section_header( TITLE => "New Pack Specifics");

        $html .= $SKIN->td_input ( TEXT => 'Viewable Language Name<br>&nbsp;&nbsp;&nbsp;&nbsp;(Example "English")', NAME => 'PACK_NAME', VALUE=> '', REQ => 1);
        $html .= $SKIN->td_input ( TEXT => 'Authors Name',          NAME => 'AUTHOR_NAME',  VALUE=> '', REQ => 1);
        $html .= $SKIN->td_input ( TEXT => 'Authors Email Address', NAME => 'AUTHOR_EMAIL', VALUE=> '', REQ => 1);


    }

    if ($IN{'CODE'} eq 'do_export') {

        $html .= $SKIN->section_header( TITLE => "Export Specifics");

        $html .= $SKIN->td_input ( TEXT => 'Export Filename (no spaces or non alphanumerics)<br>&nbsp;&nbsp;&nbsp;&nbsp;Example: "english"', NAME => 'PACK_NAME', VALUE=> '', REQ => 1);

    }
    

    $html .= $SKIN->td_submit(   NAME => '', VALUE => $IN{'SUBMIT'} );

    $html .= $SKIN->form_end();
    $html .= $SKIN->end_table();

    $ADMIN->Output( WHERE => 'LANGUAGES', NAV_ONE => "Language Control", PRINT => $html);

}


sub list_components {
    my $obj = shift;

    my %IN = ( CODE    => "",
               SUBMIT  => "",
               TEXT    => "",
               DB      => "",
               A_TXT   => "",
               B_TXT   => "",
               @_,
              );

    my $db = $IN{'DB'};

    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language pack!");
    }

    #Get the langauge files

    opendir LANG, $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'} or die $!;
    my %langs   =  map   {     $_->[0] => $_->[1]    }
                   sort  {    $a->[0] cmp $b->[0]    }
                   map   { [ $_ => (split /\./)[0] ] }
                   grep  {          !/^\./           } readdir LANG;    #Read from dir
    closedir LANG;

    my @lang_files;

    for my $l (keys %langs) {
        next if $l =~ /index/;
        next if $l =~ /config/;
        $langs{$l} =~ s!^(\w+)Words$!$1 Words!i;
        push @lang_files, { NAME => $langs{$l}, VALUE => $l };
    }

    my $html  = $SKIN->title( TITLE => 'Language Control', TEXT => $IN{'TEXT'} );
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'lang',
                                        CODE  => $IN{'CODE'},
                                        LANG  => $iB::IN{'LANG'}
                                      } );

    $html .= $SKIN->section_header( TITLE => $IN{'A_TXT'}, TEXT => $IN{'B_TXT'});

    $html .= $SKIN->td_select( TEXT     => "Language Pack Components",
                               NAME     => 'LANG_COMP',
                               REQ      => 1,
                               VALUES   => '',
                               DATA     => \@lang_files
                             );


    $html .= $SKIN->td_submit(   NAME => '', VALUE => $IN{'SUBMIT'} );

    $html .= $SKIN->form_end();
    $html .= $SKIN->end_table();

    $ADMIN->Output( WHERE => 'LANGUAGES', NAV_ONE => "Language Control", PRINT => $html);

}


sub list_entries {
    my $obj = shift;

    my %IN = ( CODE    => "",
               SUBMIT  => "",
               TEXT    => "",
               DB      => "",
               A_TXT   => "",
               B_TXT   => "",
               @_,
              );

    my $db = $IN{'DB'};

    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language pack!");
    }
    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}.'/'.$iB::IN{'LANG_COMP'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language component!");
    }

    do $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}.'/'.$iB::IN{'LANG_COMP'};

    my $lang = (split /\./, $iB::IN{'LANG_COMP'})[0];

    my $req;

    eval { $req = $lang->new(); };
    die $@ if $@;

    my $html  = $SKIN->title( TITLE => 'Language Control', TEXT => $IN{'TEXT'} );
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'lang',
                                        CODE  => $IN{'CODE'},
                                        LANG  => $iB::IN{'LANG'},
                                        COMP  => $iB::IN{'LANG_COMP'}
                                      } );

    $html .= $SKIN->section_header( TITLE => $IN{'A_TXT'}, TEXT => $IN{'B_TXT'});

    for my $l ( sort { $a cmp $b } keys %{$req}) {
        $req->{$l} =~ s!&#33;!\!!g;
        $html .= $SKIN->td_textarea( TEXT  => $l ." <span style='color:red'>=&gt</span> ",
                                     NAME  => 'LL_'.$l,
                                     VALUE => $req->{$l},
                                     REG   => 1,
                                     NO_PARSE => 1,
                                     ROWS  => 3,
                                   );
    }


    $html .= $SKIN->td_submit(   NAME => '', VALUE => $IN{'SUBMIT'} );

    $html .= $SKIN->form_end();
    $html .= $SKIN->end_table();

    $ADMIN->Output( WHERE => 'LANGUAGES', NAV_ONE => "Language Control", PRINT => $html);

}






sub do_edit {
    my ($obj, $db) = @_;

    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language pack!");
    }
    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}.'/'.$iB::IN{'COMP'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language component!");
    }

    # Pull in the current language file
    require $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}.'/'.$iB::IN{'COMP'};

    # Get the name of the package (remove the '.pm')
    my $lang = (split /\./, $iB::IN{'COMP'})[0];

    # Build up our code to eval
    my $req;
    eval { $req = $lang->new(); };
    die $@ if $@;

    # Get the edited fields
    my @all_edits = grep { $_ =~ m#^LL_([\d\w]+)$# } $iB::CGI->param();

    for my $f (@all_edits) {
        # Get the field contents
        my $field = $iB::CGI->param($f);
        # Remove any newline characters
        $field =~ s!\n!!g;
        # Make '!' safe
        $field =~ s:!:&#33;:g;
        # Get the "true" key name
        $f =~ s!^LL_([\d\w]+)!$1!;
        # Overwrite the old key ref
        # with the new value
        $req->{$f} = $field;
    }

    # Overwrite the old module with the new

    $ADMIN->make_module( FILE     => $iB::IN{'COMP'},
                         PKG_NAME => $lang,
                         PATH     => $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}.'/',
                         VALUES   => $req,
                       );
    $ADMIN->write_log( TITLE => 'Language File updated');

    $ADMIN->static_screen( URL   => "act=lang&CODE=view&LANG_COMP=$iB::IN{'COMP'}&LANG=$iB::IN{'LANG'}",
                           TITLE => "The changes were successful",
                         );
}



sub do_remove {
    my ($obj, $db) = @_;

    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language pack!");
    }

    # First off, lets remove the language files are directory

    rmtree ( $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'} );
    
    # Lets remove it from the boardinfo file..

    my $OLD = Boardinfo->new();

    $OLD->{'LANGUAGES'} =~ s!(^|\|&\|)$iB::IN{'LANG'}:(.+?)($|\|&\|)!$1$3!;
    # Tidy up the string.
    $OLD->{'LANGUAGES'} =~ s!\|&\|\|&\|!\|&\|!g;
    $OLD->{'LANGUAGES'} =~ s!^\|&\|!!;
    $OLD->{'LANGUAGES'} =~ s!\|&\|$!!;

    #= '|&|'.$new_directory.':'.$iB::IN{'PACK_NAME'};
    #en:English|&|LANG-2:Testing|&|LANG-2:Testing

    $ADMIN->make_module( FILE     => "Boardinfo.pm",
                         PKG_NAME => 'Boardinfo',
                         VALUES   => $OLD
                       );
   

    $ADMIN->static_screen( URL   => "act=lang&CODE=new",
                           TITLE => "Language Pack removed",
                                    
                         );
}


sub do_new {
    my ($obj, $db) = @_;

    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language pack!");
    }

    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter an email address") unless $iB::IN{'AUTHOR_EMAIL'};
    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter an authors name")  unless $iB::IN{'AUTHOR_NAME'};
    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter a viewable package name")  unless $iB::IN{'PACK_NAME'};

    # Count up the current language files.
    my $cnt = 0;
    for my $l ( split( /\|\&\|/, $iB::INFO->{'LANGUAGES'} ) ) {
        ++$cnt;
    }
    ++$cnt;
    
    my $new_directory = 'LANG-'.$cnt;

    # Create the new Directory
    mkdir ($iB::INFO->{'IKON_DIR'}.'Languages/'.$new_directory, 0777);
   
    opendir (DIR, $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) or die  "Cannot Open the Directory!";
    my @files =  grep  {   !/^\./   } readdir DIR;
    closedir DIR;

    # Copy the files across
    for my $f (@files) {
        copy($iB::INFO->{'IKON_DIR'}."Languages/$iB::IN{'LANG'}/$f"  ,
             $iB::INFO->{'IKON_DIR'}."Languages/$new_directory/$f"   );
    }

    # Create the config file

    open CONF, ">".$iB::INFO->{'IKON_DIR'}."Languages/$new_directory/config.cfg";
    print CONF "AUTHOR=$iB::IN{'AUTHOR_NAME'}\nEMAIL=$iB::IN{'AUTHOR_EMAIL'}\nPACK_NAME=$iB::IN{'PACK_NAME'}\nCREATED=".time;
    close CONF;

    #Update the Boardinfo file

    my $OLD = Boardinfo->new();

    $OLD->{'LANGUAGES'} .= '|&|'.$new_directory.':'.$iB::IN{'PACK_NAME'};

    $ADMIN->make_module( FILE     => "Boardinfo.pm",
                         PKG_NAME => 'Boardinfo',
                         VALUES   => $OLD
                       );
   
    $ADMIN->write_log( TITLE => 'Language Pack Created');

    $ADMIN->static_screen( URL   => "act=lang&CODE=new",
                           TITLE => "The changes were successful.<br><br>You may now edit your new package by clicking on this link:
                                    <a href='$iB::INFO->{'BOARD_URL'}/ikonboard.$iB::INFO->{'CGI_EXT'}?AD=1&s=$iB::SESSION&act=lang&CODE=list&LANG=$new_directory'>Edit your new language Pack</a>",
                         );
}




sub do_export {
    my ($obj, $db) = @_;

    # Check for Language files
    unless (-e $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "I cannot find that language pack!");
    }

    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter a export package name")  unless $iB::IN{'PACK_NAME'};

    # Remove non unix characters (alpha numerics)
    $iB::IN{'PACK_NAME'} =~ s!^(?:\W+)$!!g;
    # Swop whitespace into underscores
    $iB::IN{'PACK_NAME'} =~ y! !_!;

    my $new_directory = 'LANG-'.$iB::IN{'PACK_NAME'};

    # Create the new Directory
    mkdir ($iB::INFO->{'IKON_DIR'}.'OUTGOING/'.$new_directory, 0777);
   
    # Get the files
    opendir (DIR, $iB::INFO->{'IKON_DIR'}.'Languages/'.$iB::IN{'LANG'}) or die  "Cannot Open the Directory!";
    my @files =  grep  {   !/^\./   } readdir DIR;
    closedir DIR;

    # Copy the files across to the temp dir.
    for my $f (@files) {
        copy($iB::INFO->{'IKON_DIR'}."Languages/$iB::IN{'LANG'}/$f"  ,
             $iB::INFO->{'IKON_DIR'}."OUTGOING/$new_directory/$f"   );
    }

    # Get the new files and locations
    opendir (DIR, $iB::INFO->{'IKON_DIR'}.'OUTGOING/'.$new_directory) or die  "Cannot Open the Directory!";
    my @new_files =  grep  {   !/^\./   } readdir DIR;
    closedir DIR;

    # Iterate over the file list and add on the full path
    my @files_to_archive;
    for (@new_files) {
        push @files_to_archive, "$new_directory/$_";
    }
    

    # Create the Tar file.

    {

        my $cwd  = $iB::INFO->{'IKON_DIR'};
        chdir $INFO->{'IKON_DIR'}."OUTGOING";
        my $tar  = Archive::Tar->new();
        $tar->add_files(@files_to_archive) or ($obj->{'ERROR'} = $Archive::Tar::error and chdir $cwd and return);
        $tar->write("$new_directory.tar")  or ($obj->{'ERROR'} = $Archive::Tar::error and chdir $cwd and return);
        chdir $cwd;

    }

    # Remove the non archived files

    rmtree $iB::INFO->{'IKON_DIR'}.'OUTGOING/'.$new_directory;

   
    $ADMIN->write_log( TITLE => 'Language Pack Ready for export');

    $ADMIN->static_screen( URL   => "act=lang&CODE=new",
                           TITLE => "The changes were successful.<br><br>You may now download your new package by clicking on this link:
                                    <a href='$iB::INFO->{'BOARD_URL'}/OUTGOING/$new_directory.tar'>Download the language Pack</a>",
                         );
}


sub do_import {
    my ($obj, $db) = @_;

    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter a export package name")  unless $iB::IN{'PACK_NAME'};
    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter a export package name")  unless $iB::IN{'INSTALL_NAME'};

    # Remove .tar from the name to get the dir name
    my $new_directory =  $iB::IN{'INSTALL_NAME'};
    $new_directory    =~ s!\.tar$!!g;

    # Create the new Directory
    mkdir ($iB::INFO->{'IKON_DIR'}.'INCOMING/'.$new_directory, 0777);

    # Extract the .tar file

    {

        my $cwd = $iB::INFO->{'IKON_DIR'};
        my $tar = Archive::Tar->new();

        unless ($tar->read($iB::INFO->{'IKON_DIR'}."INCOMING/$iB::IN{'INSTALL_NAME'}", 0)) {
    	        die "+>ERROR: Cannot read the .tar file (Is it there and uploaded in Binary?)\n";
        }

        chdir $iB::INFO->{'IKON_DIR'}."INCOMING";
        my @files = $tar->list_files();

        for (@files) {
            if ($_ !~ /^(?:[\.\w\d\+\-\_\/\\]+)$/) {
                die "+>ERROR: Tar file is corrupted, please re-upload\n";
                
            }
        }

        $tar->extract(@files, $iB::INFO->{'IKON_DIR'}."INCOMING");
        chdir $cwd;

    }

    # Count up the current language files.
    my $cnt = 0;
    for my $l ( split( /\|\&\|/, $iB::INFO->{'LANGUAGES'} ) ) {
        ++$cnt;
    }
    ++$cnt;
    
    my $new_lang = 'LANG-'.$cnt;

    # Create the new directory
    mkdir ($iB::INFO->{'IKON_DIR'}.'Languages/'.$new_lang, 0777);
   
    # Get the files
    opendir (DIR, $iB::INFO->{'IKON_DIR'}.'INCOMING/'.$new_directory) or die  "Cannot Open the Directory!";
    my @files =  grep  {   !/^\./   } readdir DIR;
    closedir DIR;

    # Copy the files across to the language dir.
    for my $f (@files) {
        copy($iB::INFO->{'IKON_DIR'}."INCOMING/$new_directory/$f"  ,
             $iB::INFO->{'IKON_DIR'}."Languages/$new_lang/$f"      );
    }

    
    # Remove the non archived files

    rmtree $iB::INFO->{'IKON_DIR'}.'INCOMING/'.$new_directory;

    #Update the Boardinfo file

    my $OLD = Boardinfo->new();

    $OLD->{'LANGUAGES'} .= '|&|'.$new_lang.':'.$iB::IN{'PACK_NAME'};

    $ADMIN->make_module( FILE     => "Boardinfo.pm",
                         PKG_NAME => 'Boardinfo',
                         VALUES   => $OLD
                       );

   
    $ADMIN->write_log( TITLE => 'Language Pack Imported');

    $ADMIN->static_screen( URL   => "act=lang&CODE=import",
                           TITLE => "The language pack has been imported successfully",
                         );
}


sub process {
    my ($obj, $db) = @_;

    my $CodeNo = $iB::IN{'CODE'};

    my %Mode = ( 'list'        => \&do_list,
                 'view'        => \&do_view,
                 'apply_edit'  => \&do_edit,
                 'new'         => \&new_splash,
                 'do_new'      => \&do_new,
                 'export'      => \&export,
                 'do_export'   => \&do_export,
                 'import'      => \&import,
                 'do_import'   => \&do_import,
                 'remove'      => \&remove,
                 'do_remove'   => \&do_remove,
               );

    $Mode{$CodeNo} ? $Mode{$CodeNo}->($obj,$db) : splash($obj,$db);
} 



sub do_tar {
    my ($obj, $file_path) = @_;
    my $cwd  = $iB::INFO->{'IKON_DIR'};

    chdir $INFO->{'IKON_DIR'}.'OUTGOING';

    my $tar      = Archive::Tar->new();
    my @filelist = $obj->Find_Files($file_path);

    $tar->add_files(@filelist)    or ($obj->{'ERROR'} = $Archive::Tar::error and chdir $cwd and return);
    $tar->write("$file_path.tar") or ($obj->{'ERROR'} = $Archive::Tar::error and chdir $cwd and return);
    chdir $cwd;
    return 1;
}

sub Find_Files {
    my ($obj, $file_path) = @_;

    my @filelist;

    opendir (DIR, "$INFO->{'IKON_DIR'}".'Languages/'.$file_path);
    my @list = readdir(DIR);
    closedir(DIR);

    foreach my $file (@list) {
        next if ($file =~ /^\.\.?$/);
        if (-d "$INFO->{'BACKUP_DIR'}/$file_path/$file") {
            push(@filelist, $obj->Find_Files($file_path.'/'.$file) );
        } else {
            push(@filelist, $file_path.'/'.$file);
        }
    }
    return @filelist;
}



1;
