Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 163 lines (131 sloc) 4.153 kb
d8359ffc »
2001-11-03 Fry :)
1 #!/usr/bin/perl -w
2 # This code is a part of Slash, and is released under the GPL.
c0e79994 »
2005-03-11 Update 2005, OSTG, etc.
3 # Copyright 1997-2005 by Open Source Technology Group. See README
d8359ffc »
2001-11-03 Fry :)
4 # and COPYING for more information, or see http://slashcode.com/.
5 # $Id$
6
7 ###############################################################################
8 # dailyStuff - this program runs various housekeeping tasks, sends out the
9 # the mailing list, and compiles site statistics report and sends the report
10 # to the site admin
11 ###############################################################################
12
55101925 »
2002-11-26 No longer use dailyStuff, move its functionality to daily.pl
13 exit(1); # this is no longer in use, see themes/slashcode/tasks/daily.pl
14
d8359ffc »
2001-11-03 Fry :)
15 use strict;
16 use File::Basename;
17 use File::Path;
18 use File::Spec::Functions;
19 use Slash;
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
20 use Slash::Constants qw(:messages);
d8359ffc »
2001-11-03 Fry :)
21 use Slash::Display;
22 use Slash::Utility;
23
24 my $virtual_user = $ARGV[0];
25 createEnvironment($ARGV[0]);
26
27 my $constants = getCurrentStatic();
28 my $slashdb = getCurrentDB();
29 my $messages = getObject('Slash::Messages');
30
31 doLogInit('dailyStuff');
32
33 # On a site with a lot of users, this may take hours.
34 dailyStuffLog('MailingList Begin');
35 mailingList();
36 dailyStuffLog('MailingList End');
37
38
39 doLogExit('dailyStuff');
40
82231287 »
2001-12-02 dailyStuff fixes
41 sub generateDailyMailees {
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
42 my($n_users, $h_users) = @_;
43 my %mailings = (
44 dailynews => {
45 users => $n_users,
46 code => MSG_CODE_NEWSLETTER,
47 subj => getData('newsletter subject', {}, 'messages'),
48 },
49 dailyheadlines => {
50 users => $h_users,
51 code => MSG_CODE_HEADLINES,
52 subj => getData('headlines subject', {}, 'messages'),
53 },
d8359ffc »
2001-11-03 Fry :)
54 );
55
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
56 for my $mailing (keys %mailings) {
57 my $users = $mailings{$mailing}{users};
58 my $mkeys = $mailings{$mailing}{mkeys} ||= {};
59
56ce7c7d »
2002-07-15 Allow bulk mails to be individualized if necessary, by passing uid an…
60 for my $uid (keys %$users) {
61 my $user = $users->{$uid};
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
62
63 my $key = $user->{sectioncollapse};
82231287 »
2001-12-02 dailyStuff fixes
64 for (@{$user}{qw(exaid extid exsect)}) {
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
65 $key .= '|' . join(',', sort m/'(.+?)'/g);
66 }
56ce7c7d »
2002-07-15 Allow bulk mails to be individualized if necessary, by passing uid an…
67 # allow us to make certain emails sent individually,
68 # by including a unique value in users_param for
69 # this key -- pudge
70 $user->{daily_mail_special} ||= '';
71 $key .= '|' . $user->{daily_mail_special};
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
72
73 if (exists $mkeys->{$key}) {
74 push @{$mkeys->{$key}{mails}}, $user->{realemail};
75 } else {
76 $mkeys->{$key}{mails} = [$user->{realemail}];
8075bef3 »
2001-12-04 Oops, get user right in dailyStuff, right now everyone getting defaul…
77 $mkeys->{$key}{user} = {
56ce7c7d »
2002-07-15 Allow bulk mails to be individualized if necessary, by passing uid an…
78 uid => $uid,
8075bef3 »
2001-12-04 Oops, get user right in dailyStuff, right now everyone getting defaul…
79 map { ($_ => $user->{$_}) }
56ce7c7d »
2002-07-15 Allow bulk mails to be individualized if necessary, by passing uid an…
80 qw(sectioncollapse exaid extid exsect daily_mail_special)
8075bef3 »
2001-12-04 Oops, get user right in dailyStuff, right now everyone getting defaul…
81 };
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
82 }
83 }
84 }
d8359ffc »
2001-11-03 Fry :)
85
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
86 return \%mailings;
d8359ffc »
2001-11-03 Fry :)
87 }
88
82231287 »
2001-12-02 dailyStuff fixes
89 sub generateDailyMail {
90 my($mailing, $user) = @_;
91
92 my $stories;
93 # get data if not gotten yet
94 my $data = $slashdb->getDailyMail($user) or return;
95 return unless @$data; # no mail, no mas!
96
97 for (@$data) {
98 my(%story, @ref);
99 @story{qw(sid title section author tid time dept
100 introtext bodytext)} = @$_;
101
102 1 while chomp($story{introtext});
103 1 while chomp($story{bodytext});
104
a44a5a25 »
2002-06-13 Update dailyStuff to parse Slashized links in daily newsletter, and t…
105 $story{introtext} = parseSlashizedLinks($story{introtext});
106 $story{bodytext} = parseSlashizedLinks($story{bodytext});
107
82231287 »
2001-12-02 dailyStuff fixes
108 my $asciitext = $story{introtext};
109 $asciitext .= "\n\n" . $story{bodytext}
110 if $constants->{newsletter_body};
111 ($story{asciitext}, @ref) = html2text($asciitext, 74);
112
113 $story{refs} = \@ref;
114 push @$stories, \%story;
115 }
116
117 return slashDisplay($mailing,
118 { stories => $stories, urlize => \&urlize },
ca9bfc53 »
2004-06-22 Section => Skin
119 { Return => 1, Nocomm => 1, Page => 'messages', Skin => 'NONE' }
82231287 »
2001-12-02 dailyStuff fixes
120 );
121 }
122
d8359ffc »
2001-11-03 Fry :)
123 sub mailingList {
124 return unless $messages;
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
125 my $n_users = $messages->getNewsletterUsers();
126 my $h_users = $messages->getHeadlineUsers();
127
82231287 »
2001-12-02 dailyStuff fixes
128 my $mailings = generateDailyMailees($n_users, $h_users) or return;
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
129
130 for my $mailing (keys %$mailings) {
131 my $subj = $mailings->{$mailing}{subj};
132 my $code = $mailings->{$mailing}{code};
133 my $mkeys = $mailings->{$mailing}{mkeys};
134
135 dailyStuffLog("Daily Mail ($mailing) begin");
136 for my $key (keys %$mkeys) {
8075bef3 »
2001-12-04 Oops, get user right in dailyStuff, right now everyone getting defaul…
137 my $user = $mkeys->{$key}{user};
9cf6f017 »
2001-12-04 Don't send empty messages
138 my $text = generateDailyMail($mailing, $user) or next;
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
139 $messages->bulksend(
56ce7c7d »
2002-07-15 Allow bulk mails to be individualized if necessary, by passing uid an…
140 $mkeys->{$key}{mails}, $subj,
141 $text, $code, $user->{uid}
af32b28c »
2001-11-26 Send messages per user's settings; fix nickname encoding
142 );
143 }
144 dailyStuffLog("Daily Mail ($mailing) end");
145 }
d8359ffc »
2001-11-03 Fry :)
146 }
147
148 sub dailyStuffLog {
149 doLog('dailyStuff', \@_);
150 }
151
152 sub urlize {
153 local($_) = @_;
154 s/^(.{62})/$1\n/g;
155 s/(\S{74})/$1\n/g;
156 $_ = "<URL:" . $_ . ">";
157 return $_;
158 }
159
160 1;
56ce7c7d »
2002-07-15 Allow bulk mails to be individualized if necessary, by passing uid an…
161
162 __END__
Something went wrong with that request. Please try again.