oddmuse/modules/namespaces.pl

# Copyright (C) 2004, 2005  Alex Schroeder <alex@emacswiki.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
#    Free Software Foundation, Inc.
#    59 Temple Place, Suite 330
#    Boston, MA 02111-1307 USA

$ModulesDescription .= '<p>$Id: namespaces.pl,v 1.14 2005/04/25 21:14:52 as Exp $</p>';

use vars qw($NamespacesMain $NamespacesSelf $NamespaceCurrent $NamespaceRoot);

$NamespacesMain = 'Main'; # to get back to the main namespace
$NamespacesSelf = 'Self'; # for your own namespace
$NamespaceCurrent = '';   # will be automatically set to the current namespace, if any
$NamespaceRoot = '';      # will be automatically set to the original $ScriptName

my $NamespacesInit = 0;

push(@MyInitVariables, \&NamespacesInitVariables);

sub NamespacesInitVariables {
  # Do this before changing the $DataDir and $ScriptName
  if (not $InterSiteInit and !$Monolithic and $UsePathInfo) {
    $InterSite{$NamespacesMain} = $ScriptName . '/';
    foreach my $name (glob("$DataDir/*")) {
      if (-d $name
	  and $name =~ m|/($InterSitePattern)$|
	  and $name ne $NamespacesMain
	  and $name ne $NamespacesSelf) {
	$InterSite{$1} = $ScriptName . '/' . $1 . '/';
      }
    }
  }
  $NamespaceCurrent = '';
  if (($UsePathInfo and not $NamespacesInit
       # make sure ordinary page names are not matched!
       and $q->path_info() =~ m|^/($InterSitePattern)(/.*)?|
       and ($2 or $q->param or $q->keywords)
       and ($1 ne $NamespacesMain)
       and ($1 ne $NamespacesSelf))
      or
      (GetParam('ns', '') =~ m/^($InterSitePattern)$/
       and ($1 ne $NamespacesMain)
       and ($1 ne $NamespacesSelf))) {
    $NamespaceCurrent = $1;
    $NamespacesInit = 1;
    # Change some stuff from the original InitVariables call:
    $SiteName   .= ' ' . $NamespaceCurrent;
    $InterWikiMoniker = $NamespaceCurrent;
    $DataDir    .= '/' . $NamespaceCurrent;
    $PageDir     = "$DataDir/page";
    $KeepDir     = "$DataDir/keep";
    $RefererDir  = "$DataDir/referer";
    $TempDir     = "$DataDir/temp";
    $LockDir     = "$TempDir/lock";
    $NoEditFile  = "$DataDir/noedit";
    $RcFile	 = "$DataDir/rc.log";
    $RcOldFile   = "$DataDir/oldrc.log";
    $IndexFile   = "$DataDir/pageidx";
    $VisitorFile = "$DataDir/visitors.log";
    $PermanentAnchorsFile = "$DataDir/permanentanchors";
    # $ConfigFile -- shared
    # $ModuleDir -- shared
    # $NearDir -- shared
    $NamespaceRoot = $ScriptName;
    $ScriptName .= '/' . $NamespaceCurrent;
    $FullUrl .= '/' . $NamespaceCurrent;
    $WikiDescription .= "<p>Current namespace: $NamespaceCurrent</p>";
    # override LastUpdate
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks)
      = stat($IndexFile);
    $LastUpdate = $mtime;
    CreateDir($DataDir); # Create directory if it doesn't exist
    ReportError(Ts('Could not create %s', $DataDir) . ": $!", '500 INTERNAL SERVER ERROR')
      unless -d $DataDir;
  }
  $InterSite{$NamespacesSelf} = $ScriptName . '?';
}

*OldNamespaceDoRc = *DoRc;
*DoRc = *NewNamespaceDoRc;

sub NewNamespaceDoRc { # Copy of DoRc
  my $GetRC = shift;
  my $showHTML = $GetRC eq \&GetRcHtml; # optimized for HTML
  my $starttime = 0;
  if (GetParam('from', 0)) {
    $starttime = GetParam('from', 0);
  } else {
    $starttime = $Now - GetParam('days', $RcDefault) * 86400; # 24*60*60
  }
  # get the list of rc.log and oldrc.log files we need.  rcoldfiles is
  # a mapping from rcfiles to rcoldfiles.
  my @rcfiles = ();
  my %rcoldfiles = ();
  my %namespaces = ();
  warn "Current NS: $NamespaceCurrent\n";
  if ($NamespaceCurrent) {
    push(@rcfiles, $RcFile);
    $rcoldfiles{$RcFile} = $RcOldFile;
  } else {
    push(@rcfiles, $RcFile);
    $rcoldfiles{$RcFile} = $RcOldFile;
    # get the namespaces from the intermap instead of parsing the
    # directory.  this reduces the chances of getting different
    # results.
    foreach my $site (keys %InterSite) { 
      if ($InterSite{$site} =~ m|^$ScriptName/([^/]*)|) {
	my $ns = $1 or next;
	my $file = "$DataDir/$ns/rc.log";
	push(@rcfiles, $file);
	$namespaces{$file} = $ns;
	$rcoldfiles{$file} = "$DataDir/$ns/oldrc.log";
      }
    }
  }
  warn "Logfiles: @rcfiles\n";
  # now need them line by line, trying to conserve ram instead of
  # optimizing for speed (and slurping them all in).  when opening a
  # rcfile, compare the first timestamp with the starttime.  if any
  # rcfile exists with no timestamp before the starttime, we need to
  # open its rcoldfile.
  @lines = ();
  foreach my $file (@rcfiles) {
    my ($ts, @new) = NamespaceRcLines($file, $starttime, $namespaces{$file});
    push(@lines, @new);
    if (not $ts or $starttime <= $ts) {
      ($ts, @new) = NamespaceRcLines($rcoldfiles{$file}, $starttime, $namespaces{$file});
      push(@lines, @new);
    }
  }
  if (not @lines && $showHTML) {
    print $q->p($q->strong(Ts('No updates since %s', TimeToText($starttime))));
  } else {
    print &$GetRC(@lines);
  }
  print GetFilterForm() if $showHTML;
}

sub NamespaceRcLines {
  my ($file, $starttime, $ns) = @_;
  warn "Reading $file\n";
  open(F,$file) or return (0, ());
  my $line = <F> or return (0, ());
  my ($ts,$id,$rest) = split(/$FS/, $line); # just look at the first element
  my $first = $ts;
  my @result = ();
  while ($ts) {
    # here we add the namespace to the id, but this will never work,
    # we need to fix this later in ScriptLink!
    push(@result, join($FS, $ts, ($ns ? ($ns.'/'.$id) : $id), $rest)) if $ts >= $starttime;
    $line = <F> or last;
    ($ts,$id,$rest) = split(/$FS/, $line); # just look at the first element
  }
  warn "Returning $#result lines\n";
  return ($first, @result);
}

*OldNamespaceScriptLink = *ScriptLink;
*ScriptLink = *NewNamespaceScriptLink;

sub NewNamespaceScriptLink {
  my ($action, @rest) = @_;
  local $ScriptName = $ScriptName;
  if ($action !~ /=/ and $action =~ /(.*?)%2f(.*)/) {
    $ScriptName .= "/$1";
    $action = $2;
  } elsif ($action =~ /(.*=)(.*?)%2f(.*)/) {
    $ScriptName .= '/' . $2;
    $action = $1 . $3;
  }
  return OldNamespaceScriptLink($action, @rest);
}