lib/TWiki/Contrib/MailerContrib/Subscription.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) 2004 Wind River Systems Inc.
colas@0
     4
# Copyright (C) 1999-2006 TWiki Contributors.
colas@0
     5
# All Rights Reserved. TWiki Contributors
colas@0
     6
# are listed in the AUTHORS file in the root of this distribution.
colas@0
     7
# NOTE: Please extend that file, not this notice.
colas@0
     8
#
colas@0
     9
#
colas@0
    10
# As per the GPL, removal of this notice is prohibited.
colas@0
    11
colas@0
    12
use strict;
colas@0
    13
colas@0
    14
=pod
colas@0
    15
colas@0
    16
---+ package TWiki::Contrib::MailerContrib::Subscription
colas@0
    17
Object that represents a single subscription of a user to
colas@0
    18
notification on a page. A subscription is expressed as a page
colas@0
    19
spec (which may contain wildcards) and a depth of children of
colas@0
    20
matching pages that the user is subscribed to.
colas@0
    21
colas@0
    22
=cut
colas@0
    23
colas@0
    24
package TWiki::Contrib::MailerContrib::Subscription;
colas@0
    25
colas@0
    26
=pod
colas@0
    27
colas@0
    28
---++ new($pages, $childDepth, $news)
colas@0
    29
   * =$pages= - Wildcarded expression matching subscribed pages
colas@0
    30
   * =$childDepth= - Depth of children of $topic to notify changes for. Defaults to 0
colas@0
    31
   * =$mode= - ! if this is a non-changes subscription and the topics should
colas@0
    32
   be mailed evebn if there are no changes. ? to mail the full topic only
colas@0
    33
   if there are changes. undef to mail changes only.
colas@0
    34
Create a new subscription.
colas@0
    35
colas@0
    36
=cut
colas@0
    37
colas@0
    38
sub new {
colas@0
    39
    my ( $class, $topics, $depth, $mode ) = @_;
colas@0
    40
colas@0
    41
    my $this = bless( {}, $class );
colas@0
    42
colas@0
    43
    $this->{topics} = $topics || '';
colas@0
    44
    $this->{depth} = $depth || 0;
colas@0
    45
    $this->{mode} = $mode || '';
colas@0
    46
colas@0
    47
    $topics =~ s/[^\w\*]//g;
colas@0
    48
    $topics =~ s/\*/\.\*\?/g;
colas@0
    49
    $this->{topicsRE} = qr/^$topics$/;
colas@0
    50
colas@0
    51
    return $this;
colas@0
    52
}
colas@0
    53
colas@0
    54
=pod
colas@0
    55
colas@0
    56
---++ stringify() -> string
colas@0
    57
Return a string representation of this object, in Web<nop>Notify format.
colas@0
    58
colas@0
    59
=cut
colas@0
    60
colas@0
    61
sub stringify {
colas@0
    62
    my $this = shift;
colas@0
    63
colas@0
    64
    my $record = $this->{topics} . ($this->{mode} || '');
colas@0
    65
    # convert RE back to wildcard
colas@0
    66
    $record =~ s/\.\*\?/\*/;
colas@0
    67
    $record .= " ($this->{depth})" if ( $this->{depth} );
colas@0
    68
    return $record;
colas@0
    69
}
colas@0
    70
colas@0
    71
=pod
colas@0
    72
colas@0
    73
---++ matches($topic, $db, $depth) -> boolean
colas@0
    74
   * =$topic= - Topic object we are checking
colas@0
    75
   * =$db= - TWiki::Contrib::MailerContrib::UpData database of parent names
colas@0
    76
   * =$depth= - If non-zero, check if the parent of the given topic matches as well. undef = 0.
colas@0
    77
Check if we match this topic. Recurses up the parenthood tree seeing if
colas@0
    78
this is a child of a parent that matches within the depth range.
colas@0
    79
colas@0
    80
=cut
colas@0
    81
colas@0
    82
sub matches {
colas@0
    83
    my ( $this, $topic, $db, $depth ) = @_;
colas@0
    84
    return 0 unless ($topic);
colas@0
    85
colas@0
    86
    return 1 if ( $topic =~ $this->{topicsRE} );
colas@0
    87
colas@0
    88
    $depth = $this->{depth} unless defined( $depth );
colas@0
    89
    $depth ||= 0;
colas@0
    90
colas@0
    91
    if ( $depth ) {
colas@0
    92
        my $parent = $db->getParent( $topic );
colas@0
    93
        $parent =~ s/^.*\.//;
colas@0
    94
        return $this->matches( $parent, $db, $depth - 1 ) if ( $parent );
colas@0
    95
    }
colas@0
    96
colas@0
    97
    return 0;
colas@0
    98
}
colas@0
    99
colas@0
   100
=pod
colas@0
   101
colas@0
   102
---++ covers($other, $db) -> $boolean
colas@0
   103
   * =$other= - Other subscription object we are checking
colas@0
   104
   * =$db= - TWiki::Contrib::MailerContrib::UpData database of parent names
colas@0
   105
Return true if this subscription already covers all the topics
colas@0
   106
specified by another subscription. Thus:
colas@0
   107
   * A&#2A;B _covers_ AB, AxB
colas@0
   108
   * A&#2A; _covers_ A&#2A;B
colas@0
   109
   * &#2A;B _does not cover_ A&#2A;
colas@0
   110
colas@0
   111
=cut
colas@0
   112
colas@0
   113
sub covers {
colas@0
   114
    my( $this, $tother, $db ) = @_;
colas@0
   115
colas@0
   116
    # A different mode never matches
colas@0
   117
    return 0 unless $this->{mode} eq $tother->{mode};
colas@0
   118
colas@0
   119
    # do they match without taking into account the depth?
colas@0
   120
    return 0 unless( $this->matches($tother->{topics}, undef, 0) );
colas@0
   121
colas@0
   122
    # if we have a depth and they don't, that's already catered for
colas@0
   123
    # by the matches test above
colas@0
   124
colas@0
   125
    # if we don't have a depth and they do, then we might be covered
colas@0
   126
    # by them, but that's irrelevant
colas@0
   127
colas@0
   128
    # if we have a depth and they have a depth, then there is coverage
colas@0
   129
    # if our depth is >= their depth
colas@0
   130
    return 0 unless( $this->{depth} >= $tother->{depth} );
colas@0
   131
colas@0
   132
    return 1;
colas@0
   133
}
colas@0
   134
colas@0
   135
=pod
colas@0
   136
colas@0
   137
---++ getMode() -> $mode
colas@0
   138
Return ! if this is a non-changes subscription and the topics should
colas@0
   139
be mailed even if there are no changes. ? to mail the full topic only
colas@0
   140
if there are changes. undef to mail changes only.
colas@0
   141
colas@0
   142
=cut
colas@0
   143
colas@0
   144
sub getMode {
colas@0
   145
    my $this = shift;
colas@0
   146
colas@0
   147
    return $this->{mode};
colas@0
   148
}
colas@0
   149
colas@0
   150
=pod
colas@0
   151
colas@0
   152
---++ equals($other) -> $boolean
colas@0
   153
Compare two subscriptions.
colas@0
   154
colas@0
   155
=cut
colas@0
   156
colas@0
   157
sub equals {
colas@0
   158
    my( $this, $tother ) = @_;
colas@0
   159
    return 0 unless ($this->{mode} eq $tother->{mode});
colas@0
   160
    return 0 unless ($this->{depth} == $tother->{depth});
colas@0
   161
    return 0 unless ($this->{topics} eq $tother->{topics});
colas@0
   162
}
colas@0
   163
colas@0
   164
1;