###############################################################################
# AdminSubs.pm                                                                #
# $Date: 06.01.17 $                                                           #
###############################################################################
# YaBB: Yet another Bulletin Board                                            #
# Open-Source Community Software for Webmasters                               #
# Version:        YaBB 2.7.00                                                 #
# Packaged:       June 1, 2017                                                #
# Distributed by: http://www.yabbforumsoftware.com                                    #
# =========================================================================== #
# Copyright (c) 2000-2017 YaBB (www.yabbforumsoftware.com) - All Rights Reserved.     #
# Software by:  The YaBB Development Team                                     #
#               with assistance from the YaBB community.                      #
###############################################################################
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
our $VERSION = '2.7.00';

our $adminsubspmver = 'YaBB 2.7.00 $Revision: 2059 $';
our @adminsubsmods  = ();
our $adminsubsmods  = 0;
if (@adminsubsmods) {
    $adminsubsmods = 1;
}

our ($action);
$action ||= q{};
if ( $action eq 'detailedversion' ) { return 1; }

our (
    $adminurl, $yysetlocation, %croak,    %FORM,   %INFO,
    $boarddir, $sourcedir,     $admindir, $vardir, $langdir, $boardsdir,
    $helpfile, $templatesdir,  $yymain,   %admintxt,
    @categoryorder, %cat, %catinfo, %board, %subboard,
);

sub mail_list {
    my ($mailline) = @_;
    is_admin_or_gmod();
    my $delmailline = $INFO{'delmail'} || 0;
    my $prnmail = q{};
    if ($mailline) {
        $prnmail = qq~$mailline\n~;
    }
    if ( -e "$vardir/maillist.dat" ) {
        our (%maillist);
        require 'Variables/maillist.dat';

        if ($delmailline) {
            delete $maillist{$delmailline};
        }
        foreach my $otime ( keys %maillist ) {
            my ( $osubject, $otext, $osender ) = @{ $maillist{$otime} };
            $prnmail .=
              qq~\$maillist{'$otime'} = ['$osubject', '$otext', '$osender'];\n~;
        }
    }
    $prnmail .= qq~\n1;\n~;
    our ($FILE);
    fopen( 'FILE', '>', "$vardir/maillist.dat" )
      or croak "$croak{'open'} maillist.dat";
    print {$FILE} $prnmail or croak "$croak{'print'} FILE";
    fclose('FILE') or croak "$croak{'close'} maillist.dat";

    if ( $INFO{'delmail'} ) {
        $yysetlocation = qq~$adminurl?action=mailinggrps~;
        redirectexit();
    }
    return;
}

sub write_settings_to {
    my ( $file, $setfile ) = @_;
    my $filler = q{ } x 50;

    # Fix a certain type of syntax error
    $setfile =~ s/=\s+;/= 0;/gxsm;

    # Make it look nicely aligned. The comment starts after 50 Col

    $setfile =~
s/(.+;)[ \t]+([#].+$)/ $1 . substr($filler,(length $1 < 50 ? length $1 : 49)) . $2 /gexm;
    $setfile =~ s/\t+([#].+$)/$filler$1/gxm;

    local *cut_comment = sub {
        my ( $comment, $length ) =
          ( q{}, 120 );    # 120 Col is the max width of page
        my $var_length = length $_[0];
        while ( $length < $var_length ) { $length += 120; }
        for ( split /[ ]+/xsm, $_[1] ) {
            if ( ( $var_length + length($comment) + length ) > $length ) {
                $comment =~ s/[ ]$//xsm;
                $comment .= "\n$filler#  $_ ";
                $length += 120;
            }
            else { $comment .= "$_ "; }
        }
        $comment =~ s/[ ]$//xsm;
        return $comment;
    };
    $setfile =~ s/(.+)([#].+$)/ $1 . cut_comment($1,$2) /gexm;

    # Write it out
    open my $SETTINGS, '>', $file
      or fatal_error( $croak{'open'}, 'SETTINGS', 1 );
    print {$SETTINGS} $setfile or croak "$croak{'print'} SETTINGS";
    close $SETTINGS or croak "$croak{'close'} SETTINGS";
    return;
}

sub chk_ip {
    my ($tochk) = @_;
    my $bad = 0;
    if ( $tochk =~ /[^A-F0-9.:]/ixsm ) { $bad = 1; }
    elsif ( $tochk =~ /[.]/xsm && $tochk !~ /[:]/xsm ) {
        my @chk = split /[.]/xsm, $tochk;
        if ( @chk > 4 ) { $bad = 2; }
        else {
            foreach my $i (@chk) {
                if ( $i =~ /\D/xsm || $i eq q{} || $i > 255 ) {
                    $bad = 3;
                    last;
                }
            }
        }
    }
    elsif ( $tochk =~ /[:]/xsm ) {
        if ( $tochk =~ /(?:[:][:]).*?([:][:])/xsm ) {
            $bad = 4;
        }
        elsif ( $tochk =~ /[:]{3}/xsm ) {
            $bad = 5;
        }
    }
    return $bad;
}

sub write_forummaster {
    my $newforum = qq~\$mloaded = 1;\n~;
    my @catorder = undupe(@categoryorder);
    my $catlist  = join q{ }, @catorder;
    $newforum .= qq~\@categoryorder = qw($catlist);\n~;
    foreach my $key ( @catorder) {
        my $value = $cat{$key};
        if ( $value && $value ne q{} ) {
            my $val2 = join q{', '}, @{$value};
            $newforum .= qq~\$cat{'$key'} = ['$val2'];\n~;
        }
    }
    foreach my $key (@catorder) {
        my $value = $catinfo{$key};
        if ( $value && $value ne q{} ) {
            $value =~ s/\$/\\\$/gxsm;
            my $values = join q{', '}, @{$value};
            $newforum .= qq~\$catinfo{'$key'} = ['$values'];\n~;
        }
    }
    while ( my ( $key, $value ) = each %subboard ) {
        if ( @{$value} ) {
            my $val2 = join q{', '}, @{$value};
            $newforum .= qq~\$subboard{'$key'} = ['$val2'];\n~;
        }
    }
    while ( my ( $key, $value ) = each %board ) {
        $value =~ s/\$/\\\$/gxsm;
        $value =~ s/\~//gxsm;
        my $val2 = join q{', '}, @{$value};
        $newforum .= qq~\$board{'$key'} = ['$val2'];\n~;
    }
    $newforum .= qq~\n1;~;

    our ($FORUMMASTER);
    fopen( 'FORUMMASTER', '>', "$boardsdir/forum.master" )
      or croak "$croak{'open'} forum.master";
    print {$FORUMMASTER} $newforum or croak "$croak{'print'} FORUMMASTER";
    fclose('FORUMMASTER') or croak "$croak{'close'} forum.master";
    return;
}

1;
