view release on metacpan or  search on metacpan

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

  # We can use the error message as the HTTP error code
  ReportError(Ts('CGI Internal error: %s', $q->cgi_error), $q->cgi_error) if $q->cgi_error;
  print $q->header(-status=>'304 NOT MODIFIED') and return if PageFresh(); # return value is ignored
  my $id = GetId();
  my $action = lc(GetParam('action', '')); # script?action=foo;id=bar
  $action = 'download' if GetParam('download', '') and not $action; # script/download/id
  if ($Action{$action}) {
    &{$Action{$action}}($id);
  } elsif ($action and defined &MyActions) {
    eval { local $SIG{__DIE__}; MyActions(); };
  } elsif ($action) {
    ReportError(Ts('Invalid action parameter %s', $action), '501 NOT IMPLEMENTED');
  } elsif (GetParam('search', '') ne '') { # allow search for "0"
    SetParam('action', 'search'); # make sure this gets a NOINDEX
    DoSearch();
  } elsif (GetParam('match', '') ne '') {
    SetParam('action', 'index'); # make sure this gets a NOINDEX
    DoIndex();
  } elsif (GetParam('title', '') and not GetParam('Cancel', '')) {
    DoPost(GetParam('title', ''));
  } else {
    BrowseResolvedPage($id || $HomePage);  # default action!
  }
}

sub ValidId { # hack alert: returns error message if invalid, and unfortunately the empty string if valid!
  my $id = FreeToNormal(shift);
  return T('Page name is missing') unless $id;
  require bytes;
  return Ts('Page name is too long: %s', $id) if bytes::length($id) > $PageNameLimit;
  return Ts('Invalid Page %s (must not end with .db)', $id) if $id =~ m|\.db$|;
  return Ts('Invalid Page %s (must not end with .lck)', $id) if $id =~ m|\.lck$|;
  return Ts('Invalid Page %s', $id) if $FreeLinks ? $id !~ m|^$FreeLinkPattern$| : $id !~ m|^$LinkPattern$|;
}

sub ValidIdOrDie {
  my $id = shift;
  my $error = ValidId($id);
  ReportError($error, '400 BAD REQUEST') if $error;
  return 1;
}

sub ResolveId { # return css class, resolved id, title (eg. for popups), exist-or-not
  my $id = shift;
  return ('local', $id, '', 1) if $IndexHash{$id};
  return ('', '', '', '');
}

sub BrowseResolvedPage {
  my $id = FreeToNormal(shift);
  my ($class, $resolved, $title, $exists) = ResolveId($id);
  if ($class and $class eq 'near' and not GetParam('rcclusteronly', 0)) { # nearlink (is url)
    print $q->redirect({-uri=>$resolved});
  } elsif ($class and $class eq 'alias') { # an anchor was found instead of a page
    ReBrowsePage($resolved);
  } elsif (not $resolved and $NotFoundPg and $id !~ /$CommentsPattern/) { # custom page-not-found message
    BrowsePage($NotFoundPg);
  } elsif ($resolved or $id =~ /$CommentsPattern/ and $1 and $IndexHash{$1}) { # an existing page
    BrowsePage(($resolved or $id), GetParam('raw', 0));
  } else {      # new page!
    BrowsePage($id, GetParam('raw', 0), undef, '404 NOT FOUND') if ValidIdOrDie($id);
  }
}

sub NewText { # only if no revision is available
  my $id = shift;
  if ($CommentsPrefix and $id =~ /^($CommentsPrefix)/) {
    return T('There are no comments, yet. Be the first to leave a comment!');
  } elsif ($id eq $HomePage) {
    return T('Welcome!');
  } else {
    return Ts('This page does not exist, but you can %s.',
              '[' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . ' '
              . T('create it now') . ']');
  }
}

sub BrowsePage {
  my ($id, $raw, $comment, $status) = @_;
  OpenPage($id);
  my ($revisionPage, $revision) = GetTextRevision(GetParam('revision', ''));
  my $text    = $revisionPage->{text};
  $text = NewText($id) unless $revision or $Page{revision} or $comment; # new text for new pages
  # handle a single-level redirect
  my $oldId = GetParam('oldid', '');
  if ((substr($text, 0, 10) eq '#REDIRECT ')) {
    if ($oldId) {
      $Message .= $q->p(T('Too many redirections'));
    } elsif ($revision) {
      $Message .= $q->p(T('No redirection for old revisions'));
    } elsif (($FreeLinks and $text =~ /^\#REDIRECT\s+\[\[$FreeLinkPattern\]\]/)
       or ($WikiLinks and $text =~ /^\#REDIRECT\s+$LinkPattern/)) {
      return ReBrowsePage(FreeToNormal($1), $id);
    } else {
      $Message .= $q->p(T('Invalid link pattern for #REDIRECT'));
    }
  }
  # shortcut if we only need the raw text: no caching, no diffs, no html.
  if ($raw) {
    print GetHttpHeader('text/plain', $Page{ts}, $IndexHash{$id} ? undef : '404 NOT FOUND');
    print $Page{ts} . " # Do not delete this line when editing!\n" if $raw == 2;
    print $text;
    return;
  }
  # normal page view
  my $msg = GetParam('msg', '');
  $Message .= $q->p($msg) if $msg; # show message if the page is shown
  SetParam('msg', '');
  print GetHeader($id, NormalToFree($id), $oldId, undef, $status);
  my $showDiff = GetParam('diff', 0);
  if ($UseDiff and $showDiff) {
    PrintHtmlDiff($showDiff, GetParam('diffrevision'), $revisionPage, $Page{revision});
    print $q->hr();
  }
  PrintPageContent($text, $revision, $comment);
  SetParam('rcclusteronly', $id) if FreeToNormal(GetCluster($text)) eq $id; # automatically filter by cluster
  PrintRcHtml($id);
  PrintFooter($id, $revision, $comment, $revisionPage);
}

sub ReBrowsePage {
  my ($id, $oldId) = map { UrlEncode($_); } @_; # encode before printing URL
  if ($oldId) {     # Target of #REDIRECT (loop breaking)
    print GetRedirectPage("action=browse;oldid=$oldId;id=$id", $id);
  } else {
    print GetRedirectPage($id, $id);
  }
}

sub GetRedirectPage {
  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
}