App-phoebe

 view release on metacpan or  search on metacpan

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

     $UrlProtocols, $ImageExtensions, $LastUpdate,
     %LockOnCreation, %PlainTextPages, %AdminPages,
     @MyAdminCode, @MyFormChanges, @MyInitVariables, @MyMacros, @MyMaintenance,
     $DocumentHeader, %HtmlEnvironmentContainers, $FS, $Counter, @Debugging);

# Internal variables:
our ($q, $bol, $OpenPageName, %Page, %Translate, %IndexHash, @IndexList,
     @HtmlStack, @HtmlAttrStack, @Blocks, @Flags,
     %Includes, $FootnoteNumber, $CollectingJournal, $HeaderIsPrinted,
     %Locks, $Fragment, $Today, $ModulesDescription, %RssInterwikiTranslate,
     $Message, $Now, %RecentVisitors, %MyInc, $WikiDescription, %InterSite, %OldCookie);

# Can be set outside the script: $DataDir, $UseConfig, $ConfigFile, $ModuleDir,
# $ConfigPage, $AdminPass, $EditPass, $ScriptName, $FullUrl, $RunCGI.

# 1 = load config file in the data directory
our $UseConfig //= 1;

# Main wiki directory
our $DataDir;
$DataDir    ||= decode_utf8($ENV{WikiDataDir}) if $UseConfig;

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

our $RunCGI    //= 1;

# 1 = allow page views using wiki.pl/PageName
our $UsePathInfo = 1;

# -1 = disabled, 0 = 10s; 1 = partial HTML cache; 2 = HTTP/1.1 caching
our $UseCache    = 2;

our $SiteName    = 'Wiki';          # Name of site (used for titles)
our $HomePage    = 'HomePage';      # Home page
our $CookieName  = 'Wiki';          # Name for this wiki (for multi-wiki sites)

our $MaxPost     = 1024 * 210;      # Maximum 210K posts (about 200K for pages)
our $StyleSheet  = '';              # URL for CSS stylesheet (like '/wiki.css')
our $StyleSheetPage = '';           # Page for CSS sheet
our $LogoUrl     = '';              # URL for site logo ('' for no logo)
our $NotFoundPg  = '';              # Page for not-found links ('' for blank pg)

our $EditAllowed = 1;               # 0 = no, 1 = yes, 2 = comments pages only, 3 = comments only
our $AdminPass //= '';              # Whitespace separated passwords.
our $EditPass  //= '';              # Whitespace separated passwords.

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

# 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,

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

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

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

  }
}

sub ReInit {   # init everything we need if we want to link to stuff
  my $id = shift; # when saving a page, what to do depends on the page being saved
  AllPagesList() unless $id;
  InterInit() if $InterMap and (not $id or $id eq $InterMap);
  %RssInterwikiTranslate = () if not $id or $id eq $RssInterwikiTranslate; # special since rarely used
}

sub InitCookie {
  undef $q->{'.cookies'};   # Clear cache if it exists (for SpeedyCGI)
  my $cookie = $q->cookie($CookieName);
  %OldCookie = split(/$FS/, UrlDecode($cookie));
  my %provided = map { $_ => 1 } $q->param;
  for my $key (keys %OldCookie) {
    SetParam($key, $OldCookie{$key}) unless $provided{$key};
  }
  CookieUsernameFix();
  CookieRollbackFix();
}

sub CookieUsernameFix {
  # Only valid usernames get stored in the new cookie.
  my $name = GetParam('username', '');
  $q->delete('username');
  if (not $name) {
    # do nothing
  } elsif ($WikiLinks and not $FreeLinks and $name !~ /^$LinkPattern$/) {
    $Message .= $q->p(Ts('Invalid UserName %s: not saved.', $name));
  } elsif ($FreeLinks and $name !~ /^$FreeLinkPattern$/) {
    $Message .= $q->p(Ts('Invalid UserName %s: not saved.', $name));
  } elsif (length($name) > 50) { # Too long
    $Message .= $q->p(T('UserName must be 50 characters or less: not saved'));
  } else {
    SetParam('username', $name);
  }
}

