lib/TWiki/Contrib/MailerContrib.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
     2 #
       
     3 # Copyright (C) 2004 Wind River Systems Inc.
       
     4 # Copyright (C) 1999-2006 TWiki Contributors.
       
     5 # All Rights Reserved. TWiki Contributors
       
     6 # are listed in the AUTHORS file in the root of this distribution.
       
     7 # NOTE: Please extend that file, not this notice.
       
     8 #
       
     9 # This program is free software; you can redistribute it and/or
       
    10 # modify it under the terms of the GNU General Public License
       
    11 # as published by the Free Software Foundation; either version 2
       
    12 # of the License, or (at your option) any later version. For
       
    13 # more details read LICENSE in the root of this distribution.
       
    14 #
       
    15 # This program is distributed in the hope that it will be useful,
       
    16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
    18 #
       
    19 # As per the GPL, removal of this notice is prohibited.
       
    20 
       
    21 =pod
       
    22 
       
    23 ---+ package TWiki::Contrib::MailerContrib
       
    24 
       
    25 Package of support for extended Web<nop>Notify notification, supporting per-topic notification and notification of changes to children.
       
    26 
       
    27 Also supported is a simple API that can be used to change the Web<nop>Notify topic from other code.
       
    28 
       
    29 =cut
       
    30 
       
    31 package TWiki::Contrib::MailerContrib;
       
    32 
       
    33 use strict;
       
    34 
       
    35 use URI;
       
    36 use CGI qw(-any);
       
    37 
       
    38 require TWiki;
       
    39 require TWiki::Plugins;
       
    40 require TWiki::Time;
       
    41 require TWiki::Func;
       
    42 require TWiki::Contrib::MailerContrib::WebNotify;
       
    43 require TWiki::Contrib::MailerContrib::Change;
       
    44 require TWiki::Contrib::MailerContrib::UpData;
       
    45 
       
    46 use vars qw ( $VERSION $RELEASE $verbose );
       
    47 
       
    48 $VERSION = '$Rev: 16078 (22 Jan 2008) $';
       
    49 $RELEASE = 'TWiki-4';
       
    50 
       
    51 =pod
       
    52 
       
    53 ---++ StaticMethod mailNotify($webs, $session, $verbose, $exwebs)
       
    54    * =$webs= - filter list of names webs to process. Wildcards (*) may be used.
       
    55    * =$session= - optional session object. If not given, will use a local object.
       
    56    * =$verbose= - true to get verbose (debug) output.
       
    57    * =$exwebs = - filter list of webs to exclude.
       
    58 
       
    59 Main entry point.
       
    60 
       
    61 Process the Web<nop>Notify topics in each web and generate and issue
       
    62 notification mails. Designed to be invoked from the command line; should
       
    63 only be called by =mailnotify= scripts.
       
    64 
       
    65 =cut
       
    66 
       
    67 sub mailNotify {
       
    68     my( $webs, $twiki, $noisy, $exwebs ) = @_;
       
    69 
       
    70     $verbose = $noisy;
       
    71 
       
    72     my $webstr;
       
    73     if ( defined( $webs )) {
       
    74         $webstr = join( '|', @$webs );
       
    75     }
       
    76     $webstr = '*' unless ( $webstr );
       
    77     $webstr =~ s/\*/\.\*/g;
       
    78 
       
    79     my $exwebstr = '';
       
    80     if ( defined( $exwebs )) {
       
    81         $exwebstr = join( '|', @$exwebs );
       
    82     }
       
    83     $exwebstr =~ s/\*/\.\*/g;
       
    84 
       
    85     if (!defined $twiki) {
       
    86         $twiki = new TWiki();
       
    87     }
       
    88 
       
    89     $TWiki::Plugins::SESSION = $twiki;
       
    90 
       
    91     my $context = TWiki::Func::getContext();
       
    92 
       
    93     $context->{command_line} = 1;
       
    94 
       
    95     # absolute URL context for email generation
       
    96     $context->{absolute_urls} = 1;
       
    97 
       
    98     $TWiki::cfg{MailerContrib}{EmailFilterIn} ||=
       
    99       '[A-Za-z0-9\.+-_]+\@[A-Za-z0-9.-]+';
       
   100 
       
   101     my $report = '';
       
   102     foreach my $web ( TWiki::Func::getListOfWebs( 'user ') ) {
       
   103        if ( $web =~ /^($webstr)$/ && $web !~ /^($exwebstr)$/ ) {
       
   104           $report .= _processWeb( $twiki, $web );
       
   105        }
       
   106     }
       
   107 
       
   108     $context->{absolute_urls} = 0;
       
   109 
       
   110     return $report;
       
   111 }
       
   112 
       
   113 # PRIVATE: Read the webnotify, and notify changes
       
   114 sub _processWeb {
       
   115     my( $twiki, $web) = @_;
       
   116 
       
   117     if( ! TWiki::Func::webExists( $web ) ) {
       
   118 #        print STDERR "**** ERROR mailnotifier cannot find web $web\n";
       
   119         return '';
       
   120     }
       
   121 
       
   122     print "Processing $web\n" if $verbose;
       
   123 
       
   124     my $report = '';
       
   125 
       
   126     # Read the webnotify and load subscriptions
       
   127     my $wn = new TWiki::Contrib::MailerContrib::WebNotify(
       
   128         $twiki, $web, $TWiki::cfg{NotifyTopicName} );
       
   129     if ( $wn->isEmpty() ) {
       
   130         print "\t$web has no subscribers\n" if $verbose;
       
   131     } else {
       
   132         # create a DB object for parent pointers
       
   133         print $wn->stringify() if $verbose;
       
   134         my $db = new TWiki::Contrib::MailerContrib::UpData( $twiki, $web );
       
   135         $report .= _processSubscriptions( $twiki, $web, $wn, $db );
       
   136     }
       
   137 
       
   138     return $report;
       
   139 }
       
   140 
       
   141 # Process subscriptions in $notify
       
   142 sub _processSubscriptions {
       
   143     my ( $twiki, $web, $notify, $db ) = @_;
       
   144 
       
   145     my $metadir = TWiki::Func::getWorkArea('MailerContrib');
       
   146     my $notmeta = $web;
       
   147     $notmeta =~ s#/#.#g;
       
   148     $notmeta = "$metadir/$notmeta";
       
   149 
       
   150     my $timeOfLastNotify = 0;
       
   151     if( open(F, "<$notmeta")) {
       
   152         local $/ = undef;
       
   153         $timeOfLastNotify = <F>;
       
   154         close(F);
       
   155     }
       
   156 
       
   157     if ( $verbose ) {
       
   158         print "\tLast notification was at " .
       
   159           TWiki::Time::formatTime( $timeOfLastNotify, 'iso' ). "\n";
       
   160     }
       
   161 
       
   162     my $timeOfLastChange = 0;
       
   163 
       
   164     # Hash indexed on email address, each entry contains a hash
       
   165     # of topics already processed in the change set for this email.
       
   166     # Each subhash maps the topic name to the index of the change
       
   167     # record for this topic in the array of Change objects for this
       
   168     # email in %changeset.
       
   169     my %seenset;
       
   170 
       
   171     # Hash indexed on email address, each entry contains an array
       
   172     # indexed by the index stored in %seenSet. Each entry in the array
       
   173     # is a ref to a Change object.
       
   174     my %changeset;
       
   175 
       
   176     # Hash indexed on topic name, mapping to email address, used to
       
   177     # record simple newsletter subscriptions.
       
   178     my %allSet;
       
   179 
       
   180     if( !defined( &TWiki::Func::eachChangeSince )) {
       
   181         require TWiki::Contrib::MailerContrib::CompatibilityHacks;
       
   182     }
       
   183 
       
   184     # + 1 because the 'since' check is >=
       
   185     my $it = TWiki::Func::eachChangeSince( $web, $timeOfLastNotify + 1 );
       
   186     while( $it->hasNext() ) {
       
   187         my $change = $it->next();
       
   188         next if $change->{more} && $change->{more} =~ /minor$/;
       
   189 
       
   190         next unless TWiki::Func::topicExists( $web, $change->{topic} );
       
   191 
       
   192         $timeOfLastChange = $change->{time} unless( $timeOfLastChange );
       
   193 
       
   194         print "\tChange to $change->{topic} at ".
       
   195           TWiki::Time::formatTime( $change->{time}, 'iso' ).
       
   196               ". New revision is $change->{revision}\n" if ( $verbose );
       
   197 
       
   198         # Formulate a change record, irrespective of
       
   199         # whether any subscriber is interested
       
   200         $change = new TWiki::Contrib::MailerContrib::Change(
       
   201             $twiki, $web, $change->{topic}, $change->{user},
       
   202             $change->{time}, $change->{revision} );
       
   203 
       
   204         # Now, find subscribers to this change and extend the change set
       
   205         $notify->processChange(
       
   206             $change, $db, \%changeset, \%seenset, \%allSet );
       
   207     }
       
   208     # For each topic, see if there's a compulsory subscription independent
       
   209     # of the time since last notify
       
   210     foreach my $topic (TWiki::Func::getTopicList($web)) {
       
   211         $notify->processCompulsory( $topic, $db, \%allSet );
       
   212     }
       
   213 
       
   214     # Now generate emails for each recipient
       
   215     my $report = _sendChangesMails(
       
   216         $twiki, $web, \%changeset,
       
   217         TWiki::Time::formatTime($timeOfLastNotify) );
       
   218 
       
   219     $report .= _sendNewsletterMails( $twiki, $web, \%allSet);
       
   220 
       
   221     if ($timeOfLastChange != 0) {
       
   222         if( open(F, ">$notmeta" )) {
       
   223             print F $timeOfLastChange;
       
   224             close(F);
       
   225         }
       
   226     }
       
   227 
       
   228     return $report;
       
   229 }
       
   230 
       
   231 # PRIVATE generate and send an email for each user
       
   232 sub _sendChangesMails {
       
   233     my ( $twiki, $web, $changeset, $lastTime ) = @_;
       
   234     my $report = '';
       
   235 
       
   236     my $skin = TWiki::Func::getSkin();
       
   237     my $template = TWiki::Func::readTemplate( 'mailnotify', $skin );
       
   238 
       
   239     my $homeTopic = $TWiki::cfg{HomeTopicName};
       
   240 
       
   241     my $before_html = TWiki::Func::expandTemplate( 'HTML:before' );
       
   242     my $middle_html = TWiki::Func::expandTemplate( 'HTML:middle' );
       
   243     my $after_html = TWiki::Func::expandTemplate( 'HTML:after' );
       
   244 
       
   245     my $before_plain = TWiki::Func::expandTemplate( 'PLAIN:before' );
       
   246     my $middle_plain = TWiki::Func::expandTemplate( 'PLAIN:middle' );
       
   247     my $after_plain = TWiki::Func::expandTemplate( 'PLAIN:after' );
       
   248 
       
   249     my $mailtmpl = TWiki::Func::expandTemplate( 'MailNotifyBody' );
       
   250     $mailtmpl = TWiki::Func::expandCommonVariables(
       
   251         $mailtmpl, $homeTopic, $web );
       
   252     if( $TWiki::cfg{RemoveImgInMailnotify} ) {
       
   253         # change images to [alt] text if there, else remove image
       
   254         $mailtmpl =~ s/<img\s[^>]*\balt=\"([^\"]+)[^>]*>/[$1]/goi;
       
   255         $mailtmpl =~ s/<img src=.*?[^>]>//goi;
       
   256     }
       
   257 
       
   258     my $sentMails = 0;
       
   259 
       
   260     foreach my $email ( keys %{$changeset} ) {
       
   261         my $html = '';
       
   262         my $plain = '';
       
   263         foreach my $change (sort { $a->{TIME} cmp $b->{TIME} }
       
   264                             @{$changeset->{$email}} ) {
       
   265 
       
   266             $html .= $change->expandHTML( $middle_html );
       
   267             $plain .= $change->expandPlain( $middle_plain );
       
   268         }
       
   269 
       
   270         $plain =~ s/\($TWiki::cfg{UsersWebName}\./\(/go;
       
   271 
       
   272         my $mail = $mailtmpl;
       
   273 
       
   274         $mail =~ s/%EMAILTO%/$email/go;
       
   275         $mail =~ s/%HTML_TEXT%/$before_html$html$after_html/go;
       
   276         $mail =~ s/%PLAIN_TEXT%/$before_plain$plain$after_plain/go;
       
   277         $mail =~ s/%LASTDATE%/$lastTime/geo;
       
   278         $mail = TWiki::Func::expandCommonVariables( $mail, $homeTopic, $web );
       
   279 
       
   280         my $base = $TWiki::cfg{DefaultUrlHost} . $TWiki::cfg{ScriptUrlPath};
       
   281         $mail =~ s/(href=\")([^"]+)/$1.relativeURL($base,$2)/goei;
       
   282         $mail =~ s/(action=\")([^"]+)/$1.relativeURL($base,$2)/goei;
       
   283 
       
   284         # remove <nop> and <noautolink> tags
       
   285         $mail =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;
       
   286 
       
   287         my $error = TWiki::Func::sendEmail( $mail, 5 );
       
   288 
       
   289         if ($error) {
       
   290             print STDERR "Error sending mail forf $web: $error\n";
       
   291             $report .= $error."\n";
       
   292         } else {
       
   293             print "Notified $email of changes in $web\n" if $verbose;
       
   294             $sentMails++;
       
   295         }
       
   296     }
       
   297     $report .= "\t$sentMails change notifications from $web\n";
       
   298 
       
   299     return $report;
       
   300 }
       
   301 
       
   302 sub relativeURL {
       
   303     my( $base, $link ) = @_;
       
   304     return URI->new_abs( $link, URI->new($base) )->as_string;
       
   305 }
       
   306 
       
   307 sub _sendNewsletterMails {
       
   308     my ($twiki, $web, $allSet) = @_;
       
   309 
       
   310     my $report = '';
       
   311     foreach my $topic (keys %$allSet) {
       
   312         $report .= _sendNewsletterMail(
       
   313             $twiki, $web, $topic, $allSet->{$topic});
       
   314     }
       
   315     return $report;
       
   316 }
       
   317 
       
   318 sub _sendNewsletterMail {
       
   319     my ($twiki, $web, $topic, $emails) = @_;
       
   320     my $wikiName = TWiki::Func::getWikiName();
       
   321 
       
   322     # SMELL: this code is almost identical to PublishContrib
       
   323 
       
   324     # Read topic data.
       
   325     my ($meta, $text) = TWiki::Func::readTopic( $web, $topic );
       
   326 
       
   327     if (!defined( &TWiki::Func::pushTopicContext )) {
       
   328         require TWiki::Contrib::MailerContrib::TopicContext;
       
   329     }
       
   330     TWiki::Func::pushTopicContext( $web, $topic );
       
   331 
       
   332     $twiki->enterContext( 'can_render_meta', $meta );
       
   333 
       
   334     # Get the skin for this topic
       
   335     my $skin = TWiki::Func::getSkin();
       
   336     TWiki::Func::readTemplate( 'newsletter', $skin );
       
   337     my $header = TWiki::Func::expandTemplate( 'NEWS:header' );
       
   338     my $body = TWiki::Func::expandTemplate( 'NEWS:body' );
       
   339     my $footer = TWiki::Func::expandTemplate( 'NEWS:footer' );
       
   340 
       
   341     my ($revdate, $revuser, $maxrev);
       
   342     ($revdate, $revuser, $maxrev) = $meta->getRevisionInfo();
       
   343 
       
   344     # Handle standard formatting.
       
   345     $body =~ s/%TEXT%/$text/g;
       
   346     # Don't render the header, it is preformatted
       
   347     $header = TWiki::Func::expandCommonVariables($header, $topic, $web);
       
   348     my $tmpl = "$body\n$footer";
       
   349     $tmpl = TWiki::Func::expandCommonVariables($tmpl, $topic, $web);
       
   350     $tmpl = TWiki::Func::renderText($tmpl, "", $meta);
       
   351     $tmpl = "$header$tmpl";
       
   352 
       
   353     # REFACTOR OPPORTUNITY: stop factor me into getTWikiRendering()
       
   354     # SMELL: this code is identical to PublishContrib!
       
   355 
       
   356     # New tags
       
   357     my $newTmpl = '';
       
   358     my $tagSeen = 0;
       
   359     my $publish = 1;
       
   360     foreach my $s ( split( /(%STARTPUBLISH%|%STOPPUBLISH%)/, $tmpl )) {
       
   361         if( $s eq '%STARTPUBLISH%' ) {
       
   362             $publish = 1;
       
   363             $newTmpl = '' unless( $tagSeen );
       
   364             $tagSeen = 1;
       
   365         } elsif( $s eq '%STOPPUBLISH%' ) {
       
   366             $publish = 0;
       
   367             $tagSeen = 1;
       
   368         } elsif( $publish ) {
       
   369             $newTmpl .= $s;
       
   370         }
       
   371     }
       
   372     $tmpl = $newTmpl;
       
   373     $tmpl =~ s/.*?<\/nopublish>//gs;
       
   374     $tmpl =~ s/%MAXREV%/$maxrev/g;
       
   375     $tmpl =~ s/%CURRREV%/$maxrev/g;
       
   376     $tmpl =~ s/%REVTITLE%//g;
       
   377     $tmpl =~ s|( ?) *</*nop/*>\n?|$1|gois;
       
   378 
       
   379     # Remove <base.../> tag
       
   380     $tmpl =~ s/<base[^>]+\/>//;
       
   381     # Remove <base...>...</base> tag
       
   382     $tmpl =~ s/<base[^>]+>.*?<\/base>//;
       
   383 
       
   384     # Rewrite absolute URLs
       
   385     my $base = $TWiki::cfg{DefaultUrlHost} . $TWiki::cfg{ScriptUrlPath};
       
   386     $tmpl =~ s/(href=\")([^"]+)/$1.relativeURL($base,$2)/goei;
       
   387     $tmpl =~ s/(action=\")([^"]+)/$1.relativeURL($base,$2)/goei;
       
   388 
       
   389     my $report = '';
       
   390     my $sentMails = 0;
       
   391 
       
   392     my %targets = map { $_ => 1 } @$emails;
       
   393 
       
   394     foreach my $email ( keys %targets ) {
       
   395         my $mail = $tmpl;
       
   396 
       
   397         $mail =~ s/%EMAILTO%/$email/go;
       
   398 
       
   399         my $base = $TWiki::cfg{DefaultUrlHost} . $TWiki::cfg{ScriptUrlPath};
       
   400         $mail =~ s/(href=\")([^"]+)/$1.relativeURL($base,$2)/goei;
       
   401         $mail =~ s/(action=\")([^"]+)/$1.relativeURL($base,$2)/goei;
       
   402 
       
   403         # remove <nop> and <noautolink> tags
       
   404         $mail =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;
       
   405 
       
   406         my $error = TWiki::Func::sendEmail( $mail, 5 );
       
   407 
       
   408         if ($error) {
       
   409             print STDERR "Error sending mail for $web: $error\n";
       
   410             $report .= $error."\n";
       
   411         } else {
       
   412             print "Sent newletter for $web to $email\n" if $verbose;
       
   413             $sentMails++;
       
   414         }
       
   415     }
       
   416     $report .= "\t$sentMails newsletters from $web\n";
       
   417 
       
   418     TWiki::Func::popTopicContext();
       
   419 
       
   420     return $report;
       
   421 }
       
   422 
       
   423 1;