lib/TWiki/UI/Statistics.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
colas@0
     2
#
colas@0
     3
# Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
colas@0
     4
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
colas@0
     5
# are listed in the AUTHORS file in the root of this distribution.
colas@0
     6
# NOTE: Please extend that file, not this notice.
colas@0
     7
#
colas@0
     8
# Additional copyrights apply to some or all of the code in this
colas@0
     9
# file as follows:
colas@0
    10
# Copyright (C) 2002 Richard Donkin, rdonkin@bigfoot.com
colas@0
    11
#
colas@0
    12
# This program is free software; you can redistribute it and/or
colas@0
    13
# modify it under the terms of the GNU General Public License
colas@0
    14
# as published by the Free Software Foundation; either version 2
colas@0
    15
# of the License, or (at your option) any later version. For
colas@0
    16
# more details read LICENSE in the root of this distribution.
colas@0
    17
#
colas@0
    18
# This program is distributed in the hope that it will be useful,
colas@0
    19
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    20
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
colas@0
    21
#
colas@0
    22
# As per the GPL, removal of this notice is prohibited.
colas@0
    23
colas@0
    24
=begin twiki
colas@0
    25
colas@0
    26
---+ package TWiki::UI::Statistics
colas@0
    27
colas@0
    28
Statistics extraction and presentation
colas@0
    29
colas@0
    30
=cut
colas@0
    31
colas@0
    32
package TWiki::UI::Statistics;
colas@0
    33
colas@0
    34
use strict;
colas@0
    35
use Assert;
colas@0
    36
use File::Copy qw(copy);
colas@0
    37
use IO::File;
colas@0
    38
use Error qw( :try );
colas@0
    39
colas@0
    40
require TWiki;
colas@0
    41
require TWiki::Sandbox;
colas@0
    42
colas@0
    43
my $debug = 0;
colas@0
    44
colas@0
    45
BEGIN {
colas@0
    46
    # Do a dynamic 'use locale' for this module
colas@0
    47
    if( $TWiki::cfg{UseLocale} ) {
colas@0
    48
        require locale;
colas@0
    49
        import locale();
colas@0
    50
    }
colas@0
    51
}
colas@0
    52
colas@0
    53
=pod
colas@0
    54
colas@0
    55
---++ StaticMethod statistics( $session )
colas@0
    56
colas@0
    57
=statistics= command handler.
colas@0
    58
This method is designed to be
colas@0
    59
invoked via the =UI::run= method.
colas@0
    60
colas@0
    61
Generate statistics topic.
colas@0
    62
If a web is specified in the session object, generate WebStatistics
colas@0
    63
topic update for that web. Otherwise do it for all webs
colas@0
    64
colas@0
    65
=cut
colas@0
    66
colas@0
    67
