# Module of TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2004 Oliver Krueger
# Portions Copyright (C) 2000-2004 Peter Thoeny, peter@thoeny.com
# Portions Copyright (C) 2004 CrawfordCurrie, http://c-dot.co.uk
#
# For licensing info read license.txt file in the TWiki root.
# 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, published at 
# http://www.gnu.org/copyleft/gpl.html

=begin twiki

---+ TWiki::Changes Module

This module implements the changes functionality.

=cut

package TWiki::Changes;
use strict;
use Algorithm::Diff;

use vars qw(
            $cacheRev1webTopic $cacheRev1date $cacheRev1user
           );

# 'Use locale' for internationalisation of Perl sorting and searching - 
# main locale settings are done in TWiki::setupLocale
BEGIN {
    # Do a dynamic 'use locale' for this module
    if( $TWiki::useLocale ) {
        require locale;
        import locale ();
    }
    $cacheRev1webTopic = "";
}

# ===========================
# Normally writes no output, uncomment writeDebug line to get output of all RCS etc command to debug file

=pod

---++ sub handleChanges (  $web, $topic, $args  )

Not yet documented.

=cut

sub handleChanges
{
    my( $theWeb, $theTopic, $theAttributes ) = @_;
    
    my $theWebName         = TWiki::extractNameValuePair( $theAttributes, "web" );
    my $theExcludeTopic    = TWiki::extractNameValuePair( $theAttributes, "excludetopic" ) || " ";
    my $theExcludeWeb      = TWiki::extractNameValuePair( $theAttributes, "excludeweb" ) || "";
    my $theHeader          = TWiki::extractNameValuePair( $theAttributes, "header" ) || undef;
    my $theFormat          = TWiki::extractNameValuePair( $theAttributes, "format" ) || "\$topic";
    my $theFooter          = TWiki::extractNameValuePair( $theAttributes, "footer" ) || "";
    my $theLimit           = TWiki::extractNameValuePair( $theAttributes, "limit" ) || "0";
    my $theHonorDontNotify = TWiki::extractNameValuePair( $theAttributes, "honordontnotify" ) || "on";
    if( $theHonorDontNotify eq "off" ) { $theHonorDontNotify = 0; } else { $theHonorDontNotify = 1; };
    
    my $text = "";    # return value

    ### partly copied from Search.pm

    my @webList = ();

    # Search what webs?  "" current web, list gets the list, all gets all
    if( $theWebName ) {
        foreach my $web ( split( /[\,\s]+/, $theWebName ) ) {
            # the web processing loop filters for valid web names, so don't do it here.

            if( $web =~ /^(all|on)$/i  ) {
                # get list of all webs by scanning $dataDir
                opendir DIR, $TWiki::dataDir;
                my @tmpList = readdir(DIR);
                closedir(DIR);
                @tmpList = sort
                   grep { s#^.+/([^/]+)$#$1# }
                   grep { -d }
                   map  { "$TWiki::dataDir/$_" }
                   grep { ! /^[._]/ } @tmpList;

                   # what that does (looking from the bottom up) is take the file
                   # list, filter out the dot directories and dot files, turn the
                   # list into full paths instead of just file names, filter out
                   # any non-directories, strip the path back off, and sort
                   # whatever was left after all that (which should be merely a
                   # list of directory's names.)

                foreach my $aweb ( @tmpList ) {
                    push( @webList, $aweb ) unless( grep { /^$aweb$/ } @webList );
                }

            } else {
                push( @webList, $web ) unless( grep { /^$web$/ } @webList );
            }
        }

    } else {
        #default to current web
        push @webList, $TWiki::webName;
    };
    ### copy end

    my $count = 0;        # number of topics found
    my %WebBGColor = ();
    my @topicList = ();

    WEBLIST: foreach my $thisWebName ( @webList ) {

        # PTh 03 Nov 2000: Add security check
        $thisWebName =~ s/$TWiki::securityFilter//go;
        $thisWebName =~ /(.*)/;
        $thisWebName = $1;  # untaint variable

        # exclude unwanted webs
        foreach my $excludeweb ( split( /[\,\s]+/, $theExcludeWeb ) ) {
          if ( $excludeweb eq $thisWebName ) { next WEBLIST; };
        };
        
        # can't process what ain't thar
        next unless TWiki::Store::webExists( $thisWebName );

        # remember webbgcolor for each web
        $WebBGColor { $thisWebName } = &TWiki::Prefs::getPreferencesValue( "WEBBGCOLOR", $thisWebName ) || "\#FF00FF";

        my $changes = TWiki::Store::readFile( "$TWiki::dataDir/$thisWebName/.changes" );
        my @bar = ();         # one line in .changes
        my %exclude = ();     # to avoid doubles

        TOPICLIST: foreach( reverse split( /\n/, $changes ) ) {
            @bar = split( /\t/ );
            if( ( ! %exclude ) || ( ! $exclude{ $bar[0] } ) ) {
                next unless ( TWiki::Store::topicExists( $thisWebName, $bar[0] ) );   # maybe a performance luxury
                foreach my $excludetopic ( split( /[\,\s]+/, $theExcludeTopic ) ) {   # exclude unwanted topics
                  if ( $bar[0] =~ m/$excludetopic/ ) { next TOPICLIST; };
                };
                next unless ( $bar[3] );                      # no rev avail (this should not happen, but it does)
                next unless ( not ($theHonorDontNotify && $bar[4]) );
                next unless ( &TWiki::Func::checkAccessPermission( "VIEW", &TWiki::Func::getWikiUserName(), "", $bar[0], $thisWebName ) );
                # checking view permission on a web-level could speed this process

                # I hope, missing rev nums in col3 dont interfere
                # (date, web, topic, user, rev)
                my @topicListItem = ( $bar[2], $thisWebName, $bar[0], $bar[1], $bar[3] );
                
                push @topicList, \@topicListItem;
                $exclude{ $bar[0] } = "1";
                $count += 1;
            }
        }
    }


    # the topics are primarily sorted by web by now
    # sorting it by time
    sub timereverse { $b->[0] <=> $a->[0]; };
    my @sortedTopicList = sort timereverse @topicList;


    my $num = 0; # another counting var
    foreach my $topicListItem ( @sortedTopicList ) {
      next unless (( $theLimit == 0 ) || ($num < $theLimit ));
        my $line = $theFormat;
        my $web = $topicListItem->[1];
        my $topic = $topicListItem->[2];
        my $rev = $topicListItem->[4];

        $line =~ s/\$topic/$topic/gos;              # expand $topic
        $line =~ s/\$web/$web/gos;                  # expand $web
        $line =~ s/\$bgcolor/$WebBGColor{$web}/gos; # expand $bgcolor
        $line =~ s/\$wikiusername/TWiki::userToWikiName($topicListItem->[3])/geos;  # expand $wikiusername
        $line =~ s/\$date/TWiki::formatTime($topicListItem->[0])/geos;  # expand $date
        $line =~ s/\$rev/r1.$rev/gos;               # expand $rev

        # only create summary if necessary
        if( $line =~ m/\$summary/ ) {
            my $asummary = TWiki::Store::readFileHead( "$TWiki::dataDir\/$web\/$topic.txt", 16 );
            $asummary = TWiki::makeTopicSummary( $asummary, $topic, $web );
            # expand $topic
            $line =~ s/\$summary/$asummary/gos;
        }

        # only create diffs if necessary
        if ( $line =~ m/\$diffs(?:\((\d+[cl])\))?/ ) {
            my $fmt = $1 || "120c";
            my $oldRev = $rev - 1;
            my $otext =
              TWiki::Store::readTopicRevision( $web, $topic, $oldRev );
            my $ntext =
              TWiki::Store::readTopic( $web, $topic );
            my $diffs = merge($otext, $ntext, $fmt =~ /c$/ ? "" : "\n");
            if ( $fmt =~ /^(\d+)c$/ ) {
                $diffs =~ s/(.{$1}).*$//;
            } elsif ( $fmt =~ /^(\d+)l$/ ) {
                $diffs =~ s/((?:.*?\n){$1}).*$//;
            }
            $diffs = TWiki::makeTopicSummary( $diffs, $topic, $web );
            $diffs =~ s/\0(\/?(?:ins|del))\0/<$1>/g;
            $line =~ s/\$diffs(?:\(.*?\))?/$diffs/s;
        }

        $text .= "$line \n";
        $num++;
        
    };

    $text = $theHeader . "\n" . $text . $theFooter . "\n";

    # I18N fix
    my $mixedAlpha = $TWiki::regex{mixedAlpha};

    $text =~ s/\$count(\(\))?/$count/gos;         # expand $count
    $text =~ s/\$n\(\)/\n/gos;                    # expand "$n()" to new line
    $text =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos;    # expand "$n" to new line
    $text =~ s/\$quot(\(\))?/\"/gos;              # expand double quote
    $text =~ s/\$percnt(\(\))?/\%/gos;            # expand percent
    $text =~ s/\$dollar(\(\))?/\$/gos;            # expand dollar

    return $text;
}

=pod

---++ sub merge( $a, $b, $sep )

Perform a merge of two versions of the same text, using
HTML tags to mark conflicts.

The granularity of the merge depends on the setting of $sep.
For example, if it is =qr/(\n)/=, a line-by-line merge will be done.
Note that the expression must have parentheses in it, or the
separators will be discarded i.e.
=merge($a, $b, qr/\s+/)=
will _remove_ all whitespace from the output, whereas
=merge($a, $b, qr/(\s+)/)= will retain it.

Where conflicts exist, they are marked using HTML &lt;del> and
&lt;ins> tags. &lt;del> marks content from $a while &lt;ins>
marks content from $b.

Non-conflicting content (insertions from either set) are not
marked.

=cut

sub merge {
    my ( $ia, $ib, $sep ) = @_;

    my @a = split( /($sep)/, $ia );
    my @b = split( /($sep)/, $ib );

    my @out;
    Algorithm::Diff::traverse_balanced( \@a, \@b,
                                        {
                                         MATCH => \&_acceptA,
                                         DISCARD_A => \&_acceptA,
                                         DISCARD_B => \&_acceptB,
                                         CHANGE => \&_change
                                        },
                                        undef,
                                        \@out,
                                        \@a,
                                        \@b );
    return join( "", @out);
}

sub _acceptA {
    my ( $a, $b, $out, $ai, $bi ) = @_;

    push( @$out, $ai->[$a] );
}

sub _acceptB {
    my ( $a, $b, $out, $ai, $bi ) = @_;

    push( @$out, $bi->[$b] );
}

sub _change {
    my ( $a, $b, $out, $ai, $bi ) = @_;

    push( @$out, "\0del\0 $ai->[$a] \0/del\0" );
    push( @$out, "\0ins\0 $bi->[$b] \0/ins\0" );
}

#=========================

1;

# EOF