binmode results from the CPAN

binmode

App-Phoebe

view release on metacpan or search on metacpan

our $IndentLimit      = 20;        	# Maximum depth of nested lists
our $CurrentLanguage = 'en';		# Language of error messages etc
our $LanguageLimit     = 3;        	# Number of matches req. for each language
our $JournalLimit    = 200;        	# how many pages can be collected in one go?
our $PageNameLimit   = 120;        	# max length of page name in bytes
$DocumentHeader = "<!DOCTYPE html>\n<html>";
our @MyFooters = (\&GetCommentForm, \&WrapperEnd, \&DefaultFooter);
# Checkboxes at the end of the index.
our @IndexOptions = ();
# Display short comments below the GotoBar for special days
# Example: %SpecialDays = ('1-1' => 'New Year', '1-2' => 'Next Day');
our %SpecialDays = ();
# Replace regular expressions with inlined images
# Example: %Smilies = (":-?D(?=\\W)" => '/pics/grin.png');
our %Smilies = ();
# Detect page languages when saving edits
# Example: %Languages = ('de' => '\b(der|die|das|und|oder)\b');
our %Languages = ();
our @KnownLocks = qw(main diff index merge visitors); # locks to remove
our $LockExpiration = 60; # How long before expirable locks are expired
our %LockExpires = (diff=>1, index=>1, merge=>1, visitors=>1); # locks to expire after some time
our %LockCleaners = (); # What to do if a job under a lock gets a signal like SIGINT. e.g. 'diff' => \&CleanDiff
our %CookieParameters = (username=>'', pwd=>'', homepage=>'', theme=>'', css=>'', msg=>'', lang=>'', embed=>$EmbedWiki,
		     toplinkbar=>$TopLinkBar, topsearchform=>$TopSearchForm, matchingpages=>$MatchingPages, );
our %Action = (rc => \&BrowseRc,               rollback => \&DoRollback,
           browse => \&BrowseResolvedPage, maintain => \&DoMaintain,
           random => \&DoRandom,           pagelock => \&DoPageLock,
           history => \&DoHistory,         editlock => \&DoEditLock,
           edit => \&DoEdit,               version => \&DoShowVersion,
           download => \&DoDownload,       rss => \&DoRss,
           unlock => \&DoUnlock,           password => \&DoPassword,
           index => \&DoIndex,             admin => \&DoAdminPage,
           clear => \&DoClearCache,        debug => \&DoDebug,
           contrib => \&DoContributors,    more => \&DoJournal);
our @MyRules = (\&LinkRules, \&ListRule); # don't set this variable, add to it!
our %RuleOrder = (\&LinkRules => 0, \&ListRule => 0);

# The 'main' program, called at the end of this script file (aka. as handler)
sub DoWikiRequest {
  Init();
  DoSurgeProtection();
  if (not $BannedCanRead and UserIsBanned() and not UserIsEditor()) {
    ReportError(T('Reading not allowed: user, ip, or network is blocked.'), '403 FORBIDDEN',
		0, $q->p(ScriptLink('action=password', T('Login'), 'password')));
  }
  DoBrowseRequest();
}

sub ReportError {   # fatal!
  my ($errmsg, $status, $log, @html) = @_;
  InitRequest(); # make sure we can report errors before InitRequest
  print GetHttpHeader('text/html', 'nocache', $status), GetHtmlHeader(T('Error')),
    $q->start_div({class=>'error'}), $q->h1(QuoteHtml($errmsg)), @html, $q->end_div,
      $q->end_html, "\n\n"; # newlines for FCGI because of exit()
  WriteStringToFile("$TempDir/error", '<body>' . $q->h1("$status $errmsg") . $q->Dump) if $log;
  map { ReleaseLockDir($_); } keys %Locks;
  exit 2;
}

sub Init {
  binmode(STDOUT, ':encoding(UTF-8)'); # this is where the HTML gets printed
  binmode(STDERR, ':encoding(UTF-8)'); # just in case somebody prints debug info to stderr
  InitDirConfig();
  $FS = "\x1e"; # The FS character is the RECORD SEPARATOR control char in ASCII
  $Message = ''; # Warnings and non-fatal errors.
  InitLinkPatterns(); # Link pattern can be changed in config files
  InitModules(); # Modules come first so that users can change module variables in config
  InitConfig(); # Config comes as early as possible; remember $q is not available here
  InitRequest(); # get $q with $MaxPost; set these in the config file
  InitCookie(); # After InitRequest, because $q is used
  InitVariables(); # After config, to change variables, after InitCookie for GetParam
}