sub statistics {
colas@0
    68
    my $session = shift;
colas@0
    69
colas@0
    70
    my $webName = $session->{webName};
colas@0
    71
colas@0
    72
    my $tmp = '';
colas@0
    73
    # web to redirect to after finishing
colas@0
    74
    my $destWeb = $TWiki::cfg{UsersWebName};
colas@0
    75
    my $logDate = $session->{cgiQuery}->param( 'logdate' ) || '';
colas@0
    76
    $logDate =~ s/[^0-9]//g;  # remove all non numerals
colas@0
    77
    $debug = $session->{cgiQuery}->param( 'debug' );
colas@0
    78
colas@0
    79
    unless( $session->inContext( 'command_line' )) {
colas@0
    80
        # running from CGI
colas@0
    81
        print $session->generateHTTPHeaders();
colas@0
    82
        print CGI::start_html(-title=>'TWiki: Create Usage Statistics');
colas@0
    83
    }
colas@0
    84
    # Initial messages
colas@0
    85
    _printMsg( $session, 'TWiki: Create Usage Statistics' );
colas@0
    86
    _printMsg( $session, '!Do not interrupt this script!' );
colas@0
    87
    _printMsg( $session, '(Please wait until page download has finished)' );
colas@0
    88
colas@0
    89
    require TWiki::Time;
colas@0
    90
    unless( $logDate ) {
colas@0
    91
        $logDate =
colas@0
    92
          TWiki::Time::formatTime( time(), '$year$mo', 'servertime' );
colas@0
    93
    }
colas@0
    94
colas@0
    95
    my $logMonth;
colas@0
    96
    my $logYear;
colas@0
    97
    if ( $logDate =~ /^(\d\d\d\d)(\d\d)$/ ) {
colas@0
    98
        $logYear = $1;
colas@0
    99
        $logMonth = $TWiki::Time::ISOMONTH[ ( $2 % 12 ) - 1 ];
colas@0
   100
    } else {
colas@0
   101
        _printMsg( $session, "!Error in date $logDate - must be YYYYMM" );
colas@0
   102
        return;
colas@0
   103
    }
colas@0
   104
colas@0
   105
    my $logMonthYear = "$logMonth $logYear";
colas@0
   106
    _printMsg( $session, "* Statistics for $logMonthYear" );
colas@0
   107
colas@0
   108
    my $logFile = $TWiki::cfg{LogFileName};
colas@0
   109
    $logFile =~ s/%DATE%/$logDate/g;
colas@0
   110
colas@0
   111
    unless( -e $logFile ) {
colas@0
   112
        _printMsg( $session, "!Log file $logFile does not exist; aborting" );
colas@0
   113
        return;
colas@0
   114
    }
colas@0
   115
colas@0
   116
    # Copy the log file to temp file, since analysis could take some time
colas@0
   117
colas@0
   118
    # FIXME move the temp dir stuff to TWiki.cfg
colas@0
   119
    my $tmpDir;
colas@0
   120
    if ( $TWiki::cfg{OS} eq 'UNIX' ) { 
colas@0
   121
        $tmpDir = $ENV{'TEMP'} || "/tmp"; 
colas@0
   122
    } elsif ( $TWiki::cfg{OS} eq 'WINDOWS' ) {
colas@0
   123
        $tmpDir = $ENV{'TEMP'} || "c:/"; 
colas@0
   124
    } else {
colas@0
   125
        # FIXME handle other OSs properly - assume Unix for now.
colas@0
   126
        $tmpDir = "/tmp";
colas@0
   127
    }
colas@0
   128
    my $randNo = int ( rand 1000);	# For mod_perl with threading...
colas@0
   129
    my $tmpFilename = TWiki::Sandbox::untaintUnchecked( "$tmpDir/twiki-stats.$$.$randNo" );
colas@0
   130
colas@0
   131
    File::Copy::copy ($logFile, $tmpFilename)
colas@0
   132
        or throw Error::Simple( 'Cannot backup log file: '.$! );
colas@0
   133
colas@0
   134
    my $TMPFILE = new IO::File;
colas@0
   135
    open $TMPFILE, $tmpFilename
colas@0
   136
      or throw Error::Simple( 'Cannot open backup file: '.$! );
colas@0
   137
colas@0
   138
    # Do a single data collection pass on the temporary copy of logfile,
colas@0
   139
    # then process each web once.
colas@0
   140
    my ($viewRef, $contribRef, $statViewsRef, $statSavesRef, $statUploadsRef) =
colas@0
   141
      _collectLogData( $session, $TMPFILE, $logMonthYear );
colas@0
   142
colas@0
   143
    my @weblist;
colas@0
   144
    my $webSet = TWiki::Sandbox::untaintUnchecked($session->{cgiQuery}->param( 'webs' )) || $session->{requestedWebName};
colas@0
   145
    if( $webSet) {
colas@0
   146
        # do specific webs
colas@0
   147
        push( @weblist, split( /,\s*/, $webSet ));
colas@0
   148
    } else {
colas@0
   149
        # otherwise do all user webs:
colas@0
   150
        @weblist = $session->{store}->getListOfWebs( 'user' );
colas@0
   151
    }
colas@0
   152
    my $firstTime = 1;
colas@0
   153
    foreach my $web ( @weblist ) {
colas@0
   154
        try {
colas@0
   155
            $destWeb = _processWeb( $session,
colas@0
   156
                                $web,
colas@0
   157
                                $logMonthYear,
colas@0
   158
                                $viewRef,
colas@0
   159
                                $contribRef,
colas@0
   160
                                $statViewsRef,
colas@0
   161
                                $statSavesRef,
colas@0
   162
                                $statUploadsRef,
colas@0
   163
                                $firstTime );
colas@0
   164
        } catch TWiki::AccessControlException with  {
colas@0
   165
            _printMsg( $session, '  - ERROR: no permission to CHANGE statistics topic in '.$web);
colas@0
   166
        }
colas@0
   167
        $firstTime = 0;
colas@0
   168
    }
colas@0
   169
colas@0
   170
    close $TMPFILE;		# Shouldn't be necessary with 'my'
colas@0
   171
    unlink $tmpFilename;# FIXME: works on Windows???  Unlink before
colas@0
   172
    # usage to ensure deleted on crash?
colas@0
   173
colas@0
   174
    if( !$session->inContext( 'command_line' ) ) {
colas@0
   175
        $tmp = $TWiki::cfg{Stats}{TopicName};
colas@0
   176
        my $url = $session->getScriptUrl( 0, 'view', $destWeb, $tmp );
colas@0
   177
        _printMsg( $session, '* Go to '
colas@0
   178
                   . CGI::a( { href => $url,
colas@0
   179
                               rel => 'nofollow' }, "$webName.$tmp") );
colas@0
   180
    }
colas@0
   181
    _printMsg( $session, 'End creating usage statistics' );
colas@0
   182
    print CGI::end_html() unless( $session->inContext( 'command_line' ) );
colas@0
   183
}
colas@0
   184
