Fixed a bunch of stuff

This commit is contained in:
Aleks-Daniel Jakimenko
2015-04-28 00:03:11 +03:00
parent 10ca910c81
commit a615bedccf
19 changed files with 46 additions and 50 deletions

View File

@@ -100,7 +100,7 @@ sub GetBackLink {
our ($BacklinkBanned);
$BacklinkBanned = "HomePage|ScratchPad" if !$BacklinkBanned;
tie my %backhash, 'MLDBM', $backfile, O_CREAT|O_RDWR, 0644 or die "Cannot open file $backfile $!\n";
tie my %backhash, 'MLDBM', $backfile, O_CREAT|O_RDWR, oct(644) or die "Cannot open file $backfile $!\n";
# Search database for matches
while ( my ($source, $hashes) = each %backhash ) {

View File

@@ -183,14 +183,13 @@ sub CreateClusterMap {
sub ClusterMapPrintRcHtml {
my ( @options ) = @_;
my $page = "";
my $cluster = GetParam('rcclusteronly');
if ($cluster ne "") {
CreateClusterMap();
print "Pages in this cluster:";
print "<ul>";
foreach $page (sort keys %{$ClusterMap{$cluster}}) {
foreach my $page (sort keys %{$ClusterMap{$cluster}}) {
my $title = $page;
$title =~ s/_/ /g;
print "<li>" . ScriptLink($page, $title, 'local') . "</li>";

View File

@@ -16,7 +16,7 @@ directory for your Oddmuse Wiki.
=cut
AddModuleDescription('creole.pl', 'Creole Markup Extension');
our ($q, $bol, %InterSite, $FreeLinkPattern, $FullUrlPattern, $FreeLinkPattern, $FreeInterLinkPattern, $InterSitePattern, @MyRules, %RuleOrder, @MyInitVariables, @HtmlStack, @HtmlAttrStack);
our ($q, $bol, %InterSite, $FullUrlPattern, $FreeLinkPattern, $FreeInterLinkPattern, $InterSitePattern, @MyRules, %RuleOrder, @MyInitVariables, @HtmlStack, @HtmlAttrStack);
# ....................{ CONFIGURATION }....................

View File

@@ -245,7 +245,7 @@ sub FootnotesRule {
my $is_adjacent_footnote = defined $3;
# A number range (e.g., "2-5") of references to other footnotes.
if ($footnote_text =~ m/^(\d+)-(\d+)$/co) {
if ($footnote_text =~ m/^(\d+)-(\d+)$/o) {
my ($footnote_number_first, $footnote_number_last) = ($1, $2);
# '&#x2013;', below, is the HTML entity for a Unicode en-dash.
print $q->a({-href=> '#footnotes' .$footnote_number_first,
@@ -258,7 +258,7 @@ sub FootnotesRule {
}, $footnote_number_last.($is_adjacent_footnote ? ', ' : ''));
}
# A number (e.g., "5") implying reference to another footnote.
elsif ($footnote_text =~ m/^(\d+)$/co) {
elsif ($footnote_text =~ m/^(\d+)$/o) {
my $footnote_number = $1;
print $q->a({-href=> '#footnotes' .$footnote_number,
-title=> 'Footnote #'.$footnote_number,
@@ -322,7 +322,7 @@ sub PrintFooterFootnotes {
Prints the list of footnotes.
=cut
sub PrintFootnotes() {
sub PrintFootnotes {
print
$q->start_div({-class=> 'footnotes'})
.$q->h2(T($FootnotesHeaderText));

View File

@@ -90,10 +90,10 @@ sub GitRun {
# read the temporary file with the output
close($fh);
open(STDOUT, ">&", $oldout) or die "Can't dup \$oldout: $!";
open(F, '<', $fh) or die "Can't open temp file for reading: $!";
open(my $F, '<', $fh) or die "Can't open temp file for reading: $!";
local $/ = undef; # Read complete files
$GitResult = <F>;
close(F);
$GitResult = <$F>;
close($F);
} else {
$exitStatus = system($GitBinary, @_);
}

View File

@@ -30,7 +30,7 @@ sub HtmlTemplateLanguage {
my $requested_language = $q->http('Accept-language');
my @languages = split(/ *, */, $requested_language);
my %Lang = ();
foreach $_ (@languages) {
foreach (@languages) {
my $qual = 1;
$qual = $1 if (/q=([0-9.]+)/);
$Lang{$qual} = $1 if (/^([-a-z]+)/);

View File

@@ -78,7 +78,7 @@ sub HoneyPotNewGetFormStart {
$html .= $q->textfield({-name=>$HoneyPotOk, -id=>$HoneyPotOk,
-default=>time,
-size=>40, -maxlength=>250}) if $HoneyPotOk;
$html .= $q->label({-for=>$HoneyPotIdiot1}, 'Leave empty:'), ' ',
$html .= $q->label({-for=>$HoneyPotIdiot1}, 'Leave empty:') . ' ' .
$q->textfield({-name=>$HoneyPotIdiot1, -id=>$HoneyPotIdiot1,
-size=>40, -maxlength=>250}) if $HoneyPotIdiot1;
$html .= $q->textarea(-name=>$HoneyPotIdiot2, -id=>$HoneyPotIdiot2,

View File

@@ -99,7 +99,7 @@ sub HtmlTemplateLanguage {
my $requested_language = $q->http('Accept-language');
my @languages = split(/ *, */, $requested_language);
my %Lang = ();
foreach $_ (@languages) {
foreach (@languages) {
my $qual = 1;
$qual = $1 if (/q=([0-9.]+)/);
$Lang{$qual} = $1 if (/^([-a-z]+)/);

View File

@@ -49,7 +49,7 @@ sub LoadLanguage {
my $requested_language = $q->http('Accept-language');
my @languages = split(/ *, */, $requested_language);
my %Lang = ();
foreach $_ (@languages) {
foreach (@languages) {
my $qual = 1;
$qual = $1 if (/q=([0-9.]+)/);
$Lang{$qual} = $1 if (/^([-a-z]+)/);
@@ -62,7 +62,7 @@ sub LoadLanguage {
# . "Result: "
# . join(', ', map { "$_ ($Lang{$_})" } @prefs))
# . $q->end_html) && exit if GetParam('debug', '');
foreach $_ (@prefs) {
foreach (@prefs) {
last if $Lang{$_} eq 'en'; # the default
my $file = $library{$Lang{$_}};
$file = "$LoadLanguageDir/$file" if defined $LoadLanguageDir;

View File

@@ -313,7 +313,7 @@ sub LocalNamesNewSave {
length(@collection > 1)
? join(', and ',
join(', ', @collection[0 .. $#collection-1]),
@collection[-1])
$collection[-1])
: @collection), 1)
unless $localnames eq $Page{text};
}

View File

@@ -21,7 +21,7 @@ use strict;
AddModuleDescription('login.pl', 'Login Module');
our ($q, %Action, $SiteName, @MyAdminCode, $IndexFile, $DataDir, $FullUrl);
our ($RegistrationForm, $MinimumPasswordLength, $RegistrationsMustBeApproved, $LoginForm, $PasswordFile, $PasswordFileToUse, $PendingPasswordFile, $RequireLoginToEdit, $ConfirmEmailAddress, $UncomfirmedPasswordFile, $EmailSenderAddress, $EmailCommand, $EmailRegExp, $NotifyPendingRegistrations, $EmailConfirmationMessage, $ResetPasswordMessage, $RegistrationForm, $LogoutForm, $ResetForm, $ChangePassForm, $RequireCamelUserName, $UsernameRegExp);
our ($RegistrationForm, $MinimumPasswordLength, $RegistrationsMustBeApproved, $LoginForm, $PasswordFile, $PasswordFileToUse, $PendingPasswordFile, $RequireLoginToEdit, $ConfirmEmailAddress, $UncomfirmedPasswordFile, $EmailSenderAddress, $EmailCommand, $EmailRegExp, $NotifyPendingRegistrations, $EmailConfirmationMessage, $ResetPasswordMessage, $LogoutForm, $ResetForm, $ChangePassForm, $RequireCamelUserName, $UsernameRegExp);
my $EncryptedPassword = "";
@@ -372,7 +372,6 @@ sub AddUser {
my %passwords = ();
my %emails = ();
my $key;
if (open (PASSWD, $FileToUse)) {
while ( <PASSWD> ) {
@@ -388,7 +387,7 @@ sub AddUser {
$emails{$username} = $email;
open (PASSWD, ">$FileToUse");
foreach $key ( sort keys(%passwords)) {
foreach my $key ( sort keys(%passwords)) {
print PASSWD "$key:$passwords{$key}:$emails{$key}\n";
}
close PASSWD;
@@ -515,7 +514,6 @@ sub RemoveUser {
my %passwords = ();
my %emails = ();
my $key;
if (open (PASSWD, $FileToUse)) {
while ( <PASSWD> ) {
@@ -529,7 +527,7 @@ sub RemoveUser {
close PASSWD;
open (PASSWD, ">$FileToUse");
foreach $key ( sort keys(%passwords)) {
foreach my $key ( sort keys(%passwords)) {
print PASSWD "$key:$passwords{$key}:$emails{$key}\n";
}
close PASSWD;
@@ -600,7 +598,6 @@ sub ChangePassword {
my %passwords = ();
my %emails = ();
my $key;
if (open (PASSWD, $PasswordFile)) {
while ( <PASSWD> ) {
@@ -615,7 +612,7 @@ sub ChangePassword {
$passwords{$user} = $hash;
open (PASSWD, ">$PasswordFile");
foreach $key ( sort keys(%passwords)) {
foreach my $key ( sort keys(%passwords)) {
print PASSWD "$key:$passwords{$key}:$emails{$key}\n";
}
close PASSWD;

View File

@@ -123,7 +123,7 @@ sub DoPingbackServer {
if ($res->is_success) {
$out = $res->content;
} else {
$out = $res->status_line, "\n";
$out = $res->status_line . "\n";
}
result('200 OK', 0, "Oddmuse PingbackServer! $id OK");

View File

@@ -63,10 +63,10 @@ sub NewPrivateWikiReadFile {
PrivateWikiInit();
my $file = shift;
utf8::encode($file); # filenames are bytes!
if (open(IN, '<', $file)) {
if (open(my $IN, '<', $file)) {
local $/ = undef; # Read complete files
my $data = <IN>;
close IN;
my $data = <$IN>;
close $IN;
return (1, '') unless $data;
$cipher->set_iv(substr $data, 0, 16);
$data = $cipher->decrypt(substr $data, 16);
@@ -87,13 +87,13 @@ sub NewPrivateWikiWriteStringToFile {
PrivateWikiInit();
my ($file, $string) = @_;
utf8::encode($file);
open(OUT, '>', $file) or ReportError(Ts('Cannot write %s', $file) . ": $!", '500 INTERNAL SERVER ERROR');
open(my $OUT, '>', $file) or ReportError(Ts('Cannot write %s', $file) . ": $!", '500 INTERNAL SERVER ERROR');
utf8::encode($string);
my $iv = $random->random_bytes(16);
$cipher->set_iv($iv);
print OUT $iv;
print OUT $cipher->encrypt(PadTo16Bytes $string);
close(OUT);
print $OUT $iv;
print $OUT $cipher->encrypt(PadTo16Bytes $string);
close($OUT);
}
# TODO is there any better way to append data to encrypted files?
@@ -323,9 +323,9 @@ sub GetRcLines { # starttime, hash of seen pages to use as a second return value
# check the first timestamp in the default file, maybe read old log file
my $filelike = ReadFile($RcFile); # CHANGED
open F, '<:utf8', \$filelike or die $!; # CHANGED
open my $F, '<:encoding(UTF-8)', \$filelike or die $!; # CHANGED
my $line = <F>;
my $line = <$F>;
my ($ts) = split(/$FS/o, $line); # the first timestamp in the regular rc file
if (not $ts or $ts > $starttime) { # we need to read the old rc file, too
push(@result, GetRcLinesFor($RcOldFile, $starttime, \%match, \%following));
@@ -353,9 +353,9 @@ sub GetRcLinesFor {
my @result = ();
my $filelike = ReadFile($file); # CHANGED
open F, '<:utf8', \$filelike or return (); # CHANGED
open my $F, '<:encoding(UTF-8)', \$filelike or return (); # CHANGED
while (my $line = <F>) {
while (my $line = <$F>) {
chomp($line);
my ($ts, $id, $minor, $summary, $host, $username, $revision,
$languages, $cluster) = split(/$FS/o, $line);

View File

@@ -32,7 +32,7 @@ sub NewPrintJournal {
my ($num, $regexp, $mode) = @_;
if (!$CollectingJournal) {
$CollectingJournal = 1;
$regexp = "^\d\d\d\d-\d\d-\d\d" unless $regexp;
$regexp = '^\d\d\d\d-\d\d-\d\d' unless $regexp;
$num = 10 unless $num;
my @pages = (grep(/$regexp/, AllPagesList()));
if (defined &JournalSort) {

View File

@@ -111,9 +111,9 @@ extensions (namely, hibernal) to obtain the title and subtitle for pages.
=cut
sub GetSmartTitles {
my ($title) = $Page{text} =~ m/(?:^|\n)\#TITLE[ \t]+(.*?)\s*\n+/c;
my ($subtitle) = $Page{text} =~ m/(?:^|\n)\#SUBTITLE[ \t]+(.*?)\s*\n+/c;
my ($interlink, $suburl) = $Page{text} =~ m/(?:^|\n)\#SUBURL(:)?[ \t]+(.*?)\s*\n+/c;
my ($title) = $Page{text} =~ m/(?:^|\n)\#TITLE[ \t]+(.*?)\s*\n+/;
my ($subtitle) = $Page{text} =~ m/(?:^|\n)\#SUBTITLE[ \t]+(.*?)\s*\n+/;
my ($interlink, $suburl) = $Page{text} =~ m/(?:^|\n)\#SUBURL(:)?[ \t]+(.*?)\s*\n+/;
return ($title, $subtitle, $suburl, $interlink ? 1 : '');
}

View File

@@ -142,7 +142,7 @@ sub StaticWriteFile {
binmode(F);
StaticFile($id, $mimetype, $data);
} elsif ($html) {
binmode(F, ':utf8');
binmode(F, ':encoding(UTF-8)');
StaticHtml($id);
} else {
print "no data for ";

View File

@@ -41,7 +41,7 @@ sub SyncNewSave {
SyncOldSave(@_);
# %Page is now set, but the reply was not yet sent back to the
# browser
my $id = $OpenPageName;
my $id = $OpenPageName; # TODO masks earlier declaration
my $data = $Page{text};
my $user = $Page{username};
my $summary = $Page{summary};

View File

@@ -207,7 +207,7 @@ sub RunMyRulesToc {
# lookahead expression resembling (?!\s+id=".*?") to work. As such, I
# use a simple negative character class hack. *shrug*
while ($html =~ s~<h([1-6](\s+[^i]\w+\s+=\s+"[^"]")*)>
~<h$1 id="$TocAnchorPrefix$TocHeaderNumber">~cgx) {
~<h$1 id="$TocAnchorPrefix$TocHeaderNumber">~gx) {
$TocHeaderNumber++;
}
}
@@ -231,7 +231,7 @@ sub NewTocApplyRules {
{
local *STDOUT;
open( STDOUT, '>', \$html) or die "Can't open memory file: $!";
binmode STDOUT, ":utf8";
binmode STDOUT, ":encoding(UTF-8)";
($blocks, $flags) = OldTocApplyRules(@_);
close STDOUT;
utf8::decode($blocks);

View File

@@ -72,18 +72,18 @@ for (my $i=0; $q->param("fileToUpload$i"); $i++) {
squeak 'Error: Filename contains invalid characters'; # this should not happen
}
open(LOGFILE, '>>', $logFile) or squeak "$!";
print LOGFILE $q->param("key") . ' ' . $ENV{REMOTE_ADDR} . ' ' . $curFilename . "\n";
close LOGFILE;
open(my $LOGFILE, '>>', $logFile) or squeak "$!";
print $LOGFILE $q->param("key") . ' ' . $ENV{REMOTE_ADDR} . ' ' . $curFilename . "\n";
close $LOGFILE;
my $uploadFileHandle = $q->upload("fileToUpload$i");
open(UPLOADFILE, '>', "$uploadDir/$curFilename") or squeak "$!";
binmode UPLOADFILE;
open($UPLOADFILE, '>', "$uploadDir/$curFilename") or squeak "$!";
binmode $UPLOADFILE;
while (<$uploadFileHandle>) {
print UPLOADFILE;
print $UPLOADFILE;
}
close UPLOADFILE;
close $UPLOADFILE;
if ($q->param("nameOnly")) {
print "$curFilename\n";
} else {