source: perl/modules/Jabber/lib/BarnOwl/Message/Jabber.pm @ 9375f8c

debianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 9375f8c was 9375f8c, checked in by Anders Kaseorg <andersk@mit.edu>, 16 years ago
Jabber: Escape interpolated variables in regexes using "\Q\E".
  • Property mode set to 100644
File size: 3.4 KB
RevLine 
[2cedb7a]1use warnings;
2use strict;
3
4=head1 NAME
5
6BarnOwl::Message::Jabber
7
8=head1 DESCRIPTION
9
10A subclass of BarnOwl::Message for Jabber messages
11
12=cut
13
14package BarnOwl::Message::Jabber;
15
16use base qw( BarnOwl::Message );
17
18sub jtype { shift->{jtype} };
19sub from { shift->{from} };
20sub to { shift->{to} };
21sub room { shift->{room} };
[693c8f2]22sub subject { shift->{subject} };
[2cedb7a]23sub status { shift->{status} }
24
[a1a2036]25sub login_type {
26    my $self = shift;
27    my $type = $self->jtype;
28    return " ($type)" if $type;
29}
30
[2cedb7a]31sub login_extra {
32    my $self = shift;
33    my $show = $self->{show};
34    my $status = $self->status;
35    my $s = "";
36    $s .= $show if $show;
37    $s .= ", $status" if $status;
38    return $s;
39}
40
41sub long_sender {
42    my $self = shift;
43    return $self->from;
44}
45
46sub context {
47    return shift->room;
48}
49
[693c8f2]50sub subcontext {
51    return shift->subject || "";
52}
53
[2cedb7a]54sub smartfilter {
55    my $self = shift;
56    my $inst = shift;
57
[38a7f22]58    my $filter;
[2cedb7a]59
60    if($self->jtype eq 'chat') {
61        my $user;
62        if($self->direction eq 'in') {
63            $user = $self->from;
64        } else {
65            $user = $self->to;
66        }
67        return smartfilter_user($user, $inst);
68    } elsif ($self->jtype eq 'groupchat') {
69        my $room = $self->room;
70        $filter = "jabber-room-$room";
[38a7f22]71        BarnOwl::command(qw[filter], $filter,
[9375f8c]72                         qw[type ^jabber$ and room], "^\Q$room\E\$");
[2cedb7a]73        return $filter;
74    } elsif ($self->login ne 'none') {
75        return smartfilter_user($self->from, $inst);
76    }
77}
78
79sub smartfilter_user {
80    my $user = shift;
81    my $inst = shift;
82
83    $user   = Net::Jabber::JID->new($user)->GetJID( $inst ? 'full' : 'base' );
84    my $filter = "jabber-user-$user";
[38a7f22]85    BarnOwl::command(qw[filter], $filter, qw[type ^jabber$],
[9375f8c]86                     qw[and ( ( direction ^in$ and from], "^\Q$user\E(/.*)?\$",
87                     qw[) or ( direction ^out$ and to ], "^\Q$user\E(/.*)?\$",
[38a7f22]88                     qw[ ) ) ]);
[2cedb7a]89    return $filter;
90
91}
92
[d5dcd7c]93sub replycmd {
94    my $self = shift;
95    my ($recip, $account, $subject);
96    if ($self->is_loginout) {
97        $recip   = $self->sender;
98        $account = $self->recipient;
99    } elsif ($self->jtype eq 'chat') {
100        return $self->replysendercmd;
101    } elsif ($self->jtype eq 'groupchat') {
102        $recip = $self->room;
103        if ($self->is_incoming) {
104            $account = $self->to;
105        } else {
106            $account = $self->from;
107        }
108        $subject = $self->subject;
[96134cb]109    } else {
110        # Unknown type
111        return;
[d5dcd7c]112    }
113    return jwrite_cmd($recip, $account, $subject);
114}
115
116sub replysendercmd {
117    my $self = shift;
118    if($self->jtype eq 'groupchat'
119       || $self->jtype eq 'chat') {
120        my ($recip, $account);
121        if ($self->is_incoming) {
122            $recip   = $self->from;
123            $account = $self->to;
124        } else {
125            $recip   = $self->to;
126            $account = $self->from;
127        }
128        return jwrite_cmd($recip, $account);
129    }
130    return $self->replycmd;
131}
132
133sub jwrite_cmd {
134    my ($recip, $account, $subject) = @_;
135    if (defined $recip) {
[680ada9]136        $recip   = BarnOwl::quote($recip);
137        $account = BarnOwl::quote($account);
[d5dcd7c]138        my $cmd = "jwrite $recip -a $account";
139        if (defined $subject) {
[680ada9]140            $cmd .= " -s " . BarnOwl::quote($subject);
[d5dcd7c]141        }
142        return $cmd;
143    } else {
144        return undef;
145    }
146}
[2cedb7a]147
148=head1 SEE ALSO
149
150L<BarnOwl::Message>
151
152=cut
153
1541;
Note: See TracBrowser for help on using the repository browser.