colas@0
   185
# Debug only
colas@0
   186
# Print all entries in a view or contrib hash, sorted by web and item name
colas@0
   187
sub _debugPrintHash {
colas@0
   188
    my ($statsRef) = @_;
colas@0
   189
    # print "Main.WebHome views = " . ${$statsRef}{'Main'}{'WebHome'}."\n";
colas@0
   190
    # print "Main web, TWikiGuest contribs = " . ${$statsRef}{'Main'}{'Main.TWikiGuest'}."\n";
colas@0
   191
    foreach my $web ( sort keys %$statsRef) {
colas@0
   192
        my $count = 0;
colas@0
   193
        print $web,' web:',"\n";
colas@0
   194
        # Get reference to the sub-hash for this web
colas@0
   195
        my $webhashref = ${$statsRef}{$web};
colas@0
   196
		# print 'webhashref is ' . ref ($webhashref) ."\n";
colas@0
   197
        # Items can be topics (for view hash) or users (for contrib hash)
colas@0
   198
        foreach my $item ( sort keys %$webhashref ) {
colas@0
   199
            print "  $item = ",( ${$webhashref}{$item} || 0 ),"\n";
colas@0
   200
            $count += ${$webhashref}{$item};
colas@0
   201
        }
colas@0
   202
        print "  WEB TOTAL = $count\n";
colas@0
   203
    }
colas@0
   204
}
colas@0
   205
colas@0
   206
colas@0
   207
# Process the whole log file and collect information in hash tables.
colas@0
   208
# Must build stats for all webs, to handle case of renames into web
colas@0
   209
# requested for a single-web statistics run.
colas@0
   210
#
colas@0
   211
# Main hash tables are divided by web:
colas@0
   212
#
colas@0
   213
#   $view{$web}{$TopicName} == number of views, by topic
colas@0
   214
#   $contrib{$web}{"Main.".$WikiName} == number of saves/uploads, by user
colas@0
   215
colas@0
   216