sub InitModules {
  if ($UseConfig and $ModuleDir and IsDir($ModuleDir)) {
    foreach my $lib (Glob("$ModuleDir/*.p[ml]")) {
      if (not $MyInc{$lib}) {
	$MyInc{$lib} = 1;   # Cannot use %INC in mod_perl settings
	my $file = encode_utf8($lib);
	do $file;
	$Message .= CGI::p("$lib: $@") if $@; # no $q exists, yet
      }
    }
  }
}

sub InitConfig {
  if ($UseConfig and $ConfigFile and not $INC{$ConfigFile} and IsFile($ConfigFile)) {
    do $ConfigFile; # these options must be set in a wrapper script or via the environment
    $Message .= CGI::p("$ConfigFile: $@") if $@; # remember, no $q exists, yet
  }
  if ($ConfigPage) { # $FS and $MaxPost must be set in config file!
    my ($status, $data) = ReadFile(GetPageFile(FreeToNormal($ConfigPage)));
    my $page = ParseData($data); # before InitVariables so GetPageContent won't work
    eval $page->{text} if $page->{text}; # perlcritic dislikes the use of eval here but we really mean it
    $Message .= CGI::p("$ConfigPage: $@") if $@;
  }
}

sub InitDirConfig {
  $PageDir     = "$DataDir/page";  # Stores page data
  $KeepDir     = "$DataDir/keep";  # Stores kept (old) page data
  $TempDir     = "$DataDir/temp";  # Temporary files and locks
  $LockDir     = "$TempDir/lock";  # DB is locked if this exists
  $NoEditFile  = "$DataDir/noedit"; # Indicates that the site is read-only
  $RcFile      = "$DataDir/rc.log"; # New RecentChanges logfile
  $RcOldFile   = "$DataDir/oldrc.log"; # Old RecentChanges logfile
  $IndexFile   = "$DataDir/pageidx";   # List of all pages
  $VisitorFile = "$DataDir/visitors.log"; # List of recent visitors
  $DeleteFile  = "$DataDir/delete.log"; # Deletion logfile
  $RssDir      = "$DataDir/rss";    # For rss feed cache
  $ConfigFile ||= "$DataDir/config";  # Config file with Perl code to execute
  $ModuleDir  ||= "$DataDir/modules"; # For extensions (ending in .pm or .pl)
}

sub InitRequest { # set up $q
  $CGI::POST_MAX = $MaxPost;
  $q ||= new CGI;
}

sub InitVariables {  # Init global session variables for mod_perl!
  $WikiDescription = $q->p($q->a({-href=>'https://www.oddmuse.org/'}, 'Oddmuse'),

t/oddmuse-wiki.pl view on Meta::CPAN

  }
  print GetEditForm($id, $upload, $oldText, $revision), $q->end_div();
  PrintFooter($id, 'edit');
}

sub GetEditForm {
  my ($page_name, $upload, $oldText, $revision) = @_;
  my $html = GetFormStart(undef, undef, $upload ? 'edit upload' : 'edit text') # protected by questionasker
    .$q->p(GetHiddenValue("title", $page_name),
	   ($revision ? GetHiddenValue('revision', $revision) : ''),
           GetHiddenValue('oldtime', GetParam('oldtime', $Page{ts})), # prefer parameter over actual timestamp
	   ($upload ? GetUpload() : GetTextArea('text', $oldText)));
  my $summary = UnquoteHtml(GetParam('summary', ''))
    || ($Now - $Page{ts} < ($SummaryHours * 3600) ? $Page{summary} : '');
  $html .= $q->p(T('Summary:').$q->br().GetTextArea('summary', $summary, 2))
    .$q->p($q->checkbox(-name=>'recent_edit', -checked=>(GetParam('recent_edit', '') eq 'on'),
                        -label=>T('This change is a minor edit.')));
  $html .= T($EditNote) if $EditNote; # Allow translation
  my $username = GetParam('username', '');
  $html .= $q->p($q->label({-for=>'username'}, T('Username:')).' '
    .$q->textfield(-name=>'username', -id=>'username', -default=>$username,
                   -override=>1, -size=>20, -maxlength=>50))
    .$q->p($q->submit(-name=>'Save', -accesskey=>T('s'), -value=>T('Save')),
           ($upload ? '' : ' ' . $q->submit(-name=>'Preview', -accesskey=>T('p'), -value=>T('Preview'))).
           ' '.$q->submit(-name=>'Cancel', -value=>T('Cancel')));
  if ($upload) {
    $html .= $q->p(ScriptLink('action=edit;upload=0;id=' . UrlEncode($page_name), T('Replace this file with text'),   'upload'));
  } elsif ($UploadAllowed or UserIsAdmin()) {
    $html .= $q->p(ScriptLink('action=edit;upload=1;id=' . UrlEncode($page_name), T('Replace this text with a file'), 'upload'));
  }
  $html .= $q->end_form();
  foreach my $sub (@MyFormChanges) {
    $html = $sub->($html, 'edit', $upload);
  }
  return $html;
}

