| ############################################################################### |
| ############################################################################### |
| # System.pl # |
| # System.pm # |
| |
| # $Date: 01.05.16 $ # |
| ############################################################################### |
| ############################################################################### |
| # YaBB: Yet another Bulletin Board # |
| # YaBB: Yet another Bulletin Board # |
| # Open-Source Community Software for Webmasters # |
| # Open-Source Community Software for Webmasters # |
| # Version: YaBB 2.5.2 # |
| # Version: YaBB 2.6.12 # |
| # Packaged: October 21, 2012 # |
| # Packaged: January 5, 2016 # |
| # Distributed by: http://www.yabbforum.com # |
| # Distributed by: http://www.yabbforum.com # |
| # =========================================================================== # |
| # =========================================================================== # |
| # Copyright (c) 2000-2012 YaBB (www.yabbforum.com) - All Rights Reserved. # |
| # Copyright (c) 2000-2016 YaBB (www.yabbforum.com) - All Rights Reserved. # |
| # Software by: The YaBB Development Team # |
| # Software by: The YaBB Development Team # |
| # with assistance from the YaBB community. # |
| # with assistance from the YaBB community. # |
| ############################################################################### |
| ############################################################################### |
| |
| use CGI::Carp qw(fatalsToBrowser); |
| |
| our $VERSION = '2.6.12'; |
| |
| |
| $systemplver = 'YaBB 2.5.2 $Revision: 1.0 $'; |
| $systempmver = 'YaBB 2.6.12 $Revision: 1710 $'; |
| |
| |
| sub BoardTotals { |
| sub BoardTotals { |
| my ($testboard, $line, @lines, $updateboard, @boardvars, $tag, $cnt); |
| my ( $job, @updateboards ) = @_; |
| my ($job, @updateboards) = @_; |
| my ( $line, @lines, $updateboard, @boardvars, $cnt ); |
| if (!@updateboards) { @updateboards = @allboards; } |
| if ( !@updateboards ) { @updateboards = @allboards; } |
| chomp(@updateboards); |
| chomp @updateboards; |
| if (@updateboards) { |
| if (@updateboards) { |
| my @tags = qw(board threadcount messagecount lastposttime lastposter lastpostid lastreply lastsubject lasticon lasttopicstate); |
| my @tags = |
| if ($job eq "load") { |
| qw(board threadcount messagecount lastposttime lastposter lastpostid lastreply lastsubject lasticon lasttopicstate); |
| fopen(FORUMTOTALS, "$boardsdir/forum.totals") || &fatal_error('cannot_open', "$boardsdir/forum.totals", 1); |
| if ( $job eq 'load' ) { |
| @lines = <FORUMTOTALS>; |
| fopen( FORUMTOTALS, "$boardsdir/forum.totals" ) |
| fclose(FORUMTOTALS); |
| or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 ); |
| chomp(@lines); |
| @lines = <FORUMTOTALS>; |
| foreach $updateboard (@updateboards) { |
| fclose(FORUMTOTALS); |
| foreach $line (@lines) { |
| chomp @lines; |
| @boardvars = split(/\|/, $line); |
| foreach $updateboard (@updateboards) { |
| if ($boardvars[0] eq $updateboard && exists($board{ $boardvars[0] })) { |
| foreach $line (@lines) { |
| for ($cnt = 1; $cnt < @tags; $cnt++) { |
| @boardvars = split /\|/xsm, $line; |
| ${$uid.$updateboard}{ $tags[$cnt] } = $boardvars[$cnt]; |
| if ( $boardvars[0] eq $updateboard |
| } |
| && exists $board{ $boardvars[0] } ) |
| last; |
| { |
| } |
| for my $cnt ( 1 .. $#tags ) { |
| } |
| ${ $uid . $updateboard }{ $tags[$cnt] } = |
| } |
| $boardvars[$cnt]; |
| |
| } |
| } elsif ($job eq "update") { |
| last; |
| fopen(FORUMTOTALS, "+<$boardsdir/forum.totals") || &fatal_error('cannot_open', "$boardsdir/forum.totals", 1); |
| } |
| @lines = <FORUMTOTALS>; |
| } |
| for ($line = 0; $line < @lines; $line++) { |
| } |
| @boardvars = split(/\|/, $lines[$line]); |
| } |
| if (exists $board{ $boardvars[0] }) { |
| elsif ( $job eq 'update' ) { |
| if ($boardvars[0] eq $updateboards[0]) { |
| fopen( FORUMTOTALS, "<$boardsdir/forum.totals" ) |
| $lines[$line] = "$updateboards[0]|"; |
| or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 ); |
| chomp $boardvars[9]; |
| @lines = <FORUMTOTALS>; |
| for ($cnt = 1; $cnt < @tags; $cnt++) { |
| fclose( FORUMTOTALS ); |
| if (exists(${$uid.$boardvars[0]}{ $tags[$cnt] })) { |
| for $line ( 0 .. ( $#lines ) ) { |
| $lines[$line] .= ${$uid.$boardvars[0]}{ $tags[$cnt] }; |
| @boardvars = split /\|/xsm, $lines[$line]; |
| } else { |
| if ( exists $board{ $boardvars[0] } ) { |
| $lines[$line] .= $boardvars[$cnt]; |
| if ( $boardvars[0] eq $updateboards[0] ) { |
| } |
| $lines[$line] = "$updateboards[0]|"; |
| $lines[$line] .= $cnt < $#tags ? "|" : "\n"; |
| chomp $boardvars[9]; |
| } |
| for my $cnt ( 1 .. $#tags ) { |
| } |
| if ( |
| } else { |
| exists( |
| $lines[$line] = ''; |
| ${ $uid . $boardvars[0] }{ $tags[$cnt] } |
| } |
| ) |
| } |
| ) |
| truncate FORUMTOTALS, 0; |
| { |
| seek FORUMTOTALS, 0, 0; |
| $lines[$line] .= |
| print FORUMTOTALS @lines; |
| ${ $uid . $boardvars[0] }{ $tags[$cnt] }; |
| fclose(FORUMTOTALS); |
| } |
| |
| else { |
| } elsif ($job eq "delete") { |
| $lines[$line] .= $boardvars[$cnt]; |
| fopen(FORUMTOTALS, "+<$boardsdir/forum.totals") || &fatal_error('cannot_open', "$boardsdir/forum.totasl", 1); |
| } |
| @lines = <FORUMTOTALS>; |
| $lines[$line] .= $cnt < $#tags ? q{|} : "\n"; |
| for ($line = 0; $line < @lines; $line++) { |
| } |
| @boardvars = split(/\|/, $lines[$line], 2); |
| } |
| if ($boardvars[0] eq $updateboards[0] || !exists $board{$boardvars[0]}) { |
| } |
| $lines[$line] = ''; |
| else { |
| } |
| $lines[$line] = q{}; |
| } |
| } |
| truncate FORUMTOTALS, 0; |
| } |
| seek FORUMTOTALS, 0, 0; |
| fopen( FORUMTOTALS, ">$boardsdir/forum.totals" ) |
| print FORUMTOTALS @lines; |
| or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 ); |
| fclose(FORUMTOTALS); |
| print {FORUMTOTALS} @lines or croak "$croak{'print'} FORUMTOTALS"; |
| |
| fclose(FORUMTOTALS); |
| } elsif ($job eq "add") { |
| |
| fopen(FORUMTOTALS, ">>$boardsdir/forum.totals") || &fatal_error('cannot_open', "$boardsdir/forum.totals", 1); |
| } |
| foreach (@updateboards) { print FORUMTOTALS "$_|0|0|N/A|N/A||||\n"; } |
| elsif ( $job eq 'delete' ) { |
| fclose(FORUMTOTALS); |
| fopen( FORUMTOTALS, "<$boardsdir/forum.totals" ) |
| } |
| or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 ); |
| } |
| @lines = <FORUMTOTALS>; |
| |
| fclose( FORUMTOTALS ); |
| |
| for my $line ( 0 .. $#lines ) { |
| |
| @boardvars = split /\|/xsm, $lines[$line], 2; |
| |
| if ( $boardvars[0] eq $updateboards[0] |
| |
| || !exists $board{ $boardvars[0] } ) |
| |
| { |
| |
| $lines[$line] = q{}; |
| |
| } |
| |
| } |
| |
| fopen( FORUMTOTALS, ">$boardsdir/forum.totals" ) |
| |
| or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 ); |
| |
| print {FORUMTOTALS} @lines or croak "$croak{'print'} FORUMTOTALS"; |
| |
| fclose(FORUMTOTALS); |
| |
| } |
| |
| elsif ( $job eq 'add' ) { |
| |
| fopen( FORUMTOTALS, ">>$boardsdir/forum.totals" ) |
| |
| or fatal_error( 'cannot_open', "$boardsdir/forum.totals", 1 ); |
| |
| foreach (@updateboards) { |
| |
| print {FORUMTOTALS} "$_|0|0|N/A|N/A||||\n" |
| |
| or croak "$croak{'print'} FORUMTOTALS"; |
| |
| } |
| |
| fclose(FORUMTOTALS); |
| |
| } |
| |
| } |
| |
| return; |
| } |
| } |
| |
| |
| sub BoardCountTotals { |
| sub BoardCountTotals { |
| my $cntboard = $_[0]; |
| my ($cntboard) = @_; |
| unless ($cntboard) { return undef; } |
| if ( !$cntboard ) { return; } |
| my (@threads, $threadcount, $messagecount, $i, $threadline); |
| |
| |
| fopen( BOARD, "$boardsdir/$cntboard.txt" ) |
| fopen(BOARD, "$boardsdir/$cntboard.txt") || &fatal_error('cannot_open', "$boardsdir/$cntboard.txt", 1); |
| or fatal_error( 'cannot_open', "$boardsdir/$cntboard.txt", 1 ); |
| @threads = <BOARD>; |
| my @threads = <BOARD>; |
| fclose(BOARD); |
| fclose(BOARD); |
| $threadcount = @threads; |
| my $threadcount = @threads; |
| $messagecount = $threadcount; |
| my $messagecount = $threadcount; |
| for ($i = 0; $i < @threads; $i++) { |
| for my $i ( 0 .. $#threads ) { |
| @threadline = split(/\|/, $threads[$i]); |
| my @threadline = split /\|/xsm, $threads[$i]; |
| if ($threadline[8] =~ /m/) { |
| if ( $threadline[8] =~ /m/sm ) { |
| $threadcount--; |
| $threadcount--; |
| $messagecount--; |
| $messagecount--; |
| next; |
| next; |
| } |
| } |
| $messagecount += $threadline[5]; |
| $messagecount += $threadline[5]; |
| } |
| } |
| ${$uid.$cntboard}{'threadcount'} = $threadcount; |
| ${ $uid . $cntboard }{'threadcount'} = $threadcount; |
| ${$uid.$cntboard}{'messagecount'} = $messagecount; |
| ${ $uid . $cntboard }{'messagecount'} = $messagecount; |
| &BoardSetLastInfo($cntboard,\@threads); |
| BoardSetLastInfo( $cntboard, \@threads ); |
| |
| return; |
| } |
| } |
| |
| |
| sub BoardSetLastInfo { |
| sub BoardSetLastInfo { |
| my ($setboard,$board_ref) = @_; |
| my ( $setboard, $board_ref ) = @_; |
| my ($lastthread, $lastthreadid, $lastthreadstate, @lastthreadmessages, @lastmessage); |
| my ( $lastthread, $lastthreadid, $lastthreadstate, @lastthreadmessages, |
| |
| @lastmessage ); |
| foreach $lastthread (@$board_ref) { |
| |
| if ($lastthread) { |
| foreach my $lastthread ( @{$board_ref} ) { |
| ($lastthreadid, undef, undef, undef, undef, undef, undef, undef, $lastthreadstate) = split(/\|/, $lastthread); |
| if ($lastthread) { |
| if ($lastthreadstate !~ /m/) { |
| ( |
| chomp $lastthreadstate; |
| $lastthreadid, undef, undef, |
| fopen(FILE, "$datadir/$lastthreadid.txt") || &fatal_error("cannot_open","$datadir/$lastthreadid.txt", 1); |
| undef, undef, undef, |
| @lastthreadmessages = <FILE>; |
| undef, undef, $lastthreadstate |
| fclose(FILE); |
| ) = split /\|/xsm, $lastthread; |
| @lastmessage = split(/\|/, $lastthreadmessages[$#lastthreadmessages], 7); |
| if ( $lastthreadstate !~ /m/sm ) { |
| last; |
| chomp $lastthreadstate; |
| } |
| fopen( FILE, "$datadir/$lastthreadid.txt" ) |
| $lastthreadid = ''; |
| or fatal_error( 'cannot_open', "$datadir/$lastthreadid.txt", |
| } |
| 1 ); |
| } |
| @lastthreadmessages = <FILE>; |
| ${$uid.$setboard}{'lastposttime'} = $lastthreadid ? $lastmessage[3] : 'N/A'; |
| fclose(FILE); |
| ${$uid.$setboard}{'lastposter'} = $lastthreadid ? ($lastmessage[4] eq "Guest" ? "Guest-$lastmessage[1]" : $lastmessage[4]) : 'N/A'; |
| @lastmessage = |
| ${$uid.$setboard}{'lastpostid'} = $lastthreadid ? $lastthreadid : ''; |
| split /\|/xsm, $lastthreadmessages[-1], 7; |
| ${$uid.$setboard}{'lastreply'} = $lastthreadid ? $#lastthreadmessages : ''; |
| last; |
| ${$uid.$setboard}{'lastsubject'} = $lastthreadid ? $lastmessage[0] : ''; |
| } |
| ${$uid.$setboard}{'lasticon'} = $lastthreadid ? $lastmessage[5] : ''; |
| $lastthreadid = q{}; |
| ${$uid.$setboard}{'lasttopicstate'} = ($lastthreadid && $lastthreadstate) ? $lastthreadstate : "0"; |
| } |
| &BoardTotals("update", $setboard); |
| } |
| |
| ${ $uid . $setboard }{'lastposttime'} = |
| |
| $lastthreadid ? $lastmessage[3] : 'N/A'; |
| |
| ${ $uid . $setboard }{'lastposter'} = |
| |
| $lastthreadid |
| |
| ? ( |
| |
| $lastmessage[4] eq 'Guest' ? "Guest-$lastmessage[1]" : $lastmessage[4] ) |
| |
| : 'N/A'; |
| |
| ${ $uid . $setboard }{'lastpostid'} = $lastthreadid ? $lastthreadid : q{}; |
| |
| ${ $uid . $setboard }{'lastreply'} = |
| |
| $lastthreadid ? $#lastthreadmessages : q{}; |
| |
| ${ $uid . $setboard }{'lastsubject'} = |
| |
| $lastthreadid ? $lastmessage[0] : q{}; |
| |
| ${ $uid . $setboard }{'lasticon'} = $lastthreadid ? $lastmessage[5] : q{}; |
| |
| ${ $uid . $setboard }{'lasttopicstate'} = |
| |
| ( $lastthreadid && $lastthreadstate ) ? $lastthreadstate : '0'; |
| |
| BoardTotals( 'update', $setboard ); |
| |
| return; |
| } |
| } |
| |
| |
| #### THREAD MANAGEMENT #### |
| #### THREAD MANAGEMENT #### |
| |
| |
| sub MessageTotals { |
| sub MessageTotals { |
| # usage: &MessageTotals("task",<threadid>) |
| |
| # tasks: update, load, incview, incpost, decpost, recover |
| |
| my ($job,$updatethread) = @_; |
| |
| chomp $updatethread; |
| |
| return if !$updatethread; |
| |
| |
| |
| if ($job eq "update") { |
| |
| if (${$updatethread}{'board'} eq "") { ## load if the variable is not already filled |
| |
| &MessageTotals("load",$updatethread); |
| |
| } |
| |
| |
| |
| } elsif ($job eq "load") { |
| |
| if (${$updatethread}{'board'} ne "") { return; } ## skip load if the variable is already filled |
| |
| fopen(CTB, "$datadir/$updatethread.ctb",1); |
| |
| foreach (<CTB>) { |
| |
| if ($_ =~ /^'(.*?)',"(.*?)"/) { ${$updatethread}{$1} = $2; } |
| |
| } |
| |
| fclose(CTB); |
| |
| @repliers = split(",", ${$updatethread}{'repliers'}); |
| |
| return; |
| |
| |
| |
| } elsif ($job eq "incview") { |
| |
| ${$updatethread}{'views'}++; |
| |
| |
| |
| } elsif ($job eq "incpost") { |
| |
| ${$updatethread}{'replies'}++; |
| |
| |
| |
| } elsif ($job eq "decpost") { |
| |
| ${$updatethread}{'replies'}--; |
| |
| |
| |
| } elsif ($job eq 'recover') { |
| |
| # storing thread status |
| |
| my $threadstatus; |
| |
| my $openboard = ${$updatethread}{'board'}; |
| |
| fopen(TESTBOARD, "$boardsdir/$openboard.txt") || &fatal_error('cannot_open', "$boardsdir/$openboard.txt", 1); |
| |
| while ($ThreadLine = <TESTBOARD>) { |
| |
| if ($updatethread == (split /\|/, $ThreadLine, 2)[0]) { |
| |
| $threadstatus = (split /\|/, $ThreadLine)[8]; |
| |
| chomp $threadstatus; |
| |
| last; |
| |
| } |
| |
| } |
| |
| fclose(TESTBOARD); |
| |
| # storing thread other info |
| |
| fopen(MSG, "$datadir/$updatethread.txt") || &fatal_error('cannot_open', "$datadir/$updatethread.txt", 1); |
| |
| my @threaddata = <MSG>; |
| |
| fclose(MSG); |
| |
| my @lastinfo = split(/\|/, $threaddata[$#threaddata]); |
| |
| my $lastpostdate = sprintf("%010d", $lastinfo[3]); |
| |
| my $lastposter = $lastinfo[4] eq 'Guest' ? qq~Guest-$lastinfo[1]~ : $lastinfo[4]; |
| |
| # rewrite/create a correct thread.ctb |
| |
| ${$updatethread}{'replies'} = $#threaddata; |
| |
| ${$updatethread}{'views'} = ${$updatethread}{'views'} || 0; |
| |
| ${$updatethread}{'lastposter'} = $lastposter; |
| |
| ${$updatethread}{'lastpostdate'} = $lastpostdate; |
| |
| ${$updatethread}{'threadstatus'} = $threadstatus; |
| |
| @repliers = (); |
| |
| |
| |
| } else { |
| |
| return; |
| |
| } |
| |
| |
| |
| ## trap writing false ctb files on forged num= actions ## |
| |
| if (-e "$datadir/$updatethread.txt") { |
| |
| my $format = 'SDT, DD MM YYYY HH:mm:ss zzz'; # The format |
| |
| # Save their old format |
| |
| my $timeformat = ${$uid.$username}{'timeformat'}; |
| |
| my $timeselect = ${$uid.$username}{'timeselect'}; |
| |
| # Override their settings |
| |
| ${$uid.$username}{'timeformat'} = $format; |
| |
| ${$uid.$username}{'timeselect'} = 7; |
| |
| # Do the work |
| |
| my $newtime = &timeformat($date, 1,"rfc"); |
| |
| # And restore their settings |
| |
| ${$uid.$username}{'timeformat'} = $timeformat; |
| |
| ${$uid.$username}{'timeselect'} = $timeselect; |
| |
| |
| |
| ${$updatethread}{'repliers'} = join(",", @repliers); |
| |
| |
| |
| # Changes here on @tag must also be done in Post.pl -> sub Post2 -> my @tag = ... |
| |
| my @tag = qw(board replies views lastposter lastpostdate threadstatus repliers); |
| |
| fopen(UPDATE_CTB, ">$datadir/$updatethread.ctb",1) || &fatal_error('cannot_open', "$datadir/$updatethread.ctb", 1); |
| |
| print UPDATE_CTB qq~### ThreadID: $updatethread, LastModified: $newtime ###\n\n~; |
| |
| for (my $cnt = 0; $cnt < @tag; $cnt++) { |
| |
| print UPDATE_CTB qq~'$tag[$cnt]',"${$updatethread}{$tag[$cnt]}"\n~; |
| |
| } |
| |
| fclose(UPDATE_CTB); |
| |
| } |
| |
| } |
| |
| |
| |
| # NOBODY expects the Spanish Inquisition! |
| # usage: &MessageTotals("task",<threadid>) |
| # - Monty Python |
| # tasks: update, load, incview, incpost, decpost, recover |
| |
| my ( $job, $updatethread ) = @_; |
| |
| chomp $updatethread; |
| |
| if ( !$updatethread ) { return; } |
| |
| |
| |
| if ( $job eq 'update' ) { |
| |
| if ( ${$updatethread}{'board'} eq q{} ) |
| |
| { ## load if the variable is not already filled |
| |
| MessageTotals( 'load', $updatethread ); |
| |
| } |
| |
| } |
| |
| elsif ( $job eq 'load' ) { |
| |
| if ( ${$updatethread}{'board'} ne q{} ) { |
| |
| return; |
| |
| } ## skip load if the variable is already filled |
| |
| fopen( CTB, "$datadir/$updatethread.ctb", 1 ); |
| |
| while ( my $inp = <CTB> ) { |
| |
| if ( $inp =~ /^'(.*?)',"(.*?)"/xsm ) { ${$updatethread}{$1} = $2; } |
| |
| } |
| |
| fclose(CTB); |
| |
| @repliers = split /,/xsm, ${$updatethread}{'repliers'}; |
| |
| return; |
| |
| |
| |
| } |
| |
| elsif ( $job eq 'incview' ) { |
| |
| ${$updatethread}{'views'}++; |
| |
| |
| |
| } |
| |
| elsif ( $job eq 'incpost' ) { |
| |
| ${$updatethread}{'replies'}++; |
| |
| |
| |
| } |
| |
| elsif ( $job eq 'decpost' ) { |
| |
| ${$updatethread}{'replies'}--; |
| |
| |
| |
| } |
| |
| elsif ( $job eq 'recover' ) { |
| |
| |
| |
| # storing thread status |
| |
| my $threadstatus; |
| |
| my $openboard = ${$updatethread}{'board'}; |
| |
| fopen( TESTBOARD, "$boardsdir/$openboard.txt" ) |
| |
| or fatal_error( 'cannot_open', "$boardsdir/$openboard.txt", 1 ); |
| |
| while ( $ThreadLine = <TESTBOARD> ) { |
| |
| if ( $updatethread == ( split /\|/xsm, $ThreadLine, 2 )[0] ) { |
| |
| $threadstatus = ( split /\|/xsm, $ThreadLine )[8]; |
| |
| chomp $threadstatus; |
| |
| last; |
| |
| } |
| |
| } |
| |
| fclose(TESTBOARD); |
| |
| |
| |
| # storing thread other info |
| |
| fopen( MSG, "$datadir/$updatethread.txt" ) |
| |
| or fatal_error( 'cannot_open', "$datadir/$updatethread.txt", 1 ); |
| |
| my @threaddata = <MSG>; |
| |
| fclose(MSG); |
| |
| my @lastinfo = split /\|/xsm, $threaddata[-1]; |
| |
| my $lastpostdate = sprintf '%010d', $lastinfo[3]; |
| |
| my $lastposter = |
| |
| $lastinfo[4] eq 'Guest' ? qq~Guest-$lastinfo[1]~ : $lastinfo[4]; |
| |
| |
| |
| # rewrite/create a correct thread.ctb |
| |
| ${$updatethread}{'replies'} = $#threaddata; |
| |
| ${$updatethread}{'views'} = ${$updatethread}{'views'} || 0; |
| |
| ${$updatethread}{'lastposter'} = $lastposter; |
| |
| ${$updatethread}{'lastpostdate'} = $lastpostdate; |
| |
| ${$updatethread}{'threadstatus'} = $threadstatus; |
| |
| @repliers = (); |
| |
| } |
| |
| else { |
| |
| return; |
| |
| } |
| |
| |
| |
| ## trap writing false ctb files on forged num= actions ## |
| |
| if ( -e "$datadir/$updatethread.txt" ) { |
| |
| my $newtime = ctbtime(); |
| |
| ${$updatethread}{'repliers'} = join q{,}, @repliers; |
| |
| |
| |
| # Changes here on @tag must also be done in Post.pm -> sub Post2 -> my @tag = ... |
| |
| my @tag = |
| |
| qw(board replies views lastposter lastpostdate threadstatus repliers); |
| |
| fopen( UPDATE_CTB, ">$datadir/$updatethread.ctb", 1 ) |
| |
| or fatal_error( 'cannot_open', "$datadir/$updatethread.ctb", 1 ); |
| |
| print {UPDATE_CTB} |
| |
| qq~### ThreadID: $updatethread, LastModified: $newtime ###\n\n~ |
| |
| or croak "$croak{'print'} UPDATE_CTB"; |
| |
| for my $cnt ( 0 .. $#tag ) { |
| |
| print {UPDATE_CTB} qq~'$tag[$cnt]',"${$updatethread}{$tag[$cnt]}"\n~ |
| |
| or croak "$croak{'print'} UPDATE_CTB"; |
| |
| } |
| |
| fclose(UPDATE_CTB); |
| |
| } |
| |
| return; |
| |
| } |
| |
| |
| #### USER AND MEMBERSHIP MANAGEMENT #### |
| #### USER AND MEMBERSHIP MANAGEMENT #### |
| |
| |
| sub UserAccount { |
| sub UserAccount { |
| my ($user, $action, $pars) = @_; |
| my ( $user, $action, $pars ) = @_; |
| return if !${$uid.$user}{'password'}; |
| return if !${ $uid . $user }{'password'}; |
| |
| |
| if ($action eq "update") { |
| if ( $action eq 'update' ) { |
| if ($pars) { |
| if ($pars) { |
| foreach (split(/\+/, $pars)) { ${$uid.$user}{$_} = $date; } |
| foreach ( split /\+/xsm, $pars ) { ${ $uid . $user }{$_} = $date; } |
| } elsif ($username eq $user) { |
| } |
| ${$uid.$user}{'lastonline'} = $date; |
| elsif ( $username eq $user ) { |
| } |
| ${ $uid . $user }{'lastonline'} = $date; |
| $userext = "vars"; |
| } |
| ${$uid.$user}{'reversetopic'} = $ttsreverse unless exists(${$uid.$user}{'reversetopic'}); |
| $userext = 'vars'; |
| } elsif ($action eq "preregister") { |
| if ( !exists( ${ $uid . $user }{'reversetopic'} ) ) { |
| $userext = "pre"; |
| ${ $uid . $user }{'reversetopic'} = $ttsreverse; |
| } elsif ($action eq "register") { |
| } |
| $userext = "vars"; |
| } |
| } elsif ($action eq "delete") { |
| elsif ( $action eq 'preregister' ) { |
| unlink "$memberdir/$user.vars"; |
| $userext = 'pre'; |
| return; |
| } |
| } else { $userext = "vars"; } |
| elsif ( $action eq 'register' ) { |
| |
| $userext = 'vars'; |
| # using sequential tag writing as hashes do not sort the way we like them to |
| } |
| my @tags = qw(realname password position addgroups email hidemail regdate regtime regreason location bday gender userpic usertext signature template language stealth webtitle weburl icq aim yim skype myspace facebook msn gtalk timeselect timeformat timeoffset dsttimeoffset dynamic_clock postcount lastonline lastpost lastim im_ignorelist im_popup im_imspop pmmessprev pmviewMess pmactprev notify_me board_notifications thread_notifications favorites buddylist cathide pageindex reversetopic postlayout sesquest sesanswer session lastips onlinealert offlinestatus awaysubj awayreply awayreplysent spamcount spamtime numberformat); |
| elsif ( $action eq 'delete' ) { |
| if ($extendedprofiles) { |
| unlink "$memberdir/$user.vars"; |
| require "$sourcedir/ExtendedProfiles.pl"; |
| return; |
| push(@tags, &ext_get_fields_array()); |
| } |
| } |
| else { $userext = 'vars'; } |
| fopen(UPDATEUSER, ">$memberdir/$user.$userext",1) || &fatal_error('cannot_open', "$memberdir/$user.$userext", 1); |
| |
| print UPDATEUSER "### User variables for ID: $user ###\n\n"; |
| # using sequential tag writing as hashes do not sort the way we like them to |
| for (my $cnt = 0; $cnt < @tags; $cnt++) { |
| my @tags = |
| print UPDATEUSER qq~'$tags[$cnt]',"${$uid.$user}{$tags[$cnt]}"\n~; |
| 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); |
| } |
| |
| fclose(UPDATEUSER); |
| if ($extendedprofiles) { |
| |
| require Sources::ExtendedProfiles; |
| |
| push @tags, ext_get_fields_array(); |
| |
| } |
| |
| push @tags, 'topicpreview', 'collapsescpoll'; |
| |
| ## Mod hook ## |
| |
| |
| |
| fopen( UPDATEUSER, ">$memberdir/$user.$userext", 1 ) |
| |
| or fatal_error( 'cannot_open', "$memberdir/$user.$userext", 1 ); |
| |
| print {UPDATEUSER} "### User variables for ID: $user ###\n\n" |
| |
| or croak "$croak{'print'} UPDATEUSER"; |
| |
| for my $cnt ( 0 .. $#tags ) { |
| |
| print {UPDATEUSER} qq~'$tags[$cnt]',"${$uid.$user}{$tags[$cnt]}"\n~ |
| |
| or croak "$croak{'print'} UPDATEUSER"; |
| |
| } |
| |
| fclose(UPDATEUSER); |
| |
| return; |
| } |
| } |
| |
| |
| sub MemberIndex { |
| sub MemberIndex { |
| my ($memaction, $user) = @_; |
| my ( $memaction, $user, $mychk ) = @_; |
| if ($memaction eq "add" && &LoadUser($user)) { |
| if ( $memaction eq 'add' && LoadUser($user) ) { |
| $theregdate = &stringtotime(${$uid.$user}{'regdate'}); |
| $theregdate = stringtotime( ${ $uid . $user }{'regdate'} ); |
| $theregdate = sprintf("%010d", $theregdate); |
| $theregdate = sprintf '%010d', $theregdate; |
| if (!${$uid.$user}{'postcount'}) { ${$uid.$user}{'postcount'} = 0; } |
| if ( !${ $uid . $user }{'postcount'} ) { |
| if (!${$uid.$user}{'position'}) { ${$uid.$user}{'position'} = &MemberPostGroup(${$uid.$user}{'postcount'}); } |
| ${ $uid . $user }{'postcount'} = 0; |
| &ManageMemberlist("add", $user, $theregdate); |
| } |
| &ManageMemberinfo("add", $user, ${$uid.$user}{'realname'}, ${$uid.$user}{'email'}, ${$uid.$user}{'position'}, ${$uid.$user}{'postcount'}); |
| if ( !${ $uid . $user }{'position'} ) { |
| |
| ${ $uid . $user }{'position'} = |
| fopen(TTL, "$memberdir/members.ttl") || &fatal_error('cannot_open', "$memberdir/members.ttl", 1); |
| MemberPostGroup( ${ $uid . $user }{'postcount'} ); |
| $buffer = <TTL>; |
| } |
| fclose(TTL); |
| ManageMemberlist( 'add', $user, $theregdate ); |
| |
| ManageMemberinfo( |
| ($membershiptotal, undef) = split(/\|/, $buffer); |
| 'add', |
| $membershiptotal++; |
| $user, |
| |
| ${ $uid . $user }{'realname'}, |
| fopen(TTL, ">$memberdir/members.ttl") || &fatal_error('cannot_open', "$memberdir/members.ttl", 1); |
| ${ $uid . $user }{'email'}, |
| print TTL qq~$membershiptotal|$user~; |
| ${ $uid . $user }{'position'}, |
| fclose(TTL); |
| ${ $uid . $user }{'postcount'} |
| return 0; |
| ); |
| |
| |
| } elsif ($memaction eq "remove" && $user) { |
| fopen( TTL, "$memberdir/members.ttl" ) |
| &ManageMemberlist("delete", $user); |
| or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 ); |
| &ManageMemberinfo("delete", $user); |
| $buffer = <TTL>; |
| |
| fclose(TTL); |
| require "$sourcedir/Notify.pl"; |
| |
| &removeNotifications($user); |
| ( $membershiptotal, undef ) = split /\|/xsm, $buffer; |
| |
| $membershiptotal++; |
| fopen(MEMLIST, "$memberdir/memberlist.txt") || &fatal_error('cannot_open', "$memberdir/memberlist.txt", 1); |
| |
| @memberlt = <MEMLIST>; |
| fopen( TTL, ">$memberdir/members.ttl" ) |
| fclose(MEMLIST); |
| or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 ); |
| |
| print {TTL} qq~$membershiptotal|$user~ or croak "$croak{'print'} TTL"; |
| my $membershiptotal = @memberlt; |
| fclose(TTL); |
| my ($lastuser, undef) = split(/\t/, $memberlt[$#memberlt], 2); |
| return 0; |
| |
| |
| fopen(TTL, ">$memberdir/members.ttl") || &fatal_error('cannot_open', "$memberdir/members.ttl", 1); |
| } |
| print TTL qq~$membershiptotal|$lastuser~; |
| elsif ( $memaction eq 'remove' && $user ) { |
| fclose(TTL); |
| ManageMemberlist( 'delete', $user ); |
| return 0; |
| ManageMemberinfo( 'delete', $user ); |
| |
| |
| } elsif ($memaction eq "check_exist" && $user) { |
| require Sources::Notify; |
| &ManageMemberinfo("load"); |
| removeNotifications($user); |
| while (($curmemb, $value) = each(%memberinf)) { |
| |
| ($curname, $curmail, $curposition, $curpostcnt) = split(/\|/, $value); |
| fopen( MEMLIST, "$memberdir/memberlist.txt" ) |
| if (lc $user eq lc $curmemb) { undef %memberinf; return $curmemb; } |
| or fatal_error( 'cannot_open', "$memberdir/memberlist.txt", 1 ); |
| elsif (lc $user eq lc $curmail) { undef %memberinf; return $curmail; } |
| @memberlt = <MEMLIST>; |
| elsif (lc $user eq lc $curname) { undef %memberinf; return $curname; } |
| fclose(MEMLIST); |
| } |
| |
| |
| my $membershiptotal = @memberlt; |
| } elsif ($memaction eq "who_is" && $user) { |
| my ( $lastuser, undef ) = split /\t/xsm, $memberlt[-1], 2; |
| &ManageMemberinfo("load"); |
| |
| while (($curmemb, $value) = each(%memberinf)) { |
| fopen( TTL, ">$memberdir/members.ttl" ) |
| ($curname, $curmail, $curposition, $curpostcnt) = split(/\|/, $value); |
| or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 ); |
| if (lc $user eq lc $curmemb) { undef %memberinf; return $curmemb; } |
| print {TTL} qq~$membershiptotal|$lastuser~ |
| if (lc $user eq lc $curmail) { undef %memberinf; return $curmemb; } |
| or croak "$croak{'print'} TTL"; |
| elsif (lc $user eq lc $curname) { undef %memberinf; return $curmemb; } |
| fclose(TTL); |
| } |
| return 0; |
| } |
| |
| # if ($memaction eq "rebuild") { ... Deleted! Don't rebuild |
| } |
| # member list here, or you run into browser/server timeout |
| elsif ( ( $memaction eq 'check_exist' || $memaction eq 'who_is' ) && $user ) { |
| # with xx-large forums!!! Use Admin.pl -> sub RebuildMemList instead! |
| ManageMemberinfo('load'); |
| |
| while ( ( $curmemb, $value ) = each %memberinf ) { |
| |
| ( $curname, $curmail, $curposition, $curpostcnt ) = |
| |
| split /\|/xsm, $value; |
| |
| if ( $memaction eq 'check_exist') { |
| |
| if ( lc $user eq lc $curmemb && $mychk == 0 ) { |
| |
| undef %memberinf; |
| |
| return $curmemb; |
| |
| } |
| |
| elsif ( lc $user eq lc $curmail && $mychk == 2 ) { |
| |
| undef %memberinf; |
| |
| return $curmail; |
| |
| } |
| |
| elsif ( lc $user eq lc $curname && $mychk == 1 ) { |
| |
| undef %memberinf; |
| |
| return $curname; |
| |
| } |
| |
| } |
| |
| elsif ( $memaction eq 'who_is' && ( lc $user eq lc $curmemb || lc $user eq lc $curmail || ($screenlogin && lc $user eq lc $curname ) ) ) { |
| |
| undef %memberinf; |
| |
| return $curmemb; |
| |
| } |
| |
| } |
| |
| } |
| |
| # return; |
| } |
| } |
| |
| |
| sub MemberPostGroup { |
| sub MemberPostGroup { |
| $userpostcnt = $_[0]; |
| my ($userpostcnt) = @_; |
| $grtitle = ""; |
| $grtitle = q{}; |
| foreach $postamount (sort { $b <=> $a } keys %Post) { |
| foreach my $postamount ( reverse sort { $a <=> $b } keys %Post ) { |
| if ($userpostcnt >= $postamount) { |
| if ( $userpostcnt >= $postamount ) { |
| ($grtitle, undef) = split(/\|/, $Post{$postamount}, 2); |
| ( $grtitle, undef ) = split /\|/xsm, $Post{$postamount}, 2; |
| last; |
| last; |
| } |
| } |
| } |
| } |
| return $grtitle; |
| return $grtitle; |
| } |
| } |
| |
| |
| sub MembershipCountTotal { |
| sub MembershipCountTotal { |
| fopen(MEMBERLISTREAD, "$memberdir/memberlist.txt") || &fatal_error('cannot_open', "$memberdir/memberlist.txt", 1); |
| fopen( MEMBERLISTREAD, "$memberdir/memberlist.txt" ) |
| my @num = <MEMBERLISTREAD>; |
| or fatal_error( 'cannot_open', "$memberdir/memberlist.txt", 1 ); |
| fclose(MEMBERLISTREAD); |
| my @num = <MEMBERLISTREAD>; |
| ($latestmember, $meminfo) = split(/\t/, $num[$#num]); |
| fclose(MEMBERLISTREAD); |
| my $membertotal = @num; |
| ( $latestmember, $meminfo ) = split /\t/xsm, $num[-1]; |
| undef @num; |
| my $membertotal = @num; |
| |
| undef @num; |
| fopen(MEMTTL, ">$memberdir/members.ttl") || &fatal_error('cannot_open', "$memberdir/members.ttl", 1); |
| |
| print MEMTTL qq~$membertotal|$latestmember~; |
| fopen( MEMTTL, ">$memberdir/members.ttl" ) |
| fclose(MEMTTL); |
| or fatal_error( 'cannot_open', "$memberdir/members.ttl", 1 ); |
| |
| print {MEMTTL} qq~$membertotal|$latestmember~ |
| if (wantarray()) { |
| or croak "$croak{'print'} MEMTTL"; |
| &ManageMemberinfo("load"); |
| fclose(MEMTTL); |
| ($latestrealname, undef) = split(/\|/, $memberinf{$latestmember}, 2); |
| |
| undef %memberinf; |
| if (wantarray) { |
| return ($membertotal, $latestmember, $latestrealname); |
| ManageMemberinfo('load'); |
| } else { |
| ( $latestrealname, undef ) = |
| return $membertotal; |
| split /\|/xsm, $memberinf{$latestmember}, 2; |
| } |
| undef %memberinf; |
| |
| return ( $membertotal, $latestmember, $latestrealname ); |
| |
| } |
| |
| else { |
| |
| return $membertotal; |
| |
| } |
| } |
| } |
| |
| |
| sub RegApprovalCheck { |
| sub RegApprovalCheck { |
| ## alert admins and gmods of waiting users for approval |
| ## alert admins and gmods of waiting users for approval |
| if ($regtype == 1 && ($iamadmin || ($iamgmod && $allow_gmod_admin eq "on" && $gmod_access{'view_reglog'} eq "on"))) { |
| if ( |
| opendir(MEM,"$memberdir"); |
| $regtype == 1 |
| my @approval = (grep /.wait$/i, readdir(MEM)); |
| && ( |
| closedir(MEM); |
| $iamadmin |
| my $app_waiting = $#approval+1; |
| || ( $iamgmod |
| if ($app_waiting == 1) { |
| && $allow_gmod_admin eq 'on' |
| $yyadmin_alert .= qq~<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>~; |
| && $gmod_access{'view_reglog'} eq 'on' ) |
| } elsif ($app_waiting > 1) { |
| ) |
| $yyadmin_alert .= qq~<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>~; |
| ) |
| } |
| { |
| } |
| opendir MEM, "$memberdir"; |
| ## alert admins and gmods of waiting users for validations |
| my @approval = ( grep { /.wait$/ixsm } readdir MEM ); |
| if (($regtype == 1 || $regtype == 2) && ($iamadmin || ($iamgmod && $allow_gmod_admin eq "on" && $gmod_access{'view_reglog'} eq "on"))) { |
| closedir MEM; |
| opendir(MEM,"$memberdir"); |
| my $app_waiting = $#approval + 1; |
| my @preregged = (grep /.pre$/i, readdir(MEM)); |
| if ( $app_waiting == 1 ) { |
| closedir(MEM); |
| $yyadmin_alert .= |
| my $preregged_waiting = $#preregged+1; |
| qq~<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>~; |
| if ($preregged_waiting == 1) { |
| } |
| $yyadmin_alert .= qq~<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>~; |
| elsif ( $app_waiting > 1 ) { |
| } elsif ($preregged_waiting > 1) { |
| $yyadmin_alert .= |
| $yyadmin_alert .= qq~<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>~; |
| qq~<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>~; |
| } |
| } |
| } |
| } |
| |
| ## alert admins and gmods of waiting users for validations |
| |
| if ( |
| |
| ( $regtype == 1 || $regtype == 2 ) |
| |
| && ( |
| |
| $iamadmin |
| |
| || ( $iamgmod |
| |
| && $allow_gmod_admin eq 'on' |
| |
| && $gmod_access{'view_reglog'} eq 'on' ) |
| |
| ) |
| |
| ) |
| |
| { |
| |
| opendir MEM, "$memberdir"; |
| |
| my @preregged = ( grep { /.pre$/ixsm } readdir MEM ); |
| |
| closedir MEM; |
| |
| my $preregged_waiting = $#preregged + 1; |
| |
| if ( $preregged_waiting == 1 ) { |
| |
| $yyadmin_alert .= |
| |
| qq~<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>~; |
| |
| } |
| |
| elsif ( $preregged_waiting > 1 ) { |
| |
| $yyadmin_alert .= |
| |
| qq~<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>~; |
| |
| } |
| |
| } |
| |
| return; |
| } |
| } |
| |
| |
| sub activation_check { |
| sub activation_check { |
| my ($changed,$regtime,$regmember); |
| my ( $changed, $regtime, $regmember ); |
| my $timespan = $preregspan * 3600; |
| my $timespan = $preregspan * 3600; |
| fopen(INACT, "$memberdir/memberlist.inactive"); |
| fopen( INACT, "$memberdir/memberlist.inactive" ); |
| my @actlist = <INACT>; |
| my @actlist = <INACT>; |
| fclose(INACT); |
| fclose(INACT); |
| |
| |
| # check if user is in pre-registration and check activation key |
| # check if user is in pre-registration and check activation key |
| foreach (@actlist) { |
| foreach (@actlist) { |
| ($regtime, undef, $regmember, undef) = split(/\|/, $_, 4); |
| ( $regtime, undef, $regmember, undef ) = split /\|/xsm, $_, 4; |
| if ($date - $regtime > $timespan) { |
| if ( $date - $regtime > $timespan ) { |
| $changed = 1; |
| $changed = 1; |
| unlink "$memberdir/$regmember.pre"; |
| unlink "$memberdir/$regmember.pre"; |
| |
| |
| # add entry to registration log |
| # add entry to registration log |
| fopen(REGLOG, ">>$vardir/registration.log", 1); |
| fopen( REGLOG, ">>$vardir/registration.log", 1 ); |
| print REGLOG "$date|T|$regmember|\n"; |
| print {REGLOG} "$date|T|$regmember|\n" |
| fclose(REGLOG); |
| or croak "$croak{'print'} REGLOG"; |
| } else { |
| fclose(REGLOG); |
| # update non activate user list |
| } |
| # write valid registration to the list again |
| else { |
| push(@outlist, $_); |
| |
| } |
| # update non activate user list |
| } |
| # write valid registration to the list again |
| if ($changed) { |
| push @outlist, $_; |
| # re-open inactive list for update if changed |
| } |
| fopen(INACT, ">$memberdir/memberlist.inactive", 1); |
| } |
| print INACT @outlist; |
| if ($changed) { |
| fclose(INACT); |
| |
| } |
| # re-open inactive list for update if changed |
| |
| fopen( INACT, ">$memberdir/memberlist.inactive", 1 ); |
| |
| print {INACT} @outlist or croak "$croak{'print'} INACT"; |
| |
| fclose(INACT); |
| |
| } |
| |
| return; |
| } |
| } |
| |
| |
| sub MakeStealthURL { |
| sub MakeStealthURL { |
| # Usage is simple - just call MakeStealthURL with any url, and it will stealthify it. |
| |
| # if stealth urls are turned off, it just gives you the same value back |
| # Usage is simple - just call MakeStealthURL with any url, and it will stealthify it. |
| my $theurl = $_[0]; |
| # if stealth urls are turned off, it just gives you the same value back |
| if ($stealthurl) { |
| my ($theurl) = @_; |
| $theurl =~ s~([^\w\"\=\[\]]|[\n\b]|\A)\\*(\w+://[\w\~\.\;\:\,\$\-\+\!\*\?/\=\&\@\#\%]+\.[\w\~\;\:\$\-\+\!\*\?/\=\&\@\#\%]+[\w\~\;\:\$\-\+\!\*\?/\=\&\@\#\%])~$boardurl/$yyexec.$yyext?action=dereferer;url=$2~isg; |
| if ($stealthurl) { |
| $theurl =~ s~([^\"\=\[\]/\:\.(\://\w+)]|[\n\b]|\A)\\*(www\.[^\.][\w\~\.\;\:\,\$\-\+\!\*\?/\=\&\@\#\%]+\.[\w\~\;\:\$\-\+\!\*\?/\=\&\@\#\%]+[\w\~\;\:\$\-\+\!\*\?/\=\&\@\#\%])~$boardurl/$yyexec.$yyext?action=dereferer;url=http://$2~isg; |
| $theurl =~ |
| } |
| s/([^\w\"\=\[\]]|[\n\b]|\A)\\*(\w+:\/\/[\w\~\.\;\:\,\$\-\+\!\*\?\/\=\&\@\#\%]+\.[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%]+[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%])/$boardurl\/$yyexec.$yyext?action=dereferer;url=$2/isgm; |
| $theurl; |
| $theurl =~ |
| |
| s/([^\"\=\[\]\/\:\.(\:\/\/\w+)]|[\n\b]|\A)\\*(www\.[^\.][\w\~\.\;\:\,\$\-\+\!\*\?\/\=\&\@\#\%]+\.[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%]+[\w\~\;\:\$\-\+\!\*\?\/\=\&\@\#\%])/$boardurl\/$yyexec.$yyext?action=dereferer;url=http:\/\/$2/isgm; |
| |
| } |
| |
| return $theurl; |
| } |
| } |
| |
| |
| sub arraysort { |
| sub arraysort { |
| # usage: &arraysort(1,"|","R",@array_to_sort); |
| |
| |
| |
| my ($sortfield, $delimiter, $reverse, @in) = @_; |
| # usage: &arraysort(1,"|","R",@array_to_sort); |
| my (@sk, @out, @sortkey, %newline, $oldline, $n); |
| |
| foreach $oldline (@in) { |
| my ( $sortfield, $delimiter, $reverse, @in ) = @_; |
| @sk = split(/$delimiter/, $oldline); |
| my ( @out, @sortkey, %newline, $n ); |
| $sk[$sortfield] = "$sk[$sortfield]-$n"; ## make sure that identical keys are avoided ## |
| foreach my $oldline (@in) { |
| $n++; |
| my @sk = split /$delimiter/xsm, $oldline; |
| $newline{ $sk[$sortfield] } = $oldline; |
| $sk[$sortfield] = |
| } |
| "$sk[$sortfield]-$n"; ## make sure that identical keys are avoided ## |
| @sortkey = sort keys %newline; |
| $n++; |
| if ($reverse) { |
| $newline{ $sk[$sortfield] } = $oldline; |
| @sortkey = reverse @sortkey; |
| } |
| } |
| @sortkey = sort keys %newline; |
| foreach (@sortkey) { |
| if ($reverse) { |
| push(@out, $newline{$_}); |
| @sortkey = reverse @sortkey; |
| } |
| } |
| return @out; |
| foreach (@sortkey) { |
| |
| push @out, $newline{$_}; |
| |
| } |
| |
| return @out; |
| } |
| } |
| |
| |
| sub keygen { |
| sub keygen { |
| ## length = output length, type = A (All), U (Uppercase), L (lowercase) ## |
| ## length = output length, type = A (All), U (Uppercase), L (lowercase) ## |
| my ($length, $type) = @_; |
| my ( $length, $type ) = @_; |
| if ($length <= 0 || $length > 10000 || !$length) { return; } |
| if ( $length <= 0 || $length > 10_000 || !$length ) { return; } |
| $type = uc($type); |
| $type = uc $type; |
| if ($type ne "A" && $type ne "U" && $type ne "L") { $type = "A"; } |
| if ( $type ne 'A' && $type ne 'U' && $type ne 'L' ) { $type = 'A'; } |
| |
| |
| # generate random ID for password reset or other purposes. |
| # generate random ID for password reset or other purposes. |
| @chararray = 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); |
| @chararray = |
| my $randid; |
| 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); |
| for (my $i; $i < $length; $i++) { |
| my $randid; |
| $randid .= $chararray[int(rand(61))]; |
| for my $i ( 0 .. ( $length - 1 ) ) { |
| } |
| $randid .= $chararray[ int rand 61 ]; |
| if ($type eq "U") { return uc $randid; } |
| } |
| elsif ($type eq "L") { return lc $randid; } |
| if ( $type eq 'U' ) { return uc $randid; } |
| else { return $randid; } |
| elsif ( $type eq 'L' ) { return lc $randid; } |
| |
| else { return $randid; } |
| |
| } |
| |
| |
| |
| ## Sticky Shimmy Shuffle by astro-pilot ## |
| |
| ## added to core on February 22, 2013 ## |
| |
| sub Rearrange_Sticky { |
| |
| my ( $i, $upstky, $downstky, $stkynum, $stky, @stickies, $oldboard ); |
| |
| $board = $INFO{'board'}; |
| |
| $stkynum = $INFO{'num'}; |
| |
| $direction = $INFO{'direction'}; |
| |
| $oldboard = $INFO{'oldboard'}; |
| |
| fopen( FILE, "$boardsdir/$board.txt" ) |
| |
| or fatal_error( |
| |
| "300 $messageindex_txt{'106'}: $messageindex_txt{'23'} $board.txt"); |
| |
| @threads = <FILE>; |
| |
| fclose(FILE); |
| |
| my $n = 0; |
| |
| |
| |
| foreach (@threads) { |
| |
| my ( |
| |
| $mnum, $msub, $mname, $memail, $mdate, |
| |
| $mreplies, $musername, $micon, $mstate |
| |
| ) = split /\|/xsm, $_; |
| |
| if ( $mstate =~ /(s|a)/ism && $mnum eq $stkynum ) { $stky = $n; } |
| |
| if ( $mstate =~ /(s|a)/ism ) { push @stickies, $_; $n++; } |
| |
| if ( $mstate =~ /s/ism ) { $_ = q{}; } |
| |
| } |
| |
| if ( $direction eq 'down' && $stky != $#stickies ) { |
| |
| $i = $stky; |
| |
| $i++; |
| |
| $downstky = $stickies[$stky]; |
| |
| $upstky = $stickies[$i]; |
| |
| $stickies[$stky] = $upstky; |
| |
| $stickies[$i] = $downstky; |
| |
| } |
| |
| if ( $direction eq 'up' && $stky != 0 ) { |
| |
| $i = $stky; |
| |
| $i--; |
| |
| $downstky = $stickies[$i]; |
| |
| $upstky = $stickies[$stky]; |
| |
| $stickies[$i] = $upstky; |
| |
| $stickies[$stky] = $downstky; |
| |
| } |
| |
| if ($oldboard) { @threads = @stickies; $currentboard = $oldboard; } |
| |
| else { push @threads, @stickies; } |
| |
| if ( ( $direction ne 'up' || $stky != 0 ) |
| |
| && ( $direction ne 'down' || $stky != $#stickies ) ) |
| |
| { |
| |
| fopen( FILE, ">$boardsdir/$board.txt" ) |
| |
| or fatal_error( |
| |
| "300 $messageindex_txt{'106'}: $messageindex_txt{'23'} $board.txt"); |
| |
| foreach (@threads) { |
| |
| chomp $_; |
| |
| next if /^(\s)*$/xsm; |
| |
| print {FILE} "$_\n" or croak "$croak{'print'} FILE"; |
| |
| } |
| |
| fclose(FILE); |
| |
| } |
| |
| $yySetLocation = qq~$scripturl?board=$currentboard;~; |
| |
| redirectexit(); |
| |
| return; |
| } |
| } |
| |
| |
| 1; |
| 1; |
| |
| |