source: perl/lib/BarnOwl/Message/Zephyr.pm @ ee183be

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since ee183be was ee183be, checked in by Nelson Elhage <nelhage@mit.edu>, 15 years ago
Break perlwrap.pm into multiple files. Break perlwrap.pm out into .pm files in perl/lib. With this commit, we keep perlwrap.pm around and still load it as before. The next commit will delete perlwrap.pm and start loading perl files directly from disk at runtime.
  • Property mode set to 100644
File size: 5.0 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Message::Zephyr;
5
6use constant WEBZEPHYR_PRINCIPAL => "daemon.webzephyr";
7use constant WEBZEPHYR_CLASS     => "webzephyr";
8use constant WEBZEPHYR_OPCODE    => "webzephyr";
9
10use base qw( BarnOwl::Message );
11
12sub strip_realm {
13    my $sender = shift;
14    my $realm = BarnOwl::zephyr_getrealm();
15    $sender =~ s/\@$realm$//;
16    return $sender;
17}
18
19sub login_type {
20    return (shift->zsig eq "") ? "(PSEUDO)" : "";
21}
22
23sub login_extra {
24    my $m = shift;
25    return undef if (!$m->is_loginout);
26    my $s = lc($m->host);
27    $s .= " " . $m->login_tty if defined $m->login_tty;
28    return $s;
29}
30
31sub long_sender {
32    my $m = shift;
33    return $m->zsig;
34}
35
36sub context {
37    return shift->class;
38}
39
40sub subcontext {
41    return shift->instance;
42}
43
44sub login_tty {
45    my ($m) = @_;
46    return undef if (!$m->is_loginout);
47    return $m->fields->[2];
48}
49
50sub login_host {
51    my ($m) = @_;
52    return undef if (!$m->is_loginout);
53    return $m->fields->[0];
54}
55
56sub zwriteline  { return shift->{"zwriteline"}; }
57
58sub is_ping     { return (lc(shift->opcode) eq "ping"); }
59
60sub is_personal {
61    my ($m) = @_;
62    return ((lc($m->class) eq "message")
63            && $m->is_private);
64}
65
66sub is_mail {
67    my ($m) = @_;
68    return ((lc($m->class) eq "mail") && $m->is_private);
69}
70
71sub pretty_sender {
72    my ($m) = @_;
73    return strip_realm($m->sender);
74}
75
76sub pretty_recipient {
77    my ($m) = @_;
78    return strip_realm($m->recipient);
79}
80
81# Portion of the reply command that preserves the context
82sub context_reply_cmd {
83    my $m = shift;
84    my $class = "";
85    if (lc($m->class) ne "message") {
86        $class = "-c " . BarnOwl::quote($m->class);
87    }
88    my $instance = "";
89    if (lc($m->instance) ne "personal") {
90        $instance = "-i " . BarnOwl::quote($m->instance);
91    }
92    if (($class eq "") or  ($instance eq "")) {
93        return $class . $instance;
94    } else {
95        return $class . " " . $instance;
96    }
97}
98
99sub personal_context {
100    my ($m) = @_;
101    return $m->context_reply_cmd();
102}
103
104sub short_personal_context {
105    my ($m) = @_;
106    if(lc($m->class) eq 'message')
107    {
108        if(lc($m->instance) eq 'personal')
109        {
110            return '';
111        } else {
112            return $m->instance;
113        }
114    } else {
115        return $m->class;
116    }
117}
118
119# These are arguably zephyr-specific
120sub class       { return shift->{"class"}; }
121sub instance    { return shift->{"instance"}; }
122sub realm       { return shift->{"realm"}; }
123sub opcode      { return shift->{"opcode"}; }
124sub host        { return shift->{"hostname"}; }
125sub hostname    { return shift->{"hostname"}; }
126sub header      { return shift->{"header"}; }
127sub auth        { return shift->{"auth"}; }
128sub fields      { return shift->{"fields"}; }
129sub zsig        { return shift->{"zsig"}; }
130
131sub zephyr_cc {
132    my $self = shift;
133    return $1 if $self->body =~ /^\s*cc:\s+([^\n]+)/i;
134    return undef;
135}
136
137sub replycmd {
138    my $self = shift;
139    my $sender = shift;
140    $sender = 0 unless defined $sender;
141    my ($class, $instance, $to, $cc);
142    if($self->is_outgoing) {
143        return $self->{zwriteline};
144    }
145
146    if($sender && $self->opcode eq WEBZEPHYR_OPCODE) {
147        $class = WEBZEPHYR_CLASS;
148        $instance = $self->pretty_sender;
149        $instance =~ s/-webzephyr$//;
150        $to = WEBZEPHYR_PRINCIPAL;
151    } elsif($self->class eq WEBZEPHYR_CLASS
152            && $self->is_loginout) {
153        $class = WEBZEPHYR_CLASS;
154        $instance = $self->instance;
155        $to = WEBZEPHYR_PRINCIPAL;
156    } elsif($self->is_loginout) {
157        $class = 'MESSAGE';
158        $instance = 'PERSONAL';
159        $to = $self->sender;
160    } elsif($sender && !$self->is_private) {
161        # Possible future feature: (Optionally?) include the class and/or
162        # instance of the message being replied to in the instance of the
163        # outgoing personal reply
164        $class = 'MESSAGE';
165        $instance = 'PERSONAL';
166        $to = $self->sender;
167    } else {
168        $class = $self->class;
169        $instance = $self->instance;
170        $to = $self->recipient;
171        $cc = $self->zephyr_cc();
172        if($to eq '*' || $to eq '') {
173            $to = '';
174        } elsif($to !~ /^@/) {
175            $to = $self->sender;
176        }
177    }
178
179    my $cmd;
180    if(lc $self->opcode eq 'crypt') {
181        $cmd = 'zcrypt';
182    } else {
183        $cmd = 'zwrite';
184    }
185
186    my $context_part = $self->context_reply_cmd();
187    $cmd .= " " . $context_part unless ($context_part eq '');
188    if ($to ne '') {
189        $to = strip_realm($to);
190        if (defined $cc) {
191            my @cc = grep /^[^-]/, ($to, split /\s+/, $cc);
192            my %cc = map {$_ => 1} @cc;
193            delete $cc{strip_realm(BarnOwl::zephyr_getsender())};
194            @cc = keys %cc;
195            $cmd .= " -C " . join(" ", @cc);
196        } else {
197            if(BarnOwl::getvar('smartstrip') eq 'on') {
198                $to = BarnOwl::zephyr_smartstrip_user($to);
199            }
200            $cmd .= " $to";
201        }
202    }
203    return $cmd;
204}
205
206sub replysendercmd {
207    my $self = shift;
208    return $self->replycmd(1);
209}
210
211
2121;
Note: See TracBrowser for help on using the repository browser.