sub _collectLogData {
colas@0
   217
    my( $session, $TMPFILE, $theLogMonthYear ) = @_;
colas@0
   218
colas@0
   219
    # Log file format:
colas@0
   220
    # | date | user | op | web.topic | notes | ip |
colas@0
   221
    # date = e.g. 03 Feb 2000 - 02:43
colas@0
   222
    # user = e.g. Main.PeterThoeny
colas@0
   223
    # user = e.g. PeterThoeny
colas@0
   224
    # user = e.g. peter (intranet login)
colas@0
   225
    # web.topic = e.g MyWeb.MyTopic
colas@0
   226
    # notes = e.g. minor
colas@0
   227
    # notes = e.g. not on thursdays
colas@0
   228
    # ip = e.g. 127.0.0.5
colas@0
   229
colas@0
   230
    my %view;		# Hash of hashes, counts topic views by (web, topic)
colas@0
   231
    my %contrib;	# Hash of hashes, counts uploads/saves by (web, user)
colas@0
   232
colas@0
   233
    # Hashes for each type of statistic, one hash entry per web
colas@0
   234
    my %statViews;
colas@0
   235
    my %statSaves;
colas@0
   236
    my %statUploads;
colas@0
   237
    my $users = $session->{users};
colas@0
   238
colas@0
   239
    binmode $TMPFILE;
colas@0
   240
    while ( my $line = <$TMPFILE> ) {
colas@0
   241
        my @fields = split( /\s*\|\s*/, $line );
colas@0
   242
colas@0
   243
        my( $date, $logFileUserName );
colas@0
   244
        while( !$date && scalar( @fields )) {
colas@0
   245
            $date = shift @fields;
colas@0
   246
        }
colas@0
   247
        while( !$logFileUserName && scalar( @fields )) {
colas@0
   248
            $logFileUserName = shift @fields;
colas@0
   249
        }
colas@0
   250
colas@0
   251
        my( $opName, $webTopic, $notes, $ip ) = @fields;
colas@0
   252
colas@0
   253
        # ignore minor changes - not statistically helpful
colas@0
   254
        next if( $notes && $notes =~ /(minor|dontNotify)/ );
colas@0
   255
colas@0
   256
        # ignore searches for now - idea: make a "top search phrase list" 
colas@0
   257
        next if( $opName && $opName =~ /(search)/ );
colas@0
   258
colas@0
   259
        # ignore "renamed web" log lines
colas@0
   260
        next if( $opName && $opName =~ /(renameweb)/ );
colas@0
   261
colas@0
   262
        # ignore "change password" log lines
colas@0
   263
        next if( $opName && $opName =~ /(changepasswd)/ );
colas@0
   264
colas@0
   265
        # .+ is used because topics name can contain stuff like !, (, ), =, -, _ and they should have stats anyway
colas@0
   266
        if( $opName && $webTopic =~ /(^$TWiki::regex{webNameRegex})\.($TWiki::regex{wikiWordRegex}$|$TWiki::regex{abbrevRegex}|.+)/ ) {
colas@0
   267
            my $webName = $1;
colas@0
   268
            my $topicName = $2;
colas@0
   269
colas@0
   270
            if( $opName eq 'view' ) {
colas@0
   271
	    	next if ($topicName eq 'WebRss');
colas@0
   272
	    	next if ($topicName eq 'WebAtom');
colas@0
   273
                $statViews{$webName}++;
colas@0
   274
                unless( $notes && $notes =~ /\(not exist\)/ ) {
colas@0
   275
                    $view{$webName}{$topicName}++;
colas@0
   276
                }
colas@0
   277
colas@0
   278
            } elsif( $opName eq 'save' ) {
colas@0
   279
                $statSaves{$webName}++;
colas@0
   280
                $contrib{$webName}{$users->webDotWikiName($logFileUserName)}++;
colas@0
   281
colas@0
   282
            } elsif( $opName eq 'upload' ) {
colas@0
   283
                $statUploads{$webName}++;
colas@0
   284
                $contrib{$webName}{$users->webDotWikiName($logFileUserName)}++;
colas@0
   285
colas@0
   286
            } elsif( $opName eq 'rename' ) {
colas@0
   287
                # Pick up the old and new topic names
colas@0
   288
                $notes =~/moved to ($TWiki::regex{webNameRegex})\.($TWiki::regex{wikiWordRegex}|$TWiki::regex{abbrevRegex}|\w+)/o;
colas@0
   289
                my $newTopicWeb = $1;
colas@0
   290
                my $newTopicName = $2;
colas@0
   291
colas@0
   292
                # Get number of views for old topic this month (may be zero)
colas@0
   293
                my $oldViews = $view{$webName}{$topicName} || 0;
colas@0
   294
colas@0
   295
                # Transfer views from old to new topic
colas@0
   296
                $view{$newTopicWeb}{$newTopicName} = $oldViews;
colas@0
   297
                delete $view{$webName}{$topicName};
colas@0
   298
colas@0
   299
                # Transfer views from old to new web
colas@0
   300
                if ( $newTopicWeb ne $webName ) {
colas@0
   301
                    $statViews{$webName} -= $oldViews;
colas@0
   302
                    $statViews{$newTopicWeb} += $oldViews;
colas@0
   303
                }
colas@0
   304
            }
colas@0
   305
        } else {
colas@0
   306
            $session->writeDebug('WebStatistics: Bad logfile line '.$line);
colas@0
   307
        }
colas@0
   308
    }
colas@0
   309
colas@0
   310
    return \%view, \%contrib, \%statViews, \%statSaves, \%statUploads;
colas@0
   311
}
colas@0
   312