sub CookieRollbackFix {
  my @rollback = grep(/rollback-(\d+)/, $q->param);
  if (@rollback and $rollback[0] =~ /(\d+)/) {
    SetParam('to', $1);
    $q->delete('action');
    SetParam('action', 'rollback');
  }
}

sub GetParam {
  my ($name, $default) = @_;

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

  my ($action, $name) = @_;
  my ($url, $html);
  if (GetParam('raw', 0)) {
    $html = GetHttpHeader('text/plain');
    $html .= Ts('Please go on to %s.', $action); # no redirect
    return $html;
  }
  $url = $ScriptName . (($UsePathInfo and $action !~ /=/) ? '/' : '?') . $action;
  my $nameLink = $q->a({-href=>$url}, $name);
  my %headers = (-uri=>$url);
  my $cookie = Cookie();
  $headers{-cookie} = $cookie if $cookie;
  return $q->redirect(%headers);
}

sub DoRandom {
  my @pages = AllPagesList();
  ReBrowsePage($pages[int(rand($#pages + 1))]);
}

sub PageFresh { # pages can depend on other pages (ie. last update), admin status, and css
  return 1 if $q->http('HTTP_IF_NONE_MATCH') and GetParam('cache', $UseCache) >= 2
    and $q->http('HTTP_IF_NONE_MATCH') eq PageEtag();
}

sub PageEtag {
  my ($changed, %params) = CookieData();
  return UrlEncode(join($FS, $LastUpdate||$Now, sort(values %params))); # no CTL in field values
}

sub FileFresh { # old files are never stale, current files are stale when the page was modified
  return 1 if $q->http('HTTP_IF_NONE_MATCH') and GetParam('cache', $UseCache) >= 2
    and (GetParam('revision', 0) or $q->http('HTTP_IF_NONE_MATCH') eq $Page{ts});
}

sub BrowseRc {
  my $id = shift;

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

  # situation, cookie parameters can influence the look of the page and we
  # cannot rely on $LastUpdate. HTTP/1.0 clients will ignore etags. See RFC 2616
  # section 13.3.4.
  if (GetParam('cache', $UseCache) >= 2 and $ts ne 'nocache') {
    $headers{'-last-modified'} = TimeToRFC822($ts) if $ts;
    $headers{-etag} = PageEtag();
  }
  $headers{-type} = GetParam('mime-type', $type);
  $headers{-status} = $status if $status;
  $headers{-Content_Encoding} = $encoding if $encoding;
  my $cookie = Cookie();
  $headers{-cookie} = $cookie if $cookie;
  if ($q->request_method() eq 'HEAD') {
    print $q->header(%headers), "\n\n"; # add newlines for FCGI because of exit()
    exit; # total shortcut -- HEAD never expects anything other than the header!
  }
  return $q->header(%headers);
}

sub CookieData {
  my ($changed, %params);
  foreach my $key (keys %CookieParameters) {
    my $default = $CookieParameters{$key};
    my $value = GetParam($key, $default);
    $params{$key} = $value if $value ne $default;
    # The cookie is considered to have changed under the following
    # condition: If the value was already set, and the new value is
    # not the same as the old value, or if there was no old value, and
    # the new value is not the default.
    my $change = (defined $OldCookie{$key} ? ($value ne $OldCookie{$key}) : ($value ne $default));
    $changed = 1 if $change; # note if any parameter changed and needs storing
  }
  return $changed, %params;
}

sub Cookie {
  my ($changed, %params) = CookieData(); # params are URL encoded
  if ($changed) {
    my $cookie = join(UrlEncode($FS), %params); # no CTL in field values
    return $q->cookie(-name=>$CookieName, -value=>$cookie, -expires=>'+2y', secure=>$ENV{'HTTPS'}, httponly=>1);
  }
  return '';
}

sub GetHtmlHeader {   # always HTML!
  my ($title, $id) = @_;
  my $edit_link = $id ? '<link rel="alternate" type="application/wiki" title="'
      . T('Edit this page') . '" href="' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . '" />' : '';
  my $theme = GetParam('theme', 'default');
  return $DocumentHeader

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

    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')) {