1###############################################################################
2# System.pm                                                                   #
3# $Date: 12.02.14 $                                                           #
4###############################################################################
5# YaBB: Yet another Bulletin Board                                            #
6# Open-Source Community Software for Webmasters                               #
7# Version:        YaBB 2.6.11                                                 #
8# Packaged:       December 2, 2014                                            #
9# Distributed by: http://www.yabbforum.com                                    #
10# =========================================================================== #
11# Copyright (c) 2000-2014 YaBB (www.yabbforum.com) - All Rights Reserved.     #
12# Software by:  The YaBB Development Team                                     #
13#               with assistance from the YaBB community.                      #
14###############################################################################
15use CGI::Carp qw(fatalsToBrowser);
16our $VERSION = '2.6.11';
17
18$systempmver = 'YaBB 2.6.11 $Revision: 1611 $';
19
20sub BoardTotals {
21    my ( $job, @updateboards ) = @_;
22    my ( $line, @lines, $updateboard, @boardvars, $cnt );
23    if ( !@updateboards ) { @updateboards = @allboards; }
24    chomp @updateboards;
25    if (@updateboards) {
26        my @tags =
27          qw(board threadcount messagecount lastposttime lastposter lastpostid lastreply lastsubject lasticon lasttopicstate);
28        if ( $job eq 'load' ) {
29            fopen( FORUMTOTALS, "$boardsdir/forum.totals" )
30              or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 );
31            @lines = <FORUMTOTALS>;
32            fclose(FORUMTOTALS);
33            chomp @lines;
34            foreach $updateboard (@updateboards) {
35                foreach $line (@lines) {
36                    @boardvars = split /\|/xsm, $line;
37                    if ( $boardvars[0] eq $updateboard
38                        && exists $board{ $boardvars[0] } )
39                    {
40                        for my $cnt ( 1 .. $#tags ) {
41                            ${ $uid . $updateboard }{ $tags[$cnt] } =
42                              $boardvars[$cnt];
43                        }
44                        last;
45                    }
46                }
47            }
48        }
49        elsif ( $job eq 'update' ) {
50            fopen( FORUMTOTALS, "<$boardsdir/forum.totals" )
51              or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 );
52            @lines = <FORUMTOTALS>;
53            fclose( FORUMTOTALS );
54            for $line ( 0 .. ( $#lines ) ) {
55                @boardvars = split /\|/xsm, $lines[$line];
56                if ( exists $board{ $boardvars[0] } ) {
57                    if ( $boardvars[0] eq $updateboards[0] ) {
58                        $lines[$line] = "$updateboards[0]|";
59                        chomp $boardvars[9];
60                        for my $cnt ( 1 .. $#tags ) {
61                            if (
62                                exists(
63                                    ${ $uid . $boardvars[0] }{ $tags[$cnt] }
64                                )
65                              )
66                            {
67                                $lines[$line] .=
68                                  ${ $uid . $boardvars[0] }{ $tags[$cnt] };
69                            }
70                            else {
71                                $lines[$line] .= $boardvars[$cnt];
72                            }
73                            $lines[$line] .= $cnt < $#tags ? q{|} : "\n";
74                        }
75                    }
76                }
77                else {
78                    $lines[$line] = q{};
79                }
80            }
81            fopen( FORUMTOTALS, ">$boardsdir/forum.totals" )
82              or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 );
83            print {FORUMTOTALS} @lines or croak "$croak{'print'} FORUMTOTALS";
84            fclose(FORUMTOTALS);
85
86        }
87        elsif ( $job eq 'delete' ) {
88            fopen( FORUMTOTALS, "<$boardsdir/forum.totals" )
89              or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 );
90            @lines = <FORUMTOTALS>;
91            fclose( FORUMTOTALS );
92            for my $line ( 0 .. ( @lines - 1 ) ) {
93                @boardvars = split /\|/xsm, $lines[$line], 2;
94                if ( $boardvars[0] eq $updateboards[0]
95                    || !exists $board{ $boardvars[0] } )
96                {
97                    $lines[$line] = q{};
98                }
99            }
100            fopen( FORUMTOTALS, ">$boardsdir/forum.totals" )
101              or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 );
102            print {FORUMTOTALS} @lines or croak "$croak{'print'} FORUMTOTALS";
103            fclose(FORUMTOTALS);
104        }
105        elsif ( $job eq 'add' ) {
106            fopen( FORUMTOTALS, ">>$boardsdir/forum.totals" )
107              or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 );
108            foreach (@updateboards) {
109                print {FORUMTOTALS} "$_|0|0|N/A|N/A||||\n"
110                  or croak "$croak{'print'} FORUMTOTALS";
111            }
112            fclose(FORUMTOTALS);
113        }
114    }
115    return;
116}
117
118sub BoardCountTotals {
119    my ($cntboard) = @_;
120    if ( !$cntboard ) { return; }
121
122    fopen( BOARD, "$boardsdir/$cntboard.txt" )
123      or fatal_error( 'cannot_open', "$boardsdir/$cntboard.txt", 1 );
124    my @threads = <BOARD>;
125    fclose(BOARD);
126    my $threadcount  = @threads;
127    my $messagecount = $threadcount;
128    for my $i ( 0 .. ( @threads - 1 ) ) {
129        my @threadline = split /\|/xsm, $threads[$i];
130        if ( $threadline[8] =~ /m/sm ) {
131            $threadcount--;
132            $messagecount--;
133            next;
134        }
135        $messagecount += $threadline[5];
136    }
137    ${ $uid . $cntboard }{'threadcount'}  = $threadcount;
138    ${ $uid . $cntboard }{'messagecount'} = $messagecount;
139    BoardSetLastInfo( $cntboard, \@threads );
140    return;
141}
142
143sub BoardSetLastInfo {
144    my ( $setboard, $board_ref ) = @_;
145    my ( $lastthread, $lastthreadid, $lastthreadstate, @lastthreadmessages,
146        @lastmessage );
147
148    foreach my $lastthread ( @{$board_ref} ) {
149        if ($lastthread) {
150            (
151                $lastthreadid, undef, undef,
152                undef,         undef, undef,
153                undef,         undef, $lastthreadstate
154            ) = split /\|/xsm, $lastthread;
155            if ( $lastthreadstate !~ /m/sm ) {
156                chomp $lastthreadstate;
157                fopen( FILE, "$datadir/$lastthreadid.txt" )
158                  or fatal_error( 'cannot_open', "$datadir/$lastthreadid.txt",
159                    1 );
160                @lastthreadmessages = <FILE>;
161                fclose(FILE);
162                @lastmessage =
163                  split /\|/xsm, $lastthreadmessages[-1], 7;
164                last;
165            }
166            $lastthreadid = q{};
167        }
168    }
169    ${ $uid . $setboard }{'lastposttime'} =
170      $lastthreadid ? $lastmessage[3] : 'N/A';
171    ${ $uid . $setboard }{'lastposter'} =
172      $lastthreadid
173      ? (
174        $lastmessage[4] eq 'Guest' ? "Guest-$lastmessage[1]" : $lastmessage[4] )
175      : 'N/A';
176    ${ $uid . $setboard }{'lastpostid'} = $lastthreadid ? $lastthreadid : q{};
177    ${ $uid . $setboard }{'lastreply'} =
178      $lastthreadid ? $#lastthreadmessages : q{};
179    ${ $uid . $setboard }{'lastsubject'} =
180      $lastthreadid ? $lastmessage[0] : q{};
181    ${ $uid . $setboard }{'lasticon'} = $lastthreadid ? $lastmessage[5] : q{};
182    ${ $uid . $setboard }{'lasttopicstate'} =
183      ( $lastthreadid && $lastthreadstate ) ? $lastthreadstate : '0';
184    BoardTotals( 'update', $setboard );
185    return;
186}
187
188#### THREAD MANAGEMENT ####
189
190sub MessageTotals {
191
192    # usage: &MessageTotals("task",<threadid>)
193    # tasks: update, load, incview, incpost, decpost, recover
194    my ( $job, $updatethread ) = @_;
195    chomp $updatethread;
196    if ( !$updatethread ) { return; }
197
198    if ( $job eq 'update' ) {
199        if ( ${$updatethread}{'board'} eq q{} )
200        {    ## load if the variable is not already filled
201            MessageTotals( 'load', $updatethread );
202        }
203    }
204    elsif ( $job eq 'load' ) {
205        if ( ${$updatethread}{'board'} ne q{} ) {
206            return;
207        }    ## skip load if the variable is already filled
208        fopen( CTB, "$datadir/$updatethread.ctb", 1 );
209        while ( my $inp = <CTB> ) {
210            if ( $inp =~ /^'(.*?)',"(.*?)"/xsm ) { ${$updatethread}{$1} = $2; }
211        }
212        fclose(CTB);
213        @repliers = split /,/xsm, ${$updatethread}{'repliers'};
214        return;
215
216    }
217    elsif ( $job eq 'incview' ) {
218        ${$updatethread}{'views'}++;
219
220    }
221    elsif ( $job eq 'incpost' ) {
222        ${$updatethread}{'replies'}++;
223
224    }
225    elsif ( $job eq 'decpost' ) {
226        ${$updatethread}{'replies'}--;
227
228    }
229    elsif ( $job eq 'recover' ) {
230
231        # storing thread status
232        my $threadstatus;
233        my $openboard = ${$updatethread}{'board'};
234        fopen( TESTBOARD, "$boardsdir/$openboard.txt" )
235          or fatal_error( 'cannot_open', "$boardsdir/$openboard.txt", 1 );
236        while ( $ThreadLine = <TESTBOARD> ) {
237            if ( $updatethread == ( split /\|/xsm, $ThreadLine, 2 )[0] ) {
238                $threadstatus = ( split /\|/xsm, $ThreadLine )[8];
239                chomp $threadstatus;
240                last;
241            }
242        }
243        fclose(TESTBOARD);
244
245        # storing thread other info
246        fopen( MSG, "$datadir/$updatethread.txt" )
247          or fatal_error( 'cannot_open', "$datadir/$updatethread.txt", 1 );
248        my @threaddata = <MSG>;
249        fclose(MSG);
250        my @lastinfo = split /\|/xsm, $threaddata[-1];
251        my $lastpostdate = sprintf '%010d', $lastinfo[3];
252        my $lastposter =
253          $lastinfo[4] eq 'Guest' ? qq~Guest-$lastinfo[1]~ : $lastinfo[4];
254
255        # rewrite/create a correct thread.ctb
256        ${$updatethread}{'replies'}      = $#threaddata;
257        ${$updatethread}{'views'}        = ${$updatethread}{'views'} || 0;
258        ${$updatethread}{'lastposter'}   = $lastposter;
259        ${$updatethread}{'lastpostdate'} = $lastpostdate;
260        ${$updatethread}{'threadstatus'} = $threadstatus;
261        @repliers = ();
262    }
263    else {
264        return;
265    }
266
267    ## trap writing false ctb files on forged num= actions ##
268    if ( -e "$datadir/$updatethread.txt" ) {
269        my $format = 'SDT, DD MM YYYY HH:mm:ss zzz';    # The format
270                                                        # Save their old format
271        my $timeformat = ${ $uid . $username }{'timeformat'};
272        my $timeselect = ${ $uid . $username }{'timeselect'};
273
274        # Override their settings
275        ${ $uid . $username }{'timeformat'} = $format;
276        ${ $uid . $username }{'timeselect'} = 7;
277
278        # Do the work
279        my $newtime = timeformat( $date, 1, 'rfc' );
280
281        # And restore their settings
282        ${ $uid . $username }{'timeformat'} = $timeformat;
283        ${ $uid . $username }{'timeselect'} = $timeselect;
284
285        ${$updatethread}{'repliers'} = join q{,}, @repliers;
286
287# Changes here on @tag must also be done in Post.pm -> sub Post2 -> my @tag = ...
288        my @tag =
289          qw(board replies views lastposter lastpostdate threadstatus repliers);
290        fopen( UPDATE_CTB, ">$datadir/$updatethread.ctb", 1 )
291          or fatal_error( 'cannot_open', "$datadir/$updatethread.ctb", 1 );
292        print {UPDATE_CTB}
293          qq~### ThreadID: $updatethread, LastModified: $newtime ###\n\n~
294          or croak "$croak{'print'} UPDATE_CTB";
295        for my $cnt ( 0 .. ( @tag - 1 ) ) {
296            print {UPDATE_CTB} qq~'$tag[$cnt]',"${$updatethread}{$tag[$cnt]}"\n~
297              or croak "$croak{'print'} UPDATE_CTB";
298        }
299        fclose(UPDATE_CTB);
300    }
301    return;
302}
303
304#### USER AND MEMBERSHIP MANAGEMENT ####
305
306sub UserAccount {
307    my ( $user, $action, $pars ) = @_;
308    return if !${ $uid . $user }{'password'};
309
310    if ( $action eq 'update' ) {
311        if ($pars) {
312            foreach ( split /\+/xsm, $pars ) { ${ $uid . $user }{$_} = $date; }
313        }
314        elsif ( $username eq $user ) {
315            ${ $uid . $user }{'lastonline'} = $date;
316        }
317        $userext = 'vars';
318        if ( !exists( ${ $uid . $user }{'reversetopic'} ) ) {
319            ${ $uid . $user }{'reversetopic'} = $ttsreverse;
320        }
321    }
322    elsif ( $action eq 'preregister' ) {
323        $userext = 'pre';
324    }
325    elsif ( $action eq 'register' ) {
326        $userext = 'vars';
327    }
328    elsif ( $action eq 'delete' ) {
329        unlink "$memberdir/$user.vars";
330        return;
331    }
332    else { $userext = 'vars'; }
333
334    # using sequential tag writing as hashes do not sort the way we like them to
335    my @tags =
336      qw(realname password position addgroups email hidemail regdate regtime regreason location bday hideage disableage gender disablegender userpic usertext signature template language stealth webtitle weburl icq aim yim skype myspace facebook twitter youtube msn gtalk timeselect user_tz dynamic_clock postcount lastonline lastpost lastim im_ignorelist im_popup im_imspop pmviewMess notify_me board_notifications thread_notifications favorites buddylist cathide pageindex reversetopic postlayout sesquest sesanswer session lastips onlinealert offlinestatus awaysubj awayreply awayreplysent spamcount spamtime hide_avatars hide_user_text hide_img hide_attach_img hide_signat hide_smilies_row numberformat collapsebdrules return_to);
337
338    if ($extendedprofiles) {
339        require Sources::ExtendedProfiles;
340        push @tags, ext_get_fields_array();
341    }
342    push @tags, 'topicpreview', 'collapsescpoll';
343   ## Mod hook ##
344
345    fopen( UPDATEUSER, ">$memberdir/$user.$userext", 1 )
346      or fatal_error( 'cannot_open', "$memberdir/$user.$userext", 1 );
347    print {UPDATEUSER} "### User variables for ID: $user ###\n\n"
348      or croak "$croak{'print'} UPDATEUSER";
349    for my $cnt ( 0 .. ( @tags - 1 ) ) {
350        print {UPDATEUSER} qq~'$tags[$cnt]',"${$uid.$user}{$tags[$cnt]}"\n~
351          or croak "$croak{'print'} UPDATEUSER";
352    }
353    fclose(UPDATEUSER);
354    return;
355}
356
357sub MemberIndex {
358    my ( $memaction, $user, $mychk ) = @_;
359    if ( $memaction eq 'add' && LoadUser($user) ) {
360        $theregdate = stringtotime( ${ $uid . $user }{'regdate'} );
361        $theregdate = sprintf '%010d', $theregdate;
362        if ( !${ $uid . $user }{'postcount'} ) {
363            ${ $uid . $user }{'postcount'} = 0;
364        }
365        if ( !${ $uid . $user }{'position'} ) {
366            ${ $uid . $user }{'position'} =
367              MemberPostGroup( ${ $uid . $user }{'postcount'} );
368        }
369        ManageMemberlist( 'add', $user, $theregdate );
370        ManageMemberinfo(
371            'add',
372            $user,
373            ${ $uid . $user }{'realname'},
374            ${ $uid . $user }{'email'},
375            ${ $uid . $user }{'position'},
376            ${ $uid . $user }{'postcount'}
377        );
378
379        fopen( TTL, "$memberdir/members.ttl" )
380          or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 );
381        $buffer = <TTL>;
382        fclose(TTL);
383
384        ( $membershiptotal, undef ) = split /\|/xsm, $buffer;
385        $membershiptotal++;
386
387        fopen( TTL, ">$memberdir/members.ttl" )
388          or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 );
389        print {TTL} qq~$membershiptotal|$user~ or croak "$croak{'print'} TTL";
390        fclose(TTL);
391        return 0;
392
393    }
394    elsif ( $memaction eq 'remove' && $user ) {
395        ManageMemberlist( 'delete', $user );
396        ManageMemberinfo( 'delete', $user );
397
398        require Sources::Notify;
399        removeNotifications($user);
400
401        fopen( MEMLIST, "$memberdir/memberlist.txt" )
402          or fatal_error( 'cannot_open', "$memberdir/memberlist.txt", 1 );
403        @memberlt = <MEMLIST>;
404        fclose(MEMLIST);
405
406        my $membershiptotal = @memberlt;
407        my ( $lastuser, undef ) = split /\t/xsm, $memberlt[-1], 2;
408
409        fopen( TTL, ">$memberdir/members.ttl" )
410          or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 );
411        print {TTL} qq~$membershiptotal|$lastuser~
412          or croak "$croak{'print'} TTL";
413        fclose(TTL);
414        return 0;
415
416    }
417    elsif ( ( $memaction eq 'check_exist' || $memaction eq 'who_is' ) && $user ) {
418        ManageMemberinfo('load');
419        while ( ( $curmemb, $value ) = each %memberinf ) {
420            ( $curname, $curmail, $curposition, $curpostcnt ) =
421              split /\|/xsm, $value;
422            if ( $memaction eq 'check_exist') {
423                if ( lc $user eq lc $curmemb && $mychk == 0 ) {
424                    undef %memberinf;
425                    return $curmemb;
426                }
427                elsif ( lc $user eq lc $curmail && $mychk == 2 ) {
428                    undef %memberinf;
429                    return $curmail;
430                }
431                elsif ( lc $user eq lc $curname && $mychk == 1 ) {
432                    undef %memberinf;
433                    return $curname;
434                }
435            }
436            elsif ( $memaction eq 'who_is' && ( lc $user eq lc $curmemb || lc $user eq lc $curmail || ($screenlogin && lc $user eq lc $curname ) ) ) {
437                undef %memberinf;
438                return $curmemb;
439            }
440        }
441    }
442#    return;
443}
444
445sub MemberPostGroup {
446    my ($userpostcnt) = @_;
447    $grtitle = q{};
448    foreach my $postamount ( reverse sort { $a <=> $b } keys %Post ) {
449        if ( $userpostcnt >= $postamount ) {
450            ( $grtitle, undef ) = split /\|/xsm, $Post{$postamount}, 2;
451            last;
452        }
453    }
454    return $grtitle;
455}
456
457sub MembershipCountTotal {
458    fopen( MEMBERLISTREAD, "$memberdir/memberlist.txt" )
459      or fatal_error( 'cannot_open', "$memberdir/memberlist.txt", 1 );
460    my @num = <MEMBERLISTREAD>;
461    fclose(MEMBERLISTREAD);
462    ( $latestmember, $meminfo ) = split /\t/xsm, $num[-1];
463    my $membertotal = @num;
464    undef @num;
465
466    fopen( MEMTTL, ">$memberdir/members.ttl" )
467      or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 );
468    print {MEMTTL} qq~$membertotal|$latestmember~
469      or croak "$croak{'print'} MEMTTL";
470    fclose(MEMTTL);
471
472    if (wantarray) {
473        ManageMemberinfo('load');
474        ( $latestrealname, undef ) =
475          split /\|/xsm, $memberinf{$latestmember}, 2;
476        undef %memberinf;
477        return ( $membertotal, $latestmember, $latestrealname );
478    }
479    else {
480        return $membertotal;
481    }
482}
483
484sub RegApprovalCheck {
485    ## alert admins and gmods of waiting users for approval
486    if (
487        $regtype == 1
488        && (
489            $iamadmin
490            || (   $iamgmod
491                && $allow_gmod_admin eq 'on'
492                && $gmod_access{'view_reglog'} eq 'on' )
493        )
494      )
495    {
496        opendir MEM, "$memberdir";
497        my @approval = ( grep { /.wait$/ixsm } readdir MEM );
498        closedir MEM;
499        my $app_waiting = $#approval + 1;
500        if ( $app_waiting == 1 ) {
501            $yyadmin_alert .=
502qq~<div class="editbg">$reg_txt{'admin_alert_start_one'} $app_waiting $reg_txt{'admin_alert_one'} <a href="$boardurl/AdminIndex.$yyaext?action=view_reglog">$reg_txt{'admin_alert_end'}</a></div>~;
503        }
504        elsif ( $app_waiting > 1 ) {
505            $yyadmin_alert .=
506qq~<div class="editbg">$reg_txt{'admin_alert_start_more'} $app_waiting $reg_txt{'admin_alert_more'} <a href="$boardurl/AdminIndex.$yyaext?action=view_reglog">$reg_txt{'admin_alert_end_more'}</a></div>~;
507        }
508    }
509    ## alert admins and gmods of waiting users for validations
510    if (
511        ( $regtype == 1 || $regtype == 2 )
512        && (
513            $iamadmin
514            || (   $iamgmod
515                && $allow_gmod_admin eq 'on'
516                && $gmod_access{'view_reglog'} eq 'on' )
517        )
518      )
519    {
520        opendir MEM, "$memberdir";
521        my @preregged = ( grep { /.pre$/ixsm } readdir MEM );
522        closedir MEM;
523        my $preregged_waiting = $#preregged + 1;
524        if ( $preregged_waiting == 1 ) {
525            $yyadmin_alert .=
526qq~<div class="editbg">$reg_txt{'admin_alert_start_one'} $preregged_waiting $reg_txt{'admin_alert_act_one'} <a href="$boardurl/AdminIndex.$yyaext?action=view_reglog">$reg_txt{'admin_alert_act_end'}</a></div>~;
527        }
528        elsif ( $preregged_waiting > 1 ) {
529            $yyadmin_alert .=
530qq~<div class="editbg">$reg_txt{'admin_alert_start_more'} $preregged_waiting $reg_txt{'admin_alert_act_more'} <a href="$boardurl/AdminIndex.$yyaext?action=view_reglog">$reg_txt{'admin_alert_act_end_more'}</a></div>~;
531        }
532    }
533    return;
534}
535
536sub activation_check {
537    my ( $changed, $regtime, $regmember );
538    my $timespan = $preregspan * 3600;
539    fopen( INACT, "$memberdir/memberlist.inactive" );
540    my @actlist = <INACT>;
541    fclose(INACT);
542
543    # check if user is in pre-registration and check activation key
544    foreach (@actlist) {
545        ( $regtime, undef, $regmember, undef ) = split /\|/xsm, $_, 4;
546        if ( $date - $regtime > $timespan ) {
547            $changed = 1;
548            unlink "$memberdir/$regmember.pre";
549
550            # add entry to registration log
551            fopen( REGLOG, ">>$vardir/registration.log", 1 );
552            print {REGLOG} "$date|T|$regmember|\n"
553              or croak "$croak{'print'} REGLOG";
554            fclose(REGLOG);
555        }
556        else {
557
558            # update non activate user list
559            # write valid registration to the list again
560            push @outlist, $_;
561        }
562    }
563    if ($changed) {
564
565        # re-open inactive list for update if changed
566        fopen( INACT, ">$memberdir/memberlist.inactive", 1 );
567        print {INACT} @outlist or croak "$croak{'print'} INACT";
568        fclose(INACT);
569    }
570    return;
571}
572
573sub MakeStealthURL {
574
575# Usage is simple - just call MakeStealthURL with any url, and it will stealthify it.
576# if stealth urls are turned off, it just gives you the same value back
577    my ($theurl) = @_;
578    if ($stealthurl) {
579        $theurl =~
580s/([^\w\"\=\[\]]|[\n\b]|\A)\\*(\w+:\/\/[\w\~\.\;\:\,\$\-\+\!\*\?\/\=\&\@\#\%]+\.[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%]+[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%])/$boardurl\/$yyexec.$yyext?action=dereferer;url=$2/isgm;
581        $theurl =~
582s/([^\"\=\[\]\/\:\.(\:\/\/\w+)]|[\n\b]|\A)\\*(www\.[^\.][\w\~\.\;\:\,\$\-\+\!\*\?\/\=\&\@\#\%]+\.[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%]+[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%])/$boardurl\/$yyexec.$yyext?action=dereferer;url=http:\/\/$2/isgm;
583    }
584    return $theurl;
585}
586
587sub arraysort {
588
589    # usage: &arraysort(1,"|","R",@array_to_sort);
590
591    my ( $sortfield, $delimiter, $reverse, @in ) = @_;
592    my ( @out, @sortkey, %newline, $n );
593    foreach my $oldline (@in) {
594        my @sk = split /$delimiter/xsm, $oldline;
595        $sk[$sortfield] =
596          "$sk[$sortfield]-$n";  ## make sure that identical keys are avoided ##
597        $n++;
598        $newline{ $sk[$sortfield] } = $oldline;
599    }
600    @sortkey = sort keys %newline;
601    if ($reverse) {
602        @sortkey = reverse @sortkey;
603    }
604    foreach (@sortkey) {
605        push @out, $newline{$_};
606    }
607    return @out;
608}
609
610sub keygen {
611    ## length = output length, type = A (All), U (Uppercase), L (lowercase) ##
612    my ( $length, $type ) = @_;
613    if ( $length <= 0 || $length > 10_000 || !$length ) { return; }
614    $type = uc $type;
615    if ( $type ne 'A' && $type ne 'U' && $type ne 'L' ) { $type = 'A'; }
616
617    # generate random ID for password reset or other purposes.
618    @chararray =
619      qw(0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z);
620    my $randid;
621    for my $i ( 0 .. ( $length - 1 ) ) {
622        $randid .= $chararray[ int rand 61 ];
623    }
624    if    ( $type eq 'U' ) { return uc $randid; }
625    elsif ( $type eq 'L' ) { return lc $randid; }
626    else                   { return $randid; }
627}
628
629## Sticky Shimmy Shuffle by astro-pilot ##
630## added to core on February 22, 2013 ##
631sub Rearrange_Sticky {
632    my ( $i, $upstky, $downstky, $stkynum, $stky, @stickies, $oldboard );
633    $board     = $INFO{'board'};
634    $stkynum   = $INFO{'num'};
635    $direction = $INFO{'direction'};
636    $oldboard  = $INFO{'oldboard'};
637    fopen( FILE, "$boardsdir/$board.txt" )
638      or fatal_error(
639        "300 $messageindex_txt{'106'}: $messageindex_txt{'23'} $board.txt");
640    @threads = <FILE>;
641    fclose(FILE);
642    my $n = 0;
643
644    foreach (@threads) {
645        my (
646            $mnum,     $msub,      $mname, $memail, $mdate,
647            $mreplies, $musername, $micon, $mstate
648        ) = split /\|/xsm, $_;
649        if ( $mstate =~ /(s|a)/ism && $mnum eq $stkynum ) { $stky = $n; }
650        if ( $mstate =~ /(s|a)/ism ) { push @stickies, $_; $n++; }
651        if ( $mstate =~ /s/ism ) { $_ = q{}; }
652    }
653    if ( $direction eq 'down' && $stky != $#stickies ) {
654        $i = $stky;
655        $i++;
656        $downstky        = $stickies[$stky];
657        $upstky          = $stickies[$i];
658        $stickies[$stky] = $upstky;
659        $stickies[$i]    = $downstky;
660    }
661    if ( $direction eq 'up' && $stky != 0 ) {
662        $i = $stky;
663        $i--;
664        $downstky        = $stickies[$i];
665        $upstky          = $stickies[$stky];
666        $stickies[$i]    = $upstky;
667        $stickies[$stky] = $downstky;
668    }
669    if ($oldboard) { @threads = @stickies; $currentboard = $oldboard; }
670    else           { push @threads, @stickies; }
671    if (   ( $direction ne 'up' || $stky != 0 )
672        && ( $direction ne 'down' || $stky != $#stickies ) )
673    {
674        fopen( FILE, ">$boardsdir/$board.txt" )
675          or fatal_error(
676            "300 $messageindex_txt{'106'}: $messageindex_txt{'23'} $board.txt");
677        foreach (@threads) {
678            chomp $_;
679            next if /^(\s)*$/xsm;
680            print {FILE} "$_\n" or croak "$croak{'print'} FILE";
681        }
682        fclose(FILE);
683    }
684    $yySetLocation = qq~$scripturl?board=$currentboard;~;
685    redirectexit();
686    return;
687}
688## End Sticky Shimmy Shuffle ##
689
6901;
691