colas@0
   313
sub _processWeb {
colas@0
   314
    my( $session, $web, $theLogMonthYear, $viewRef, $contribRef,
colas@0
   315
        $statViewsRef, $statSavesRef, $statUploadsRef, $isFirstTime ) = @_;
colas@0
   316
colas@0
   317
    my( $topic, $user ) = ( $session->{topicName}, $session->{user} );
colas@0
   318
colas@0
   319
    if( $isFirstTime ) {
colas@0
   320
        _printMsg( $session, '* Executed by '.$user );
colas@0
   321
    }
colas@0
   322
colas@0
   323
    _printMsg( $session, "* Reporting on $web web" );
colas@0
   324
colas@0
   325
    # Handle null values, print summary message to browser/stdout
colas@0
   326
    my $statViews = $statViewsRef->{$web};
colas@0
   327
    my $statSaves = $statSavesRef->{$web};
colas@0
   328
    my $statUploads = $statUploadsRef->{$web};
colas@0
   329
    $statViews ||= 0;
colas@0
   330
    $statSaves ||= 0;
colas@0
   331
    $statUploads ||= 0;
colas@0
   332
    _printMsg( $session, "  - view: $statViews, save: $statSaves, upload: $statUploads" );
colas@0
   333
colas@0
   334
    
colas@0
   335
    # Get the top N views and contribs in this web
colas@0
   336
    my (@topViews) = _getTopList( $TWiki::cfg{Stats}{TopViews}, $web, $viewRef );
colas@0
   337
    my (@topContribs) = _getTopList( $TWiki::cfg{Stats}{TopContrib}, $web, $contribRef );
colas@0
   338
colas@0
   339
    # Print information to stdout
colas@0
   340
    my $statTopViews = '';
colas@0
   341
    my $statTopContributors = '';
colas@0
   342
    if( @topViews ) {
colas@0
   343
        $statTopViews = join( CGI::br(), @topViews );
colas@0
   344
        $topViews[0] =~ s/[\[\]]*//g;
colas@0
   345
        _printMsg( $session, '  - top view: '.$topViews[0] );
colas@0
   346
    }
colas@0
   347
    if( @topContribs ) {
colas@0
   348
        $statTopContributors = join( CGI::br(), @topContribs );
colas@0
   349
        _printMsg( $session, '  - top contributor: '.$topContribs[0] );
colas@0
   350
    }
colas@0
   351
colas@0
   352
    # Update the WebStatistics topic
colas@0
   353
colas@0
   354
    my $tmp;
colas@0
   355
    my $statsTopic = $TWiki::cfg{Stats}{TopicName};
colas@0
   356
    # DEBUG
colas@0
   357
    # $statsTopic = 'TestStatistics';		# Create this by hand
colas@0
   358
    if( $session->{store}->topicExists( $web, $statsTopic ) ) {
colas@0
   359
        my( $meta, $text ) =
colas@0
   360
          $session->{store}->readTopic( undef, $web, $statsTopic, undef );
colas@0
   361
        my @lines = split( /\r?\n/, $text );
colas@0
   362
        my $statLine;
colas@0
   363
        my $idxStat = -1;
colas@0
   364
        my $idxTmpl = -1;
colas@0
   365
        for( my $x = 0; $x < @lines; $x++ ) {
colas@0
   366
            $tmp = $lines[$x];
colas@0
   367
            # Check for existing line for this month+year
colas@0
   368
            if( $tmp =~ /$theLogMonthYear/ ) {
colas@0
   369
                $idxStat = $x;
colas@0
   370
            } elsif( $tmp =~ /<\!\-\-statDate\-\->/ ) {
colas@0
   371
                $statLine = $tmp;
colas@0
   372
                $idxTmpl = $x;
colas@0
   373
            }
colas@0
   374
        }
colas@0
   375
        if( ! $statLine ) {
colas@0
   376
            $statLine = '| <!--statDate--> | <!--statViews--> | <!--statSaves--> | <!--statUploads--> | <!--statTopViews--> | <!--statTopContributors--> |';
colas@0
   377
        }
colas@0
   378
        $statLine =~ s/<\!\-\-statDate\-\->/$theLogMonthYear/;
colas@0
   379
        $statLine =~ s/<\!\-\-statViews\-\->/ $statViews/;
colas@0
   380
        $statLine =~ s/<\!\-\-statSaves\-\->/ $statSaves/;
colas@0
   381
        $statLine =~ s/<\!\-\-statUploads\-\->/ $statUploads/;
colas@0
   382
        $statLine =~ s/<\!\-\-statTopViews\-\->/$statTopViews/;
colas@0
   383
        $statLine =~ s/<\!\-\-statTopContributors\-\->/$statTopContributors/;
colas@0
   384
colas@0
   385
        if( $idxStat >= 0 ) {
colas@0
   386
            # entry already exists, need to update
colas@0
   387
            $lines[$idxStat] = $statLine;
colas@0
   388
colas@0
   389
        } elsif( $idxTmpl >= 0 ) {
colas@0
   390
            # entry does not exist, add after <!--statDate--> line
colas@0
   391
            $lines[$idxTmpl] = "$lines[$idxTmpl]\n$statLine";
colas@0
   392
colas@0
   393
        } else {
colas@0
   394
            # entry does not exist, add at the end
colas@0
   395
            $lines[@lines] = $statLine;
colas@0
   396
        }
colas@0
   397
        $text = join( "\n", @lines );
colas@0
   398
        $text .= "\n";
colas@0
   399
        $session->{store}->saveTopic( $user, $web, $statsTopic,
colas@0
   400
                                      $text, $meta,
colas@0
   401
                                      { minor => 1,
colas@0
   402
                                        dontlog => 1 } );
colas@0
   403
colas@0
   404
        _printMsg( $session, "  - Topic $statsTopic updated" );
colas@0
   405
colas@0
   406
    } else {
colas@0
   407
        _printMsg( $session, "! Warning: No updates done, topic $web.$statsTopic does not exist" );
colas@0
   408
    }
colas@0
   409
colas@0
   410
    return $web;
colas@0
   411
}
colas@0
   412