sub GetTextArea {
  my ($name, $text, $rows) = @_;
  return $q->textarea(-id=>$name, -name=>$name, -default=>$text, -rows=>$rows || 25, -columns=>78, -override=>1);
}

sub GetUpload {
  return T('File to upload:') . ' ' . $q->filefield(-name=>'file', -size=>50, -maxlength=>100);
}

sub DoDownload {
  my $id = shift;
  OpenPage($id) if ValidIdOrDie($id);
  print $q->header(-status=>'304 NOT MODIFIED') and return if FileFresh(); # FileFresh needs an OpenPage!
  my ($revisionPage, $revision) = GetTextRevision(GetParam('revision', '')); # maybe revision reset!
  my $text = $revisionPage->{text};
  if (my ($type, $encoding) = TextIsFile($text)) {
    my ($data) = $text =~ /^[^\n]*\n(.*)/s;
    my %allowed = map {$_ => 1} @UploadTypes;
    if (@UploadTypes and not $allowed{$type}) {
      ReportError(Ts('Files of type %s are not allowed.', $type), '415 UNSUPPORTED MEDIA TYPE');
    }
    print GetHttpHeader($type, $Page{ts}, undef, $encoding);
    require MIME::Base64;
    binmode(STDOUT, ":pop:raw"); # need to pop utf8 for Windows users!?
    print MIME::Base64::decode($data);
  } else {
    print GetHttpHeader('text/plain', $Page{ts});
    print $text;
  }
}

sub DoPassword {
  my $id = shift;
  print GetHeader('', T('Password')), $q->start_div({-class=>'content password'});
  print $q->p(T('Your password is saved in a cookie, if you have cookies enabled. Cookies may get lost if you connect from another machine, from another account, or using another software.'));
  if (not $AdminPass and not $EditPass) {
    print $q->p(T('This site does not use admin or editor passwords.'));
  } else {
    if (UserIsAdmin()) {
      print $q->p(T('You are currently an administrator on this site.'));
    } elsif (UserIsEditor()) {
      print $q->p(T('You are currently an editor on this site.'));
    } else {
      print $q->p(T('You are a normal user on this site.'));
      if (not GetParam('pwd')) {
	print $q->p(T('You do not have a password set.'));
      } else {
	print $q->p(T('Your password does not match any of the administrator or editor passwords.'));
      }
    }
    print GetFormStart(undef, undef, 'password'),
      $q->p(GetHiddenValue('action', 'password'), T('Password:'), ' ',
	    $q->password_field(-name=>'pwd', -size=>20, -maxlength=>64),
	    $q->hidden(-name=>'id', -value=>$id),
	    $q->submit(-name=>'Save', -accesskey=>T('s'), -value=>T('Save'))),
      $q->end_form;
  }
  if ($id) {
    print $q->p(ScriptLink('action=browse;id=' . UrlEncode($id) . ';time=' . time,
			   Ts('Return to %s', NormalToFree($id))));
  }
  print $q->end_div();
  PrintFooter();
}

sub UserIsEditorOrError {
  UserIsEditor()
    or ReportError(T('This operation is restricted to site editors only...'), '403 FORBIDDEN');
  return 1;
}

sub UserIsAdminOrError {
  UserIsAdmin()
    or ReportError(T('This operation is restricted to administrators only...'), '403 FORBIDDEN');
  return 1;
}

sub UserCanEditOrDie {
  my $id = shift;
  ValidIdOrDie($id);
  if (not UserCanEdit($id, 1)) {
    my $rule = UserIsBanned();
    if ($rule) {
      ReportError(T('Edit Denied'), '403 FORBIDDEN', undef,

( run in 0.702 second using v1.01-cache-2.11-cpan-f56aa216473 )