lib/TWiki/Contrib/MailerContrib/Subscriber.pm
changeset 0 414e01d06fd5
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 use strict;
       
    22 
       
    23 =pod
       
    24 
       
    25 ---+ package TWiki::Contrib::MailerContrib::Subscriber
       
    26 Object that represents a subscriber to notification. A subscriber is
       
    27 a name (which may be a wikiName or an email address) and a list of
       
    28 subscriptions which describe the topis subscribed to, and
       
    29 unsubscriptions representing topics they are specifically not
       
    30 interested in. The subscriber
       
    31 name may also be a group, so it may expand to many email addresses.
       
    32 
       
    33 =cut
       
    34 
       
    35 package TWiki::Contrib::MailerContrib::Subscriber;
       
    36 
       
    37 use TWiki;
       
    38 use TWiki::Plugins;
       
    39 use Assert;
       
    40 
       
    41 require TWiki::Contrib::MailerContrib::WebNotify;
       
    42 
       
    43 =pod
       
    44 
       
    45 ---++ new($name)
       
    46    * =$name= - Wikiname, with no web, or email address, of user targeted for notification
       
    47 Create a new user.
       
    48 
       
    49 =cut
       
    50 
       
    51 sub new {
       
    52     my ( $class, $name ) = @_;
       
    53     my $this = bless( { name => $name }, $class );
       
    54 
       
    55     return $this;
       
    56 }
       
    57 
       
    58 =pod
       
    59 
       
    60 ---++ getEmailAddresses() -> \@list
       
    61 Get a list of email addresses for the user(s) represented by this
       
    62 subscription
       
    63 
       
    64 =cut
       
    65 
       
    66 sub getEmailAddresses {
       
    67     my $this = shift;
       
    68 
       
    69     unless ( defined( $this->{emails} )) {
       
    70         if ( $this->{name} =~ /^$TWiki::cfg{MailerContrib}{EmailFilterIn}$/ ) {
       
    71             push( @{$this->{emails}}, $this->{name} );
       
    72         } else {
       
    73             my $users = $TWiki::Plugins::SESSION->{users};
       
    74             if ($users->can('findUserByWikiName')) {
       
    75                 # User is represented by a wikiname. Map to a canonical
       
    76                 # userid.
       
    77                 my $list = $users->findUserByWikiName($this->{name});
       
    78                 foreach my $user (@$list) {
       
    79                     # Automatically expands groups
       
    80                     push( @{$this->{emails}}, $users->getEmails($user) );
       
    81                 }
       
    82             } else {
       
    83                 # Old code; use the user object
       
    84                 my $user = $users->findUser( $this->{name}, undef, 1 );
       
    85                 if( $user ) {
       
    86                     push( @{$this->{emails}}, $user->emails() );
       
    87                 } else {
       
    88                     $user = $users->findUser(
       
    89                         $this->{name}, $this->{name}, 1 );
       
    90                     if( $user ) {
       
    91                         push( @{$this->{emails}}, $user->emails() );
       
    92                     } else {
       
    93                         # unknown - can't find an email
       
    94                         $this->{emails} = [];
       
    95                     }
       
    96                 }
       
    97             }
       
    98         }
       
    99     }
       
   100     return $this->{emails};
       
   101 }
       
   102 
       
   103 # Add a subsciption to an internal list, optimising the list so that
       
   104 # the fewest subscriptions are kept that are needed to cover all
       
   105 # topics.
       
   106 sub _addAndOptimise {
       
   107     my( $this, $set, $new ) = @_;
       
   108 
       
   109     # Don't add already covered duplicates
       
   110     my $i = 0;
       
   111     my @remove;
       
   112     foreach my $known (@{$this->{$set}}) {
       
   113         return if $known->covers($new);
       
   114         if( $new->covers( $known )) {
       
   115             # remove anything covered by the new subscription
       
   116             unshift(@remove, $i);
       
   117         }
       
   118         $i++;
       
   119     }
       
   120     foreach $i (@remove) {
       
   121         splice(@{$this->{$set}}, $i, 1);
       
   122     }
       
   123     push( @{$this->{$set}}, $new );
       
   124 }
       
   125 
       
   126 # Subtract a subscription from an internal list. Do the best job
       
   127 # you can in the face of wildcards.
       
   128 sub _subtract {
       
   129     my( $this, $set, $new ) = @_;
       
   130 
       
   131     my $i = 0;
       
   132     my @remove;
       
   133     foreach my $known (@{$this->{$set}}) {
       
   134         if( $new->covers( $known )) {
       
   135             # remove anything covered by the new subscription
       
   136             unshift(@remove, $i);
       
   137         }
       
   138         $i++;
       
   139     }
       
   140     foreach $i (@remove) {
       
   141         splice(@{$this->{$set}}, $i, 1);
       
   142     }
       
   143 }
       
   144 
       
   145 =pod
       
   146 
       
   147 ---++ subscribe($subs)
       
   148    * =$subs= - Subscription object
       
   149 Add a new subscription to this subscriber object.
       
   150 
       
   151 =cut
       
   152 
       
   153 sub subscribe {
       
   154     my ( $this, $subs ) = @_;
       
   155 
       
   156     $this->_addAndOptimise( 'subscriptions', $subs );
       
   157     $this->_subtract( 'unsubscriptions', $subs );
       
   158 }
       
   159 
       
   160 =pod
       
   161 
       
   162 ---++ unsubscribe($subs)
       
   163    * =$subs= - Subscription object
       
   164 Add a new unsubscription to this subscriber object.
       
   165 The unsubscription will always be added, even if there is
       
   166 a wildcard overlap with an existing subscription or unsubscription.
       
   167 
       
   168 An unsubscription is a statement of the subscribers desire _not_
       
   169 to be notified of changes to this topic.
       
   170 
       
   171 =cut
       
   172 
       
   173 sub unsubscribe {
       
   174     my ( $this, $subs ) = @_;
       
   175 
       
   176     $this->_addAndOptimise( 'unsubscriptions', $subs );
       
   177     $this->_subtract( 'subscriptions', $subs );
       
   178 }
       
   179 
       
   180 =pod
       
   181 
       
   182 ---++ isSubscribedTo($topic, $db) -> $subscription
       
   183    * =$topic= - Topic object we are checking
       
   184    * =$db= - TWiki::Contrib::MailerContrib::UpData database of parents
       
   185 Check if we have a subscription to the given topic. Return the subscription
       
   186 that matches if we do, undef otherwise.
       
   187 
       
   188 =cut
       
   189 
       
   190 sub isSubscribedTo {
       
   191    my ( $this, $topic, $db ) = @_;
       
   192 
       
   193    foreach my $subscription ( @{$this->{subscriptions}} ) {
       
   194        if ( $subscription->matches( $topic, $db )) {
       
   195            return $subscription;
       
   196        }
       
   197    }
       
   198 
       
   199    return undef;
       
   200 }
       
   201 
       
   202 =pod
       
   203 
       
   204 ---++ isUnsubscribedFrom($topic) -> $subscription
       
   205    * =$topic= - Topic object we are checking
       
   206    * =$db= - TWiki::Contrib::MailerContrib::UpData database of parents
       
   207 Check if we have an unsubscription from the given topic. Return the subscription that matches if we do, undef otherwise.
       
   208 
       
   209 =cut
       
   210 
       
   211 sub isUnsubscribedFrom {
       
   212    my ( $this, $topic, $db ) = @_;
       
   213 
       
   214    foreach my $subscription ( @{$this->{unsubscriptions}} ) {
       
   215        if ( $subscription->matches( $topic, $db )) {
       
   216            return $subscription;
       
   217        }
       
   218    }
       
   219 
       
   220    return undef;
       
   221 }
       
   222 
       
   223 =pod
       
   224 
       
   225 ---++ stringify() -> string
       
   226 Return a string representation of this object, in Web<nop>Notify format.
       
   227 
       
   228 =cut
       
   229 
       
   230 sub stringify {
       
   231     my $this = shift;
       
   232     my $subs = join( ' ',
       
   233                      map { $_->stringify(); }
       
   234                      @{$this->{subscriptions}} );
       
   235     my $unsubs = join( " - ",
       
   236                        map { $_->stringify(); }
       
   237                        @{$this->{unsubscriptions}} );
       
   238     $unsubs = " - $unsubs" if $unsubs;
       
   239 
       
   240     my $name = $this->{name};
       
   241     if ($name !~ /^($TWiki::regex{wikiWordRegex}|$TWiki::cfg{MailerContrib}{EmailFilterIn})$/) {
       
   242         $name = $name =~ /'/ ? '"'.$name.'"' : "'$name'";
       
   243     }
       
   244     return "   * " . $name . ": " .
       
   245       $subs . $unsubs;
       
   246 }
       
   247 
       
   248 1;