colas@0
   413
# Get the items with top N frequency counts
colas@0
   414
# Items can be topics (for view hash) or users (for contrib hash)
colas@0
   415
sub _getTopList
colas@0
   416
{
colas@0
   417
    my( $theMaxNum, $webName, $statsRef ) = @_;
colas@0
   418
colas@0
   419
    # Get reference to the sub-hash for this web
colas@0
   420
    my $webhashref = $statsRef->{$webName};
colas@0
   421
colas@0
   422
    # print "Main.WebHome views = " . $statsRef->{$webName}{'WebHome'}."\n";
colas@0
   423
    # print "Main web, TWikiGuest contribs = " . ${$statsRef}{$webName}{'Main.TWikiGuest'}."\n";
colas@0
   424
colas@0
   425
    my @list = ();
colas@0
   426
    my $topicName;
colas@0
   427
    my $statValue;
colas@0
   428
colas@0
   429
    # Convert sub hash of item=>statsvalue pairs into an array, @list, 
colas@0
   430
    # of '$statValue $topicName', ready for sorting.
colas@0
   431
    while( ( $topicName, $statValue ) = each( %$webhashref ) ) {
colas@0
   432
        # Right-align statistic value for sorting
colas@0
   433
        $statValue = sprintf '%7d', $statValue;	
colas@0
   434
        # Add new array item at end of array
colas@0
   435
        if( $topicName =~ /\./ ) {
colas@0
   436
            $list[@list] = "$statValue $topicName";
colas@0
   437
        } else {
colas@0
   438
            $list[@list] = "$statValue [[$topicName]]";
colas@0
   439
        }
colas@0
   440
    }
colas@0
   441
colas@0
   442
    # DEBUG
colas@0
   443
    # print " top N list for $webName\n";
colas@0
   444
    # print join "\n", @list;
colas@0
   445
colas@0
   446
    # Sort @list by frequency and pick the top N entries
colas@0
   447
    if( @list ) {
colas@0
   448
        # Strip initial spaces
colas@0
   449
        @list = map{ s/^\s*//; $_ } @list;
colas@0
   450
colas@0
   451
        @list = # Prepend spaces depending on no. of digits
colas@0
   452
          map{ s/^([0-9][0-9][^0-9])/\&nbsp\;$1/; $_ }
colas@0
   453
            map{ s/^([0-9][^0-9])/\&nbsp\;\&nbsp\;$1/; $_ }
colas@0
   454
              # Sort numerically, descending order
colas@0
   455
              sort { (split / /, $b)[0] <=> (split / /, $a)[0] }  @list;
colas@0
   456
colas@0
   457
        if( $theMaxNum >= @list ) {
colas@0
   458
            $theMaxNum = @list - 1;
colas@0
   459
        }
colas@0
   460
        return @list[0..$theMaxNum];
colas@0
   461
    }
colas@0
   462
    return @list;
colas@0
   463
}
colas@0
   464
colas@0
   465
sub _printMsg {
colas@0
   466
    my( $session, $msg ) = @_;
colas@0
   467
colas@0
   468
    if( $session->inContext('command_line') ) {
colas@0
   469
        $msg =~ s/&nbsp;/ /go;
colas@0
   470
    } else {
colas@0
   471
        if( $msg =~ s/^\!// ) {
colas@0
   472
            $msg = CGI::h4( CGI::span( { class=>'twikiAlert' }, $msg ));
colas@0
   473
        } elsif( $msg =~ /^[A-Z]/ ) {
colas@0
   474
            # SMELL: does not support internationalised script messages
colas@0
   475
            $msg =~ s/^([A-Z].*)/CGI::h3($1)/ge;
colas@0
   476
        } else {
colas@0
   477
            $msg =~ s/(\*\*\*.*)/CGI::span( { class=>'twikiAlert' }, $1 )/ge;
colas@0
   478
            $msg =~ s/^\s\s/&nbsp;&nbsp;/go;
colas@0
   479
            $msg =~ s/^\s/&nbsp;/go;
colas@0
   480
            $msg .= CGI::br();
colas@0
   481
        }
colas@0
   482
        $msg =~ s/==([A-Z]*)==/'=='.CGI::span( { class=>'twikiAlert' }, $1 ).'=='/ge;
colas@0
   483
    }
colas@0
   484
    print $msg,"\n";
colas@0
   485
}
colas@0
   486
colas@0
   487
1;