package Admin::Tools;
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: $!";
}

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 groups {
    my ($obj, $db) = @_;

    my $html  = $SKIN->title( TITLE => 'Tools -> Remove Member Group Dupes');
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'tools',
                                        CODE  => 'do_groups'
                                      } );

    #+-----------------------------------

    $html .= $SKIN->section_header( TITLE => "Please define your preferences", TEXT => "This will not affect your current session" );

    $html .= $SKIN->td_select( TEXT     => 'Favour lower or higher ID\'s?<br>Higher ID\'s are preferable, there is a greater chance of the dupes being the higher ID value',
                               NAME     => 'FAVOUR',
                               VALUES   => '1',
                               DATA     => [ { VALUE => 1, NAME => 'Higher'  },
                                             { VALUE => 0, NAME => 'Lower'   },
                                           ]
                             );



    $html .= $SKIN->td_submit(   NAME => '', VALUE => 'Remove these membergroups' );


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

    #+-----------------------------------

    $ADMIN->Output( WHERE => 'MAINTAIN', NAV_ONE => 'Tools -> Remove duplicate membergroups', PRINT => $html);


}

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

    # Get all the member groups

    my $groups = $db->query(  TABLE  => 'mem_groups' );

    # Set up some counters.
    my ($groups_removed, @errors, $groups_ignored);

    my $poss_dupes = {};
    my @delete;            # Group ID's to remove.
    my @to_remove;         # Group ID's to check.
    my $cant_remove;
    my $mapped    = {};

    # Loop through and see where we are..

    for my $m (@{$groups}) {
        if (exists $poss_dupes->{ $m->{TITLE} }) {
            if ($iB::IN{FAVOUR}) {
                if ($m->{ID} > $poss_dupes->{ $m->{TITLE} }) {
                    push @to_remove, $m->{ID};
                }
            } else {
                 if ($m->{ID} < $poss_dupes->{ $m->{TITLE} }) {
                    push @to_remove, $m->{ID};
                }               
            }
        } else {
            $poss_dupes->{ $m->{TITLE} } = $m->{ID};
        }
        $mapped->{ $m->{ID} } = $m->{TITLE};
    }

    # Hopefully, @to_remove should hold the groups that are dupes
    # now we make sure that no members are actually in that group
    # before we merrily delete them.

    # This could be a server burner ;)

    my $query;
    for my $g (@to_remove) {
        next unless defined $g;
        $query .= " MEMBER_GROUP == '$g' or";
    }
    # Remove the last OR
    $query =~ s/or$//i;

    # Get the members

    my $members = $db->query( TABLE   => 'member_profiles',
                              COLUMNS => ["MEMBER_ID", "MEMBER_NAME", "MEMBER_GROUP"],
                              WHERE   => $query,
                            );

    if (scalar(@{$members}) > 0) {
        for my $mem (@{$members}) {
            ++$cant_remove->{$mem->{MEMBER_GROUP}}; 
        }
    }

    undef $members;

    # Final loop, check off the ones we can delete, error on the ones we can't.

    for my $i (@to_remove) {
        if (exists $cant_remove->{ $i }) {
            push @errors, "Can't remove group ID $i ($mapped->{ $i }) - $cant_remove->{ $i } members still in that group";
            next;
        } else {
            push @delete, $i;
        }
    }

    # Delete the groups

    if (@delete > 0) {
        $db->delete( TABLE  => "mem_groups",
                     KEY    => \@delete,
                   );
    }

    # Output the screen

    my $cnt = scalar @delete;

    my $message = qq~The following results were returned.<br><br>Groups successfully removed: $cnt~;
    
    if (@errors > 0) {
        $message .= "<br><br>The following errors were reported:<ul>";
        for (@errors) {
            $message .= "<li>$_";
        }
        $message .= "</ul>";
    }

    $ADMIN->static_screen( URL   => "act=tools&CODE=groups",
                           TITLE => "Member Group Removal Results",
                           TEXT  => "$message"
                         );

}



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

    my $html  = $SKIN->title( TITLE => 'Tools -> Remove Custom Member Titles' );
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'tools',
                                        CODE  => "do_titles",
                                      } );



    $html .= $SKIN->section_header( TITLE => "Remove what custom title?", TEXT => "This is handy for those who converted iB2 members and found that the member titles won't advance");

    $html .= $SKIN->td_input ( TEXT => 'Enter title to remove<br>&nbsp;&nbsp;&nbsp;&nbsp;(Case sensitive)', NAME => 'TITLE', VALUE=> '', REQ => 1);
    
    

    $html .= $SKIN->td_submit(   NAME => '', VALUE => "Process" );

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

    $ADMIN->Output( WHERE => 'MAINTAIN', NAV_ONE => "Tools -> Remove Custom Member Titles", PRINT => $html);

}

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

    $ADMIN->Error( DB => $db, STD => $std, MSG => "You must enter a title") unless $iB::IN{TITLE};

    # Check to see how many members match.

    $iB::IN{TITLE} =~ s/'/\\'/g;
    
    my $mems = $db->query( TABLE   => "member_profiles",
                           WHERE   => "MEMBER_TITLE eq '$iB::IN{TITLE}'",
                           COLUMNS => ["MEMBER_ID"],
                           MATCH   => "WITH COUNT",
                         );

    undef $mems;

    my $cnt = $db->matched_records;

    my $message;

    unless ($cnt) {
        $message = "<span style='color:red;font-weight:bold'>No members found with that member title ($iB::IN{TITLE}) update aborted</span>";
    } else {
        $db->update( TABLE  => 'member_profiles',
                     WHERE  => "MEMBER_TITLE eq '$iB::IN{TITLE}'",
                     VALUES => { MEMBER_TITLE => "0" }               # We still need a value for *SQL  
                   );
        $message = "$cnt members updated successfully";
    }

    $ADMIN->static_screen( URL   => "act=tools&CODE=titles",
                           TITLE => "Member Title Removal Results",
                           TEXT  => "$message"
                         );
}

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

    my @editable; 
    my @skins = split( /\|\&\|/, $INFO->{'SKINS'} );
    for my $s (@skins) {
        @_ = split /\:/, $s;
        push @editable, { NAME => $_[2], VALUE => $_[1] };
    }

    my $size = scalar @editable + 1;

    my $html  = $SKIN->title( TITLE => 'Styles/Skin Control', TEXT => "This tool will allow you to rebuild the .cfg files that ikonboard uses when editing the skin HTML. This is useful if when editing the HTML, the text areas appear blank, or if you've edited the perl modules by hand and wish to create the configuration files for others to use after you've exported the skin.");
       $html .= $SKIN->begin_table();
       $html .= $SKIN->form_start();
       $html .= $SKIN->hidden_fields( { act   => 'tools',
                                        CODE  => 'do_skin'
                                      } );

    #+-----------------------------------

    $html .= $SKIN->section_header( TITLE => "Please choose  the 'Skin' to rebuild the .cfg files" );

    $html .= $SKIN->td_select( TEXT     => 'Installed Skins',
                               NAME     => 'SKIN',
                               SIZE     => $size,
                               VALUES   => 'Default',
                               DATA     => \@editable,
                             );

    $html .= $SKIN->td_submit(   NAME => '', VALUE => 'Rebuild the config files for this skin' );


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

    #+-----------------------------------

    $ADMIN->Output( WHERE => 'STYLES', NAV_ONE => 'Tools -&gt; Styles/Skin Control', PRINT => $html);

}

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

    opendir DIR, $iB::INFO->{'IKON_DIR'} . 'Skin/' . $iB::IN{'SKIN'} or die "Cannot open the directory that contains $iB::IN{SKIN}";
    my @files = grep { /\.pm$/ } readdir DIR;
    closedir DIR;
    
    for my $file (@files) {
    
        # skip Styles.pm
        
        next if $file =~ /^Styles\.pm/;
        next if $file =~ /^gfx_data\.cfg/;
    
        my $conf = $file;
        $conf =~ s!\.pm$!\.cfg!;
        my $name = $file;
        $name =~ s!\.pm$!!;
    
        open FILE, $iB::INFO->{'IKON_DIR'} . 'Skin/' . $iB::IN{'SKIN'} . '/'.$file;
        my @data =  <FILE>;
        close FILE;
        
        my $header;
        my %subs;
        my $flag = 0;
        my $start = 0;
        
        # Grab the subroutines..
        for my $i (@data) {
            chomp $i;
            next if $i =~ /^\#/;          # Ignore comments
            next if $i =~ /^1;/;          # Ignore perl require
            next if $i =~ /^package/i;    # Ignore package declaration
            next if $i =~ /^\s+$/;        # Ignore empty lines
            next if $i =~ /^__END__/;     # Ignore end statement
            if ($i =~ /^sub (\w+)\s{0,}\{/) {
                $subs{ $1 } = '';
                $flag = $1;
                $start = 1;
                next;
            }
            if ($flag) {
                $subs{$flag} .= $i."\n";
                next;
            } elsif ($start == 0) {
                $header .= $i."\n";
            }
        }
            
        # start the config..
        
        my $config = qq~$name\n[=HEADER]\n$header\n~;
        
        
        # see what we have...
        
        for my $s (keys %subs) {
            $subs{$s} =~ /return qq~(.+?)~;/s;
            # $subr = the HTML
            my $subr = $1;
            $subs{$s} =~ s/return qq~(.+?)~;.+?\}//s;
            # $top = top INFO
            my $top = $subs{$s};
            
            $config .= qq~[=SUB-$s]\n#=DESC\n\n#=TOP_LINE\n$top\n#=BODY\n$subr\n~;
        
        }
        
        $config =~ s/\r/\n/g;
        $config =~ s/\n\n/\n/g;
        $config =~ s!#=DESC!#=DESC\n!g;
        
        open FILE, ">".$iB::INFO->{'IKON_DIR'} . 'Skin/' . $iB::IN{'SKIN'} . '/'.$conf;
        print FILE $config;
        close FILE;
        
        $result .= "<li>$conf configuration file rebuilt...<br>";
    }

    $ADMIN->static_screen( URL   => "act=tools&CODE=skin",
                           TITLE => "Skin config rebuild results",
                           TEXT  => "<ul>$result</ul>"
                         );

}

##########################################################################################
#
# Process Sub
#
##########################################################################################


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

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

    # Only allow super admins access...

    unless ($iB::MEMBER->{'MEMBER_GROUP'} == $iB::INFO->{'SUPAD_GROUP'}) {
        $ADMIN->Error( DB => $db, STD => $std, MSG => "Sorry, only the board owners have access to this part");
    }

    my %Mode = ( 'groups'        => \&groups,
                 'do_groups'     => \&do_groups,
                 'titles'        => \&titles,
                 'do_titles'     => \&do_titles,
                 'skin'          => \&skin,
                 'do_skin'       => \&do_skin,
               );


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


1;