line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package LJ::Simple; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
8144
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
4
|
1
|
|
|
1
|
|
4
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
134
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
require Exporter; |
7
|
|
|
|
|
|
|
require AutoLoader; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
@ISA = qw(Exporter AutoLoader); |
10
|
|
|
|
|
|
|
@EXPORT_OK = qw(); |
11
|
|
|
|
|
|
|
@EXPORT = qw(); |
12
|
|
|
|
|
|
|
$VERSION = '0.15'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
## Bring in modules we use |
15
|
1
|
|
|
1
|
|
5
|
use strict; # Silly not to be strict |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
24
|
|
16
|
1
|
|
|
1
|
|
7197
|
use Socket; # Required for talking to the LJ server |
|
1
|
|
|
|
|
4083
|
|
|
1
|
|
|
|
|
641
|
|
17
|
1
|
|
|
1
|
|
963
|
use POSIX; # For errno values and other POSIX functions |
|
1
|
|
|
|
|
6926
|
|
|
1
|
|
|
|
|
7
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
## Helper function prototypes |
20
|
|
|
|
|
|
|
sub Debug(@); |
21
|
|
|
|
|
|
|
sub EncVal($$); |
22
|
|
|
|
|
|
|
sub DecVal($); |
23
|
|
|
|
|
|
|
sub SendRequest($$$$); |
24
|
|
|
|
|
|
|
sub dump_list($$); |
25
|
|
|
|
|
|
|
sub dump_hash($$); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=pod |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 NAME |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
LJ::Simple - A perl module to access LiveJournal via its flat protocol |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 SYNOPSIS |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
C is an object based C module which is used to access |
36
|
|
|
|
|
|
|
LiveJournal-based web logs. This module implements most of the |
37
|
|
|
|
|
|
|
flat protocol LiveJournal uses; for details of this protocol please |
38
|
|
|
|
|
|
|
see: L |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 REQUIREMENTS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
This module requires nothing other than the modules which come with the |
43
|
|
|
|
|
|
|
standard perl 5.6.1 distribution. The only modules it B are |
44
|
|
|
|
|
|
|
C and C. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
If you have the C module available then the code will make use of |
47
|
|
|
|
|
|
|
encrypted passwords automatically. However C is not required for |
48
|
|
|
|
|
|
|
this module to work. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 DESCRIPTION |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
C is a trival API to access LiveJournal. Currently it |
53
|
|
|
|
|
|
|
allows you to: |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=over 2 |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=item Login |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Log into the LiveJournal system |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item Post |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Post a new journal entry in the LiveJournal system |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=item Synchronise |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Returns a list of journal entries created or modified from a given |
68
|
|
|
|
|
|
|
date. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item Edit |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Edit the contents of an existing entry within the LiveJournal system |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item Delete |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Delete an existing post from the LiveJournal system |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=back |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 EXAMPLE |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
The following simple examples shows you how to use the module to post a |
83
|
|
|
|
|
|
|
simple LiveJournal entry. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head2 Using LJ::Simple::QuickPost() |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
C is a routine which allows you to quickly post an entry into |
88
|
|
|
|
|
|
|
LiveJournal; as such it lacks a lot of the abilities which using the object-based |
89
|
|
|
|
|
|
|
interface provides. The C routine is explained in depth below, however |
90
|
|
|
|
|
|
|
the following example shows how it can be used to easily post to LiveJournal: |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
use LJ::Simple; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
LJ::Simple::QuickPost( |
95
|
|
|
|
|
|
|
user => "test", |
96
|
|
|
|
|
|
|
pass => "test", |
97
|
|
|
|
|
|
|
entry => "Just a simple entry", |
98
|
|
|
|
|
|
|
) || die "$0: Failed to post entry: $LJ::Simple::error\n"; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head2 Using the standard calls |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
use LJ::Simple; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Log into the server |
105
|
|
|
|
|
|
|
my $lj = new LJ::Simple ({ |
106
|
|
|
|
|
|
|
user => "test", |
107
|
|
|
|
|
|
|
pass => "test", |
108
|
|
|
|
|
|
|
site => undef, |
109
|
|
|
|
|
|
|
}); |
110
|
|
|
|
|
|
|
(defined $lj) |
111
|
|
|
|
|
|
|
|| die "$0: Failed to log into LiveJournal: $LJ::Simple::error\n"; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Prepare the event |
114
|
|
|
|
|
|
|
my %Event=(); |
115
|
|
|
|
|
|
|
$lj->NewEntry(\%Event) || |
116
|
|
|
|
|
|
|
die "$0: Failed to create new entry: $LJ::Simple::error\n"; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# Put in the entry |
119
|
|
|
|
|
|
|
my $entry=<
|
120
|
|
|
|
|
|
|
A simple entry made using LJ::Simple version $LJ::Simple::VERSION |
121
|
|
|
|
|
|
|
EOF |
122
|
|
|
|
|
|
|
$lj->SetEntry(\%Event,$entry) |
123
|
|
|
|
|
|
|
|| die "$0: Failed to set entry: $LJ::Simple::error\n"; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# Say we are happy |
126
|
|
|
|
|
|
|
$lj->SetMood(\%Event,"happy") |
127
|
|
|
|
|
|
|
|| die "$0: Failed to set mood: $LJ::Simple::error\n"; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# Post the event |
130
|
|
|
|
|
|
|
my ($item_id,$anum,$html_id)=$lj->PostEntry(\%Event); |
131
|
|
|
|
|
|
|
(defined $item_id) |
132
|
|
|
|
|
|
|
|| die "$0: Failed to post journal entry: $LJ::Simple::error\n"; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head1 VARIABLES |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
There are various variables which can be used to control certain |
137
|
|
|
|
|
|
|
aspects of the module. It is generally recommended that if you |
138
|
|
|
|
|
|
|
wish to change these variables that you do so B you |
139
|
|
|
|
|
|
|
create the initial object. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
The variable you are most likely to use is C<$LJ::Simple::error> |
142
|
|
|
|
|
|
|
which holds error messages if any of the C calls |
143
|
|
|
|
|
|
|
fail. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=over 4 |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item $LJ::Simple::error |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Holds error messages, is set with a blank string at the |
150
|
|
|
|
|
|
|
start of each method. Whilst the messages are relatively free-form, |
151
|
|
|
|
|
|
|
there are some prefixes which are sometimes used: |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
CODE: An error in the code calling the API |
154
|
|
|
|
|
|
|
INTERNAL: An internal error in this module |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item $LJ::Simple::debug |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
If set to C<1>, debugging messages are sent to stderr. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item $LJ::Simple::protocol |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
If set to C<1> the protocol used to talk to the remote server is sent to stderr. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item $LJ::Simple::raw_protocol |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
If set to C<1> the raw protocol used to talk to the remote server is sent to stderr; |
167
|
|
|
|
|
|
|
this is only useful if you are doing debugging on C itself as the protocol |
168
|
|
|
|
|
|
|
is shown as the module gets it from the server; non-printable characters are converted |
169
|
|
|
|
|
|
|
to their octal presentation form, I a newline becomes C<\012>. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
It should be noted that if C<$LJ::Simple::raw_protocol> is set along with |
172
|
|
|
|
|
|
|
C<$LJ::Simple::protocol> then the raw protocol display takes precedence for data |
173
|
|
|
|
|
|
|
returning from the LJ server. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item $LJ::Simple::UTF |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
If set to C<1> the LiveJournal server is told to expect UTF-8 encoded characters. |
178
|
|
|
|
|
|
|
If you enable this the module will attempt to use the utf8 perl module. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
The default is see if we have a version of Perl with UTF-8 support and use |
181
|
|
|
|
|
|
|
it if its available. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item $LJ::Simple::challenge |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
If set to C<1> we make use of the challenge-response system instead of using |
186
|
|
|
|
|
|
|
plain or hashed passwords. This does add some overhead into processing requests |
187
|
|
|
|
|
|
|
since every action has to be preceeded by a request for a challenge value from |
188
|
|
|
|
|
|
|
the server. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
The default is to see if we have the C module available and if |
191
|
|
|
|
|
|
|
so we make use of the challenge-response system. This can be disabled by |
192
|
|
|
|
|
|
|
setting the variable to C<0>. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item $LJ::Simple::timeout |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
The time - specified in seconds - to wait for data from the server. If |
197
|
|
|
|
|
|
|
given a value of C the API will block until data is avaiable. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=item $LJ::Simple::NonBlock |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
By default this is set to C. When given a reference to a sub-routine this |
202
|
|
|
|
|
|
|
module will call the given sub-routine at various stages of processing the responses |
203
|
|
|
|
|
|
|
to the LiveJournal server. This is intended for GUI applications which need to process |
204
|
|
|
|
|
|
|
event queues, update progress bars, I. When called the sub-routine is passed a |
205
|
|
|
|
|
|
|
number of variables which maybe useful; the calling method is: |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
&{sub}($mode,$status,$action,$bytes_in,$bytes_out,$time,$waiting) |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$mode - The mode sent to the LJ server |
210
|
|
|
|
|
|
|
$status - The status of the request; ranges from 0 to 1 |
211
|
|
|
|
|
|
|
$action - The action performed |
212
|
|
|
|
|
|
|
$bytes_in - The number of bytes read from the remote server |
213
|
|
|
|
|
|
|
$bytes_out - The number of bytes written to the remote server |
214
|
|
|
|
|
|
|
$time - The time taken so far in seconds |
215
|
|
|
|
|
|
|
$waiting - Are we waiting for a response from the server ? |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
It should be noted that if C<$waiting> is set to C<1> then it is B recommended |
218
|
|
|
|
|
|
|
that the sub-routine calls C |
219
|
|
|
|
|
|
|
this is not done it is likely that this module will consume far more CPU than necessary. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
An example sub-routine follows: |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub LJStatus { |
224
|
|
|
|
|
|
|
my ($mode,$status,$action,$bytes_in,$bytes_out,$time,$waiting) = @_; |
225
|
|
|
|
|
|
|
print "\$mode = $mode\n"; |
226
|
|
|
|
|
|
|
print "\$status = $status\n"; |
227
|
|
|
|
|
|
|
print "\$action = $action\n"; |
228
|
|
|
|
|
|
|
print "\$bytes_in = $bytes_in\n"; |
229
|
|
|
|
|
|
|
print "\$bytes_out = $bytes_out\n"; |
230
|
|
|
|
|
|
|
print "\$time = $time\n"; |
231
|
|
|
|
|
|
|
print "\$waiting = $waiting\n"; |
232
|
|
|
|
|
|
|
print "\n"; |
233
|
|
|
|
|
|
|
($waiting) && select(undef,undef,undef,0.5); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
$LJ::Simple::NonBlock=\&LJStatus; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item $LJ::Simple::ProtoSub |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
By default this points to a sub-routine within the module; this is called when |
241
|
|
|
|
|
|
|
the protocol between the module and LiveJournal server is to be shown, in other |
242
|
|
|
|
|
|
|
words when C<$LJ::Simple::protocol> is set to C<1>. The sub-routine called must |
243
|
|
|
|
|
|
|
take two variables; it is called in the following way: |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
&{sub}($direction,$data,$server,$ip_addr) |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
$direction - The direction of the flow; 0 means from client to server |
248
|
|
|
|
|
|
|
and 1 means from server to client |
249
|
|
|
|
|
|
|
$data - The data which has flowed; there should not be any newlines |
250
|
|
|
|
|
|
|
with the data, but do not rely on this. |
251
|
|
|
|
|
|
|
$server - The name of the LJ server we are talking to |
252
|
|
|
|
|
|
|
$ip_addr - The IP address of the LJ server we are talking to |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
If both variables are C then data is about to flow. If just C<$direction> is |
255
|
|
|
|
|
|
|
C then C<$data> holds an informational message. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
The standard sub-routine which is called is: |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub DefaultProtoSub { |
260
|
|
|
|
|
|
|
my ($direct,$data,$server,$ip_addr)=@_; |
261
|
|
|
|
|
|
|
my $arrow="--> "; |
262
|
|
|
|
|
|
|
if (!defined $direct) { |
263
|
|
|
|
|
|
|
if (!defined $data) { |
264
|
|
|
|
|
|
|
print STDERR "Connecting to $server [$ip_addr]\n"; |
265
|
|
|
|
|
|
|
print STDERR "Lines starting with \"-->\" is data SENT to the server\n"; |
266
|
|
|
|
|
|
|
print STDERR "Lines starting with \"<--\" is data RECEIVED from the server\n"; |
267
|
|
|
|
|
|
|
return; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
$arrow=""; |
270
|
|
|
|
|
|
|
} else { |
271
|
|
|
|
|
|
|
($direct) && ($arrow="<-- "); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
print STDERR "$arrow$data\n"; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
$LJ::Simple::ProtoSub=\&DefaultProtoSub; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=item $LJ::Simple::buffer |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
The number of bytes to try and read in on each C call. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=back |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub DefaultProtoSub { |
287
|
0
|
|
|
0
|
0
|
0
|
my ($direct,$data,$server,$ip_addr)=@_; |
288
|
0
|
|
|
|
|
0
|
my $arrow="--> "; |
289
|
0
|
0
|
|
|
|
0
|
if (!defined $direct) { |
290
|
0
|
0
|
|
|
|
0
|
if (!defined $data) { |
291
|
0
|
|
|
|
|
0
|
print STDERR "Connecting to $server [$ip_addr]\n"; |
292
|
0
|
|
|
|
|
0
|
print STDERR "Lines starting with \"-->\" is data SENT to the server\n"; |
293
|
0
|
|
|
|
|
0
|
print STDERR "Lines starting with \"<--\" is data RECEIVED from the server\n"; |
294
|
0
|
|
|
|
|
0
|
return; |
295
|
|
|
|
|
|
|
} |
296
|
0
|
|
|
|
|
0
|
$arrow=""; |
297
|
|
|
|
|
|
|
} else { |
298
|
0
|
0
|
|
|
|
0
|
($direct) && ($arrow="<-- "); |
299
|
|
|
|
|
|
|
} |
300
|
0
|
|
|
|
|
0
|
print STDERR "$arrow$data\n"; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
## Global variables - documented |
305
|
|
|
|
|
|
|
# Debug ? |
306
|
|
|
|
|
|
|
$LJ::Simple::debug=0; |
307
|
|
|
|
|
|
|
# Show protocol ? |
308
|
|
|
|
|
|
|
$LJ::Simple::protocol=0; |
309
|
|
|
|
|
|
|
# Protocol handling code |
310
|
|
|
|
|
|
|
$LJ::Simple::ProtoSub=\&DefaultProtoSub; |
311
|
|
|
|
|
|
|
# Show raw protocol ? |
312
|
|
|
|
|
|
|
$LJ::Simple::raw_protocol=0; |
313
|
|
|
|
|
|
|
# Use UTF-8 ? |
314
|
|
|
|
|
|
|
$LJ::Simple::UTF = undef; |
315
|
|
|
|
|
|
|
# Use challenge-response ? |
316
|
|
|
|
|
|
|
$LJ::Simple::challenge = undef; |
317
|
|
|
|
|
|
|
# Use non-block sub-routine |
318
|
|
|
|
|
|
|
$LJ::Simple::NonBlock = undef; |
319
|
|
|
|
|
|
|
# Errors |
320
|
|
|
|
|
|
|
$LJ::Simple::error=""; |
321
|
|
|
|
|
|
|
# Timeout for reading from sockets - default is 5 minutes |
322
|
|
|
|
|
|
|
$LJ::Simple::timeout = 300; |
323
|
|
|
|
|
|
|
# How much data to read from the socket in one read() |
324
|
|
|
|
|
|
|
$LJ::Simple::buffer = 8192; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
## Global variables - internal and undocumented |
327
|
|
|
|
|
|
|
# Should we not fully run the QuickPost routine ? |
328
|
|
|
|
|
|
|
$LJ::Simple::TestStopQuickPost = 0; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
## Internal variables - private to this module |
331
|
|
|
|
|
|
|
# Standard ports |
332
|
|
|
|
|
|
|
my %StdPort = ( |
333
|
|
|
|
|
|
|
http => 80, |
334
|
|
|
|
|
|
|
http_proxy => 3128, |
335
|
|
|
|
|
|
|
); |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=pod |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head1 AVAILABLE METHODS |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=head2 LJ::Simple::QuickPost() |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
C is a routine which allows you to quick post to LiveJournal. |
344
|
|
|
|
|
|
|
However it does this by hiding a lot of the details involved in using |
345
|
|
|
|
|
|
|
C to do this. This routine will do all of the work involved in |
346
|
|
|
|
|
|
|
logging into the LiveJournal server, preparing the entry and then posting it. |
347
|
|
|
|
|
|
|
If at any stage there is a failure then C<0> is returned and C<$LJ::Simple::error> |
348
|
|
|
|
|
|
|
will contain the reason why. If the entry was successfully posted to the LiveJournal |
349
|
|
|
|
|
|
|
server then the routine will return C<1>. |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
There are a number of options to the C routine: |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
LJ::Simple::QuickPost( |
354
|
|
|
|
|
|
|
user => Username |
355
|
|
|
|
|
|
|
pass => Password |
356
|
|
|
|
|
|
|
entry => Contents of the entry |
357
|
|
|
|
|
|
|
subject => Subject line of the entry |
358
|
|
|
|
|
|
|
mood => Current mood |
359
|
|
|
|
|
|
|
music => Current music |
360
|
|
|
|
|
|
|
html => HTML content ? |
361
|
|
|
|
|
|
|
protect => Security settings of the entry |
362
|
|
|
|
|
|
|
groups => Friends groups list |
363
|
|
|
|
|
|
|
tags => Tags list |
364
|
|
|
|
|
|
|
results => Hash to store results in |
365
|
|
|
|
|
|
|
); |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
Of these, only the C, C and C options are required; all of the other |
368
|
|
|
|
|
|
|
options are optional. The option names are all case insensitive. |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=over 4 |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=item user |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
The username who owns the journal the entry should be posted to; |
375
|
|
|
|
|
|
|
this option is B. |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=item pass |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
The password of the C; |
380
|
|
|
|
|
|
|
this option is B. |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=item entry |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
The actual entry itself; |
385
|
|
|
|
|
|
|
this option is B. |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=item subject |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
The subject line of the post. |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=item mood |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
The mood to associate with the post; the value is given to the C method |
394
|
|
|
|
|
|
|
for processing. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=item music |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
The music to associate with the post. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=item html |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
This is a boolean value of either C<1> or C<0>. If you want to say that the entry |
403
|
|
|
|
|
|
|
contains HTML and thus should be considered to be preformatted then set C to |
404
|
|
|
|
|
|
|
C<1>. Otherwise you can either set it to C<0> or not give the option. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=item protect |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
By default the new entry will be public unless you give the C option. This |
409
|
|
|
|
|
|
|
option should be given the protection level required for the post and can be one of |
410
|
|
|
|
|
|
|
the following: |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
public - The entry is public |
413
|
|
|
|
|
|
|
friends - Entry is friends-only |
414
|
|
|
|
|
|
|
groups - Entry is restricted to friends groups |
415
|
|
|
|
|
|
|
private - Entry is restricted to the journal's owner |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
If you set the C option to C you must also include the C |
418
|
|
|
|
|
|
|
option - see below for details. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=item groups |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
If the C option is set to C then this option should contain a |
423
|
|
|
|
|
|
|
list reference which contains the list of groups the entry should be restricted to. |
424
|
|
|
|
|
|
|
This option is B if the C option is set to C. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item tags |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Set tags for the entry; this should contain a list reference which contains the |
429
|
|
|
|
|
|
|
tags to be set. |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item results |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
The results of posting the entry should be returned; this should contain a |
434
|
|
|
|
|
|
|
hash reference. The hash given will be filled with the result of posting the |
435
|
|
|
|
|
|
|
article; the hash refered to B by this. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
The keys in the hash point to: |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
ok - Return code of QuickPost |
440
|
|
|
|
|
|
|
item_id - Item_id as returned by the LiveJournal server |
441
|
|
|
|
|
|
|
anum - Anum as returned by the LiveJournal server |
442
|
|
|
|
|
|
|
html_id - The item_id of the entry as used in HTML |
443
|
|
|
|
|
|
|
url - A URL which could be used to access the entry |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
It should be noted that when C fails, C will point to |
446
|
|
|
|
|
|
|
a value of C<0> and all other entries in the hash will be C. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=back |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Example code: |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# Simple test post |
453
|
|
|
|
|
|
|
LJ::Simple::QuickPost( |
454
|
|
|
|
|
|
|
user => "test", |
455
|
|
|
|
|
|
|
pass => "test", |
456
|
|
|
|
|
|
|
entry => "Just a simple entry", |
457
|
|
|
|
|
|
|
) || die "$0: Failed to post entry: $LJ::Simple::error\n"; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
# A friends-only preformatted entry |
460
|
|
|
|
|
|
|
LJ::Simple::QuickPost( |
461
|
|
|
|
|
|
|
user => "test", |
462
|
|
|
|
|
|
|
pass => "test", |
463
|
|
|
|
|
|
|
entry => " Friends-only, preformatted, entry ", |
464
|
|
|
|
|
|
|
html => 1, |
465
|
|
|
|
|
|
|
protect => "friends", |
466
|
|
|
|
|
|
|
) || die "$0: Failed to post entry: $LJ::Simple::error\n"; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# A entry restricted to several friends groups |
469
|
|
|
|
|
|
|
LJ::Simple::QuickPost( |
470
|
|
|
|
|
|
|
user => "test", |
471
|
|
|
|
|
|
|
pass => "test", |
472
|
|
|
|
|
|
|
entry => "Entry limited to friends groups", |
473
|
|
|
|
|
|
|
protect => "groups", |
474
|
|
|
|
|
|
|
groups => [qw( one_group another_group )], |
475
|
|
|
|
|
|
|
) || die "$0: Failed to post entry: $LJ::Simple::error\n"; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# Simple test post with tags and returning HTML |
478
|
|
|
|
|
|
|
my %Results=(); |
479
|
|
|
|
|
|
|
LJ::Simple::QuickPost( |
480
|
|
|
|
|
|
|
user => "test", |
481
|
|
|
|
|
|
|
pass => "test", |
482
|
|
|
|
|
|
|
entry => "Just a simple entry", |
483
|
|
|
|
|
|
|
tags => [ "Just a test", "Testing" ], |
484
|
|
|
|
|
|
|
results => \%Results, |
485
|
|
|
|
|
|
|
) || die "$0: Failed to post entry: $LJ::Simple::error\n"; |
486
|
|
|
|
|
|
|
print "URL = $Results{url}\n"; |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=cut |
489
|
|
|
|
|
|
|
sub QuickPost(@) { |
490
|
13
|
|
|
13
|
1
|
460
|
my %opts=(); |
491
|
13
|
|
|
|
|
14
|
my @prot_opts=(); |
492
|
13
|
|
|
|
|
29
|
while($#_>-1) { |
493
|
43
|
|
|
|
|
59
|
my $k=lc(shift(@_)); |
494
|
43
|
|
|
|
|
42
|
my $v=shift(@_); |
495
|
43
|
100
|
|
|
|
61
|
(defined $v) || next; |
496
|
42
|
|
|
|
|
85
|
$opts{$k}=$v; |
497
|
|
|
|
|
|
|
} |
498
|
13
|
|
|
|
|
17
|
foreach (qw( user pass entry )) { |
499
|
34
|
100
|
|
|
|
60
|
(exists $opts{$_}) && next; |
500
|
3
|
|
|
|
|
6
|
$LJ::Simple::error="CODE: QuickPost() called without the required $_ option"; |
501
|
3
|
|
|
|
|
6
|
return 0; |
502
|
|
|
|
|
|
|
} |
503
|
10
|
100
|
100
|
|
|
32
|
if ((exists $opts{html}) && ($opts{html}!~/^[01]$/)) { |
504
|
1
|
|
|
|
|
1
|
$LJ::Simple::error="CODE: QuickPost() not given either 0 or 1 for html option"; |
505
|
1
|
|
|
|
|
3
|
return 0; |
506
|
|
|
|
|
|
|
} |
507
|
9
|
100
|
66
|
|
|
26
|
if ((exists $opts{protect}) && ($opts{protect} eq "groups")) { |
508
|
3
|
100
|
|
|
|
8
|
if (!exists $opts{groups}) { |
509
|
1
|
|
|
|
|
1
|
$LJ::Simple::error="CODE: QuickPost() given protect=groups, but no groups option"; |
510
|
1
|
|
|
|
|
3
|
return 0; |
511
|
|
|
|
|
|
|
} |
512
|
2
|
100
|
|
|
|
7
|
if (ref($opts{groups}) ne "ARRAY") { |
513
|
1
|
|
|
|
|
2
|
$LJ::Simple::error="CODE: QuickPost() not given a list reference for the groups option"; |
514
|
1
|
|
|
|
|
4
|
return 0; |
515
|
|
|
|
|
|
|
} |
516
|
1
|
|
|
|
|
2
|
@prot_opts=@{$opts{groups}}; |
|
1
|
|
|
|
|
3
|
|
517
|
|
|
|
|
|
|
} |
518
|
7
|
100
|
100
|
|
|
23
|
if ((exists $opts{tags}) && (ref($opts{tags}) ne "ARRAY")) { |
519
|
1
|
|
|
|
|
3
|
$LJ::Simple::error="CODE: QuickPost() not given a list reference for the tags option"; |
520
|
1
|
|
|
|
|
3
|
return 0; |
521
|
|
|
|
|
|
|
} |
522
|
6
|
100
|
100
|
|
|
20
|
if ((exists $opts{results}) && (ref($opts{results}) ne "HASH")) { |
523
|
1
|
|
|
|
|
1
|
$LJ::Simple::error="CODE: QuickPost() not given a hash reference for the results option"; |
524
|
1
|
|
|
|
|
5
|
return 0; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# Kludge so we can test the input validation |
528
|
5
|
50
|
|
|
|
17
|
($LJ::Simple::TestStopQuickPost) && return 1; |
529
|
|
|
|
|
|
|
|
530
|
0
|
|
|
|
|
0
|
my $lj = new LJ::Simple({ |
531
|
|
|
|
|
|
|
user => $opts{user}, |
532
|
|
|
|
|
|
|
pass => $opts{pass}, |
533
|
|
|
|
|
|
|
}); |
534
|
0
|
0
|
|
|
|
0
|
(defined $lj) || return 0; |
535
|
|
|
|
|
|
|
|
536
|
0
|
|
|
|
|
0
|
my %Event=(); |
537
|
0
|
0
|
|
|
|
0
|
$lj->NewEntry(\%Event) || return 0; |
538
|
0
|
0
|
|
|
|
0
|
$lj->SetEntry(\%Event,$opts{entry}) || return 0; |
539
|
0
|
0
|
0
|
|
|
0
|
(exists $opts{subject}) && |
540
|
|
|
|
|
|
|
($lj->SetSubject(\%Event,$opts{subject}) || return 0); |
541
|
0
|
0
|
0
|
|
|
0
|
(exists $opts{mood}) && |
542
|
|
|
|
|
|
|
($lj->SetMood(\%Event,$opts{mood}) || return 0); |
543
|
0
|
0
|
0
|
|
|
0
|
(exists $opts{music}) && |
544
|
|
|
|
|
|
|
($lj->Setprop_current_music(\%Event,$opts{music}) || return 0); |
545
|
0
|
0
|
0
|
|
|
0
|
(exists $opts{html}) && |
546
|
|
|
|
|
|
|
($lj->Setprop_preformatted(\%Event,$opts{html}) || return 0); |
547
|
0
|
0
|
0
|
|
|
0
|
(exists $opts{protect}) && |
548
|
|
|
|
|
|
|
($lj->SetProtect(\%Event,$opts{protect},@prot_opts) || return 0); |
549
|
0
|
|
|
|
|
0
|
(exists $opts{tags}) && |
550
|
0
|
0
|
0
|
|
|
0
|
($lj->Setprop_taglist(\%Event,@{$opts{tags}}) || return 0); |
551
|
|
|
|
|
|
|
|
552
|
0
|
|
|
|
|
0
|
my $RetCode = 0; |
553
|
0
|
|
|
|
|
0
|
my ($item_id,$anum,$html_id)=$lj->PostEntry(\%Event); |
554
|
0
|
0
|
|
|
|
0
|
(defined $item_id) && ($RetCode=1); |
555
|
0
|
0
|
|
|
|
0
|
if (exists $opts{results}) { |
556
|
0
|
|
|
|
|
0
|
my $user=$lj->user(); |
557
|
0
|
|
|
|
|
0
|
my $server=$lj->{lj}->{host}; |
558
|
0
|
|
|
|
|
0
|
my $port=$lj->{lj}->{port}; |
559
|
0
|
|
|
|
|
0
|
%{$opts{results}}=( |
|
0
|
|
|
|
|
0
|
|
560
|
|
|
|
|
|
|
ok => $RetCode, |
561
|
|
|
|
|
|
|
item_id => $item_id, |
562
|
|
|
|
|
|
|
anum => $anum, |
563
|
|
|
|
|
|
|
html_id => $html_id, |
564
|
|
|
|
|
|
|
url => "http://$server:$port/users/$user/$html_id.html", |
565
|
|
|
|
|
|
|
); |
566
|
|
|
|
|
|
|
} |
567
|
0
|
|
|
|
|
0
|
return $RetCode; |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=pod |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=head2 Object creation |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=over 4 |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=item login |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Logs into the LiveJournal system. |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
## Simplest logon method |
581
|
|
|
|
|
|
|
my $lj = new LJ::Simple ( { |
582
|
|
|
|
|
|
|
user => "username", |
583
|
|
|
|
|
|
|
pass => "password", |
584
|
|
|
|
|
|
|
} ); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
## Login with options |
587
|
|
|
|
|
|
|
my $lj = new LJ::Simple ( { |
588
|
|
|
|
|
|
|
user => "username", |
589
|
|
|
|
|
|
|
pass => "password", |
590
|
|
|
|
|
|
|
site => "hostname[:port]", |
591
|
|
|
|
|
|
|
proxy => "hostname[:port]", |
592
|
|
|
|
|
|
|
moods => 0 | 1, |
593
|
|
|
|
|
|
|
pics => 0 | 1, |
594
|
|
|
|
|
|
|
fast => 0 | 1, |
595
|
|
|
|
|
|
|
} ); |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
## Login by using login() |
598
|
|
|
|
|
|
|
my $lj = LJ::Simple->login ( { |
599
|
|
|
|
|
|
|
user => "username", |
600
|
|
|
|
|
|
|
pass => "password", |
601
|
|
|
|
|
|
|
site => "hostname[:port]", |
602
|
|
|
|
|
|
|
proxy => "hostname[:port]", |
603
|
|
|
|
|
|
|
moods => 0 | 1, |
604
|
|
|
|
|
|
|
pics => 0 | 1, |
605
|
|
|
|
|
|
|
fast => 0 | 1, |
606
|
|
|
|
|
|
|
} ); |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
Where: |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
user is the username to use |
611
|
|
|
|
|
|
|
pass is the password associated with the username |
612
|
|
|
|
|
|
|
site is the remote site to use |
613
|
|
|
|
|
|
|
proxy is the HTTP proxy site to use; see below. |
614
|
|
|
|
|
|
|
moods is set to 0 if we do not want to download the mood |
615
|
|
|
|
|
|
|
list. Defaults to 1 |
616
|
|
|
|
|
|
|
pics is set to 0 if we do not want to download the user |
617
|
|
|
|
|
|
|
picture information. Defaults to 1 |
618
|
|
|
|
|
|
|
fast is set to 1 if we want to perform a fast login. |
619
|
|
|
|
|
|
|
Default is 0. See below for details of this. |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
Sites defined in C or C are a hostname with an |
622
|
|
|
|
|
|
|
optional port number, separated by a C<:>, i.e.: |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
www.livejournal.com |
625
|
|
|
|
|
|
|
www.livejournal.com:80 |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
If C is given C then the code assumes that you wish to |
628
|
|
|
|
|
|
|
connect to C. If no port is given then port |
629
|
|
|
|
|
|
|
C<80> is the default. |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
If C is given C then the code will go directly to the |
632
|
|
|
|
|
|
|
C<$site> unless a suitable environment variable is set. |
633
|
|
|
|
|
|
|
If no port is given then port C<3128> is the default. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
C also supports the use the environment variables C |
636
|
|
|
|
|
|
|
and C to store the HTTP proxy server details. The format of these |
637
|
|
|
|
|
|
|
environment variables is assumed to be: |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
http://server[:port]/ |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Where C is the name of the proxy server and the optional C the |
642
|
|
|
|
|
|
|
proxy server is on - port C<3128> is used if no port is explicitly given. |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
It should be noted that the proxy environment variables are B checked |
645
|
|
|
|
|
|
|
if the C value is B given to the C object creation. |
646
|
|
|
|
|
|
|
Thus to disable looking at the proxy environment variables use |
647
|
|
|
|
|
|
|
Cundef> in C or C. |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
If C is set to C<0> then the mood list will not be pulled from |
650
|
|
|
|
|
|
|
the LiveJournal server and the following functions will be affected: |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
o moods() will always return undef (error) |
653
|
|
|
|
|
|
|
o Setprop_current_mood_id() will not validate the mood_id |
654
|
|
|
|
|
|
|
given to it. |
655
|
|
|
|
|
|
|
o SetMood() will not attempt to convert the string it is |
656
|
|
|
|
|
|
|
given into a given mood_id |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
If C is set to C<0> then the data on the user pictures will |
659
|
|
|
|
|
|
|
not be pulled from the LiveJournal server and the following |
660
|
|
|
|
|
|
|
functions will be affected: |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
o pictures() will always return undef (error) |
663
|
|
|
|
|
|
|
o Setprop_picture_keyword() will blindly set the picture keyword |
664
|
|
|
|
|
|
|
you give it - no validation will be performed. |
665
|
|
|
|
|
|
|
o DefaultPicURL() will always return undef (error) |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
If C is set to C<1> then we will perform a I. Essentially |
668
|
|
|
|
|
|
|
all this does is to set up the various entries in the object hash which |
669
|
|
|
|
|
|
|
the routines called after C expect to see; at no time does it talk to |
670
|
|
|
|
|
|
|
the LiveJournal servers. What this means is that it is very fast. However it |
671
|
|
|
|
|
|
|
also means that when you use parts of the API which B talk to the LiveJournal |
672
|
|
|
|
|
|
|
servers its quite possible that you will get back errors associated with |
673
|
|
|
|
|
|
|
authentication errors, network outages, I. In other words, in C mode |
674
|
|
|
|
|
|
|
the login will always succeed, no matter what the state the LiveJournal |
675
|
|
|
|
|
|
|
server we're talking is in. It should be noted that the following functions |
676
|
|
|
|
|
|
|
will be affected if you enable the I: |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
o moods() will always return undef (error) |
679
|
|
|
|
|
|
|
o Setprop_current_mood_id() will not validate the mood_id |
680
|
|
|
|
|
|
|
given to it |
681
|
|
|
|
|
|
|
o SetMood() will not attempt to convert the string it is |
682
|
|
|
|
|
|
|
given into a given mood_id |
683
|
|
|
|
|
|
|
o pictures() will always return undef (error) |
684
|
|
|
|
|
|
|
o Setprop_picture_keyword() will blindly set the picture keyword |
685
|
|
|
|
|
|
|
you give it - no validation will be performed |
686
|
|
|
|
|
|
|
o communities() will always return an empty list |
687
|
|
|
|
|
|
|
o MemberOf() will always return 0 (error) |
688
|
|
|
|
|
|
|
o UseJournal() will not validate the shared journal name you |
689
|
|
|
|
|
|
|
give it |
690
|
|
|
|
|
|
|
o groups() will always return undef (error) |
691
|
|
|
|
|
|
|
o MapGroupToId() will always undef (error) |
692
|
|
|
|
|
|
|
o MapIdToGroup() will always undef (error) |
693
|
|
|
|
|
|
|
o SetProtectGroups() will always 0 (error) |
694
|
|
|
|
|
|
|
o message() will always return undef (error) |
695
|
|
|
|
|
|
|
o The key of "groups" in the list of hashes returned by |
696
|
|
|
|
|
|
|
GetFriends() will always point to an empty list |
697
|
|
|
|
|
|
|
o CheckFriends() will return undef (error) if you give it a |
698
|
|
|
|
|
|
|
list of groups |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
On success this sub-routine returns an C object. On |
701
|
|
|
|
|
|
|
failure it returns C with the reason for the failure being |
702
|
|
|
|
|
|
|
placed in C<$LJ::Simple::error>. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Example code: |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
## Simple example, going direct to www.livejournal.com:80 |
707
|
|
|
|
|
|
|
my $lj = new LJ::Simple ({ user => "someuser", pass => "somepass" }); |
708
|
|
|
|
|
|
|
(defined $lj) || |
709
|
|
|
|
|
|
|
die "$0: Failed to access LiveJournal - $LJ::Simple::error\n"; |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
## More complex example, going via a proxy server on port 3000 to a |
712
|
|
|
|
|
|
|
## a LiveJournal system available on port 8080 on the machine |
713
|
|
|
|
|
|
|
## www.somesite.com. |
714
|
|
|
|
|
|
|
my $lj = new LJ::Simple ({ |
715
|
|
|
|
|
|
|
user => "someuser", |
716
|
|
|
|
|
|
|
pass => "somepass", |
717
|
|
|
|
|
|
|
site => "www.somesite.com:8080", |
718
|
|
|
|
|
|
|
proxy => "proxy.internal:3000", |
719
|
|
|
|
|
|
|
}); |
720
|
|
|
|
|
|
|
(defined $lj) || |
721
|
|
|
|
|
|
|
die "$0: Failed to access LiveJournal - $LJ::Simple::error\n"; |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
## Another complex example, this time saying that we do not want |
724
|
|
|
|
|
|
|
## the mood list or user pictures downloaded |
725
|
|
|
|
|
|
|
my $lj = new LJ::Simple ({ |
726
|
|
|
|
|
|
|
user => "someuser", |
727
|
|
|
|
|
|
|
pass => "somepass", |
728
|
|
|
|
|
|
|
pics => 0, |
729
|
|
|
|
|
|
|
moods => 0, |
730
|
|
|
|
|
|
|
}); |
731
|
|
|
|
|
|
|
(defined $lj) || |
732
|
|
|
|
|
|
|
die "$0: Failed to access LiveJournal - $LJ::Simple::error\n"; |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
## Final example - this one shows the use of the fast logon |
735
|
|
|
|
|
|
|
my $lj = new LJ::Simple ({ |
736
|
|
|
|
|
|
|
user => "someuser", |
737
|
|
|
|
|
|
|
pass => "somepass", |
738
|
|
|
|
|
|
|
fast => 1, |
739
|
|
|
|
|
|
|
}); |
740
|
|
|
|
|
|
|
(defined $lj) || |
741
|
|
|
|
|
|
|
die "$0: Failed to access LiveJournal - $LJ::Simple::error\n"; |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=cut |
744
|
|
|
|
|
|
|
## |
745
|
|
|
|
|
|
|
## Log into the LiveJournal system. Given that the LJ stuff is just |
746
|
|
|
|
|
|
|
## layered over HTTP, its not essential to do this. However it does |
747
|
|
|
|
|
|
|
## mean that we can check the auth details, get some useful info for |
748
|
|
|
|
|
|
|
## later, etc. |
749
|
|
|
|
|
|
|
## |
750
|
|
|
|
|
|
|
sub login($$) { |
751
|
|
|
|
|
|
|
# Handle the OOP stuff |
752
|
11
|
|
|
11
|
1
|
2504
|
my $this=shift; |
753
|
11
|
|
|
|
|
22
|
$LJ::Simple::error=""; |
754
|
11
|
100
|
|
|
|
32
|
if ($#_ != 0) { |
755
|
2
|
|
|
|
|
3
|
$LJ::Simple::error="CODE: Incorrect usage of login() for argv - see docs"; |
756
|
2
|
|
|
|
|
24
|
return undef; |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
# Get the hash |
759
|
9
|
|
|
|
|
17
|
my $hr = shift; |
760
|
9
|
|
33
|
|
|
47
|
my $class = ref($this) || $this; |
761
|
9
|
|
|
|
|
16
|
my $self = {}; |
762
|
9
|
|
|
|
|
28
|
bless $self,$class; |
763
|
9
|
50
|
33
|
|
|
109
|
if ((!exists $hr->{user})||($hr->{user} eq "") || |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
764
|
|
|
|
|
|
|
(!exists $hr->{pass})||($hr->{pass} eq "")) { |
765
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Incorrect usage of login() - see docs"; |
766
|
0
|
|
|
|
|
0
|
return undef; |
767
|
|
|
|
|
|
|
} |
768
|
9
|
|
|
|
|
60
|
$self->{auth}={ |
769
|
|
|
|
|
|
|
user => $hr->{user}, |
770
|
|
|
|
|
|
|
pass => $hr->{pass}, |
771
|
|
|
|
|
|
|
challenge => {}, |
772
|
|
|
|
|
|
|
}; |
773
|
9
|
100
|
|
|
|
37
|
if (! defined $LJ::Simple::UTF) { |
|
|
50
|
|
|
|
|
|
774
|
1
|
|
|
|
|
2
|
eval { require utf8 }; |
|
1
|
|
|
|
|
893
|
|
775
|
1
|
50
|
|
|
|
10
|
if (!$@) { |
776
|
1
|
|
|
|
|
1
|
$LJ::Simple::UTF=1; |
777
|
1
|
|
|
|
|
4
|
Debug("UTF-8 support found"); |
778
|
|
|
|
|
|
|
} else { |
779
|
0
|
|
|
|
|
0
|
$LJ::Simple::UTF=0; |
780
|
0
|
|
|
|
|
0
|
Debug("No UTF-8 support found"); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
} elsif ($LJ::Simple::UTF) { |
783
|
8
|
|
|
|
|
16
|
eval { require utf8 }; |
|
8
|
|
|
|
|
71
|
|
784
|
8
|
50
|
|
|
|
20
|
if (!$@) { |
785
|
8
|
|
|
|
|
25
|
Debug("Using UTF-8 as requested"); |
786
|
|
|
|
|
|
|
} else { |
787
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: no UTF-8 support in your version of perl"; |
788
|
0
|
|
|
|
|
0
|
return undef; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
} |
791
|
9
|
|
|
|
|
15
|
eval { require Digest::MD5 }; |
|
9
|
|
|
|
|
196
|
|
792
|
9
|
50
|
|
|
|
18
|
if (!$@) { |
793
|
9
|
|
|
|
|
19
|
Debug("Using Digest::MD5"); |
794
|
9
|
|
|
|
|
70
|
my $md5=Digest::MD5->new; |
795
|
9
|
|
|
|
|
48
|
$md5->add($hr->{pass}); |
796
|
9
|
|
|
|
|
59
|
$self->{auth}->{hash}=$md5->hexdigest; |
797
|
9
|
|
|
|
|
39
|
delete $self->{auth}->{pass}; |
798
|
9
|
100
|
|
|
|
58
|
(!defined $LJ::Simple::challenge) && ($LJ::Simple::challenge=1); |
799
|
|
|
|
|
|
|
} else { |
800
|
0
|
0
|
0
|
|
|
0
|
if ((defined $LJ::Simple::challenge)&&($LJ::Simple::challenge)) { |
801
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Challenge-response auth requested, no Digest::MD5 found"; |
802
|
0
|
|
|
|
|
0
|
return undef; |
803
|
|
|
|
|
|
|
} |
804
|
0
|
|
|
|
|
0
|
$LJ::Simple::challenge=0; |
805
|
|
|
|
|
|
|
} |
806
|
9
|
100
|
100
|
|
|
61
|
if ((exists $hr->{site})&&(defined $hr->{site})&&($hr->{site} ne "")) { |
|
|
|
66
|
|
|
|
|
807
|
1
|
|
|
|
|
2
|
my $site_port=$StdPort{http}; |
808
|
1
|
50
|
|
|
|
4
|
if ($hr->{site}=~/\s*(.*?):([0-9]+)\s*$/) { |
809
|
0
|
|
|
|
|
0
|
$hr->{site} = $1; |
810
|
0
|
|
|
|
|
0
|
$site_port = $2; |
811
|
|
|
|
|
|
|
} |
812
|
1
|
|
|
|
|
5
|
$self->{lj}={ |
813
|
|
|
|
|
|
|
host => $hr->{site}, |
814
|
|
|
|
|
|
|
port => $site_port, |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
} else { |
817
|
8
|
|
|
|
|
70
|
$self->{lj}={ |
818
|
|
|
|
|
|
|
host => "www.livejournal.com", |
819
|
|
|
|
|
|
|
port => $StdPort{http}, |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
} |
822
|
9
|
50
|
66
|
|
|
56
|
if ((exists $hr->{proxy})&&(defined $hr->{proxy})&&($hr->{proxy} ne "")) { |
|
|
100
|
33
|
|
|
|
|
823
|
0
|
|
|
|
|
0
|
my $proxy_port=$StdPort{http_proxy}; |
824
|
0
|
0
|
|
|
|
0
|
if ($hr->{proxy}=~/\s*(.*?):([0-9]+)\s*$/) { |
825
|
0
|
|
|
|
|
0
|
$hr->{proxy} = $1; |
826
|
0
|
|
|
|
|
0
|
$proxy_port = $2; |
827
|
|
|
|
|
|
|
} |
828
|
0
|
|
|
|
|
0
|
$self->{proxy}={ |
829
|
|
|
|
|
|
|
host => $hr->{proxy}, |
830
|
|
|
|
|
|
|
port => $proxy_port, |
831
|
|
|
|
|
|
|
}; |
832
|
|
|
|
|
|
|
} elsif (!exists $hr->{proxy}) { |
833
|
|
|
|
|
|
|
# Getting proxy details from the environment; assumes that the proxy is |
834
|
|
|
|
|
|
|
# given as http://site[:port]/ |
835
|
|
|
|
|
|
|
# The first matching env is used. |
836
|
8
|
|
|
|
|
21
|
foreach my $env (qw( http_proxy HTTP_PROXY )) { |
837
|
16
|
100
|
|
|
|
59
|
(exists $ENV{$env}) || next; |
838
|
2
|
50
|
|
|
|
17
|
($ENV{$env}=~/^(?:http:\/\/)([^:\/]+)(?::([0-9]+)){0,1}/o) || next; |
839
|
2
|
|
|
|
|
12
|
$self->{proxy}={ |
840
|
|
|
|
|
|
|
host => $1, |
841
|
|
|
|
|
|
|
port => $2, |
842
|
|
|
|
|
|
|
}; |
843
|
2
|
100
|
|
|
|
9
|
(defined $self->{proxy}->{port}) || ($self->{proxy}->{port}=$StdPort{http_proxy}); |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
} else { |
846
|
1
|
|
|
|
|
5
|
$self->{proxy}=undef; |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
# Set fastserver to 0 until we know better |
850
|
9
|
|
|
|
|
22
|
$self->{fastserver}=0; |
851
|
|
|
|
|
|
|
|
852
|
9
|
100
|
66
|
|
|
46
|
if ((exists $hr->{fast}) && ($hr->{fast}==1)) { |
853
|
|
|
|
|
|
|
## Doing fast login, so return object |
854
|
4
|
|
|
|
|
13
|
Debug(dump_hash($self,"")); |
855
|
4
|
|
|
|
|
19
|
return $self; |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
|
858
|
5
|
|
|
|
|
7
|
my $GetMoods=1; |
859
|
5
|
100
|
66
|
|
|
22
|
if ((exists $hr->{moods}) && ($hr->{moods}==0)) { |
860
|
1
|
|
|
|
|
3
|
$GetMoods=0; |
861
|
|
|
|
|
|
|
} |
862
|
5
|
|
|
|
|
6
|
my $GetPics=1; |
863
|
5
|
100
|
66
|
|
|
21
|
if ((exists $hr->{pics}) && ($hr->{pics}==0)) { |
864
|
1
|
|
|
|
|
2
|
$GetPics=0; |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
# Perform the actual login |
868
|
5
|
50
|
|
|
|
36
|
$self->SendRequest("login", { |
869
|
|
|
|
|
|
|
"moods" => $GetMoods, |
870
|
|
|
|
|
|
|
"getpickws" => $GetPics, |
871
|
|
|
|
|
|
|
"getpickurls" => $GetPics, |
872
|
|
|
|
|
|
|
},undef) || return undef; |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
# Now see if we can set fastserver |
875
|
0
|
0
|
0
|
|
|
0
|
if ( (exists $self->{request}->{lj}->{fastserver}) && |
876
|
|
|
|
|
|
|
($self->{request}->{lj}->{fastserver} == 1) ) { |
877
|
0
|
|
|
|
|
0
|
$self->{fastserver}=1; |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
# Moods |
881
|
0
|
|
|
|
|
0
|
$self->{moods}=undef; |
882
|
0
|
|
|
|
|
0
|
$self->{mood_map}=undef; |
883
|
|
|
|
|
|
|
# Shared access journals |
884
|
0
|
|
|
|
|
0
|
$self->{access}=undef; |
885
|
|
|
|
|
|
|
# User groups |
886
|
0
|
|
|
|
|
0
|
$self->{groups}=undef; |
887
|
|
|
|
|
|
|
# Images defined |
888
|
0
|
|
|
|
|
0
|
$self->{pictures}=undef; |
889
|
|
|
|
|
|
|
# Default URL |
890
|
0
|
|
|
|
|
0
|
$self->{defaultpicurl}=undef; |
891
|
|
|
|
|
|
|
# Message from LJ |
892
|
0
|
|
|
|
|
0
|
$self->{message}=undef; |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
# Handle moods, etc. |
895
|
0
|
|
|
|
|
0
|
my ($k,$v)=(undef,undef); |
896
|
0
|
|
|
|
|
0
|
while(($k,$v) = each %{$self->{request}->{lj}}) { |
|
0
|
|
|
|
|
0
|
|
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
# Message from LJ |
899
|
0
|
0
|
|
|
|
0
|
if ($k eq "message") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
900
|
0
|
|
|
|
|
0
|
$self->{message}=$v; |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
# Moods |
903
|
|
|
|
|
|
|
} elsif ($k=~/^mood_([0-9]+)_([a-z]+)/o) { |
904
|
0
|
|
|
|
|
0
|
my ($id,$type)=($1,$2); |
905
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{moods}) { |
906
|
0
|
|
|
|
|
0
|
$self->{moods}={}; |
907
|
|
|
|
|
|
|
} |
908
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{moods}->{$id}) { |
909
|
0
|
|
|
|
|
0
|
$self->{moods}->{$id}={}; |
910
|
|
|
|
|
|
|
} |
911
|
0
|
0
|
|
|
|
0
|
if ($type eq "id") { |
|
|
0
|
|
|
|
|
|
912
|
0
|
|
|
|
|
0
|
$self->{moods}->{$id}->{id}=$v; |
913
|
|
|
|
|
|
|
} elsif ($type eq "name") { |
914
|
0
|
|
|
|
|
0
|
$self->{moods}->{$id}->{name}=$v |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
# Picture key words |
918
|
|
|
|
|
|
|
} elsif ($k=~/^(pickw_count)/o) { |
919
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{pictures}) { |
920
|
0
|
|
|
|
|
0
|
$self->{pictures}={}; |
921
|
|
|
|
|
|
|
} |
922
|
|
|
|
|
|
|
} elsif ($k eq "defaultpicurl") { |
923
|
0
|
|
|
|
|
0
|
$self->{defaultpicurl}=$v; |
924
|
|
|
|
|
|
|
} elsif ($k=~/^(pickw[^_]*)_([0-9]+)/o) { |
925
|
0
|
|
|
|
|
0
|
my ($type,$id)=($1,$2); |
926
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{pictures}) { |
927
|
0
|
|
|
|
|
0
|
$self->{pictures}={}; |
928
|
|
|
|
|
|
|
} |
929
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{pictures}->{$id}) { |
930
|
0
|
|
|
|
|
0
|
$self->{pictures}->{$id}={}; |
931
|
|
|
|
|
|
|
} |
932
|
0
|
0
|
|
|
|
0
|
if ($type eq "pickwurl") { |
|
|
0
|
|
|
|
|
|
933
|
0
|
|
|
|
|
0
|
$self->{pictures}->{$id}->{url}=$v; |
934
|
|
|
|
|
|
|
} elsif ($type eq "pickw") { |
935
|
0
|
|
|
|
|
0
|
$self->{pictures}->{$id}->{name}=$v |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
# Shared access journals |
939
|
|
|
|
|
|
|
} elsif ($k=~/^access_([0-9]+)/) { |
940
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{access}) { |
941
|
0
|
|
|
|
|
0
|
$self->{access}={}; |
942
|
|
|
|
|
|
|
} |
943
|
0
|
|
|
|
|
0
|
$self->{access}->{$v}=1; |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
# Groups |
946
|
|
|
|
|
|
|
} elsif ($k=~/^frgrp_([0-9]+)_(.*)/) { |
947
|
0
|
|
|
|
|
0
|
my ($id,$type)=($1,$2); |
948
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{groups}) { |
949
|
0
|
|
|
|
|
0
|
$self->{groups}={ |
950
|
|
|
|
|
|
|
src => {}, # Source data |
951
|
|
|
|
|
|
|
id => {}, # Id -> name mapping |
952
|
|
|
|
|
|
|
name => {}, # Real data, name keyed |
953
|
|
|
|
|
|
|
}; |
954
|
|
|
|
|
|
|
} |
955
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{groups}->{src}->{$id}) { |
956
|
0
|
|
|
|
|
0
|
$self->{groups}->{src}->{$id}={}; |
957
|
|
|
|
|
|
|
} |
958
|
0
|
0
|
|
|
|
0
|
if ($type eq "sortorder") { |
|
|
0
|
|
|
|
|
|
959
|
0
|
|
|
|
|
0
|
$self->{groups}->{src}->{$id}->{sort}=$v; |
960
|
|
|
|
|
|
|
} elsif ($type eq "name") { |
961
|
0
|
|
|
|
|
0
|
$self->{groups}->{src}->{$id}->{name}=$v |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
} |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
## We now handle the group hash fully. Note in the case |
967
|
|
|
|
|
|
|
## of groups having the same name, only the first will |
968
|
|
|
|
|
|
|
## go into the name hash. |
969
|
0
|
|
|
|
|
0
|
($k,$v)=(undef,undef); |
970
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %{$self->{groups}->{src}}) { |
|
0
|
|
|
|
|
0
|
|
971
|
0
|
|
|
|
|
0
|
$self->{groups}->{id}->{$k}=$v->{name}; |
972
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{groups}->{name}->{$v->{name}}) { |
973
|
0
|
|
|
|
|
0
|
$self->{groups}->{name}->{$v->{name}} = { |
974
|
|
|
|
|
|
|
id => $k, |
975
|
|
|
|
|
|
|
name => $v->{name}, |
976
|
|
|
|
|
|
|
sort => $v->{sort}, |
977
|
|
|
|
|
|
|
}; |
978
|
|
|
|
|
|
|
} |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
## |
982
|
|
|
|
|
|
|
## And now we handle the mood map fully |
983
|
|
|
|
|
|
|
## |
984
|
0
|
0
|
|
|
|
0
|
if ($GetMoods) { |
985
|
0
|
|
|
|
|
0
|
$self->{mood_map}={}; |
986
|
0
|
|
|
|
|
0
|
foreach (values %{$self->{moods}}) { |
|
0
|
|
|
|
|
0
|
|
987
|
0
|
|
|
|
|
0
|
$self->{mood_map}->{lc($_->{name})}=$_->{id}; |
988
|
|
|
|
|
|
|
} |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
|
991
|
0
|
|
|
|
|
0
|
Debug(dump_hash($self,"")); |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
## Logged in, so return self. |
994
|
0
|
|
|
|
|
0
|
return $self; |
995
|
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
## Define reference from new to login |
998
|
|
|
|
|
|
|
*new=""; |
999
|
|
|
|
|
|
|
*new=\&login; |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=pod |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=back |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=head2 Getting data from the LiveJournal login |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=over 4 |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=item $lj->message() |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Returns back a message set in the LiveJournal system. Either |
1013
|
|
|
|
|
|
|
returns back the message or C if no message is set. |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
Example code: |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
my $msg = $lj->message(); |
1018
|
|
|
|
|
|
|
(defined $msg) && |
1019
|
|
|
|
|
|
|
print "LJ Message: $msg\n"; |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=cut |
1022
|
|
|
|
|
|
|
sub message($) { |
1023
|
1
|
|
|
1
|
1
|
66
|
my $self=shift; |
1024
|
1
|
|
|
|
|
4
|
return $self->{message}; |
1025
|
|
|
|
|
|
|
} |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=pod |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=item $lj->moods($hash_ref) |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
Takes a reference to a hash and fills it with information about |
1032
|
|
|
|
|
|
|
the moods returned back by the server. Either returns back the |
1033
|
|
|
|
|
|
|
same hash reference or C on error. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
Note that if the LiveJournal |
1036
|
|
|
|
|
|
|
object was created with either C set to C<0> or |
1037
|
|
|
|
|
|
|
with C set to C<1> then this function will always return |
1038
|
|
|
|
|
|
|
an error. |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
The hash the given reference is pointed to is emptied before |
1041
|
|
|
|
|
|
|
it is used and after a successful call the hash given will |
1042
|
|
|
|
|
|
|
contain: |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
%hash = ( |
1045
|
|
|
|
|
|
|
list => [ list of mood names, alphabetical ] |
1046
|
|
|
|
|
|
|
moods => { |
1047
|
|
|
|
|
|
|
mood_name => mood_id |
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
idents => { |
1050
|
|
|
|
|
|
|
mood_id => mood_name |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
) |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
Example code: |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
my %Moods=(); |
1058
|
|
|
|
|
|
|
if (!defined $lj->moods(\%Moods)) { |
1059
|
|
|
|
|
|
|
die "$0: LJ error - $LJ::Simple::error"; |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
foreach (@{$Moods{list}}) { |
1062
|
|
|
|
|
|
|
print "$_ -> $Moods{moods}->{$_}\n"; |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=cut |
1067
|
|
|
|
|
|
|
sub moods($$) { |
1068
|
1
|
|
|
1
|
1
|
103
|
my $self=shift; |
1069
|
1
|
|
|
|
|
91
|
my ($hr) = @_; |
1070
|
1
|
|
|
|
|
3
|
$LJ::Simple::error=""; |
1071
|
1
|
50
|
|
|
|
6
|
if (ref($hr) ne "HASH") { |
1072
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: moods() not given a hash reference"; |
1073
|
0
|
|
|
|
|
0
|
return undef; |
1074
|
|
|
|
|
|
|
} |
1075
|
1
|
50
|
|
|
|
5
|
if (!defined $self->{moods}) { |
1076
|
1
|
|
|
|
|
2
|
$LJ::Simple::error="Unable to return moods - not requested at login"; |
1077
|
1
|
|
|
|
|
4
|
return undef; |
1078
|
|
|
|
|
|
|
} |
1079
|
0
|
|
|
|
|
0
|
%{$hr}=( |
|
0
|
|
|
|
|
0
|
|
1080
|
|
|
|
|
|
|
list => [], |
1081
|
|
|
|
|
|
|
moods => {}, |
1082
|
|
|
|
|
|
|
idents => {}, |
1083
|
|
|
|
|
|
|
); |
1084
|
0
|
|
|
|
|
0
|
my ($k,$v); |
1085
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %{$self->{moods}}) { |
|
0
|
|
|
|
|
0
|
|
1086
|
0
|
|
|
|
|
0
|
push(@{$hr->{list}},$v->{name}); |
|
0
|
|
|
|
|
0
|
|
1087
|
0
|
|
|
|
|
0
|
$hr->{moods}->{$v->{name}}=$v->{id}; |
1088
|
0
|
|
|
|
|
0
|
$hr->{idents}->{$v->{id}}=$v->{name}; |
1089
|
|
|
|
|
|
|
} |
1090
|
0
|
|
|
|
|
0
|
$hr->{list} = [ (sort { $a cmp $b } @{$hr->{list}}) ]; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1091
|
0
|
|
|
|
|
0
|
return $hr; |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=pod |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
=item $lj->communities() |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
Returns a list of shared access communities the user logged in can |
1099
|
|
|
|
|
|
|
post to. Returns an empty list if no communities are available |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
Example code: |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
my @communities = $lj->communities(); |
1104
|
|
|
|
|
|
|
print join("\n",@communities),"\n"; |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
=cut |
1107
|
|
|
|
|
|
|
sub communities($) { |
1108
|
1
|
|
|
1
|
1
|
62
|
my $self=shift; |
1109
|
1
|
|
|
|
|
3
|
$LJ::Simple::error=""; |
1110
|
1
|
50
|
|
|
|
16
|
(defined $self->{access}) || return (); |
1111
|
0
|
|
|
|
|
0
|
return sort {$a cmp $b} (keys %{$self->{access}}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
=pod |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=item $lj->MemberOf($community) |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
Returns C<1> if the user is a member of the named community. Returns |
1120
|
|
|
|
|
|
|
C<0> otherwise. |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
Example code: |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
if ($lj->MemberOf("some_community")) { |
1125
|
|
|
|
|
|
|
: |
1126
|
|
|
|
|
|
|
: |
1127
|
|
|
|
|
|
|
: |
1128
|
|
|
|
|
|
|
} |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
=cut |
1131
|
|
|
|
|
|
|
sub MemberOf($$) { |
1132
|
1
|
|
|
1
|
1
|
59
|
my $self=shift; |
1133
|
1
|
|
|
|
|
2
|
my ($community)=@_; |
1134
|
1
|
|
|
|
|
3
|
$LJ::Simple::error=""; |
1135
|
1
|
50
|
|
|
|
5
|
(defined $self->{access}) || return 0; |
1136
|
0
|
|
|
|
|
0
|
return (exists $self->{access}->{$community}); |
1137
|
|
|
|
|
|
|
} |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
=pod |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
=item $lj->groups($hash_ref) |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
Takes a reference to a hash and fills it with information about |
1144
|
|
|
|
|
|
|
the friends groups the user has configured for themselves. Either |
1145
|
|
|
|
|
|
|
returns back the hash reference or C on error. |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
The hash the given reference points to is emptied before it is |
1148
|
|
|
|
|
|
|
used and after a successful call the hash given will contain |
1149
|
|
|
|
|
|
|
the following: |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
%hash = ( |
1152
|
|
|
|
|
|
|
"name" => { |
1153
|
|
|
|
|
|
|
"Group name" => { |
1154
|
|
|
|
|
|
|
id => "Number of the group", |
1155
|
|
|
|
|
|
|
sort => "Sort order", |
1156
|
|
|
|
|
|
|
name => "Group name (copy of key)", |
1157
|
|
|
|
|
|
|
}, |
1158
|
|
|
|
|
|
|
}, |
1159
|
|
|
|
|
|
|
"id" => { |
1160
|
|
|
|
|
|
|
"Id" => "Group name", |
1161
|
|
|
|
|
|
|
}, |
1162
|
|
|
|
|
|
|
); |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
Example code: |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
my %Groups=(); |
1167
|
|
|
|
|
|
|
if (!defined $lj->groups(\%Groups)) { |
1168
|
|
|
|
|
|
|
die "$0: LJ error - $LJ::Simple::error"; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
my ($id,$name)=(undef,undef); |
1171
|
|
|
|
|
|
|
while(($id,$name)=each %{$Groups{id}}) { |
1172
|
|
|
|
|
|
|
my $srt=$Groups{name}->{$name}->{sort}; |
1173
|
|
|
|
|
|
|
print "$id\t=> $name [$srt]\n"; |
1174
|
|
|
|
|
|
|
} |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=cut |
1177
|
|
|
|
|
|
|
sub groups($$) { |
1178
|
1
|
|
|
1
|
1
|
59
|
my $self=shift; |
1179
|
1
|
|
|
|
|
2
|
my ($hr) = @_; |
1180
|
1
|
|
|
|
|
2
|
$LJ::Simple::error=""; |
1181
|
1
|
50
|
|
|
|
5
|
if (ref($hr) ne "HASH") { |
1182
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: groups() not given a hash reference"; |
1183
|
0
|
|
|
|
|
0
|
return undef; |
1184
|
|
|
|
|
|
|
} |
1185
|
1
|
50
|
|
|
|
4
|
if (!defined $self->{groups}) { |
1186
|
1
|
|
|
|
|
2
|
$LJ::Simple::error="Unable to return groups - none defined"; |
1187
|
1
|
|
|
|
|
3
|
return undef; |
1188
|
|
|
|
|
|
|
} |
1189
|
0
|
|
|
|
|
0
|
%{$hr}=( |
|
0
|
|
|
|
|
0
|
|
1190
|
|
|
|
|
|
|
name => {}, |
1191
|
|
|
|
|
|
|
id => {}, |
1192
|
|
|
|
|
|
|
); |
1193
|
0
|
|
|
|
|
0
|
my ($k,$v); |
1194
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %{$self->{groups}->{id}}) { |
|
0
|
|
|
|
|
0
|
|
1195
|
0
|
|
|
|
|
0
|
$hr->{id}->{$k}=$v; |
1196
|
|
|
|
|
|
|
} |
1197
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %{$self->{groups}->{name}}) { |
|
0
|
|
|
|
|
0
|
|
1198
|
0
|
|
|
|
|
0
|
$hr->{name}->{$k}={}; |
1199
|
0
|
|
|
|
|
0
|
my ($lk,$lv); |
1200
|
0
|
|
|
|
|
0
|
while(($lk,$lv)=each %{$self->{groups}->{name}->{$k}}) { |
|
0
|
|
|
|
|
0
|
|
1201
|
0
|
|
|
|
|
0
|
$hr->{name}->{$k}->{$lk}=$lv; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
} |
1204
|
0
|
|
|
|
|
0
|
return $hr; |
1205
|
|
|
|
|
|
|
} |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
=pod |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=item $lj->MapGroupToId($group_name) |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
Used to map a given group name to its identity. On |
1213
|
|
|
|
|
|
|
success returns the identity for the group name. On |
1214
|
|
|
|
|
|
|
failure it returns C and sets |
1215
|
|
|
|
|
|
|
C<$LJ::Simple::error>. |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
=cut |
1218
|
|
|
|
|
|
|
sub MapGroupToId($$) { |
1219
|
1
|
|
|
1
|
1
|
69
|
my $self=shift; |
1220
|
1
|
|
|
|
|
3
|
my ($grp)=@_; |
1221
|
1
|
|
|
|
|
2
|
$LJ::Simple::error=""; |
1222
|
1
|
50
|
|
|
|
4
|
if (!defined $self->{groups}) { |
1223
|
1
|
|
|
|
|
2
|
$LJ::Simple::error="Unable to map group to id - none defined"; |
1224
|
1
|
|
|
|
|
5
|
return undef; |
1225
|
|
|
|
|
|
|
} |
1226
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{groups}->{name}->{$grp}) { |
1227
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="No such group"; |
1228
|
0
|
|
|
|
|
0
|
return undef; |
1229
|
|
|
|
|
|
|
} |
1230
|
0
|
|
|
|
|
0
|
return $self->{groups}->{name}->{$grp}->{id}; |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
=pod |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=item $lj->MapIdToGroup($id) |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
Used to map a given identity to its group name. On |
1239
|
|
|
|
|
|
|
success returns the group name for the identity. On |
1240
|
|
|
|
|
|
|
failure it returns C and sets |
1241
|
|
|
|
|
|
|
C<$LJ::Simple::error>. |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
=cut |
1244
|
|
|
|
|
|
|
sub MapIdToGroup($$) { |
1245
|
1
|
|
|
1
|
1
|
62
|
my $self=shift; |
1246
|
1
|
|
|
|
|
3
|
my ($id)=@_; |
1247
|
1
|
|
|
|
|
3
|
$LJ::Simple::error=""; |
1248
|
1
|
50
|
|
|
|
5
|
if (!defined $self->{groups}) { |
1249
|
1
|
|
|
|
|
3
|
$LJ::Simple::error="Unable to map group to id - none defined"; |
1250
|
1
|
|
|
|
|
2
|
return undef; |
1251
|
|
|
|
|
|
|
} |
1252
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{groups}->{id}->{$id}) { |
1253
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="No such group ident"; |
1254
|
0
|
|
|
|
|
0
|
return undef; |
1255
|
|
|
|
|
|
|
} |
1256
|
0
|
|
|
|
|
0
|
return $self->{groups}->{id}->{$id}; |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
=pod |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
=item $lj->pictures($hash_ref) |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
Takes a reference to a hash and fills it with information about |
1265
|
|
|
|
|
|
|
the pictures the user has configured for themselves. Either |
1266
|
|
|
|
|
|
|
returns back the hash reference or C on error. Note that |
1267
|
|
|
|
|
|
|
the user has to have defined picture keywords for this to work. |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
Note that if the LiveJournal |
1270
|
|
|
|
|
|
|
object was created with either C set to C<0> or |
1271
|
|
|
|
|
|
|
with C set to C<1> then this function will always return |
1272
|
|
|
|
|
|
|
an error. |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
The hash the given reference points to is emptied before it is |
1275
|
|
|
|
|
|
|
used and after a successful call the hash given will contain |
1276
|
|
|
|
|
|
|
the following: |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
%hash = ( |
1279
|
|
|
|
|
|
|
"keywords" => "URL of picture", |
1280
|
|
|
|
|
|
|
); |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
Example code: |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
my %pictures=(); |
1285
|
|
|
|
|
|
|
if (!defined $lj->pictures(\%pictures)) { |
1286
|
|
|
|
|
|
|
die "$0: LJ error - $LJ::Simple::error"; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
my ($keywords,$url)=(undef,undef); |
1289
|
|
|
|
|
|
|
while(($keywords,$url)=each %pictures) { |
1290
|
|
|
|
|
|
|
print "\"$keywords\"\t=> $url\n"; |
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=cut |
1295
|
|
|
|
|
|
|
sub pictures($$) { |
1296
|
1
|
|
|
1
|
1
|
69
|
my $self=shift; |
1297
|
1
|
|
|
|
|
2
|
my ($hr)=@_; |
1298
|
1
|
|
|
|
|
3
|
$LJ::Simple::error=""; |
1299
|
1
|
50
|
|
|
|
4
|
if (!defined $self->{pictures}) { |
1300
|
1
|
|
|
|
|
3
|
$LJ::Simple::error="Unable to return pictures - none defined"; |
1301
|
1
|
|
|
|
|
3
|
return undef; |
1302
|
|
|
|
|
|
|
} |
1303
|
0
|
0
|
|
|
|
0
|
if (ref($hr) ne "HASH") { |
1304
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: pictures() not given a hash reference"; |
1305
|
0
|
|
|
|
|
0
|
return undef; |
1306
|
|
|
|
|
|
|
} |
1307
|
0
|
|
|
|
|
0
|
%{$hr}=(); |
|
0
|
|
|
|
|
0
|
|
1308
|
0
|
|
|
|
|
0
|
foreach (values %{$self->{pictures}}) { |
|
0
|
|
|
|
|
0
|
|
1309
|
0
|
|
|
|
|
0
|
$hr->{$_->{name}}=$_->{url}; |
1310
|
|
|
|
|
|
|
} |
1311
|
0
|
|
|
|
|
0
|
return $hr; |
1312
|
|
|
|
|
|
|
} |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
=pod |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
=item $lj->DefaultPicURL() |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
Returns the URL of the default picture used by the user. |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
Note that if the LiveJournal |
1321
|
|
|
|
|
|
|
object was created with either C set to C<0> or |
1322
|
|
|
|
|
|
|
with C set to C<1> then this function will always return |
1323
|
|
|
|
|
|
|
an error. |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
Example code: |
1326
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
print $lj->DefaultPicURL(),"\n"; |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
=cut |
1330
|
|
|
|
|
|
|
sub DefaultPicURL($) { |
1331
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1332
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1333
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{defaultpicurl}) { |
1334
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Unable to return default picture URL - none defined"; |
1335
|
0
|
|
|
|
|
0
|
return undef; |
1336
|
|
|
|
|
|
|
} |
1337
|
0
|
|
|
|
|
0
|
return $self->{defaultpicurl}; |
1338
|
|
|
|
|
|
|
} |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
=pod |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
=item $lj->user() |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
Returns the username used to log into LiveJournal |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
Example code: |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
my $user = $lj->user(); |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
=cut |
1351
|
|
|
|
|
|
|
sub user($) { |
1352
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1353
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1354
|
0
|
|
|
|
|
0
|
return $self->{auth}->{user}; |
1355
|
|
|
|
|
|
|
} |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
=pod |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
=item $lj->fastserver() |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
Used to tell if the user which was logged into the LiveJournal system can use the |
1363
|
|
|
|
|
|
|
fast servers or not. Returns C<1> if the user can use the fast servers, C<0> |
1364
|
|
|
|
|
|
|
otherwise. |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
Example code: |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
if ($lj->fastserver()) { |
1369
|
|
|
|
|
|
|
print STDERR "Using fast server for ",$lj->user(),"\n"; |
1370
|
|
|
|
|
|
|
} |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
=cut |
1373
|
|
|
|
|
|
|
sub fastserver($) { |
1374
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1375
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1376
|
0
|
|
|
|
|
0
|
return $self->{fastserver}; |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=pod |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
=back |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=head2 Tags |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
=over 4 |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
=item $lj->GetTags() |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
Returns a list of the tags the user has defined. The list returned |
1390
|
|
|
|
|
|
|
contains at least one entry, the number of entries in the list. |
1391
|
|
|
|
|
|
|
This value can range from 0 to however |
1392
|
|
|
|
|
|
|
many tags are in the list. In the event of a failure this value is |
1393
|
|
|
|
|
|
|
undefined. |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
The list of tags is a list of hash references which contain data |
1396
|
|
|
|
|
|
|
about the tag; each hash referenced will contain the following: |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
{ |
1399
|
|
|
|
|
|
|
name => The name of the tag |
1400
|
|
|
|
|
|
|
uses => Number of times has the tag been used in total |
1401
|
|
|
|
|
|
|
security => Visibility of the tag; this can be "public", "private", |
1402
|
|
|
|
|
|
|
"friends" or "group" |
1403
|
|
|
|
|
|
|
display => If defined this indicates that the tag is visible to |
1404
|
|
|
|
|
|
|
the S2 style system. If set to undef the tag is usable, |
1405
|
|
|
|
|
|
|
just not exposed to S2 |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
The list of tags is returned ordered by the tag names. |
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
Example code: |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
# Print out the names of the tags |
1413
|
|
|
|
|
|
|
my ($count,@Tags)=$lj->GetTags(); |
1414
|
|
|
|
|
|
|
(defined $count) || die "$0: Failed to get list of tags - $LJ::Simple::error\n"; |
1415
|
|
|
|
|
|
|
print "Total tags: $count\n"; |
1416
|
|
|
|
|
|
|
map { print "$_->{name}\n"; } (@Tags); |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=cut |
1419
|
|
|
|
|
|
|
sub GetTags($) { |
1420
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1421
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1422
|
0
|
|
|
|
|
0
|
my %Event=(); |
1423
|
0
|
|
|
|
|
0
|
my %Resp=(); |
1424
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("getusertags",\%Event,\%Resp) || return undef; |
1425
|
0
|
|
|
|
|
0
|
my %Tags=(); |
1426
|
0
|
|
|
|
|
0
|
while(my ($name,$val) = each %Resp) { |
1427
|
0
|
0
|
|
|
|
0
|
($name=~/tag_([0-9]+)_(.*)/o) || next; |
1428
|
0
|
|
|
|
|
0
|
my ($id,$key)=($1,$2); |
1429
|
0
|
0
|
|
|
|
0
|
(exists $Tags{$id}) || ($Tags{$id}={}); |
1430
|
0
|
|
|
|
|
0
|
$Tags{$id}->{$key}=$val; |
1431
|
|
|
|
|
|
|
} |
1432
|
0
|
|
|
|
|
0
|
my @Return=(); |
1433
|
0
|
|
|
|
|
0
|
foreach my $tag_id (keys %Tags) { |
1434
|
0
|
|
|
|
|
0
|
push(@Return,{}); |
1435
|
0
|
|
|
|
|
0
|
my $dest=$Return[$#Return]; |
1436
|
0
|
|
|
|
|
0
|
my $src=$Tags{$tag_id}; |
1437
|
0
|
0
|
|
|
|
0
|
map { $dest->{$_} = (exists $src->{$_})?$src->{$_}:undef } (qw( name uses security display )); |
|
0
|
|
|
|
|
0
|
|
1438
|
|
|
|
|
|
|
} |
1439
|
0
|
|
|
|
|
0
|
return(scalar(@Return),(sort {lc($a->{name}) cmp lc($b->{name})} @Return)); |
|
0
|
|
|
|
|
0
|
|
1440
|
|
|
|
|
|
|
} |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
=pod |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
=back |
1446
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
=head2 Dealing with friends |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
=over 4 |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
=item $lj->GetFriendOf() |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
Returns a list of the other LiveJournal users who list the current |
1454
|
|
|
|
|
|
|
user as a friend. The list returned contains at least one entry, the |
1455
|
|
|
|
|
|
|
number of entries in the list. This value can range from 0 to however |
1456
|
|
|
|
|
|
|
many users are in the list. In the event of a failure this value is |
1457
|
|
|
|
|
|
|
undefined. |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
The list of friends is a list of hash references which contain data |
1460
|
|
|
|
|
|
|
about the users who list the current user as a friend. Each hash |
1461
|
|
|
|
|
|
|
referenced will contain the following: |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
{ |
1464
|
|
|
|
|
|
|
user => The LiveJournal username |
1465
|
|
|
|
|
|
|
name => The full name of the user |
1466
|
|
|
|
|
|
|
fg => The foreground colour which represents the user |
1467
|
|
|
|
|
|
|
bg => The background colour which represents the user |
1468
|
|
|
|
|
|
|
status => The status of the user |
1469
|
|
|
|
|
|
|
type => The type of the user |
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
Both the C and C values are stored in the format of "C<#>III" |
1473
|
|
|
|
|
|
|
where the I, I, I values are given as two digit hexadecimal numbers which |
1474
|
|
|
|
|
|
|
range from C<00> to C. |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
The C of a user can be one of C, C, C or C. |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
The C of a user can either be C which means that the user is a normal |
1479
|
|
|
|
|
|
|
LiveJournal user or it can be C which means that the user is actually a |
1480
|
|
|
|
|
|
|
community which the current LJ user is a member of. |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
It should be noted that any of the values in the hash above can be undefined if |
1483
|
|
|
|
|
|
|
that value was not returned from the LiveJournal server. |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
The returned list is ordered by the LiveJournal login names of the users. |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
Example code: |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
my ($num_friends_of,@FriendOf)=$lj->GetFriendOf(); |
1490
|
|
|
|
|
|
|
(defined $num_friends_of) || |
1491
|
|
|
|
|
|
|
die "$0: Failed to get friends of user - $LJ::Simple::error\n"; |
1492
|
|
|
|
|
|
|
print "LJ login\tReal name\tfg\tbg\tStatus\tType\n"; |
1493
|
|
|
|
|
|
|
foreach (@FriendOf) { |
1494
|
|
|
|
|
|
|
print "$_->{user}\t", |
1495
|
|
|
|
|
|
|
"$_->{name}\t", |
1496
|
|
|
|
|
|
|
"$_->{fg}\t", |
1497
|
|
|
|
|
|
|
"$_->{bg}\t", |
1498
|
|
|
|
|
|
|
"$_->{status}\t", |
1499
|
|
|
|
|
|
|
"$_->{type}\n"; |
1500
|
|
|
|
|
|
|
} |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
=cut |
1503
|
|
|
|
|
|
|
sub GetFriendOf($) { |
1504
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1505
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1506
|
0
|
|
|
|
|
0
|
my %Event=(); |
1507
|
0
|
|
|
|
|
0
|
my %Resp=(); |
1508
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("friendof",\%Event,\%Resp) || return undef; |
1509
|
0
|
|
|
|
|
0
|
my %Friends=(); |
1510
|
0
|
|
|
|
|
0
|
my ($k,$v); |
1511
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %Resp) { |
1512
|
0
|
0
|
|
|
|
0
|
($k=~/^friendof_([0-9]+)_(.*)/) || next; |
1513
|
0
|
|
|
|
|
0
|
my ($id,$type)=($1,$2); |
1514
|
0
|
0
|
|
|
|
0
|
if (!exists $Friends{$id}) { |
1515
|
0
|
|
|
|
|
0
|
$Friends{$id}={ |
1516
|
|
|
|
|
|
|
user => undef, |
1517
|
|
|
|
|
|
|
name => undef, |
1518
|
|
|
|
|
|
|
bg => undef, |
1519
|
|
|
|
|
|
|
fg => undef, |
1520
|
|
|
|
|
|
|
status => "active", |
1521
|
|
|
|
|
|
|
type => "user", |
1522
|
|
|
|
|
|
|
}; |
1523
|
|
|
|
|
|
|
} |
1524
|
0
|
|
|
|
|
0
|
$Friends{$id}->{$type}=$v; |
1525
|
|
|
|
|
|
|
} |
1526
|
0
|
|
|
|
|
0
|
my @lst=sort {$a->{user} cmp $b->{user}} (values %Friends); |
|
0
|
|
|
|
|
0
|
|
1527
|
0
|
|
|
|
|
0
|
return ($#lst+1,@lst); |
1528
|
|
|
|
|
|
|
} |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
=pod |
1532
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
=item $lj->GetFriends() |
1534
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
Returns a list of the other LiveJournal user who are listed as friends of |
1536
|
|
|
|
|
|
|
the current user. The list returned contains a least one entry, the |
1537
|
|
|
|
|
|
|
number of entries in the list. This value can range from 0 to however |
1538
|
|
|
|
|
|
|
many users are in the list. In the event of a failure this value is |
1539
|
|
|
|
|
|
|
undefined. |
1540
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
The list of friends is a list of hash references which contain data |
1542
|
|
|
|
|
|
|
about the users who list the current user as a friend. Each hash |
1543
|
|
|
|
|
|
|
referenced will contain the following: |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
{ |
1546
|
|
|
|
|
|
|
user => The LiveJournal username |
1547
|
|
|
|
|
|
|
name => The full name of the user |
1548
|
|
|
|
|
|
|
fg => The foreground colour which represents the user |
1549
|
|
|
|
|
|
|
bg => The background colour which represents the user |
1550
|
|
|
|
|
|
|
dob => The date of birth for the user |
1551
|
|
|
|
|
|
|
birthday => The birthday of the user |
1552
|
|
|
|
|
|
|
groups => The list of friends groups this user is in |
1553
|
|
|
|
|
|
|
groupmask => The actual group mask for this user |
1554
|
|
|
|
|
|
|
status => The status of the user |
1555
|
|
|
|
|
|
|
type => The type of the user |
1556
|
|
|
|
|
|
|
} |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
Both the C and C values are stored in the format of "C<#>III" |
1559
|
|
|
|
|
|
|
where the I, I, I values are given as two digit hexadecimal numbers which |
1560
|
|
|
|
|
|
|
range from C<00> to C. |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
The C value is stored as a Unix timestamp; that is seconds since epoch. If the |
1563
|
|
|
|
|
|
|
user has no date of birth defined B they have only given their birthday then this |
1564
|
|
|
|
|
|
|
value will be C. |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
The C value is the date of the user's next birthday given as a Unix timestamp. |
1567
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
The C value is a reference to a list of the friends group this user is a member |
1569
|
|
|
|
|
|
|
of. It should be noted that to have any items in the list the user must be a |
1570
|
|
|
|
|
|
|
member of a friends group and the C method must B have been called |
1571
|
|
|
|
|
|
|
with the fast login option. |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
The C value is the actual group mask for the user. This is used to build |
1574
|
|
|
|
|
|
|
the C list. It is a 32-bit number where each bit represents membership of a |
1575
|
|
|
|
|
|
|
given friends group. Bits 0 and 31 are reserved; all other bits can be used. The bit |
1576
|
|
|
|
|
|
|
a group corresponds to is taken by bit-shifting 1 by the group id number. |
1577
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
The C of a user can be one of C, C, C or C. |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
The C of a user can either be C which means that the user is a normal |
1581
|
|
|
|
|
|
|
LiveJournal user or it can be C which means that the user is actually a |
1582
|
|
|
|
|
|
|
community which the current LJ user is a member of. |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
It should be noted that any of the values in the hash above can be undefined if |
1585
|
|
|
|
|
|
|
that value was not returned from the LiveJournal server. |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
The returned list is ordered by the LiveJournal login names of the users. |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
Example code: |
1590
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
use POSIX; |
1592
|
|
|
|
|
|
|
|
1593
|
|
|
|
|
|
|
my ($num_friends,@Friends)=$lj->GetFriends(); |
1594
|
|
|
|
|
|
|
(defined $num_friends) || |
1595
|
|
|
|
|
|
|
die "$0: Failed to get friends - $LJ::Simple::error\n"; |
1596
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
my $f=undef; |
1598
|
|
|
|
|
|
|
foreach $f (@Friends) { |
1599
|
|
|
|
|
|
|
foreach (qw(dob birthday)) { |
1600
|
|
|
|
|
|
|
(defined $f->{$_}) || next; |
1601
|
|
|
|
|
|
|
$f->{$_}=strftime("%Y/%m/%d",localtime($f->{$_})); |
1602
|
|
|
|
|
|
|
} |
1603
|
|
|
|
|
|
|
my ($k,$v)=(undef,undef); |
1604
|
|
|
|
|
|
|
while(($k,$v)=each %{$f}) { |
1605
|
|
|
|
|
|
|
(!defined $v) && ($f->{$k}="[undefined]"); |
1606
|
|
|
|
|
|
|
} |
1607
|
|
|
|
|
|
|
print "$f->{user}\n"; |
1608
|
|
|
|
|
|
|
print " Name : $f->{name}\n"; |
1609
|
|
|
|
|
|
|
print " Colors : fg->$f->{fg} bg->$f->{bg}\n"; |
1610
|
|
|
|
|
|
|
print " DOB : $f->{dob}\n"; |
1611
|
|
|
|
|
|
|
print " Next birthday: $f->{birthday}\n"; |
1612
|
|
|
|
|
|
|
print " Status : $f->{status}\n"; |
1613
|
|
|
|
|
|
|
print " Type : $f->{type}\n"; |
1614
|
|
|
|
|
|
|
if ($#{$f->{groups}}>-1) { |
1615
|
|
|
|
|
|
|
print " Friend groups:\n"; |
1616
|
|
|
|
|
|
|
print " + ",join("\n + ",@{$f->{groups}}),"\n"; |
1617
|
|
|
|
|
|
|
} else { |
1618
|
|
|
|
|
|
|
print " Friend groups: [none]\n"; |
1619
|
|
|
|
|
|
|
} |
1620
|
|
|
|
|
|
|
print "\n"; |
1621
|
|
|
|
|
|
|
} |
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
=cut |
1624
|
|
|
|
|
|
|
sub GetFriends($) { |
1625
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1626
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1627
|
0
|
|
|
|
|
0
|
my %Event=( |
1628
|
|
|
|
|
|
|
includegroups => 1, |
1629
|
|
|
|
|
|
|
includebdays => 1, |
1630
|
|
|
|
|
|
|
); |
1631
|
0
|
|
|
|
|
0
|
my %Resp=(); |
1632
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("getfriends",\%Event,\%Resp) || return undef; |
1633
|
0
|
|
|
|
|
0
|
my %Friends=(); |
1634
|
0
|
|
|
|
|
0
|
my ($k,$v); |
1635
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %Resp) { |
1636
|
0
|
0
|
|
|
|
0
|
($k=~/^friend_([0-9]+)_(.*)/) || next; |
1637
|
0
|
|
|
|
|
0
|
my ($id,$type)=($1,$2); |
1638
|
0
|
0
|
|
|
|
0
|
if (!exists $Friends{$id}) { |
1639
|
0
|
|
|
|
|
0
|
$Friends{$id}={ |
1640
|
|
|
|
|
|
|
user => undef, |
1641
|
|
|
|
|
|
|
name => undef, |
1642
|
|
|
|
|
|
|
bg => undef, |
1643
|
|
|
|
|
|
|
fg => undef, |
1644
|
|
|
|
|
|
|
dob => undef, |
1645
|
|
|
|
|
|
|
birthday => undef, |
1646
|
|
|
|
|
|
|
groups => [], |
1647
|
|
|
|
|
|
|
groupmask => undef, |
1648
|
|
|
|
|
|
|
status => "active", |
1649
|
|
|
|
|
|
|
type => "user", |
1650
|
|
|
|
|
|
|
}; |
1651
|
|
|
|
|
|
|
} |
1652
|
0
|
0
|
|
|
|
0
|
if ($type eq "birthday") { |
1653
|
0
|
0
|
|
|
|
0
|
($v=~/([0-9]+)-([0-9]{2})-([0-9]{2})/o) || next; |
1654
|
0
|
|
|
|
|
0
|
my @tm=(0,0,0,$3,$2,$1-1900); |
1655
|
0
|
0
|
|
|
|
0
|
if ($tm[5]>0) { |
1656
|
0
|
|
|
|
|
0
|
$Friends{$id}->{dob}=mktime(@tm); |
1657
|
0
|
0
|
|
|
|
0
|
if (!defined $Friends{$id}->{dob}) { |
1658
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to convert time $v into Unix timestamp"; |
1659
|
0
|
|
|
|
|
0
|
return undef; |
1660
|
|
|
|
|
|
|
} |
1661
|
|
|
|
|
|
|
} |
1662
|
0
|
|
|
|
|
0
|
$tm[5]=(localtime(time()))[5]; |
1663
|
0
|
|
|
|
|
0
|
$Friends{$id}->{birthday}=mktime(@tm); |
1664
|
0
|
0
|
|
|
|
0
|
if (!defined $Friends{$id}->{birthday}) { |
1665
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to convert time $v into Unix timestamp"; |
1666
|
0
|
|
|
|
|
0
|
return undef; |
1667
|
|
|
|
|
|
|
} |
1668
|
|
|
|
|
|
|
} else { |
1669
|
0
|
|
|
|
|
0
|
$Friends{$id}->{$type}=$v; |
1670
|
|
|
|
|
|
|
} |
1671
|
|
|
|
|
|
|
} |
1672
|
0
|
0
|
|
|
|
0
|
if (defined $self->{groups}) { |
1673
|
0
|
|
|
|
|
0
|
my $id=undef; |
1674
|
0
|
|
|
|
|
0
|
foreach $id (values %Friends) { |
1675
|
0
|
0
|
|
|
|
0
|
(defined $id->{groupmask}) || next; |
1676
|
0
|
|
|
|
|
0
|
foreach (values %{$self->{groups}->{name}}) { |
|
0
|
|
|
|
|
0
|
|
1677
|
0
|
|
|
|
|
0
|
my $bit=1 << $_->{id}; |
1678
|
0
|
0
|
|
|
|
0
|
if (($id->{groupmask} & $bit) == $bit) { |
1679
|
0
|
|
|
|
|
0
|
push(@{$id->{groups}},$_->{name}); |
|
0
|
|
|
|
|
0
|
|
1680
|
|
|
|
|
|
|
} |
1681
|
|
|
|
|
|
|
} |
1682
|
|
|
|
|
|
|
} |
1683
|
|
|
|
|
|
|
} |
1684
|
0
|
|
|
|
|
0
|
my @lst=sort {$a->{user} cmp $b->{user}} (values %Friends); |
|
0
|
|
|
|
|
0
|
|
1685
|
0
|
|
|
|
|
0
|
return ($#lst+1,@lst); |
1686
|
|
|
|
|
|
|
} |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
=pod |
1690
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
=item $lj->CheckFriends(@groups) |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
This routine is used to poll the LiveJournal server to see if your friends list |
1694
|
|
|
|
|
|
|
has been updated or not. This routine returns a list. The first item in the |
1695
|
|
|
|
|
|
|
list is a value which holds C<1> if there has been an update |
1696
|
|
|
|
|
|
|
to your friends list and C<0> if not. The second item in the list holds the number |
1697
|
|
|
|
|
|
|
of seconds you must wait before calling C again. |
1698
|
|
|
|
|
|
|
In the event of an error C is returned in the first item of the list. |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
The routine can be given an optional list of friends group to check instead of |
1701
|
|
|
|
|
|
|
just looking at all of the friends for the user. |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
Example code: |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
while(1) { |
1706
|
|
|
|
|
|
|
my ($new_friends,$next_update)=$lj->CheckFriends(); |
1707
|
|
|
|
|
|
|
(defined $new_friends) || |
1708
|
|
|
|
|
|
|
die "$0: Failed to check friends - $LJ::Simple::error\n"; |
1709
|
|
|
|
|
|
|
($new_friends) && print "Friends list updated\n"; |
1710
|
|
|
|
|
|
|
sleep($next_update+1); |
1711
|
|
|
|
|
|
|
} |
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
=cut |
1714
|
|
|
|
|
|
|
sub CheckFriends($@) { |
1715
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1716
|
0
|
|
|
|
|
0
|
my (@groups)=@_; |
1717
|
0
|
|
|
|
|
0
|
my %Event=(); |
1718
|
0
|
|
|
|
|
0
|
my %Resp=(); |
1719
|
0
|
0
|
|
|
|
0
|
if ($#groups>-1) { |
1720
|
0
|
0
|
|
|
|
0
|
if (!defined $self->{groups}) { |
1721
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Groups not requested at login"; |
1722
|
0
|
|
|
|
|
0
|
return 0; |
1723
|
|
|
|
|
|
|
} |
1724
|
0
|
|
|
|
|
0
|
my $g; |
1725
|
0
|
|
|
|
|
0
|
my $mask=0; |
1726
|
0
|
|
|
|
|
0
|
foreach $g (@groups) { |
1727
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{groups}->{name}->{$g}) { |
1728
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Group \"$g\" does not exist"; |
1729
|
0
|
|
|
|
|
0
|
return 0; |
1730
|
|
|
|
|
|
|
} |
1731
|
0
|
|
|
|
|
0
|
$mask=$mask | (1 << $self->{groups}->{name}->{$g}->{id}); |
1732
|
|
|
|
|
|
|
} |
1733
|
0
|
|
|
|
|
0
|
$Event{mask}=$mask; |
1734
|
|
|
|
|
|
|
} |
1735
|
0
|
0
|
|
|
|
0
|
if (exists $self->{checkfriends}) { |
1736
|
0
|
|
|
|
|
0
|
$Event{lastupdate}=$self->{checkfriends}->{lastupdate}; |
1737
|
0
|
|
|
|
|
0
|
my $currtime=time(); |
1738
|
0
|
0
|
|
|
|
0
|
if ($currtime<$self->{checkfriends}->{interval}) { |
1739
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Insufficent time left between CheckFriends() call"; |
1740
|
0
|
|
|
|
|
0
|
return undef; |
1741
|
|
|
|
|
|
|
} |
1742
|
|
|
|
|
|
|
} else { |
1743
|
0
|
|
|
|
|
0
|
$self->{checkfriends}={}; |
1744
|
|
|
|
|
|
|
} |
1745
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("checkfriends",\%Event,\%Resp) || return undef; |
1746
|
0
|
|
|
|
|
0
|
$self->{checkfriends}->{lastupdate}=$Resp{lastupdate}; |
1747
|
0
|
|
|
|
|
0
|
$self->{checkfriends}->{interval}=time() + $Resp{interval}; |
1748
|
0
|
|
|
|
|
0
|
return ($Resp{new},$Resp{interval}); |
1749
|
|
|
|
|
|
|
} |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
|
1752
|
|
|
|
|
|
|
=pod |
1753
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
=item $lj->GetDayCounts($hash_ref,$journal) |
1755
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
This routine is given a reference to hash which it fills with information |
1757
|
|
|
|
|
|
|
on the journal entries posted to the LiveJournal we are currently associated |
1758
|
|
|
|
|
|
|
with. On success the reference to the hash will be returned. On error |
1759
|
|
|
|
|
|
|
C is returned. |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
There is an optional argument - C<$journal> - which can be used to gather this |
1762
|
|
|
|
|
|
|
data for a shared journal the user has access to. If not required then this |
1763
|
|
|
|
|
|
|
value should be C or an empty string. |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
The key to the hash is a date, given as seconds since epoch (I C) |
1766
|
|
|
|
|
|
|
and the value is the number of entries made on that day. Only dates which have |
1767
|
|
|
|
|
|
|
journal entries made against them will have values in the hash; thus it can be |
1768
|
|
|
|
|
|
|
assumed that if a date is B in the hash then no journal entries were made |
1769
|
|
|
|
|
|
|
on that day. |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
The hash will be emptied before use. |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
Example code: |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
use POSIX; |
1776
|
|
|
|
|
|
|
(defined $lj->GetDayCounts(\%gdc_hr,undef)) |
1777
|
|
|
|
|
|
|
|| die "$0: Failed to get day counts - $LJ::Simple::error\n"; |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
foreach (sort {$a<=>$b} keys %gdc_hr) { |
1780
|
|
|
|
|
|
|
printf("%s %03d\n",strftime("%Y/%m/%d",localtime($_)),$gdc_hr{$_}); |
1781
|
|
|
|
|
|
|
} |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
=cut |
1784
|
|
|
|
|
|
|
sub GetDayCounts($$$) { |
1785
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1786
|
0
|
|
|
|
|
0
|
my ($hr,$journal)=@_; |
1787
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1788
|
0
|
0
|
|
|
|
0
|
if (ref($hr) ne "HASH") { |
1789
|
0
|
|
|
|
|
0
|
my $r=ref($hr); |
1790
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetDayCounts() given \"$r\", not a hash reference"; |
1791
|
0
|
|
|
|
|
0
|
return undef; |
1792
|
|
|
|
|
|
|
} |
1793
|
0
|
|
|
|
|
0
|
%{$hr}=(); |
|
0
|
|
|
|
|
0
|
|
1794
|
0
|
|
|
|
|
0
|
my %Event=(); |
1795
|
0
|
|
|
|
|
0
|
my %Resp=(); |
1796
|
0
|
0
|
0
|
|
|
0
|
if ((defined $journal) && ($journal ne "")) { |
1797
|
0
|
|
|
|
|
0
|
$Event{usejournal}=$journal; |
1798
|
|
|
|
|
|
|
} |
1799
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("getdaycounts",\%Event,\%Resp) || return undef; |
1800
|
0
|
|
|
|
|
0
|
my ($k,$v); |
1801
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %Resp) { |
1802
|
0
|
0
|
|
|
|
0
|
($k=~/([0-9]+)-([0-9]+)-([0-9]+)/o) || next; |
1803
|
0
|
0
|
|
|
|
0
|
($v==0) && next; |
1804
|
0
|
|
|
|
|
0
|
my $timet=mktime(0,0,0,$3,$2-1,$1-1900); |
1805
|
0
|
0
|
|
|
|
0
|
if (!defined $timet) { |
1806
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to convert date $k into Unix timestamp"; |
1807
|
0
|
|
|
|
|
0
|
return undef; |
1808
|
|
|
|
|
|
|
} |
1809
|
0
|
0
|
|
|
|
0
|
if (exists $hr->{$timet}) { |
1810
|
0
|
|
|
|
|
0
|
$hr->{$timet}=$hr->{$timet}+$v; |
1811
|
|
|
|
|
|
|
} else { |
1812
|
0
|
|
|
|
|
0
|
$hr->{$timet}=$v; |
1813
|
|
|
|
|
|
|
} |
1814
|
|
|
|
|
|
|
} |
1815
|
0
|
|
|
|
|
0
|
return $hr; |
1816
|
|
|
|
|
|
|
} |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
=pod |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
=item $lj->GetFriendGroups($hash_ref) |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
This routine is given a reference to a hash which it fills with information |
1824
|
|
|
|
|
|
|
on the friends groups the user has defined. On success the reference to the |
1825
|
|
|
|
|
|
|
hash will be returned. On error C is returned. |
1826
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
The hash key is the id number of the friends group as it is possible to |
1828
|
|
|
|
|
|
|
have multiple friends groups with the same name. Each hash value is a hash |
1829
|
|
|
|
|
|
|
reference which points to the following hash: |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
{ |
1832
|
|
|
|
|
|
|
id => Id of the group; used to create permission masks |
1833
|
|
|
|
|
|
|
name => Name of the group |
1834
|
|
|
|
|
|
|
sort => Sort order number from 0 to 255 |
1835
|
|
|
|
|
|
|
public => Public group ? 1 for yes, 0 for no |
1836
|
|
|
|
|
|
|
} |
1837
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
The hash given will be emptied before use. |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
Example code: |
1841
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
my %fg=(); |
1843
|
|
|
|
|
|
|
(defined $lj->GetFriendGroups(\%fg)) || |
1844
|
|
|
|
|
|
|
die "$0: Failed to get groups - $LJ::Simple::error\n"; |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
my $format="| %-4s | %-2s | %-6s | %-40s |\n"; |
1847
|
|
|
|
|
|
|
my $line=sprintf($format,"","","",""); |
1848
|
|
|
|
|
|
|
$line=~s/\|/+/go; |
1849
|
|
|
|
|
|
|
$line=~s/ /-/go; |
1850
|
|
|
|
|
|
|
print $line; |
1851
|
|
|
|
|
|
|
printf($format,"Sort","Id","Public","Group"); |
1852
|
|
|
|
|
|
|
print $line; |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
foreach (sort {$fg{$a}->{sort}<=>$fg{$b}->{sort}} keys %fg) { |
1855
|
|
|
|
|
|
|
my $hr=$fg{$_}; |
1856
|
|
|
|
|
|
|
my $pub="No"; |
1857
|
|
|
|
|
|
|
$hr->{public} && ($pub="Yes"); |
1858
|
|
|
|
|
|
|
printf($format,$hr->{sort},$hr->{id},$pub,$hr->{name}); |
1859
|
|
|
|
|
|
|
} |
1860
|
|
|
|
|
|
|
|
1861
|
|
|
|
|
|
|
print $line; |
1862
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
In case you're wondering, the above code outputs something similar to |
1864
|
|
|
|
|
|
|
the following: |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
+------+----+--------+------------------------------------------+ |
1867
|
|
|
|
|
|
|
| Sort | Id | Public | Group | |
1868
|
|
|
|
|
|
|
+------+----+--------+------------------------------------------+ |
1869
|
|
|
|
|
|
|
| 5 | 1 | Yes | Good Friends | |
1870
|
|
|
|
|
|
|
| 10 | 2 | No | Communities | |
1871
|
|
|
|
|
|
|
+------+----+--------+------------------------------------------+ |
1872
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
=cut |
1874
|
|
|
|
|
|
|
sub GetFriendGroups($$) { |
1875
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1876
|
0
|
|
|
|
|
0
|
my ($hr)=@_; |
1877
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1878
|
0
|
0
|
|
|
|
0
|
if (ref($hr) ne "HASH") { |
1879
|
0
|
|
|
|
|
0
|
my $r=ref($hr); |
1880
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetFriendGroups() given \"$r\", not a hash reference"; |
1881
|
0
|
|
|
|
|
0
|
return undef; |
1882
|
|
|
|
|
|
|
} |
1883
|
0
|
|
|
|
|
0
|
%{$hr}=(); |
|
0
|
|
|
|
|
0
|
|
1884
|
0
|
|
|
|
|
0
|
my %Event=(); |
1885
|
0
|
|
|
|
|
0
|
my %Resp=(); |
1886
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("getfriendgroups",\%Event,\%Resp) || return undef; |
1887
|
0
|
|
|
|
|
0
|
my ($k,$v); |
1888
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %Resp) { |
1889
|
0
|
0
|
|
|
|
0
|
$k=~/^frgrp_([0-9]+)_(.*)$/o || next; |
1890
|
0
|
|
|
|
|
0
|
my ($id,$name)=($1,$2); |
1891
|
0
|
0
|
|
|
|
0
|
if (!exists $hr->{$id}) { |
1892
|
0
|
|
|
|
|
0
|
$hr->{$id}={ |
1893
|
|
|
|
|
|
|
id => $id, |
1894
|
|
|
|
|
|
|
public => 0, |
1895
|
|
|
|
|
|
|
}; |
1896
|
|
|
|
|
|
|
} |
1897
|
0
|
0
|
|
|
|
0
|
($name eq "sortorder") && ($name="sort"); |
1898
|
0
|
|
|
|
|
0
|
$hr->{$id}->{$name}=$v; |
1899
|
|
|
|
|
|
|
} |
1900
|
0
|
|
|
|
|
0
|
return $hr; |
1901
|
|
|
|
|
|
|
} |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
=pod |
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
=back |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
=head2 The creation and editing of entries |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
=over 4 |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
=item $lj->NewEntry($event) |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
Prepares for a new journal entry to be sent into the LiveJournal system. |
1914
|
|
|
|
|
|
|
Takes a reference to a hash which will be emptied and prepared for use |
1915
|
|
|
|
|
|
|
by the other routines used to prepare a journal entry for posting. |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
On success returns C<1>, on failure returns C<0> |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
Example code: |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
my %Entry=(); |
1922
|
|
|
|
|
|
|
$lj->NewEntry(\%Entry) |
1923
|
|
|
|
|
|
|
|| die "$0: Failed to prepare new post - $LJ::Simple::error\n"; |
1924
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
=cut |
1926
|
|
|
|
|
|
|
sub NewEntry($$) { |
1927
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1928
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
1929
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1930
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
1931
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
1932
|
0
|
|
|
|
|
0
|
return 0; |
1933
|
|
|
|
|
|
|
} |
1934
|
|
|
|
|
|
|
## Build the event hash - put defaults in |
1935
|
0
|
|
|
|
|
0
|
my $ltime=time(); |
1936
|
0
|
|
|
|
|
0
|
my @ltime=localtime($ltime); |
1937
|
0
|
|
|
|
|
0
|
%{$event}=( |
|
0
|
|
|
|
|
0
|
|
1938
|
|
|
|
|
|
|
__new_entry => 1, |
1939
|
|
|
|
|
|
|
event => undef, |
1940
|
|
|
|
|
|
|
lineenddings => "unix", |
1941
|
|
|
|
|
|
|
subject => undef, |
1942
|
|
|
|
|
|
|
year => $ltime[5]+1900, |
1943
|
|
|
|
|
|
|
mon => $ltime[4]+1, |
1944
|
|
|
|
|
|
|
day => $ltime[3], |
1945
|
|
|
|
|
|
|
hour => $ltime[2], |
1946
|
|
|
|
|
|
|
min => $ltime[1], |
1947
|
|
|
|
|
|
|
__timet => $ltime, |
1948
|
|
|
|
|
|
|
); |
1949
|
0
|
|
|
|
|
0
|
return 1; |
1950
|
|
|
|
|
|
|
} |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
=pod |
1954
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
=item $lj->SetDate($event,$time_t) |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
Sets the date for the event being built from the given C (i.e. seconds |
1958
|
|
|
|
|
|
|
since epoch) value. Bare in mind that you may need to call |
1959
|
|
|
|
|
|
|
C<$lj-ESetprop_backdate(\%Event,1)> to backdate the journal entry if the journal being |
1960
|
|
|
|
|
|
|
posted to has events more recent than the date being set here. Returns C<1> on |
1961
|
|
|
|
|
|
|
success, C<0> on failure. |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
If the value given for C is C then the current time is used. |
1964
|
|
|
|
|
|
|
If the value given for C is negative then it is taken to be relative |
1965
|
|
|
|
|
|
|
to the current time, i.e. a value of C<-3600> is an hour earlier than the |
1966
|
|
|
|
|
|
|
current time. |
1967
|
|
|
|
|
|
|
|
1968
|
|
|
|
|
|
|
Note that C is called to convert the C value into |
1969
|
|
|
|
|
|
|
the year, month, day, hours and minute values required by LiveJournal. |
1970
|
|
|
|
|
|
|
Thus the time given to LiveJournal will be the local time as shown on |
1971
|
|
|
|
|
|
|
the machine the code is running on. |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
Example code: |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
## Set date to current time |
1976
|
|
|
|
|
|
|
$lj->SetDate(\%Event,undef) |
1977
|
|
|
|
|
|
|
|| die "$0: Failed to set date of entry - $LJ::Simple::error\n"; |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
## Set date to Wed Aug 14 11:56:42 2002 GMT |
1980
|
|
|
|
|
|
|
$lj->SetDate(\%Event,1029326202) |
1981
|
|
|
|
|
|
|
|| die "$0: Failed to set date of entry - $LJ::Simple::error\n"; |
1982
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
## Set date to an hour ago |
1984
|
|
|
|
|
|
|
$lj->SetDate(\%Event,-3600) |
1985
|
|
|
|
|
|
|
|| die "$0: Failed to set date of entry - $LJ::Simple::error\n"; |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
=cut |
1988
|
|
|
|
|
|
|
sub SetDate($$$) { |
1989
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
1990
|
0
|
|
|
|
|
0
|
my ($event,$timet)=@_; |
1991
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
1992
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
1993
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
1994
|
0
|
|
|
|
|
0
|
return 0; |
1995
|
|
|
|
|
|
|
} |
1996
|
0
|
0
|
|
|
|
0
|
(defined $timet) || ($timet=time()); |
1997
|
0
|
0
|
|
|
|
0
|
if ($timet<0) { |
1998
|
0
|
|
|
|
|
0
|
$timet=time() + $timet; |
1999
|
|
|
|
|
|
|
} |
2000
|
0
|
|
|
|
|
0
|
my @ltime=localtime($timet); |
2001
|
0
|
|
|
|
|
0
|
$event->{__timet}=$timet; |
2002
|
0
|
|
|
|
|
0
|
$event->{year}=$ltime[5]+1900; |
2003
|
0
|
|
|
|
|
0
|
$event->{mon}=$ltime[4]+1; |
2004
|
0
|
|
|
|
|
0
|
$event->{day}=$ltime[3]; |
2005
|
0
|
|
|
|
|
0
|
$event->{hour}=$ltime[2]; |
2006
|
0
|
|
|
|
|
0
|
$event->{min}=$ltime[1]; |
2007
|
0
|
|
|
|
|
0
|
return 1; |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
=pod |
2012
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
=item $lj->SetMood($event,$mood) |
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
Given a mood this routine sets the mood for the journal entry. Unlike the |
2016
|
|
|
|
|
|
|
more direct C<$lj-ESetprop_current_mood()> and C<$lj-ESetprop_current_mood_id(\%Event,)> |
2017
|
|
|
|
|
|
|
routines, this routine will attempt to first attempt to find the mood given |
2018
|
|
|
|
|
|
|
to it in the mood list returned by the LiveJournal server. If it is unable to |
2019
|
|
|
|
|
|
|
find a suitable mood then it uses the text given. |
2020
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
Note that if the LiveJournal |
2022
|
|
|
|
|
|
|
object was created with either C set to C<0> or |
2023
|
|
|
|
|
|
|
with C set to C<1> then this function will not attempt to find the |
2024
|
|
|
|
|
|
|
mood name given in C<$mood> in the mood list. |
2025
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
Returns C<1> on success, C<0> otherwise. |
2027
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
Example code: |
2029
|
|
|
|
|
|
|
|
2030
|
|
|
|
|
|
|
$lj->SetMood(\%Event,"happy") |
2031
|
|
|
|
|
|
|
|| die "$0: Failed to set mood - $LJ::Simple::error\n"; |
2032
|
|
|
|
|
|
|
|
2033
|
|
|
|
|
|
|
=cut |
2034
|
|
|
|
|
|
|
sub SetMood($$$) { |
2035
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2036
|
0
|
|
|
|
|
0
|
my ($event,$mood) = @_; |
2037
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2038
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2039
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2040
|
0
|
|
|
|
|
0
|
return 0; |
2041
|
|
|
|
|
|
|
} |
2042
|
0
|
0
|
|
|
|
0
|
if (!defined $mood) { |
2043
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: given undef value for a mood"; |
2044
|
0
|
|
|
|
|
0
|
return 0; |
2045
|
|
|
|
|
|
|
} |
2046
|
|
|
|
|
|
|
## Simple opt - none of the mood names have a space in them |
2047
|
0
|
0
|
0
|
|
|
0
|
if (($mood!~/\s/)&&(defined $self->{mood_map})) { |
2048
|
0
|
|
|
|
|
0
|
my $lc_mood=lc($mood); |
2049
|
0
|
0
|
|
|
|
0
|
if (exists $self->{mood_map}->{$lc_mood}) { |
2050
|
0
|
|
|
|
|
0
|
return $self->Setprop_current_mood_id($event,$self->{mood_map}->{$lc_mood}) |
2051
|
|
|
|
|
|
|
} |
2052
|
|
|
|
|
|
|
} |
2053
|
0
|
|
|
|
|
0
|
return $self->Setprop_current_mood($event,$mood); |
2054
|
|
|
|
|
|
|
} |
2055
|
|
|
|
|
|
|
|
2056
|
|
|
|
|
|
|
|
2057
|
|
|
|
|
|
|
|
2058
|
|
|
|
|
|
|
=pod |
2059
|
|
|
|
|
|
|
|
2060
|
|
|
|
|
|
|
=item $lj->UseJournal($event,$journal) |
2061
|
|
|
|
|
|
|
|
2062
|
|
|
|
|
|
|
The journal entry will be posted into the shared journal given |
2063
|
|
|
|
|
|
|
as an argument rather than the default journal for the user. |
2064
|
|
|
|
|
|
|
|
2065
|
|
|
|
|
|
|
Returns C<1> on success, C<0> otherwise. |
2066
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
Example code: |
2068
|
|
|
|
|
|
|
|
2069
|
|
|
|
|
|
|
$lj->UseJournal(\%Event,"some_community") |
2070
|
|
|
|
|
|
|
|| die "$0: Failed to - $LJ::Simple::error\n"; |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
=cut |
2073
|
|
|
|
|
|
|
sub UseJournal($$$) { |
2074
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2075
|
0
|
|
|
|
|
0
|
my ($event,$journal) = @_; |
2076
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2077
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2078
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2079
|
0
|
|
|
|
|
0
|
return 0; |
2080
|
|
|
|
|
|
|
} |
2081
|
0
|
0
|
|
|
|
0
|
if (!defined $journal) { |
2082
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Given undefined value for journal"; |
2083
|
0
|
|
|
|
|
0
|
return 0; |
2084
|
|
|
|
|
|
|
} |
2085
|
0
|
0
|
0
|
|
|
0
|
if ((defined $self->{access})&&(!exists $self->{access}->{$journal})) { |
2086
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="user unable to post to journal \"$journal\""; |
2087
|
0
|
|
|
|
|
0
|
return 0; |
2088
|
|
|
|
|
|
|
} |
2089
|
0
|
|
|
|
|
0
|
$event->{usejournal}=$journal; |
2090
|
0
|
|
|
|
|
0
|
return 1; |
2091
|
|
|
|
|
|
|
} |
2092
|
|
|
|
|
|
|
|
2093
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
=pod |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
=item $lj->SetSubject($event,$subject) |
2097
|
|
|
|
|
|
|
|
2098
|
|
|
|
|
|
|
Sets the subject for the journal entry. The subject has the following |
2099
|
|
|
|
|
|
|
limitations: |
2100
|
|
|
|
|
|
|
|
2101
|
|
|
|
|
|
|
o Limited to a length of 255 characters |
2102
|
|
|
|
|
|
|
o No newlines are allowed |
2103
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
Returns C<1> on success, C<0> otherwise. |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
Example code: |
2107
|
|
|
|
|
|
|
|
2108
|
|
|
|
|
|
|
$lj->SetSubject(\%Event,"Some subject") |
2109
|
|
|
|
|
|
|
|| die "$0: Failed to set subject - $LJ::Simple::error\n"; |
2110
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
=cut |
2112
|
|
|
|
|
|
|
sub SetSubject($$$) { |
2113
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2114
|
0
|
|
|
|
|
0
|
my ($event,$subject) = @_; |
2115
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2116
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2117
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2118
|
0
|
|
|
|
|
0
|
return 0; |
2119
|
|
|
|
|
|
|
} |
2120
|
0
|
0
|
|
|
|
0
|
(defined $subject) || ($subject=""); |
2121
|
0
|
0
|
|
|
|
0
|
if (length($subject)>255) { |
2122
|
0
|
|
|
|
|
0
|
my $len=length($subject); |
2123
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Subject length limited to 255 characters [given $len]"; |
2124
|
0
|
|
|
|
|
0
|
return 0; |
2125
|
|
|
|
|
|
|
} |
2126
|
0
|
0
|
|
|
|
0
|
if ($subject=~/[\r\n]/) { |
2127
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="New lines not allowed in subject"; |
2128
|
0
|
|
|
|
|
0
|
return 0; |
2129
|
|
|
|
|
|
|
} |
2130
|
0
|
|
|
|
|
0
|
$event->{subject}=$subject; |
2131
|
0
|
|
|
|
|
0
|
return 1; |
2132
|
|
|
|
|
|
|
} |
2133
|
|
|
|
|
|
|
|
2134
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
=pod |
2136
|
|
|
|
|
|
|
|
2137
|
|
|
|
|
|
|
=item $lj->SetEntry($event,@entry) |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
Sets the entry for the journal; takes a list of strings. It should be noted |
2140
|
|
|
|
|
|
|
that this list will be Ced together with a newline between each |
2141
|
|
|
|
|
|
|
list entry. |
2142
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
If the list is null or C then any existing entry is removed. |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
Returns C<1> on success, C<0> otherwise. |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
Example code: |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
# Single line entry |
2150
|
|
|
|
|
|
|
$lj->SetEntry(\%Event,"Just a simple entry") |
2151
|
|
|
|
|
|
|
|| die "$0: Failed to set entry - $LJ::Simple::error\n"; |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
# Three lines of text |
2154
|
|
|
|
|
|
|
my @stuff=( |
2155
|
|
|
|
|
|
|
"Line 1", |
2156
|
|
|
|
|
|
|
"Line 2", |
2157
|
|
|
|
|
|
|
"Line 3", |
2158
|
|
|
|
|
|
|
); |
2159
|
|
|
|
|
|
|
$lj->SetEntry(\%Event,@stuff) |
2160
|
|
|
|
|
|
|
|| die "$0: Failed to set entry - $LJ::Simple::error\n"; |
2161
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
# Clear the entry |
2163
|
|
|
|
|
|
|
$lj->SetEntry(\%Event,undef) |
2164
|
|
|
|
|
|
|
|| die "$0: Failed to set entry - $LJ::Simple::error\n"; |
2165
|
|
|
|
|
|
|
$lj->SetEntry(\%Event) |
2166
|
|
|
|
|
|
|
|| die "$0: Failed to set entry - $LJ::Simple::error\n"; |
2167
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
=cut |
2169
|
|
|
|
|
|
|
sub SetEntry($$@) { |
2170
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2171
|
0
|
|
|
|
|
0
|
my ($event,@entry) = @_; |
2172
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2173
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2174
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2175
|
0
|
|
|
|
|
0
|
return 0; |
2176
|
|
|
|
|
|
|
} |
2177
|
0
|
0
|
0
|
|
|
0
|
if ((!defined $entry[0]) || ($#entry == -1)) { |
2178
|
0
|
|
|
|
|
0
|
$event->{event}=undef; |
2179
|
|
|
|
|
|
|
} else { |
2180
|
0
|
|
|
|
|
0
|
$event->{event}=join("\n",@entry); |
2181
|
|
|
|
|
|
|
} |
2182
|
0
|
|
|
|
|
0
|
return 1; |
2183
|
|
|
|
|
|
|
} |
2184
|
|
|
|
|
|
|
|
2185
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
=pod |
2187
|
|
|
|
|
|
|
|
2188
|
|
|
|
|
|
|
=item $lj->AddToEntry($event,@entry) |
2189
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
Adds a string to the existing journal entry being worked on. The new data |
2191
|
|
|
|
|
|
|
will be appended to the existing entry with a newline separating them. |
2192
|
|
|
|
|
|
|
It should be noted that as with C<$lj-ESetEntry()> the list given to |
2193
|
|
|
|
|
|
|
this routine will be Ced together with a newline between each |
2194
|
|
|
|
|
|
|
list entry. |
2195
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
If C<$lj-ESetEntry()> has not been called then C<$lj-EAddToEntry()> acts |
2197
|
|
|
|
|
|
|
in the same way as C<$lj-ESetEntry()>. |
2198
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
If C<$lj-ESetEntry()> has already been called then calling C<$lj-EAddToEntry()> |
2200
|
|
|
|
|
|
|
with a null list or a list which starts with C is a NOP. |
2201
|
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
Returns C<1> on success, C<0> otherwise. |
2203
|
|
|
|
|
|
|
|
2204
|
|
|
|
|
|
|
Example code: |
2205
|
|
|
|
|
|
|
|
2206
|
|
|
|
|
|
|
# Single line entry |
2207
|
|
|
|
|
|
|
$lj->AddToEntry(\%Event,"Some more text") |
2208
|
|
|
|
|
|
|
|| die "$0: Failed to set entry - $LJ::Simple::error\n"; |
2209
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
# Three lines of text |
2211
|
|
|
|
|
|
|
my @stuff=( |
2212
|
|
|
|
|
|
|
"Line 5", |
2213
|
|
|
|
|
|
|
"Line 6", |
2214
|
|
|
|
|
|
|
"Line 7", |
2215
|
|
|
|
|
|
|
); |
2216
|
|
|
|
|
|
|
$lj->AddToEntry(\%Event,@stuff) |
2217
|
|
|
|
|
|
|
|| die "$0: Failed to set entry - $LJ::Simple::error\n"; |
2218
|
|
|
|
|
|
|
|
2219
|
|
|
|
|
|
|
=cut |
2220
|
|
|
|
|
|
|
sub AddToEntry($$@) { |
2221
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2222
|
0
|
|
|
|
|
0
|
my ($event,@entry) = @_; |
2223
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2224
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2225
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2226
|
0
|
|
|
|
|
0
|
return 0; |
2227
|
|
|
|
|
|
|
} |
2228
|
0
|
0
|
|
|
|
0
|
if (!defined $event->{event}) { |
2229
|
0
|
0
|
0
|
|
|
0
|
if ((!defined $entry[0]) || ($#entry == -1)) { |
2230
|
0
|
|
|
|
|
0
|
$event->{event}=undef; |
2231
|
|
|
|
|
|
|
} else { |
2232
|
0
|
|
|
|
|
0
|
$event->{event}=join("\n",@entry); |
2233
|
|
|
|
|
|
|
} |
2234
|
|
|
|
|
|
|
} else { |
2235
|
0
|
0
|
0
|
|
|
0
|
if ((!defined $entry[0]) || ($#entry == -1)) { |
2236
|
0
|
|
|
|
|
0
|
return 1; |
2237
|
|
|
|
|
|
|
} |
2238
|
0
|
|
|
|
|
0
|
$event->{event}=join("\n",$event->{event},@entry); |
2239
|
|
|
|
|
|
|
} |
2240
|
0
|
|
|
|
|
0
|
return 1; |
2241
|
|
|
|
|
|
|
} |
2242
|
|
|
|
|
|
|
|
2243
|
|
|
|
|
|
|
|
2244
|
|
|
|
|
|
|
=pod |
2245
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
=back |
2247
|
|
|
|
|
|
|
|
2248
|
|
|
|
|
|
|
=head2 Setting of journal entry security levels |
2249
|
|
|
|
|
|
|
|
2250
|
|
|
|
|
|
|
=over 4 |
2251
|
|
|
|
|
|
|
|
2252
|
|
|
|
|
|
|
=item $lj->SetProtect($event,$type,@args) |
2253
|
|
|
|
|
|
|
|
2254
|
|
|
|
|
|
|
A wrapper function which calls the underlying C routines |
2255
|
|
|
|
|
|
|
for the caller. This takes two or more arguments; the first argument is |
2256
|
|
|
|
|
|
|
the hash reference of the current event. The second argument is the |
2257
|
|
|
|
|
|
|
type of security we are setting. Subsequent arguments are related to |
2258
|
|
|
|
|
|
|
the security type. Available types and their arguments are: |
2259
|
|
|
|
|
|
|
|
2260
|
|
|
|
|
|
|
+---------+------------------+------------------------------------+ |
2261
|
|
|
|
|
|
|
| Type | Additional args | Security | |
2262
|
|
|
|
|
|
|
+---------+------------------+------------------------------------+ |
2263
|
|
|
|
|
|
|
| public | None | Public - the default | |
2264
|
|
|
|
|
|
|
| friends | None | Friends only | |
2265
|
|
|
|
|
|
|
| groups | A list of groups | Restricted to groups of friends | |
2266
|
|
|
|
|
|
|
| private | None | Private - only the user can access | |
2267
|
|
|
|
|
|
|
+---------+------------------+------------------------------------+ |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
On success this routine returns C<1>; otherwise it returns C<0> and |
2270
|
|
|
|
|
|
|
sets C<$LJ::Simple::error> to the reason why. |
2271
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
Example code: |
2273
|
|
|
|
|
|
|
|
2274
|
|
|
|
|
|
|
## Make entry public (the default) |
2275
|
|
|
|
|
|
|
$lj->SetProtect(\%Event,"public") |
2276
|
|
|
|
|
|
|
|| die "$0: Failed to make entry public - $LJ::Simple::error\n"; |
2277
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
## Make entry friends only |
2279
|
|
|
|
|
|
|
$lj->SetProtect(\%Event,"friends") |
2280
|
|
|
|
|
|
|
|| die "$0: Failed to make entry friends only - $LJ::Simple::error\n"; |
2281
|
|
|
|
|
|
|
|
2282
|
|
|
|
|
|
|
## Make entry only readable by friends in the groups "close" and "others" |
2283
|
|
|
|
|
|
|
$lj->SetProtect(\%Event,"groups","close","others") |
2284
|
|
|
|
|
|
|
|| die "$0: Failed to make entry public - $LJ::Simple::error\n"; |
2285
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
## Make entry private so only the journal owner can view it |
2287
|
|
|
|
|
|
|
$lj->SetProtect(\%Event,"private") |
2288
|
|
|
|
|
|
|
|| die "$0: Failed to make entry private - $LJ::Simple::error\n"; |
2289
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
=cut |
2291
|
|
|
|
|
|
|
sub SetProtect($$$@) { |
2292
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2293
|
0
|
|
|
|
|
0
|
my ($event,$type,@args)=@_; |
2294
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2295
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2296
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2297
|
0
|
|
|
|
|
0
|
return 0; |
2298
|
|
|
|
|
|
|
} |
2299
|
0
|
0
|
|
|
|
0
|
if (!defined $type) { |
2300
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: given undefined value for type"; |
2301
|
0
|
|
|
|
|
0
|
return 0; |
2302
|
|
|
|
|
|
|
} |
2303
|
0
|
0
|
|
|
|
0
|
if ($type eq "public") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2304
|
0
|
|
|
|
|
0
|
return $self->SetProtectPublic($event); |
2305
|
|
|
|
|
|
|
} elsif ($type eq "friends") { |
2306
|
0
|
|
|
|
|
0
|
return $self->SetProtectFriends($event); |
2307
|
|
|
|
|
|
|
} elsif ($type eq "groups") { |
2308
|
0
|
|
|
|
|
0
|
return $self->SetProtectGroups($event,@args); |
2309
|
|
|
|
|
|
|
} elsif ($type eq "private") { |
2310
|
0
|
|
|
|
|
0
|
return $self->SetProtectPrivate($event); |
2311
|
|
|
|
|
|
|
} else { |
2312
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: type \"$type\" not recognised by SetProtect()"; |
2313
|
0
|
|
|
|
|
0
|
return 0; |
2314
|
|
|
|
|
|
|
} |
2315
|
|
|
|
|
|
|
}; |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
=pod |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
=item $lj->SetProtectPublic($event) |
2320
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
Sets the current post so that anyone can read the journal entry. Note that this |
2322
|
|
|
|
|
|
|
is the default for a new post created by C - this method is most |
2323
|
|
|
|
|
|
|
useful when working with an existing post. Returns C<1> on success, C<0> |
2324
|
|
|
|
|
|
|
otherwise. |
2325
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
Example code: |
2327
|
|
|
|
|
|
|
|
2328
|
|
|
|
|
|
|
$lj->SetProtectPublic(\%Event) |
2329
|
|
|
|
|
|
|
|| die "$0: Failed to make entry public - $LJ::Simple::error\n"; |
2330
|
|
|
|
|
|
|
|
2331
|
|
|
|
|
|
|
=cut |
2332
|
|
|
|
|
|
|
sub SetProtectPublic($$) { |
2333
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2334
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
2335
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2336
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2337
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2338
|
0
|
|
|
|
|
0
|
return 0; |
2339
|
|
|
|
|
|
|
} |
2340
|
0
|
|
|
|
|
0
|
$event->{security}="public"; |
2341
|
0
|
0
|
|
|
|
0
|
(exists $event->{allowmask}) && delete $event->{allowmask}; |
2342
|
0
|
|
|
|
|
0
|
return 1; |
2343
|
|
|
|
|
|
|
} |
2344
|
|
|
|
|
|
|
|
2345
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
=pod |
2347
|
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
|
2349
|
|
|
|
|
|
|
=pod |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
=item $lj->SetProtectFriends($event) |
2352
|
|
|
|
|
|
|
|
2353
|
|
|
|
|
|
|
Sets the current post so that only friends can read the journal entry. Returns |
2354
|
|
|
|
|
|
|
C<1> on success, C<0> otherwise. |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
Example code: |
2357
|
|
|
|
|
|
|
|
2358
|
|
|
|
|
|
|
$lj->SetProtectFriends(\%Event) |
2359
|
|
|
|
|
|
|
|| die "$0: Failed to protect via friends - $LJ::Simple::error\n"; |
2360
|
|
|
|
|
|
|
|
2361
|
|
|
|
|
|
|
=cut |
2362
|
|
|
|
|
|
|
sub SetProtectFriends($$) { |
2363
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2364
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
2365
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2366
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2367
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2368
|
0
|
|
|
|
|
0
|
return 0; |
2369
|
|
|
|
|
|
|
} |
2370
|
0
|
|
|
|
|
0
|
$event->{security}="usemask"; |
2371
|
0
|
|
|
|
|
0
|
$event->{allowmask}=1; |
2372
|
0
|
|
|
|
|
0
|
return 1; |
2373
|
|
|
|
|
|
|
} |
2374
|
|
|
|
|
|
|
|
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
=pod |
2377
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
=item $lj->SetProtectGroups($event,$group1, $group2, ... $groupN) |
2379
|
|
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
Takes a list of group names and sets the current entry so that only those |
2381
|
|
|
|
|
|
|
groups can read the journal entry. Returns |
2382
|
|
|
|
|
|
|
C<1> on success, C<0> otherwise. |
2383
|
|
|
|
|
|
|
|
2384
|
|
|
|
|
|
|
Example code: |
2385
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
$lj->SetProtectGroups(\%Event,"foo","bar") |
2387
|
|
|
|
|
|
|
|| die "$0: Failed to protect via group - $LJ::Simple::error\n"; |
2388
|
|
|
|
|
|
|
|
2389
|
|
|
|
|
|
|
=cut |
2390
|
|
|
|
|
|
|
sub SetProtectGroups($$@) { |
2391
|
1
|
|
|
1
|
1
|
64
|
my $self=shift; |
2392
|
1
|
|
|
|
|
3
|
my ($event,@grps) = @_; |
2393
|
1
|
|
|
|
|
3
|
$LJ::Simple::error=""; |
2394
|
1
|
50
|
|
|
|
12
|
if (ref($event) ne "HASH") { |
2395
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2396
|
0
|
|
|
|
|
0
|
return 0; |
2397
|
|
|
|
|
|
|
} |
2398
|
1
|
50
|
|
|
|
4
|
if (!defined $self->{groups}) { |
2399
|
1
|
|
|
|
|
9
|
$LJ::Simple::error="Groups not requested at login"; |
2400
|
1
|
|
|
|
|
4
|
return 0; |
2401
|
|
|
|
|
|
|
} |
2402
|
0
|
0
|
|
|
|
0
|
if ($#grps==-1) { |
2403
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="No group names given"; |
2404
|
0
|
|
|
|
|
0
|
return 0; |
2405
|
|
|
|
|
|
|
} |
2406
|
0
|
|
|
|
|
0
|
$event->{security}="usemask"; |
2407
|
0
|
|
|
|
|
0
|
my $g; |
2408
|
0
|
|
|
|
|
0
|
my $mask=0; |
2409
|
0
|
|
|
|
|
0
|
foreach $g (@grps) { |
2410
|
0
|
0
|
|
|
|
0
|
if (!defined $g) { |
2411
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Group list contains undefined value"; |
2412
|
0
|
|
|
|
|
0
|
return 0; |
2413
|
|
|
|
|
|
|
} |
2414
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{groups}->{name}->{$g}) { |
2415
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Group \"$g\" does not exist"; |
2416
|
0
|
|
|
|
|
0
|
return 0; |
2417
|
|
|
|
|
|
|
} |
2418
|
0
|
|
|
|
|
0
|
$mask=$mask | (1 << $self->{groups}->{name}->{$g}->{id}); |
2419
|
|
|
|
|
|
|
} |
2420
|
0
|
|
|
|
|
0
|
$event->{allowmask}=$mask; |
2421
|
0
|
|
|
|
|
0
|
return 1; |
2422
|
|
|
|
|
|
|
} |
2423
|
|
|
|
|
|
|
|
2424
|
|
|
|
|
|
|
=pod |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
=item $lj->SetProtectPrivate($event) |
2427
|
|
|
|
|
|
|
|
2428
|
|
|
|
|
|
|
Sets the current post so that the owner of the journal only can read the |
2429
|
|
|
|
|
|
|
journal entry. Returns C<1> on success, C<0> otherwise. |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
Example code: |
2432
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
$lj->SetProtectPrivate(\%Event) |
2434
|
|
|
|
|
|
|
|| die "$0: Failed to protect via private - $LJ::Simple::error\n"; |
2435
|
|
|
|
|
|
|
|
2436
|
|
|
|
|
|
|
=cut |
2437
|
|
|
|
|
|
|
sub SetProtectPrivate($$) { |
2438
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2439
|
0
|
|
|
|
|
0
|
my ($event) = @_; |
2440
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2441
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2442
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2443
|
0
|
|
|
|
|
0
|
return 0; |
2444
|
|
|
|
|
|
|
} |
2445
|
0
|
|
|
|
|
0
|
$event->{security}="private"; |
2446
|
0
|
0
|
|
|
|
0
|
(exists $event->{allowmask}) && |
2447
|
|
|
|
|
|
|
delete $event->{allowmask}; |
2448
|
0
|
|
|
|
|
0
|
return 1; |
2449
|
|
|
|
|
|
|
} |
2450
|
|
|
|
|
|
|
|
2451
|
|
|
|
|
|
|
|
2452
|
|
|
|
|
|
|
## |
2453
|
|
|
|
|
|
|
## Helper function used to set meta data |
2454
|
|
|
|
|
|
|
## |
2455
|
|
|
|
|
|
|
sub Setprop_general($$$$$$) { |
2456
|
0
|
|
|
0
|
0
|
0
|
my ($self,$event,$prop,$caller,$type,$data)=@_; |
2457
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2458
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2459
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2460
|
0
|
|
|
|
|
0
|
return 0; |
2461
|
|
|
|
|
|
|
} |
2462
|
0
|
0
|
|
|
|
0
|
if (!defined $prop) { |
2463
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: given undefined value for property"; |
2464
|
0
|
|
|
|
|
0
|
return 0; |
2465
|
|
|
|
|
|
|
} |
2466
|
0
|
0
|
|
|
|
0
|
if (!defined $caller) { |
2467
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: given undefined value for caller setting $prop"; |
2468
|
0
|
|
|
|
|
0
|
return 0; |
2469
|
|
|
|
|
|
|
} |
2470
|
0
|
0
|
|
|
|
0
|
if (!defined $type) { |
2471
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: given undefined value for type by $caller setting $prop"; |
2472
|
0
|
|
|
|
|
0
|
return 0; |
2473
|
|
|
|
|
|
|
} |
2474
|
0
|
0
|
|
|
|
0
|
if (!defined $data) { |
2475
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: given undefined value for data by $caller setting $prop"; |
2476
|
0
|
|
|
|
|
0
|
return 0; |
2477
|
|
|
|
|
|
|
} |
2478
|
0
|
|
|
|
|
0
|
my $nd=undef; |
2479
|
0
|
0
|
|
|
|
0
|
if ($type eq "bool") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2480
|
0
|
0
|
0
|
|
|
0
|
if (($data == 1)||($data == 0)) { |
2481
|
0
|
|
|
|
|
0
|
$nd=$data; |
2482
|
|
|
|
|
|
|
} else { |
2483
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: Invalid value [$data] for type bool [from $caller]"; |
2484
|
0
|
|
|
|
|
0
|
return 0; |
2485
|
|
|
|
|
|
|
} |
2486
|
|
|
|
|
|
|
} elsif ($type eq "char") { |
2487
|
0
|
|
|
|
|
0
|
$nd=$data; |
2488
|
|
|
|
|
|
|
} elsif ($type eq "num") { |
2489
|
0
|
0
|
|
|
|
0
|
if ($data!~/^[0-9]+$/o) { |
2490
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: Invalid value [$data] for type num [from $caller]"; |
2491
|
0
|
|
|
|
|
0
|
return 0; |
2492
|
|
|
|
|
|
|
} |
2493
|
0
|
|
|
|
|
0
|
$nd=$data; |
2494
|
|
|
|
|
|
|
} else { |
2495
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: Unknown type \"$type\" [from $caller]"; |
2496
|
0
|
|
|
|
|
0
|
return 0; |
2497
|
|
|
|
|
|
|
} |
2498
|
0
|
0
|
|
|
|
0
|
if (!defined $nd) { |
2499
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: Setprop_general did not set \$nd [from $caller]"; |
2500
|
0
|
|
|
|
|
0
|
return 0; |
2501
|
|
|
|
|
|
|
} |
2502
|
0
|
|
|
|
|
0
|
$event->{"prop_$prop"}=$nd; |
2503
|
0
|
|
|
|
|
0
|
return 1; |
2504
|
|
|
|
|
|
|
} |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
=pod |
2507
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
=back |
2509
|
|
|
|
|
|
|
|
2510
|
|
|
|
|
|
|
=head2 Setting journal entry properties |
2511
|
|
|
|
|
|
|
|
2512
|
|
|
|
|
|
|
=over 4 |
2513
|
|
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
=item $lj->Setprop_taglist($event,@tags) |
2515
|
|
|
|
|
|
|
|
2516
|
|
|
|
|
|
|
Set the tags for the entry; C<@tags> is a list of the tags to give the |
2517
|
|
|
|
|
|
|
entry. |
2518
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
Example code: |
2520
|
|
|
|
|
|
|
|
2521
|
|
|
|
|
|
|
$lj->Setprop_taglist(\%Event,qw( gabe pets whatever )) || |
2522
|
|
|
|
|
|
|
die "$0: Failed to set back date property - $LJ::Simple::error\n"; |
2523
|
|
|
|
|
|
|
|
2524
|
|
|
|
|
|
|
=cut |
2525
|
|
|
|
|
|
|
sub Setprop_taglist($$@) { |
2526
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,@tags)=@_; |
2527
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2528
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"taglist","Setprop_taglist","char",join(", ",@tags)); |
2529
|
|
|
|
|
|
|
} |
2530
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
=pod |
2532
|
|
|
|
|
|
|
|
2533
|
|
|
|
|
|
|
=item $lj->Setprop_backdate($event,$onoff) |
2534
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
Used to indicate if the journal entry being written should be back dated or not. Back dated |
2536
|
|
|
|
|
|
|
entries do not appear on the friends view of your journal entries. The C<$onoff> |
2537
|
|
|
|
|
|
|
value takes either C<1> for switching the property on or C<0> for switching the |
2538
|
|
|
|
|
|
|
property off. Returns C<1> on success, C<0> on failure. |
2539
|
|
|
|
|
|
|
|
2540
|
|
|
|
|
|
|
You will need to set this value if the journal entry you are sending has a |
2541
|
|
|
|
|
|
|
date earlier than other entries in your journal. |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
Example code: |
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
$lj->Setprop_backdate(\%Event,1) || |
2546
|
|
|
|
|
|
|
die "$0: Failed to set back date property - $LJ::Simple::error\n"; |
2547
|
|
|
|
|
|
|
|
2548
|
|
|
|
|
|
|
=cut |
2549
|
|
|
|
|
|
|
sub Setprop_backdate($$$) { |
2550
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$onoff)=@_; |
2551
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2552
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"opt_backdated","Setprop_backdate","bool",$onoff); |
2553
|
|
|
|
|
|
|
} |
2554
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
|
2556
|
|
|
|
|
|
|
=pod |
2557
|
|
|
|
|
|
|
|
2558
|
|
|
|
|
|
|
=item $lj->Setprop_current_mood($event,$mood) |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
Used to set the current mood for the journal being written. This takes a string which |
2561
|
|
|
|
|
|
|
describes the mood. |
2562
|
|
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
It is better to use C<$lj-ESetMood()> as that will automatically use a |
2564
|
|
|
|
|
|
|
mood known to the LiveJournal server if it can. |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2567
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
Example code: |
2569
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
$lj->Setprop_current_mood(\%Event,"Happy, but tired") || |
2571
|
|
|
|
|
|
|
die "$0: Failed to set current_mood property - $LJ::Simple::error\n"; |
2572
|
|
|
|
|
|
|
|
2573
|
|
|
|
|
|
|
=cut |
2574
|
|
|
|
|
|
|
sub Setprop_current_mood($$$) { |
2575
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$mood)=@_; |
2576
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2577
|
0
|
0
|
|
|
|
0
|
if ($mood=~/[\r\n]/) { |
2578
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Mood may not contain a new line"; |
2579
|
0
|
|
|
|
|
0
|
return 0; |
2580
|
|
|
|
|
|
|
} |
2581
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"current_mood","Setprop_current_mood","char",$mood); |
2582
|
|
|
|
|
|
|
} |
2583
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
=pod |
2585
|
|
|
|
|
|
|
|
2586
|
|
|
|
|
|
|
=item $lj->Setprop_current_mood_id($event,$id) |
2587
|
|
|
|
|
|
|
|
2588
|
|
|
|
|
|
|
Used to set the current mood_id for the journal being written. This takes a number which |
2589
|
|
|
|
|
|
|
refers to a mood_id the LiveJournal server knows about. |
2590
|
|
|
|
|
|
|
|
2591
|
|
|
|
|
|
|
Note that if the LiveJournal |
2592
|
|
|
|
|
|
|
object was created with either C set to C<0> or |
2593
|
|
|
|
|
|
|
with C set to C<1> then this function will not attempt to validate |
2594
|
|
|
|
|
|
|
the C given to it. |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
It is better to use C<$lj-ESetMood()> as that will automatically use a |
2597
|
|
|
|
|
|
|
mood known to the LiveJournal server if it can. |
2598
|
|
|
|
|
|
|
|
2599
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2600
|
|
|
|
|
|
|
|
2601
|
|
|
|
|
|
|
Example code: |
2602
|
|
|
|
|
|
|
|
2603
|
|
|
|
|
|
|
$lj->Setprop_current_mood_id(\%Event,15) || |
2604
|
|
|
|
|
|
|
die "$0: Failed to set current_mood_id property - $LJ::Simple::error\n"; |
2605
|
|
|
|
|
|
|
|
2606
|
|
|
|
|
|
|
=cut |
2607
|
|
|
|
|
|
|
sub Setprop_current_mood_id($$$) { |
2608
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2609
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2610
|
0
|
0
|
|
|
|
0
|
if (defined $self->{moods}) { |
2611
|
0
|
0
|
|
|
|
0
|
if (!exists $self->{moods}->{$data}) { |
2612
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="The mood_id $data is not known by the LiveJournal server"; |
2613
|
0
|
|
|
|
|
0
|
return 0; |
2614
|
|
|
|
|
|
|
} |
2615
|
|
|
|
|
|
|
} |
2616
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"current_moodid","Setprop_current_mood_id","num",$data); |
2617
|
|
|
|
|
|
|
} |
2618
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
|
2620
|
|
|
|
|
|
|
=pod |
2621
|
|
|
|
|
|
|
|
2622
|
|
|
|
|
|
|
=item $lj->Setprop_current_music($event,$music) |
2623
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
Used to set the current music for the journal entry being written. This takes |
2625
|
|
|
|
|
|
|
a string. |
2626
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2628
|
|
|
|
|
|
|
|
2629
|
|
|
|
|
|
|
Example code: |
2630
|
|
|
|
|
|
|
|
2631
|
|
|
|
|
|
|
$lj->Setprop_current_music(\%Event,"Collected euphoric dance") || |
2632
|
|
|
|
|
|
|
die "$0: Failed to set current_music property - $LJ::Simple::error\n"; |
2633
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
=cut |
2635
|
|
|
|
|
|
|
sub Setprop_current_music($$$) { |
2636
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2637
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2638
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"current_music","Setprop_current_music","char",$data); |
2639
|
|
|
|
|
|
|
} |
2640
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
=pod |
2642
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
=item $lj->Setprop_preformatted($event,$onoff) |
2644
|
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
|
Used to set if the text for the journal entry being written is preformatted in HTML |
2646
|
|
|
|
|
|
|
or not. This takes a boolean value of C<1> for true and C<0> for false. |
2647
|
|
|
|
|
|
|
|
2648
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2649
|
|
|
|
|
|
|
|
2650
|
|
|
|
|
|
|
Example code: |
2651
|
|
|
|
|
|
|
|
2652
|
|
|
|
|
|
|
$lj->Setprop_preformatted(\%Event,1) || |
2653
|
|
|
|
|
|
|
die "$0: Failed to set property - $LJ::Simple::error\n"; |
2654
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
=cut |
2656
|
|
|
|
|
|
|
sub Setprop_preformatted($$$) { |
2657
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2658
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2659
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"opt_preformatted","Setprop_preformatted","bool",$data); |
2660
|
|
|
|
|
|
|
} |
2661
|
|
|
|
|
|
|
|
2662
|
|
|
|
|
|
|
|
2663
|
|
|
|
|
|
|
=pod |
2664
|
|
|
|
|
|
|
|
2665
|
|
|
|
|
|
|
=item $lj->Setprop_nocomments($event,$onoff) |
2666
|
|
|
|
|
|
|
|
2667
|
|
|
|
|
|
|
Used to set if the journal entry being written can be commented on or not. This takes |
2668
|
|
|
|
|
|
|
a boolean value of C<1> for true and C<0> for false. Thus if you use a value |
2669
|
|
|
|
|
|
|
of C<1> (true) then comments will not be allowed. |
2670
|
|
|
|
|
|
|
|
2671
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
Example code: |
2674
|
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
$lj->Setprop_nocomments(\%Event,1) || |
2676
|
|
|
|
|
|
|
die "$0: Failed to set property - $LJ::Simple::error\n"; |
2677
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
=cut |
2679
|
|
|
|
|
|
|
sub Setprop_nocomments($$$) { |
2680
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2681
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2682
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"opt_nocomments","Setprop_nocomments","bool",$data); |
2683
|
|
|
|
|
|
|
} |
2684
|
|
|
|
|
|
|
|
2685
|
|
|
|
|
|
|
|
2686
|
|
|
|
|
|
|
=pod |
2687
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
=item $lj->Setprop_picture_keyword($event,$keyword) |
2689
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
Used to set the picture keyword for the journal entry being written. This takes |
2691
|
|
|
|
|
|
|
a string. We check to make sure that the picture keyword exists. |
2692
|
|
|
|
|
|
|
|
2693
|
|
|
|
|
|
|
Note that if the LiveJournal |
2694
|
|
|
|
|
|
|
object was created with either C set to C<0> or |
2695
|
|
|
|
|
|
|
with C set to C<1> then this function will B validate |
2696
|
|
|
|
|
|
|
the picture keyword before setting it. |
2697
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2699
|
|
|
|
|
|
|
|
2700
|
|
|
|
|
|
|
Example code: |
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
$lj->Setprop_picture_keyword(\%Event,"Some photo") || |
2703
|
|
|
|
|
|
|
die "$0: Failed to set property - $LJ::Simple::error\n"; |
2704
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
=cut |
2706
|
|
|
|
|
|
|
sub Setprop_picture_keyword($$$) { |
2707
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2708
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2709
|
0
|
0
|
|
|
|
0
|
if (defined $self->{pictures}) { |
2710
|
0
|
|
|
|
|
0
|
my $match=0; |
2711
|
0
|
|
|
|
|
0
|
foreach (values %{$self->{pictures}}) { |
|
0
|
|
|
|
|
0
|
|
2712
|
0
|
0
|
|
|
|
0
|
if ($_->{name} eq $data) { |
2713
|
0
|
|
|
|
|
0
|
$match=1; |
2714
|
0
|
|
|
|
|
0
|
last; |
2715
|
|
|
|
|
|
|
} |
2716
|
|
|
|
|
|
|
} |
2717
|
0
|
0
|
|
|
|
0
|
if (!$match) { |
2718
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Picture keyword not associated with journal"; |
2719
|
0
|
|
|
|
|
0
|
return 0; |
2720
|
|
|
|
|
|
|
} |
2721
|
|
|
|
|
|
|
} |
2722
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"picture_keyword","Setprop_picture_keyword","char",$data); |
2723
|
|
|
|
|
|
|
} |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
|
2726
|
|
|
|
|
|
|
=pod |
2727
|
|
|
|
|
|
|
|
2728
|
|
|
|
|
|
|
=item $lj->Setprop_noemail($event,$onoff) |
2729
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
Used to say that comments on the journal entry being written should not be emailed. |
2731
|
|
|
|
|
|
|
This takes boolean value of C<1> for true and C<0> for false. |
2732
|
|
|
|
|
|
|
|
2733
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2734
|
|
|
|
|
|
|
|
2735
|
|
|
|
|
|
|
Example code: |
2736
|
|
|
|
|
|
|
|
2737
|
|
|
|
|
|
|
$lj->Setprop_noemail(\%Event,1) || |
2738
|
|
|
|
|
|
|
die "$0: Failed to set property - $LJ::Simple::error\n"; |
2739
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
=cut |
2741
|
|
|
|
|
|
|
sub Setprop_noemail($$$) { |
2742
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2743
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2744
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"opt_noemail","Setprop_noemail","bool",$data); |
2745
|
|
|
|
|
|
|
} |
2746
|
|
|
|
|
|
|
|
2747
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
=pod |
2749
|
|
|
|
|
|
|
|
2750
|
|
|
|
|
|
|
=item $lj->Setprop_unknown8bit($event,$onoff) |
2751
|
|
|
|
|
|
|
|
2752
|
|
|
|
|
|
|
Used say that there is 8-bit data which is not in UTF-8 in the journal entry |
2753
|
|
|
|
|
|
|
being written. This takes a boolean value of C<1> for true and C<0> for false. |
2754
|
|
|
|
|
|
|
|
2755
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2756
|
|
|
|
|
|
|
|
2757
|
|
|
|
|
|
|
Example code: |
2758
|
|
|
|
|
|
|
|
2759
|
|
|
|
|
|
|
$lj->Setprop_unknown8bit(\%Event,1) || |
2760
|
|
|
|
|
|
|
die "$0: Failed to set property - $LJ::Simple::error\n"; |
2761
|
|
|
|
|
|
|
|
2762
|
|
|
|
|
|
|
=cut |
2763
|
|
|
|
|
|
|
sub Setprop_unknown8bit($$$) { |
2764
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event,$data)=@_; |
2765
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2766
|
0
|
|
|
|
|
0
|
return $self->Setprop_general($event,"unknown8bit","Setprop_unknown8bit","bool",$data); |
2767
|
|
|
|
|
|
|
} |
2768
|
|
|
|
|
|
|
|
2769
|
|
|
|
|
|
|
|
2770
|
|
|
|
|
|
|
=pod |
2771
|
|
|
|
|
|
|
|
2772
|
|
|
|
|
|
|
=back |
2773
|
|
|
|
|
|
|
|
2774
|
|
|
|
|
|
|
=head2 Posting, editing and deleting journal entries |
2775
|
|
|
|
|
|
|
|
2776
|
|
|
|
|
|
|
=over 4 |
2777
|
|
|
|
|
|
|
|
2778
|
|
|
|
|
|
|
=item $lj->PostEntry($event) |
2779
|
|
|
|
|
|
|
|
2780
|
|
|
|
|
|
|
Submit a journal entry into the LiveJournal system. This requires you to have |
2781
|
|
|
|
|
|
|
set up the journal entry with C<$lj-ENewEntry()> and to have at least called |
2782
|
|
|
|
|
|
|
C<$lj-ESetEntry()>. |
2783
|
|
|
|
|
|
|
|
2784
|
|
|
|
|
|
|
On success a list containing the following is returned: |
2785
|
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
o The item_id as returned by the LiveJournal server |
2787
|
|
|
|
|
|
|
o The anum as returned by the LiveJournal server |
2788
|
|
|
|
|
|
|
o The item_id of the posted entry as used in HTML - that is the |
2789
|
|
|
|
|
|
|
value of C<($item_id * 256) + $anum)> |
2790
|
|
|
|
|
|
|
|
2791
|
|
|
|
|
|
|
On failure C is returned. |
2792
|
|
|
|
|
|
|
|
2793
|
|
|
|
|
|
|
# Build the new entry |
2794
|
|
|
|
|
|
|
my %Event; |
2795
|
|
|
|
|
|
|
$lj->NewEntry(\%Event) || |
2796
|
|
|
|
|
|
|
die "$0: Failed to create new journal entry - $LJ::Simple::error\n"; |
2797
|
|
|
|
|
|
|
|
2798
|
|
|
|
|
|
|
# Set the journal entry |
2799
|
|
|
|
|
|
|
$lj->SetEntry(\%Event,"foo") || |
2800
|
|
|
|
|
|
|
die "$0: Failed set journal entry - $LJ::Simple::error\n"; |
2801
|
|
|
|
|
|
|
|
2802
|
|
|
|
|
|
|
# And post it |
2803
|
|
|
|
|
|
|
my ($item_id,$anum,$html_id)=$lj->PostEntry(\%Event); |
2804
|
|
|
|
|
|
|
defined $item_id || |
2805
|
|
|
|
|
|
|
die "$0: Failed to submit new journal entry - $LJ::Simple::error\n"; |
2806
|
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
=cut |
2808
|
|
|
|
|
|
|
## |
2809
|
|
|
|
|
|
|
## PostEntry - actually submit a journal entry. |
2810
|
|
|
|
|
|
|
## |
2811
|
|
|
|
|
|
|
sub PostEntry($$) { |
2812
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2813
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
2814
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2815
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2816
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2817
|
0
|
|
|
|
|
0
|
return undef; |
2818
|
|
|
|
|
|
|
} |
2819
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{"__new_entry"}) { |
2820
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: NewEntry not called"; |
2821
|
0
|
|
|
|
|
0
|
return undef; |
2822
|
|
|
|
|
|
|
} |
2823
|
|
|
|
|
|
|
|
2824
|
|
|
|
|
|
|
## Blat any key in $event which starts with a double underscore |
2825
|
0
|
0
|
|
|
|
0
|
map {/^__/ && delete $event->{$_}} (keys %{$event}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2826
|
|
|
|
|
|
|
|
2827
|
0
|
0
|
|
|
|
0
|
if (!defined $event->{event}) { |
2828
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: No journal entry set - call SetEntry() or AddToEntry() first"; |
2829
|
0
|
|
|
|
|
0
|
return undef; |
2830
|
|
|
|
|
|
|
} |
2831
|
|
|
|
|
|
|
|
2832
|
|
|
|
|
|
|
## Blat any entry in $self->{event} with an undef value |
2833
|
0
|
0
|
|
|
|
0
|
map {defined $event->{$_} || delete $event->{$_}} (keys %{$event}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2834
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
## Finally send the actual request |
2836
|
0
|
|
|
|
|
0
|
my %Resp=(); |
2837
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("postevent",$event,\%Resp) || return undef; |
2838
|
|
|
|
|
|
|
|
2839
|
0
|
0
|
|
|
|
0
|
if (!exists $Resp{itemid}) { |
2840
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="LJ server did not return itemid"; |
2841
|
0
|
|
|
|
|
0
|
return undef; |
2842
|
|
|
|
|
|
|
} |
2843
|
0
|
0
|
|
|
|
0
|
if (!exists $Resp{anum}) { |
2844
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="LJ server did not return anum"; |
2845
|
0
|
|
|
|
|
0
|
return undef; |
2846
|
|
|
|
|
|
|
} |
2847
|
|
|
|
|
|
|
|
2848
|
0
|
|
|
|
|
0
|
return ($Resp{itemid},$Resp{anum},($Resp{itemid} * 256) + $Resp{anum}); |
2849
|
|
|
|
|
|
|
} |
2850
|
|
|
|
|
|
|
|
2851
|
|
|
|
|
|
|
=pod |
2852
|
|
|
|
|
|
|
|
2853
|
|
|
|
|
|
|
=item $lj->EditEntry($event) |
2854
|
|
|
|
|
|
|
|
2855
|
|
|
|
|
|
|
Edit an entry from the LiveJournal system which has the givem C. |
2856
|
|
|
|
|
|
|
The entry should have been fetched from LiveJournal using the |
2857
|
|
|
|
|
|
|
C<$lj-EGetEntries()> function and then adjusted using the various |
2858
|
|
|
|
|
|
|
C<$lj-ESet...()> functions. |
2859
|
|
|
|
|
|
|
|
2860
|
|
|
|
|
|
|
It should be noted that this function can be used to delete a journal entry |
2861
|
|
|
|
|
|
|
by setting the entry to a blank string, I by using |
2862
|
|
|
|
|
|
|
C<$lj-ESetEntry(\%Event,undef)> |
2863
|
|
|
|
|
|
|
|
2864
|
|
|
|
|
|
|
Returns C<1> on success, C<0> on failure. |
2865
|
|
|
|
|
|
|
|
2866
|
|
|
|
|
|
|
Example: |
2867
|
|
|
|
|
|
|
|
2868
|
|
|
|
|
|
|
# Fetch the most recent event |
2869
|
|
|
|
|
|
|
my %Events = (); |
2870
|
|
|
|
|
|
|
(defined $lj->GetEntries(\%Events,undef,"one",-1)) || |
2871
|
|
|
|
|
|
|
die "$0: Failed to get entries - $LJ::Simple::error\n"; |
2872
|
|
|
|
|
|
|
|
2873
|
|
|
|
|
|
|
# Mark it as private |
2874
|
|
|
|
|
|
|
foreach (values %Entries) { |
2875
|
|
|
|
|
|
|
$lj->SetProtectPrivate($_); |
2876
|
|
|
|
|
|
|
$lj->EditEntry($_) || |
2877
|
|
|
|
|
|
|
die "$0: Failed to edit entry - $LJ::Simple::error\n"; |
2878
|
|
|
|
|
|
|
} |
2879
|
|
|
|
|
|
|
|
2880
|
|
|
|
|
|
|
# Alternatively we could just delete it... |
2881
|
|
|
|
|
|
|
my $event=(values %Entries)[0]; |
2882
|
|
|
|
|
|
|
$lj->SetEntry($event,undef); |
2883
|
|
|
|
|
|
|
$lj->EditEntry($event) || |
2884
|
|
|
|
|
|
|
die "$0: Failed to edit entry - $LJ::Simple::error\n"; |
2885
|
|
|
|
|
|
|
|
2886
|
|
|
|
|
|
|
=cut |
2887
|
|
|
|
|
|
|
sub EditEntry($$) { |
2888
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2889
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
2890
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2891
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
2892
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
2893
|
0
|
|
|
|
|
0
|
return 0; |
2894
|
|
|
|
|
|
|
} |
2895
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{"__itemid"}) { |
2896
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not an existing entry; use GetEntry()"; |
2897
|
0
|
|
|
|
|
0
|
return 0; |
2898
|
|
|
|
|
|
|
} |
2899
|
0
|
|
|
|
|
0
|
$event->{itemid}=$event->{"__itemid"}; |
2900
|
|
|
|
|
|
|
|
2901
|
|
|
|
|
|
|
## Blat any key in $event which starts with a double underscore |
2902
|
0
|
0
|
|
|
|
0
|
map {/^__/ && delete $event->{$_}} (keys %{$event}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2903
|
|
|
|
|
|
|
|
2904
|
0
|
0
|
|
|
|
0
|
if (!defined $event->{event}) { |
2905
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: No journal entry set"; |
2906
|
0
|
|
|
|
|
0
|
return 0; |
2907
|
|
|
|
|
|
|
} |
2908
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
## Blat any entry in $event with an undef value |
2910
|
0
|
0
|
|
|
|
0
|
map {defined $event->{$_} || delete $event->{$_}} (keys %{$event}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2911
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
## Make the request |
2913
|
0
|
|
|
|
|
0
|
return $self->SendRequest("editevent",$event,undef); |
2914
|
|
|
|
|
|
|
} |
2915
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
=pod |
2917
|
|
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
=item $lj->DeleteEntry($item_id) |
2919
|
|
|
|
|
|
|
|
2920
|
|
|
|
|
|
|
Delete an entry from the LiveJournal system which has the given C. |
2921
|
|
|
|
|
|
|
On success C<1> is returned; on failure C<0> is returned. |
2922
|
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
Example: |
2924
|
|
|
|
|
|
|
|
2925
|
|
|
|
|
|
|
$lj->DeleteEntry($some_item_id) || |
2926
|
|
|
|
|
|
|
die "$0: Failed to delete journal entry - $LJ::Simple::error\n"; |
2927
|
|
|
|
|
|
|
|
2928
|
|
|
|
|
|
|
=cut |
2929
|
|
|
|
|
|
|
sub DeleteEntry($$) { |
2930
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
2931
|
0
|
|
|
|
|
0
|
my ($item_id) = @_; |
2932
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
2933
|
0
|
0
|
|
|
|
0
|
if (!defined $item_id) { |
2934
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: DeleteEntry() given undefined item_id"; |
2935
|
0
|
|
|
|
|
0
|
return 0; |
2936
|
|
|
|
|
|
|
} |
2937
|
0
|
0
|
|
|
|
0
|
if ($item_id!~/^[0-9]+$/) { |
2938
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: DeleteEntry() given invalid item_id"; |
2939
|
0
|
|
|
|
|
0
|
return 0; |
2940
|
|
|
|
|
|
|
} |
2941
|
0
|
|
|
|
|
0
|
my %Event=( |
2942
|
|
|
|
|
|
|
itemid => $item_id, |
2943
|
|
|
|
|
|
|
event => "", |
2944
|
|
|
|
|
|
|
); |
2945
|
0
|
|
|
|
|
0
|
return $self->SendRequest("editevent",\%Event,undef); |
2946
|
|
|
|
|
|
|
} |
2947
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
=pod |
2949
|
|
|
|
|
|
|
|
2950
|
|
|
|
|
|
|
=back |
2951
|
|
|
|
|
|
|
|
2952
|
|
|
|
|
|
|
=head2 Retriving journal entries |
2953
|
|
|
|
|
|
|
|
2954
|
|
|
|
|
|
|
=over 4 |
2955
|
|
|
|
|
|
|
|
2956
|
|
|
|
|
|
|
=item $lj->SyncItems($timestamp) |
2957
|
|
|
|
|
|
|
|
2958
|
|
|
|
|
|
|
This routine returns a list of all of the items (journal entries, to-do items, |
2959
|
|
|
|
|
|
|
comments) which have been created or updated on LiveJournal. There is an optional |
2960
|
|
|
|
|
|
|
timestamp value for specifying the time you last synchronised with the server. |
2961
|
|
|
|
|
|
|
This timestamp value can either be a Unix-style C value or a previously |
2962
|
|
|
|
|
|
|
returned timestamp from this routine. If not used specify the undefined value |
2963
|
|
|
|
|
|
|
C. |
2964
|
|
|
|
|
|
|
|
2965
|
|
|
|
|
|
|
When specifying the time you must take into account the fact that the modification |
2966
|
|
|
|
|
|
|
or creation times of the entries in the LiveJournal database are stored as the |
2967
|
|
|
|
|
|
|
time local to the computer running the database rather than GMT. Due to this |
2968
|
|
|
|
|
|
|
it is safest to use the time from the latest item downloaded from the LiveJournal |
2969
|
|
|
|
|
|
|
from a previous C call. |
2970
|
|
|
|
|
|
|
|
2971
|
|
|
|
|
|
|
On success this routine will return a list which contains first the number of |
2972
|
|
|
|
|
|
|
valid items in the list and then a list of hashes which contain the details |
2973
|
|
|
|
|
|
|
of the items found. This routine can return an empty list which signifies that |
2974
|
|
|
|
|
|
|
no new items could be found. On failure C is returned. |
2975
|
|
|
|
|
|
|
|
2976
|
|
|
|
|
|
|
The format of the returned list is as follows. The list of hashes is ordered |
2977
|
|
|
|
|
|
|
by the timestamps of the entries, oldest to newest. |
2978
|
|
|
|
|
|
|
|
2979
|
|
|
|
|
|
|
@list = ( |
2980
|
|
|
|
|
|
|
number of items returned, |
2981
|
|
|
|
|
|
|
{ |
2982
|
|
|
|
|
|
|
item_id => Item_id of the entry changed |
2983
|
|
|
|
|
|
|
type => Type of entry |
2984
|
|
|
|
|
|
|
action => What happened to the entry |
2985
|
|
|
|
|
|
|
time_t => Time of change in Unix time (see note below) |
2986
|
|
|
|
|
|
|
timestamp => Timestamp from server |
2987
|
|
|
|
|
|
|
}, |
2988
|
|
|
|
|
|
|
); |
2989
|
|
|
|
|
|
|
|
2990
|
|
|
|
|
|
|
The C of entry can be one of the following letters: |
2991
|
|
|
|
|
|
|
|
2992
|
|
|
|
|
|
|
L: Journal entries |
2993
|
|
|
|
|
|
|
C: Comments |
2994
|
|
|
|
|
|
|
T: To-do items |
2995
|
|
|
|
|
|
|
|
2996
|
|
|
|
|
|
|
It should be noted that currently the LiveJournal system will only ever |
2997
|
|
|
|
|
|
|
return C types due to the C and C types not having been implemented |
2998
|
|
|
|
|
|
|
in the LiveJournal code yet. |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
The C of the entry can be either C for a new entry, |
3001
|
|
|
|
|
|
|
C for an entry which has been modified or C for a deleted entry. |
3002
|
|
|
|
|
|
|
|
3003
|
|
|
|
|
|
|
The C value is probably going to be wrong; as far as the author of |
3004
|
|
|
|
|
|
|
this code can tell, you can not get the timezone of the server which is |
3005
|
|
|
|
|
|
|
serving out the request. This means that converting the timestamps |
3006
|
|
|
|
|
|
|
returned by the server from their format of C into |
3007
|
|
|
|
|
|
|
a Unix C value is inaccurate at best since C is defined |
3008
|
|
|
|
|
|
|
as the number of seconds since 00:00 1st January 1970 B. Functions |
3009
|
|
|
|
|
|
|
like C which can be used to create C values have to |
3010
|
|
|
|
|
|
|
assume that the data they are being given is valid for the timezone the |
3011
|
|
|
|
|
|
|
machine it is running on is actually in. Given the nature of the net |
3012
|
|
|
|
|
|
|
this is rarely the case. I I wish that the LJ developers had stored |
3013
|
|
|
|
|
|
|
timestamps in pure C in the database... and if they have done they |
3014
|
|
|
|
|
|
|
should provide a way for developers to get access to this as its B |
3015
|
|
|
|
|
|
|
more useful IMHO. |
3016
|
|
|
|
|
|
|
|
3017
|
|
|
|
|
|
|
Given the above you're probably wondering why I included the C |
3018
|
|
|
|
|
|
|
value. Well, whilst the value isn't much use when it really comes down |
3019
|
|
|
|
|
|
|
to it, it B useful when it comes to sorting the list of entries as |
3020
|
|
|
|
|
|
|
all of the entries from the same server will be inaccurate to the same |
3021
|
|
|
|
|
|
|
amount. |
3022
|
|
|
|
|
|
|
|
3023
|
|
|
|
|
|
|
The C from server takes the format of C |
3024
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
It should be noted that this routine can take a long time to return |
3026
|
|
|
|
|
|
|
if there are large numbers of entries to be returned. This is especially |
3027
|
|
|
|
|
|
|
true if you give C as the timestamp. |
3028
|
|
|
|
|
|
|
|
3029
|
|
|
|
|
|
|
Example code: |
3030
|
|
|
|
|
|
|
|
3031
|
|
|
|
|
|
|
# All entries in the last day or so; this is fudged due to timezone |
3032
|
|
|
|
|
|
|
# differences (WTF didn't they store stuff in GMT ?) |
3033
|
|
|
|
|
|
|
my ($num_of_items,@lst)=$lj->SyncItems(time() - (86400 * 2)); |
3034
|
|
|
|
|
|
|
|
3035
|
|
|
|
|
|
|
(defined $num_of_items) || |
3036
|
|
|
|
|
|
|
die "$0: Failed to sync - $LJ::Simple::error\n"; |
3037
|
|
|
|
|
|
|
|
3038
|
|
|
|
|
|
|
my $hr=undef; |
3039
|
|
|
|
|
|
|
print "Number of items: $num_of_items\n"; |
3040
|
|
|
|
|
|
|
print "Item_id\tType\tAction\tTime_t\t\tTimestamp\n"; |
3041
|
|
|
|
|
|
|
foreach $hr (@lst) { |
3042
|
|
|
|
|
|
|
print "$hr->{item_id}\t" . |
3043
|
|
|
|
|
|
|
"$hr->{type}\t" . |
3044
|
|
|
|
|
|
|
"$hr->{action}\t" . |
3045
|
|
|
|
|
|
|
"$hr->{time_t}\t" . |
3046
|
|
|
|
|
|
|
"$hr->{timestamp}\n"; |
3047
|
|
|
|
|
|
|
} |
3048
|
|
|
|
|
|
|
|
3049
|
|
|
|
|
|
|
There is also an example of how to work with all of the entries of a LiveJournal |
3050
|
|
|
|
|
|
|
shown in the C script which accompanies the C |
3051
|
|
|
|
|
|
|
distribution. This example script looks at a LiveJournal and makes sure that every |
3052
|
|
|
|
|
|
|
journal entry is at the very least marked as being friends-only. |
3053
|
|
|
|
|
|
|
|
3054
|
|
|
|
|
|
|
=cut |
3055
|
|
|
|
|
|
|
sub SyncItems($$) { |
3056
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3057
|
0
|
|
|
|
|
0
|
my ($timet)=@_; |
3058
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3059
|
0
|
0
|
|
|
|
0
|
if (!defined $timet) { |
3060
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Invalid timestamp - undefined value not allowed"; |
3061
|
0
|
|
|
|
|
0
|
return undef; |
3062
|
|
|
|
|
|
|
} |
3063
|
0
|
0
|
|
|
|
0
|
if ($LJ::Simple::debug) { |
3064
|
0
|
|
|
|
|
0
|
my $ts=undef; |
3065
|
0
|
0
|
|
|
|
0
|
if (defined $timet) { |
3066
|
0
|
|
|
|
|
0
|
$ts="\"$timet\""; |
3067
|
|
|
|
|
|
|
} else { |
3068
|
0
|
|
|
|
|
0
|
$ts="undef"; |
3069
|
|
|
|
|
|
|
} |
3070
|
0
|
|
|
|
|
0
|
Debug "SyncItems($ts)"; |
3071
|
|
|
|
|
|
|
} |
3072
|
0
|
|
|
|
|
0
|
my %Event=(); |
3073
|
0
|
|
|
|
|
0
|
my %Resp=(); |
3074
|
0
|
0
|
|
|
|
0
|
if (defined $timet) { |
3075
|
0
|
0
|
|
|
|
0
|
if ($timet=~/^[0-9]+$/) { |
3076
|
0
|
|
|
|
|
0
|
my @tm=localtime($timet); |
3077
|
0
|
0
|
|
|
|
0
|
if ($#tm==-1) { |
3078
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Invalid timestamp"; |
3079
|
0
|
|
|
|
|
0
|
return undef; |
3080
|
|
|
|
|
|
|
} |
3081
|
0
|
|
|
|
|
0
|
$Event{lastsync}=strftime("%Y-%m-%d %H:%M:%S",@tm); |
3082
|
|
|
|
|
|
|
} else { |
3083
|
0
|
|
|
|
|
0
|
$Event{lastsync}=$timet; |
3084
|
|
|
|
|
|
|
} |
3085
|
|
|
|
|
|
|
} |
3086
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("syncitems",\%Event,\%Resp) || return undef; |
3087
|
0
|
|
|
|
|
0
|
my %Mh=(); |
3088
|
0
|
|
|
|
|
0
|
my $sync_count; |
3089
|
|
|
|
|
|
|
my $sync_total; |
3090
|
0
|
|
|
|
|
0
|
my $latest=0; |
3091
|
0
|
|
|
|
|
0
|
my $latest_ts; |
3092
|
0
|
|
|
|
|
0
|
my ($key,$val); |
3093
|
0
|
|
|
|
|
0
|
while(($key,$val)=each %Resp) { |
3094
|
0
|
0
|
|
|
|
0
|
if ($key=~/sync_([0-9]+)_(.*)$/o) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3095
|
0
|
|
|
|
|
0
|
my ($id,$name)=($1,$2); |
3096
|
0
|
0
|
|
|
|
0
|
(exists $Mh{$id}) || ($Mh{$id}={}); |
3097
|
0
|
0
|
|
|
|
0
|
if ($name eq "item") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3098
|
0
|
|
|
|
|
0
|
my ($type,$item_id)=split(/-/,$val,2); |
3099
|
0
|
|
|
|
|
0
|
$Mh{$id}->{item_id}=$item_id; |
3100
|
0
|
|
|
|
|
0
|
$Mh{$id}->{type}=$type; |
3101
|
|
|
|
|
|
|
} elsif ($name eq "action") { |
3102
|
0
|
|
|
|
|
0
|
$Mh{$id}->{action}=$val; |
3103
|
|
|
|
|
|
|
} elsif ($name eq "time") { |
3104
|
0
|
|
|
|
|
0
|
$Mh{$id}->{timestamp}=$val; |
3105
|
0
|
0
|
|
|
|
0
|
if ($val!~/([0-9]+)-([0-9]+)-([0-9]+)\s([0-9]+):([0-9]+):([0-9]+)/io) { |
3106
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: failed to parse timestamp \"$val\""; |
3107
|
0
|
|
|
|
|
0
|
return undef; |
3108
|
|
|
|
|
|
|
} |
3109
|
0
|
|
|
|
|
0
|
$Mh{$id}->{time_t}=mktime($6,$5,$4,$3,$2-1,$1-1900,0,0,0); |
3110
|
0
|
0
|
|
|
|
0
|
if (!defined $Mh{$id}->{time_t}) { |
3111
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: failed to create time_t from \"$val\""; |
3112
|
0
|
|
|
|
|
0
|
return undef; |
3113
|
|
|
|
|
|
|
} |
3114
|
0
|
0
|
|
|
|
0
|
if ($Mh{$id}->{time_t}>$latest) { |
3115
|
0
|
|
|
|
|
0
|
$latest_ts=$val; |
3116
|
0
|
|
|
|
|
0
|
$latest=$Mh{$id}->{time_t}; |
3117
|
|
|
|
|
|
|
} |
3118
|
|
|
|
|
|
|
} else { |
3119
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: Unrecognised sync_[0-9]_* \"$key\""; |
3120
|
0
|
|
|
|
|
0
|
return undef; |
3121
|
|
|
|
|
|
|
} |
3122
|
|
|
|
|
|
|
} elsif ($key eq "sync_total") { |
3123
|
0
|
|
|
|
|
0
|
$sync_total=$val; |
3124
|
|
|
|
|
|
|
} elsif ($key eq "sync_count") { |
3125
|
0
|
|
|
|
|
0
|
$sync_count=$val; |
3126
|
|
|
|
|
|
|
} |
3127
|
|
|
|
|
|
|
} |
3128
|
0
|
|
|
|
|
0
|
Debug "sync_count=$sync_count\n"; |
3129
|
0
|
|
|
|
|
0
|
Debug "sync_total=$sync_total\n"; |
3130
|
0
|
|
|
|
|
0
|
my @lst=(); |
3131
|
0
|
|
|
|
|
0
|
push(@lst,values %Mh); |
3132
|
0
|
0
|
|
|
|
0
|
if ($sync_count != $sync_total) { |
3133
|
0
|
|
|
|
|
0
|
my ($num,@nl)=$self->SyncItems($latest_ts); |
3134
|
0
|
0
|
|
|
|
0
|
(defined $num) || return undef; |
3135
|
0
|
|
|
|
|
0
|
push(@lst,@nl); |
3136
|
|
|
|
|
|
|
} |
3137
|
0
|
|
|
|
|
0
|
@lst=sort { $a->{time_t} <=> $b->{time_t} } @lst; |
|
0
|
|
|
|
|
0
|
|
3138
|
0
|
|
|
|
|
0
|
map { $_->{kv}=join(":",$_->{item_id},$_->{type},$_->{action},$_->{time_t}) } @lst; |
|
0
|
|
|
|
|
0
|
|
3139
|
0
|
|
|
|
|
0
|
my %seen=(); |
3140
|
0
|
|
0
|
|
|
0
|
@lst=grep((!exists $seen{$_->{kv}}) && ($seen{$_->{kv}}=1),@lst); |
3141
|
0
|
|
|
|
|
0
|
my $tot=$#lst+1; |
3142
|
0
|
|
|
|
|
0
|
return ($tot,@lst); |
3143
|
|
|
|
|
|
|
} |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
=pod |
3146
|
|
|
|
|
|
|
|
3147
|
|
|
|
|
|
|
=item $lj->GetEntries($hash_ref,$journal,$type,@opt) |
3148
|
|
|
|
|
|
|
|
3149
|
|
|
|
|
|
|
This routine allows you to pull events from the user's LiveJournal. There are |
3150
|
|
|
|
|
|
|
several different ways this routine can work depending on the value given in |
3151
|
|
|
|
|
|
|
the C<$type> argument. |
3152
|
|
|
|
|
|
|
|
3153
|
|
|
|
|
|
|
This routine will currently only allow you to get a B |
3154
|
|
|
|
|
|
|
thanks to restrictions imposed by LiveJournal servers. If you want to perform work |
3155
|
|
|
|
|
|
|
on I journal entry within a LiveJournal account then you should look at the |
3156
|
|
|
|
|
|
|
C routine documented above. |
3157
|
|
|
|
|
|
|
|
3158
|
|
|
|
|
|
|
The first argument - C<$hash_ref> is a reference to a hash which will be filled |
3159
|
|
|
|
|
|
|
with the details of the journal entries downloaded. The key to this hash is the |
3160
|
|
|
|
|
|
|
C of the journal entries. The value is a hash reference which points to |
3161
|
|
|
|
|
|
|
a hash of the same type created by C and used by C and |
3162
|
|
|
|
|
|
|
C. The most sensible way to access this hash is to use the various |
3163
|
|
|
|
|
|
|
C routines. |
3164
|
|
|
|
|
|
|
|
3165
|
|
|
|
|
|
|
The second argument - C<$journal> - is an optional argument set if the journal |
3166
|
|
|
|
|
|
|
to be accessed is a shared journal. If this is set then the name of shared journal |
3167
|
|
|
|
|
|
|
will be propogated into the entries returned in the hash reference C<$hash_ref> as |
3168
|
|
|
|
|
|
|
if C<$lj->UseJournal($event,$journal)> was called. If not required set this to C. |
3169
|
|
|
|
|
|
|
|
3170
|
|
|
|
|
|
|
The third argument - C<$type> - specifies how the journal entries are to be |
3171
|
|
|
|
|
|
|
pulled down. The contents of the fourth argument - C<@opt> - will depend on the |
3172
|
|
|
|
|
|
|
value in the C<$type> variable. Thus: |
3173
|
|
|
|
|
|
|
|
3174
|
|
|
|
|
|
|
+-------+------------+------------------------------------------+ |
3175
|
|
|
|
|
|
|
| $type | @opt | Comments | |
3176
|
|
|
|
|
|
|
+-------+------------+------------------------------------------+ |
3177
|
|
|
|
|
|
|
| day | $timestamp | Download a single day. $timestamp is a | |
3178
|
|
|
|
|
|
|
| | | Unix timestamp for the required day | |
3179
|
|
|
|
|
|
|
+-------+------------+------------------------------------------+ |
3180
|
|
|
|
|
|
|
| lastn |$num,$before| Download a number of entries. $num has a | |
3181
|
|
|
|
|
|
|
| | | maximum value of 50. If $num is undef | |
3182
|
|
|
|
|
|
|
| | | then the default of 20 is used. $before | |
3183
|
|
|
|
|
|
|
| | | is an optional value which specifies a | |
3184
|
|
|
|
|
|
|
| | | date before which all entries must occur.| |
3185
|
|
|
|
|
|
|
| | | The date is specified as a Unix | |
3186
|
|
|
|
|
|
|
| | | timestamp. If not specified the value | |
3187
|
|
|
|
|
|
|
| | | should be undef. | |
3188
|
|
|
|
|
|
|
+-------+------------+------------------------------------------+ |
3189
|
|
|
|
|
|
|
| one | $item_id | The unique ItemID for the entry to be | |
3190
|
|
|
|
|
|
|
| | | downloaded. A value of -1 means to | |
3191
|
|
|
|
|
|
|
| | | download the most recent entry | |
3192
|
|
|
|
|
|
|
+-------+------------+------------------------------------------+ |
3193
|
|
|
|
|
|
|
| sync | $date | Get journal entries since the given date.| |
3194
|
|
|
|
|
|
|
| | | The date should be specified as a Unix | |
3195
|
|
|
|
|
|
|
| | | timestamp. | |
3196
|
|
|
|
|
|
|
+-------+------------+------------------------------------------+ |
3197
|
|
|
|
|
|
|
|
3198
|
|
|
|
|
|
|
If the operation is successful then C<$hash_ref> is returned. On failure |
3199
|
|
|
|
|
|
|
C is returned and C<$LJ::Simple::error> is updated with the |
3200
|
|
|
|
|
|
|
reason for the error. |
3201
|
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
|
Example code: |
3203
|
|
|
|
|
|
|
|
3204
|
|
|
|
|
|
|
The following code only uses a single C<$type> from the above list; C. |
3205
|
|
|
|
|
|
|
However the hash of hashes returned is the same in every C<$type> used. The |
3206
|
|
|
|
|
|
|
code below shows how to pull down the last journal entry posted and then uses |
3207
|
|
|
|
|
|
|
all of the various C routines to decode the hash returned. |
3208
|
|
|
|
|
|
|
|
3209
|
|
|
|
|
|
|
use POSIX; |
3210
|
|
|
|
|
|
|
|
3211
|
|
|
|
|
|
|
my %Entries=(); |
3212
|
|
|
|
|
|
|
(defined $lj->GetEntries(\%Entries,undef,"one",-1)) || |
3213
|
|
|
|
|
|
|
die "$0: Failed to get entries - $LJ::Simple::error\n"; |
3214
|
|
|
|
|
|
|
|
3215
|
|
|
|
|
|
|
my $Entry=undef; |
3216
|
|
|
|
|
|
|
my $Format="%-20s: %s\n"; |
3217
|
|
|
|
|
|
|
|
3218
|
|
|
|
|
|
|
foreach $Entry (values %Entries) { |
3219
|
|
|
|
|
|
|
|
3220
|
|
|
|
|
|
|
# Get URL |
3221
|
|
|
|
|
|
|
my $url=$lj->GetURL($Entry); |
3222
|
|
|
|
|
|
|
(defined $url) && print "$url\n"; |
3223
|
|
|
|
|
|
|
|
3224
|
|
|
|
|
|
|
# Get ItemId |
3225
|
|
|
|
|
|
|
my ($item_id,$anum,$html_id)=$lj->GetItemId($Entry); |
3226
|
|
|
|
|
|
|
(defined $item_id) && printf($Format,"Item_id",$item_id); |
3227
|
|
|
|
|
|
|
|
3228
|
|
|
|
|
|
|
# Get the subject |
3229
|
|
|
|
|
|
|
my $subj=$lj->GetSubject($Entry); |
3230
|
|
|
|
|
|
|
(defined $subj) && printf($Format,"Subject",$subj); |
3231
|
|
|
|
|
|
|
|
3232
|
|
|
|
|
|
|
# Get the date entry was posted |
3233
|
|
|
|
|
|
|
my $timet=$lj->GetDate($Entry); |
3234
|
|
|
|
|
|
|
if (defined $timet) { |
3235
|
|
|
|
|
|
|
printf($Format,"Date", |
3236
|
|
|
|
|
|
|
strftime("%Y-%m-%d %H:%M:%S",localtime($timet))); |
3237
|
|
|
|
|
|
|
} |
3238
|
|
|
|
|
|
|
|
3239
|
|
|
|
|
|
|
# Is entry protected ? |
3240
|
|
|
|
|
|
|
my $EntProt=""; |
3241
|
|
|
|
|
|
|
my ($protect,@prot_opt)=$lj->GetProtect($Entry); |
3242
|
|
|
|
|
|
|
if (defined $protect) { |
3243
|
|
|
|
|
|
|
if ($protect eq "public") { |
3244
|
|
|
|
|
|
|
$EntProt="public"; |
3245
|
|
|
|
|
|
|
} elsif ($protect eq "friends") { |
3246
|
|
|
|
|
|
|
$EntProt="friends only"; |
3247
|
|
|
|
|
|
|
} elsif ($protect eq "groups") { |
3248
|
|
|
|
|
|
|
$EntProt=join("","only groups - ",join(", ",@prot_opt)); |
3249
|
|
|
|
|
|
|
} elsif ($protect eq "private") { |
3250
|
|
|
|
|
|
|
$EntProt="private"; |
3251
|
|
|
|
|
|
|
} |
3252
|
|
|
|
|
|
|
printf($Format,"Journal access",$EntProt); |
3253
|
|
|
|
|
|
|
} |
3254
|
|
|
|
|
|
|
|
3255
|
|
|
|
|
|
|
## Properties |
3256
|
|
|
|
|
|
|
# Backdated ? |
3257
|
|
|
|
|
|
|
my $word="no"; |
3258
|
|
|
|
|
|
|
my $prop=$lj->Getprop_backdate($Entry); |
3259
|
|
|
|
|
|
|
if ((defined $prop) && ($prop==1)) { $word="yes" } |
3260
|
|
|
|
|
|
|
printf($Format,"Backdated",$word); |
3261
|
|
|
|
|
|
|
|
3262
|
|
|
|
|
|
|
# Preformatted ? |
3263
|
|
|
|
|
|
|
$word="no"; |
3264
|
|
|
|
|
|
|
$prop=$lj->Getprop_preformatted($Entry); |
3265
|
|
|
|
|
|
|
if ((defined $prop) && ($prop==1)) { $word="yes" } |
3266
|
|
|
|
|
|
|
printf($Format,"Preformatted",$word); |
3267
|
|
|
|
|
|
|
|
3268
|
|
|
|
|
|
|
# No comments allowed ? |
3269
|
|
|
|
|
|
|
$word="no"; |
3270
|
|
|
|
|
|
|
$prop=$lj->Getprop_nocomments($Entry); |
3271
|
|
|
|
|
|
|
if ((defined $prop) && ($prop==1)) { $word="yes" } |
3272
|
|
|
|
|
|
|
printf($Format,"No comments",$word); |
3273
|
|
|
|
|
|
|
|
3274
|
|
|
|
|
|
|
# Do not email comments ? |
3275
|
|
|
|
|
|
|
$word="no"; |
3276
|
|
|
|
|
|
|
$prop=$lj->Getprop_noemail($Entry); |
3277
|
|
|
|
|
|
|
if ((defined $prop) && ($prop==1)) { $word="yes" } |
3278
|
|
|
|
|
|
|
printf($Format,"No emailed comments",$word); |
3279
|
|
|
|
|
|
|
|
3280
|
|
|
|
|
|
|
# Unknown 8-bit ? |
3281
|
|
|
|
|
|
|
$word="no"; |
3282
|
|
|
|
|
|
|
$prop=$lj->Getprop_unknown8bit($Entry); |
3283
|
|
|
|
|
|
|
if ((defined $prop) && ($prop==1)) { $word="yes" } |
3284
|
|
|
|
|
|
|
printf($Format,"Any 8 bit, non UTF-8",$word); |
3285
|
|
|
|
|
|
|
|
3286
|
|
|
|
|
|
|
# Current music |
3287
|
|
|
|
|
|
|
$word="[None]"; |
3288
|
|
|
|
|
|
|
$prop=$lj->Getprop_current_music($Entry); |
3289
|
|
|
|
|
|
|
if ((defined $prop) && ($prop ne "")) { $word=$prop } |
3290
|
|
|
|
|
|
|
printf($Format,"Current music",$word); |
3291
|
|
|
|
|
|
|
|
3292
|
|
|
|
|
|
|
# Current mood [text] |
3293
|
|
|
|
|
|
|
$word="[None]"; |
3294
|
|
|
|
|
|
|
$prop=$lj->Getprop_current_mood($Entry); |
3295
|
|
|
|
|
|
|
if ((defined $prop) && ($prop ne "")) { $word=$prop } |
3296
|
|
|
|
|
|
|
printf($Format,"Current mood",$word); |
3297
|
|
|
|
|
|
|
|
3298
|
|
|
|
|
|
|
# Current mood [id] |
3299
|
|
|
|
|
|
|
$word="[None]"; |
3300
|
|
|
|
|
|
|
$prop=$lj->Getprop_current_mood_id($Entry); |
3301
|
|
|
|
|
|
|
if ((defined $prop) && ($prop ne "")) { $word=$prop } |
3302
|
|
|
|
|
|
|
printf($Format,"Current mood_id",$word); |
3303
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
# Picture keyword |
3305
|
|
|
|
|
|
|
$word="[None]"; |
3306
|
|
|
|
|
|
|
$prop=$lj->Getprop_picture_keyword($Entry); |
3307
|
|
|
|
|
|
|
if ((defined $prop) && ($prop ne "")) { $word=$prop } |
3308
|
|
|
|
|
|
|
printf($Format,"Picture keyword",$word); |
3309
|
|
|
|
|
|
|
|
3310
|
|
|
|
|
|
|
# Finally output the actual journal entry |
3311
|
|
|
|
|
|
|
printf($Format,"Journal entry",""); |
3312
|
|
|
|
|
|
|
my $text=$lj->GetEntry($Entry); |
3313
|
|
|
|
|
|
|
(defined $text) && |
3314
|
|
|
|
|
|
|
print " ",join("\n ",split(/\n/,$text)),"\n\n"; |
3315
|
|
|
|
|
|
|
} |
3316
|
|
|
|
|
|
|
|
3317
|
|
|
|
|
|
|
=cut |
3318
|
|
|
|
|
|
|
sub GetEntries($$@) { |
3319
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3320
|
0
|
|
|
|
|
0
|
my ($hr,$journal,$type,@opts)=@_; |
3321
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3322
|
0
|
0
|
|
|
|
0
|
if (ref($hr) ne "HASH") { |
3323
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries() not given a hash reference"; |
3324
|
0
|
|
|
|
|
0
|
return undef; |
3325
|
|
|
|
|
|
|
} |
3326
|
0
|
0
|
|
|
|
0
|
if (!defined $type) { |
3327
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries() given undefined value for type"; |
3328
|
0
|
|
|
|
|
0
|
return undef; |
3329
|
|
|
|
|
|
|
} |
3330
|
0
|
|
|
|
|
0
|
%{$hr}=(); |
|
0
|
|
|
|
|
0
|
|
3331
|
0
|
|
|
|
|
0
|
my %Event=(); |
3332
|
0
|
|
|
|
|
0
|
my %Resp=(); |
3333
|
0
|
0
|
|
|
|
0
|
if (defined $journal) { |
3334
|
0
|
|
|
|
|
0
|
$Event{usejournal}=$journal; |
3335
|
|
|
|
|
|
|
} |
3336
|
0
|
|
|
|
|
0
|
my $ctype=lc($type); |
3337
|
0
|
0
|
|
|
|
0
|
if ($ctype eq "day") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3338
|
0
|
0
|
|
|
|
0
|
if ($#opts<0) { |
3339
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) requires year,month,day in \@opts"; |
3340
|
0
|
|
|
|
|
0
|
return undef; |
3341
|
|
|
|
|
|
|
} |
3342
|
0
|
|
|
|
|
0
|
my ($timestamp)=@opts; |
3343
|
0
|
0
|
|
|
|
0
|
if ($timestamp!~/^[0-9]+$/) { |
3344
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) given invalid timestamp"; |
3345
|
0
|
|
|
|
|
0
|
return undef; |
3346
|
|
|
|
|
|
|
} |
3347
|
0
|
|
|
|
|
0
|
my @tm=localtime($timestamp); |
3348
|
0
|
0
|
|
|
|
0
|
if ($#tm==-1) { |
3349
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) given invalid timestamp"; |
3350
|
0
|
|
|
|
|
0
|
return undef; |
3351
|
|
|
|
|
|
|
} |
3352
|
0
|
|
|
|
|
0
|
$Event{selecttype}=$ctype; |
3353
|
0
|
|
|
|
|
0
|
$Event{year}=$tm[5]+1900; |
3354
|
0
|
|
|
|
|
0
|
$Event{month}=$tm[4]+1; |
3355
|
0
|
|
|
|
|
0
|
$Event{day}=$tm[3]; |
3356
|
|
|
|
|
|
|
} elsif ($ctype eq "lastn") { |
3357
|
0
|
0
|
|
|
|
0
|
if ($#opts<1) { |
3358
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) requires num and beforedate in \@opts"; |
3359
|
0
|
|
|
|
|
0
|
return undef; |
3360
|
|
|
|
|
|
|
} |
3361
|
0
|
|
|
|
|
0
|
$Event{selecttype}=$ctype; |
3362
|
0
|
|
|
|
|
0
|
my ($num,$beforedate)=@opts; |
3363
|
0
|
0
|
|
|
|
0
|
if (defined $num) { |
3364
|
0
|
0
|
|
|
|
0
|
if ($num!~/^[0-9]{1,2}$/) { |
3365
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) requires valid number for num"; |
3366
|
0
|
|
|
|
|
0
|
return undef; |
3367
|
|
|
|
|
|
|
} |
3368
|
0
|
0
|
|
|
|
0
|
if ($num>50) { |
3369
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Maximum number of journal entries returned is 50"; |
3370
|
0
|
|
|
|
|
0
|
return undef; |
3371
|
|
|
|
|
|
|
} |
3372
|
|
|
|
|
|
|
} else { |
3373
|
0
|
|
|
|
|
0
|
$num=20; |
3374
|
|
|
|
|
|
|
} |
3375
|
0
|
|
|
|
|
0
|
$Event{howmany}=$num; |
3376
|
0
|
0
|
|
|
|
0
|
if (defined $beforedate) { |
3377
|
0
|
0
|
|
|
|
0
|
if ($beforedate!~/^[0-9]+$/) { |
3378
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Invalid Unix timestamp"; |
3379
|
0
|
|
|
|
|
0
|
return undef; |
3380
|
|
|
|
|
|
|
} |
3381
|
0
|
|
|
|
|
0
|
my @tm=localtime($beforedate); |
3382
|
0
|
0
|
|
|
|
0
|
if ($#tm==-1) { |
3383
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) given invalid timestamp"; |
3384
|
0
|
|
|
|
|
0
|
return undef; |
3385
|
|
|
|
|
|
|
} |
3386
|
0
|
|
|
|
|
0
|
$Event{beforedate}=strftime("%Y-%m-%d %H:%M:%S",@tm); |
3387
|
|
|
|
|
|
|
} |
3388
|
|
|
|
|
|
|
} elsif ($ctype eq "one") { |
3389
|
0
|
0
|
|
|
|
0
|
if ($#opts<0) { |
3390
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) requires item_id in \@opts"; |
3391
|
0
|
|
|
|
|
0
|
return undef; |
3392
|
|
|
|
|
|
|
} |
3393
|
0
|
|
|
|
|
0
|
my ($item_id)=@opts; |
3394
|
0
|
0
|
|
|
|
0
|
if ($item_id!~/^-*[0-9]+$/) { |
3395
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Invalid item_id"; |
3396
|
0
|
|
|
|
|
0
|
return undef; |
3397
|
|
|
|
|
|
|
} |
3398
|
0
|
0
|
|
|
|
0
|
if ($item_id<-1) { |
3399
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Invalid item_id"; |
3400
|
0
|
|
|
|
|
0
|
return undef; |
3401
|
|
|
|
|
|
|
} |
3402
|
0
|
|
|
|
|
0
|
$Event{selecttype}=$ctype; |
3403
|
0
|
|
|
|
|
0
|
$Event{itemid}=$item_id; |
3404
|
|
|
|
|
|
|
} elsif ($ctype eq "sync") { |
3405
|
0
|
0
|
|
|
|
0
|
if ($#opts<0) { |
3406
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) requires timestamp in \@opts"; |
3407
|
0
|
|
|
|
|
0
|
return undef; |
3408
|
|
|
|
|
|
|
} |
3409
|
0
|
|
|
|
|
0
|
my ($lastsync)=@opts; |
3410
|
0
|
0
|
|
|
|
0
|
if ($lastsync!~/^[0-9]+$/) { |
3411
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Invalid Unix timestamp"; |
3412
|
0
|
|
|
|
|
0
|
return undef; |
3413
|
|
|
|
|
|
|
} |
3414
|
0
|
|
|
|
|
0
|
my @tm=localtime($lastsync); |
3415
|
0
|
0
|
|
|
|
0
|
if ($#tm==-1) { |
3416
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries($type) given invalid timestamp"; |
3417
|
0
|
|
|
|
|
0
|
return undef; |
3418
|
|
|
|
|
|
|
} |
3419
|
0
|
|
|
|
|
0
|
$Event{lastsync}=strftime("%Y-%m-%d %H:%M:%S",@tm); |
3420
|
0
|
|
|
|
|
0
|
$Event{selecttype}="syncitems"; |
3421
|
|
|
|
|
|
|
} else { |
3422
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: GetEntries() does not understand type $type\n"; |
3423
|
0
|
|
|
|
|
0
|
return undef; |
3424
|
|
|
|
|
|
|
} |
3425
|
0
|
0
|
|
|
|
0
|
$self->SendRequest("getevents",\%Event,\%Resp) || return undef; |
3426
|
0
|
|
|
|
|
0
|
my %Ev=(); |
3427
|
0
|
|
|
|
|
0
|
my %Pr=(); |
3428
|
0
|
|
|
|
|
0
|
my ($k,$v); |
3429
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %Resp) { |
3430
|
0
|
|
|
|
|
0
|
my ($num,$key,$hash)=(undef,undef,undef); |
3431
|
0
|
0
|
|
|
|
0
|
if ($k=~/^events_([0-9]+)_(.*)$/) { |
|
|
0
|
|
|
|
|
|
3432
|
0
|
|
|
|
|
0
|
($num,$key,$hash)=($1,$2,\%Ev); |
3433
|
|
|
|
|
|
|
} elsif ($k=~/^prop_([0-9]+)_(.*)$/) { |
3434
|
0
|
|
|
|
|
0
|
($num,$key,$hash)=($1,$2,\%Pr); |
3435
|
|
|
|
|
|
|
} |
3436
|
0
|
0
|
|
|
|
0
|
if (defined $hash) { |
3437
|
0
|
0
|
|
|
|
0
|
(exists $hash->{$num}) || ($hash->{$num}={}); |
3438
|
0
|
|
|
|
|
0
|
$hash->{$num}->{$key}=$v; |
3439
|
|
|
|
|
|
|
} |
3440
|
|
|
|
|
|
|
} |
3441
|
0
|
|
|
|
|
0
|
my $ehr=undef; |
3442
|
0
|
|
|
|
|
0
|
foreach $ehr (values %Ev) { |
3443
|
0
|
|
|
|
|
0
|
my $itemid=$ehr->{itemid}; |
3444
|
0
|
|
|
|
|
0
|
$hr->{$itemid}={}; |
3445
|
0
|
|
|
|
|
0
|
my $nhr=$hr->{$itemid}; |
3446
|
0
|
|
|
|
|
0
|
%{$nhr}=( |
|
0
|
|
|
|
|
0
|
|
3447
|
|
|
|
|
|
|
__htmlid => ($ehr->{itemid} * 256) + $ehr->{anum}, |
3448
|
|
|
|
|
|
|
__anum => $ehr->{anum}, |
3449
|
|
|
|
|
|
|
__itemid => $itemid, |
3450
|
|
|
|
|
|
|
event => $ehr->{event}, |
3451
|
|
|
|
|
|
|
lineenddings => "unix", |
3452
|
|
|
|
|
|
|
); |
3453
|
0
|
0
|
|
|
|
0
|
(defined $journal) && ($nhr->{usejournal}=$journal); |
3454
|
0
|
0
|
|
|
|
0
|
(exists $ehr->{subject}) && ($nhr->{subject}=$ehr->{subject}); |
3455
|
0
|
0
|
|
|
|
0
|
(exists $ehr->{allowmask}) && ($nhr->{allowmask}=$ehr->{allowmask}); |
3456
|
0
|
0
|
|
|
|
0
|
(exists $ehr->{security}) && ($nhr->{security}=$ehr->{security}); |
3457
|
0
|
0
|
|
|
|
0
|
if ($ehr->{eventtime}=~/([0-9]+)-([0-9]+)-([0-9]+)\s([0-9]+):([0-9]+):([0-9]+)/o) { |
3458
|
0
|
|
|
|
|
0
|
$nhr->{year}=int($1); |
3459
|
0
|
|
|
|
|
0
|
$nhr->{mon}=int($2); |
3460
|
0
|
|
|
|
|
0
|
$nhr->{day}=int($3); |
3461
|
0
|
|
|
|
|
0
|
$nhr->{hour}=int($4); |
3462
|
0
|
|
|
|
|
0
|
$nhr->{min}=int($5); |
3463
|
0
|
|
|
|
|
0
|
my $timet=mktime($6,$5,$4,$3,$2-1,$1-1900); |
3464
|
0
|
0
|
|
|
|
0
|
if (!defined $timet) { |
3465
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to mktime() from \"$ehr->{eventtime}\" for itemid $hr->{$ehr->{itemid}}->{__htmlid}"; |
3466
|
0
|
|
|
|
|
0
|
return undef; |
3467
|
|
|
|
|
|
|
} |
3468
|
0
|
|
|
|
|
0
|
$nhr->{__timet}=$timet; |
3469
|
|
|
|
|
|
|
} else { |
3470
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to parse eventtime \"$ehr->{eventtime}\" for itemid $hr->{$ehr->{itemid}}->{__htmlid}"; |
3471
|
0
|
|
|
|
|
0
|
return undef; |
3472
|
|
|
|
|
|
|
} |
3473
|
|
|
|
|
|
|
} |
3474
|
0
|
|
|
|
|
0
|
my $phr=undef; |
3475
|
0
|
|
|
|
|
0
|
foreach $phr (values %Pr) { |
3476
|
0
|
0
|
|
|
|
0
|
if (!exists $hr->{$phr->{itemid}}) { |
3477
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Protocol error: properties returned for itemid not seen"; |
3478
|
0
|
|
|
|
|
0
|
return undef; |
3479
|
|
|
|
|
|
|
} |
3480
|
0
|
|
|
|
|
0
|
my $nhr=$hr->{$phr->{itemid}}; |
3481
|
0
|
|
|
|
|
0
|
my $k=join("_","prop",$phr->{name}); |
3482
|
0
|
0
|
|
|
|
0
|
if (!exists $nhr->{$k}) { |
3483
|
0
|
|
|
|
|
0
|
$nhr->{$k}=$phr->{value}; |
3484
|
|
|
|
|
|
|
} |
3485
|
|
|
|
|
|
|
} |
3486
|
0
|
|
|
|
|
0
|
return $hr; |
3487
|
|
|
|
|
|
|
} |
3488
|
|
|
|
|
|
|
|
3489
|
|
|
|
|
|
|
=pod |
3490
|
|
|
|
|
|
|
|
3491
|
|
|
|
|
|
|
=back |
3492
|
|
|
|
|
|
|
|
3493
|
|
|
|
|
|
|
=head2 Getting information from an entry |
3494
|
|
|
|
|
|
|
|
3495
|
|
|
|
|
|
|
=over 4 |
3496
|
|
|
|
|
|
|
|
3497
|
|
|
|
|
|
|
=item $lj->GetDate($event) |
3498
|
|
|
|
|
|
|
|
3499
|
|
|
|
|
|
|
Gets the date for the event given. The date is returned as a C (i.e. seconds |
3500
|
|
|
|
|
|
|
since epoch) value. Returns C on failure. |
3501
|
|
|
|
|
|
|
|
3502
|
|
|
|
|
|
|
Example code: |
3503
|
|
|
|
|
|
|
|
3504
|
|
|
|
|
|
|
use POSIX; # For strftime() |
3505
|
|
|
|
|
|
|
|
3506
|
|
|
|
|
|
|
## Get date |
3507
|
|
|
|
|
|
|
my $timet=$lj->GetDate(\%Event); |
3508
|
|
|
|
|
|
|
(defined $timet) |
3509
|
|
|
|
|
|
|
|| die "$0: Failed to set date of entry - $LJ::Simple::error\n"; |
3510
|
|
|
|
|
|
|
|
3511
|
|
|
|
|
|
|
# Get time list using localtime() |
3512
|
|
|
|
|
|
|
my @tm=localtime($timet); |
3513
|
|
|
|
|
|
|
($#tm<0) && |
3514
|
|
|
|
|
|
|
die "$0: Failed to run localtime() on time_t $timet\n"; |
3515
|
|
|
|
|
|
|
|
3516
|
|
|
|
|
|
|
# Format date in the normal way used by LJ "YYYY-MM-DD hh:mm:ss" |
3517
|
|
|
|
|
|
|
my $jtime=strftime("%Y-%m-%d %H:%M:%S",@tm); |
3518
|
|
|
|
|
|
|
|
3519
|
|
|
|
|
|
|
=cut |
3520
|
|
|
|
|
|
|
sub GetDate($$) { |
3521
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3522
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
3523
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3524
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3525
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3526
|
0
|
|
|
|
|
0
|
return undef; |
3527
|
|
|
|
|
|
|
} |
3528
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{__timet}) { |
3529
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="No time value stored"; |
3530
|
0
|
|
|
|
|
0
|
return undef; |
3531
|
|
|
|
|
|
|
} |
3532
|
0
|
|
|
|
|
0
|
return $event->{__timet}; |
3533
|
|
|
|
|
|
|
} |
3534
|
|
|
|
|
|
|
|
3535
|
|
|
|
|
|
|
|
3536
|
|
|
|
|
|
|
=pod |
3537
|
|
|
|
|
|
|
|
3538
|
|
|
|
|
|
|
=item $lj->GetItemId($event) |
3539
|
|
|
|
|
|
|
|
3540
|
|
|
|
|
|
|
Returns a list which contains the real C, C and HTMLised C which |
3541
|
|
|
|
|
|
|
can be used to contruct a URL suitable for accessing the item via the web. |
3542
|
|
|
|
|
|
|
Returns C on failure. Note that you must only use this |
3543
|
|
|
|
|
|
|
routine on entries which have been returned by the C |
3544
|
|
|
|
|
|
|
routine. |
3545
|
|
|
|
|
|
|
|
3546
|
|
|
|
|
|
|
Example code: |
3547
|
|
|
|
|
|
|
|
3548
|
|
|
|
|
|
|
my ($item_id,$anum,$html_id)=$lj->GetItemId(\%Event); |
3549
|
|
|
|
|
|
|
(defined $item_id) |
3550
|
|
|
|
|
|
|
|| die "$0: Failed to get item id - $LJ::Simple::error\n"; |
3551
|
|
|
|
|
|
|
|
3552
|
|
|
|
|
|
|
=cut |
3553
|
|
|
|
|
|
|
sub GetItemId($$) { |
3554
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3555
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
3556
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3557
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3558
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3559
|
0
|
|
|
|
|
0
|
return undef; |
3560
|
|
|
|
|
|
|
} |
3561
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{__itemid}) { |
3562
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="item_id does not exist - must use GetEntries()"; |
3563
|
0
|
|
|
|
|
0
|
return undef; |
3564
|
|
|
|
|
|
|
} |
3565
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{__anum}) { |
3566
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="anum does not exist - must use GetEntries()"; |
3567
|
0
|
|
|
|
|
0
|
return undef; |
3568
|
|
|
|
|
|
|
} |
3569
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{__htmlid}) { |
3570
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="HTML id does not exist - must use GetEntries()"; |
3571
|
0
|
|
|
|
|
0
|
return undef; |
3572
|
|
|
|
|
|
|
} |
3573
|
0
|
|
|
|
|
0
|
return ($event->{__itemid},$event->{__anum},$event->{__htmlid}); |
3574
|
|
|
|
|
|
|
} |
3575
|
|
|
|
|
|
|
|
3576
|
|
|
|
|
|
|
|
3577
|
|
|
|
|
|
|
=pod |
3578
|
|
|
|
|
|
|
|
3579
|
|
|
|
|
|
|
=item $lj->GetURL($event) |
3580
|
|
|
|
|
|
|
|
3581
|
|
|
|
|
|
|
Returns the URL which can be used to access the journal entry via a web |
3582
|
|
|
|
|
|
|
browser. Returns C on failure. Note that you must only use this |
3583
|
|
|
|
|
|
|
routine on entries which have been returned by the C |
3584
|
|
|
|
|
|
|
routine. |
3585
|
|
|
|
|
|
|
|
3586
|
|
|
|
|
|
|
Example code: |
3587
|
|
|
|
|
|
|
|
3588
|
|
|
|
|
|
|
my $url=$lj->GetURL(\%Event); |
3589
|
|
|
|
|
|
|
(defined $url) |
3590
|
|
|
|
|
|
|
|| die "$0: Failed to get URL - $LJ::Simple::error\n"; |
3591
|
|
|
|
|
|
|
system("netscape -remote 'openURL($url)'"); |
3592
|
|
|
|
|
|
|
|
3593
|
|
|
|
|
|
|
=cut |
3594
|
|
|
|
|
|
|
sub GetURL($$) { |
3595
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3596
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
3597
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3598
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3599
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3600
|
0
|
|
|
|
|
0
|
return undef; |
3601
|
|
|
|
|
|
|
} |
3602
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{__htmlid}) { |
3603
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="HTML id does not exist - must use GetEntries()"; |
3604
|
0
|
|
|
|
|
0
|
return undef; |
3605
|
|
|
|
|
|
|
} |
3606
|
0
|
|
|
|
|
0
|
my $user=$self->user(); |
3607
|
0
|
|
|
|
|
0
|
my $server=$self->{lj}->{host}; |
3608
|
0
|
|
|
|
|
0
|
my $port=$self->{lj}->{port}; |
3609
|
0
|
|
|
|
|
0
|
my $htmlid=$event->{__htmlid}; |
3610
|
0
|
|
|
|
|
0
|
return "http://$server:$port/talkpost.bml\?journal=$user\&itemid=$htmlid"; |
3611
|
|
|
|
|
|
|
} |
3612
|
|
|
|
|
|
|
|
3613
|
|
|
|
|
|
|
=pod |
3614
|
|
|
|
|
|
|
|
3615
|
|
|
|
|
|
|
=item $lj->GetSubject($event) |
3616
|
|
|
|
|
|
|
|
3617
|
|
|
|
|
|
|
Gets the subject for the journal entry. Returns the subject if it is |
3618
|
|
|
|
|
|
|
available, C otherwise. |
3619
|
|
|
|
|
|
|
|
3620
|
|
|
|
|
|
|
Example code: |
3621
|
|
|
|
|
|
|
|
3622
|
|
|
|
|
|
|
my $subj=$lj->GetSubject(\%Event) |
3623
|
|
|
|
|
|
|
if (defined $subj) { |
3624
|
|
|
|
|
|
|
print "Subject: $subj\n"; |
3625
|
|
|
|
|
|
|
} |
3626
|
|
|
|
|
|
|
|
3627
|
|
|
|
|
|
|
=cut |
3628
|
|
|
|
|
|
|
sub GetSubject($$) { |
3629
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3630
|
0
|
|
|
|
|
0
|
my ($event) = @_; |
3631
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3632
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3633
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3634
|
0
|
|
|
|
|
0
|
return undef; |
3635
|
|
|
|
|
|
|
} |
3636
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{subject}) { |
3637
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="No subject set"; |
3638
|
0
|
|
|
|
|
0
|
return undef; |
3639
|
|
|
|
|
|
|
} |
3640
|
0
|
|
|
|
|
0
|
return $event->{subject}; |
3641
|
|
|
|
|
|
|
} |
3642
|
|
|
|
|
|
|
|
3643
|
|
|
|
|
|
|
|
3644
|
|
|
|
|
|
|
=pod |
3645
|
|
|
|
|
|
|
|
3646
|
|
|
|
|
|
|
=item $lj->GetEntry($event) |
3647
|
|
|
|
|
|
|
|
3648
|
|
|
|
|
|
|
Gets the entry for the journal. Returns either a single string which contains |
3649
|
|
|
|
|
|
|
the entire journal entry or C on failure. |
3650
|
|
|
|
|
|
|
|
3651
|
|
|
|
|
|
|
Example code: |
3652
|
|
|
|
|
|
|
|
3653
|
|
|
|
|
|
|
my $ent = $lj->GetEntry(\%Event); |
3654
|
|
|
|
|
|
|
(defined $ent) |
3655
|
|
|
|
|
|
|
|| die "$0: Failed to get entry - $LJ::Simple::error\n"; |
3656
|
|
|
|
|
|
|
print "Entry: $ent\n"; |
3657
|
|
|
|
|
|
|
|
3658
|
|
|
|
|
|
|
=cut |
3659
|
|
|
|
|
|
|
sub GetEntry($$) { |
3660
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3661
|
0
|
|
|
|
|
0
|
my ($event) = @_; |
3662
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3663
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3664
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3665
|
0
|
|
|
|
|
0
|
return undef; |
3666
|
|
|
|
|
|
|
} |
3667
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{event}) { |
3668
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="No journal entry set"; |
3669
|
0
|
|
|
|
|
0
|
return undef; |
3670
|
|
|
|
|
|
|
} |
3671
|
0
|
|
|
|
|
0
|
return $event->{event}; |
3672
|
|
|
|
|
|
|
} |
3673
|
|
|
|
|
|
|
|
3674
|
|
|
|
|
|
|
|
3675
|
|
|
|
|
|
|
=pod |
3676
|
|
|
|
|
|
|
|
3677
|
|
|
|
|
|
|
=item $lj->GetProtect($event) |
3678
|
|
|
|
|
|
|
|
3679
|
|
|
|
|
|
|
Gets the protection information on the event given. Returns a list with |
3680
|
|
|
|
|
|
|
details of the protection set on the post. On failure C is returned. |
3681
|
|
|
|
|
|
|
|
3682
|
|
|
|
|
|
|
There are several different types of protection which can be returned for a |
3683
|
|
|
|
|
|
|
journal entry. These include public, friends only, specific friends groups |
3684
|
|
|
|
|
|
|
and private. The list returned will always have the type of protection listed |
3685
|
|
|
|
|
|
|
first followed by any details of that protection. Thus the list can contain: |
3686
|
|
|
|
|
|
|
|
3687
|
|
|
|
|
|
|
("public") |
3688
|
|
|
|
|
|
|
A publically accessable journal entry |
3689
|
|
|
|
|
|
|
|
3690
|
|
|
|
|
|
|
("friends") |
3691
|
|
|
|
|
|
|
Only friends may read the entry |
3692
|
|
|
|
|
|
|
|
3693
|
|
|
|
|
|
|
("groups","group1" ...) |
3694
|
|
|
|
|
|
|
Only users listed in the friends groups given after the "groups" |
3695
|
|
|
|
|
|
|
may read the entry |
3696
|
|
|
|
|
|
|
|
3697
|
|
|
|
|
|
|
("private") |
3698
|
|
|
|
|
|
|
Only the owner of the journal may read the entry |
3699
|
|
|
|
|
|
|
|
3700
|
|
|
|
|
|
|
Example code: |
3701
|
|
|
|
|
|
|
|
3702
|
|
|
|
|
|
|
my ($protect,@prot_opt)=$lj->GetProtect(\%Event); |
3703
|
|
|
|
|
|
|
(defined $protect) || |
3704
|
|
|
|
|
|
|
die "$0: Failed to get entry protection type - $LJ::Simple::error\n"; |
3705
|
|
|
|
|
|
|
if ($protect eq "public") { |
3706
|
|
|
|
|
|
|
print "Journal entry is public\n"; |
3707
|
|
|
|
|
|
|
} elsif ($protect eq "friends") { |
3708
|
|
|
|
|
|
|
print "Journal entry only viewable by friends\n"; |
3709
|
|
|
|
|
|
|
} elsif ($protect eq "groups") { |
3710
|
|
|
|
|
|
|
print "Journal entry only viewable by friends in the following groups:\n"; |
3711
|
|
|
|
|
|
|
print join(", ",@prot_opt),"\n"; |
3712
|
|
|
|
|
|
|
} elsif ($protect eq "private") { |
3713
|
|
|
|
|
|
|
print "Journal entry only viewable by the journal owner\n"; |
3714
|
|
|
|
|
|
|
} |
3715
|
|
|
|
|
|
|
|
3716
|
|
|
|
|
|
|
=cut |
3717
|
|
|
|
|
|
|
sub GetProtect($$) { |
3718
|
0
|
|
|
0
|
1
|
0
|
my $self=shift; |
3719
|
0
|
|
|
|
|
0
|
my ($event)=@_; |
3720
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3721
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3722
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3723
|
0
|
|
|
|
|
0
|
return undef; |
3724
|
|
|
|
|
|
|
} |
3725
|
0
|
0
|
0
|
|
|
0
|
if ((!exists $event->{security})||($event->{security} eq "")) { |
3726
|
0
|
|
|
|
|
0
|
return "public"; |
3727
|
|
|
|
|
|
|
} |
3728
|
0
|
0
|
|
|
|
0
|
if ($event->{security} eq "private") { |
3729
|
0
|
|
|
|
|
0
|
return "private"; |
3730
|
|
|
|
|
|
|
} |
3731
|
0
|
0
|
|
|
|
0
|
if ($event->{security} ne "usemask") { |
3732
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: security contains unknown value \"$event->{security}\""; |
3733
|
0
|
|
|
|
|
0
|
return undef; |
3734
|
|
|
|
|
|
|
} |
3735
|
0
|
0
|
|
|
|
0
|
if (($event->{allowmask} & 1) == 1) { |
3736
|
0
|
|
|
|
|
0
|
return "friends"; |
3737
|
|
|
|
|
|
|
} |
3738
|
0
|
|
|
|
|
0
|
my @lst=("groups"); |
3739
|
0
|
|
|
|
|
0
|
my $g=undef; |
3740
|
0
|
|
|
|
|
0
|
foreach $g (keys %{$self->{groups}->{name}}) { |
|
0
|
|
|
|
|
0
|
|
3741
|
0
|
|
|
|
|
0
|
my $bit=1 << $self->{groups}->{name}->{$g}->{id}; |
3742
|
0
|
0
|
|
|
|
0
|
if (($event->{allowmask} & $bit) == $bit) { |
3743
|
0
|
|
|
|
|
0
|
push(@lst,$g); |
3744
|
|
|
|
|
|
|
} |
3745
|
|
|
|
|
|
|
} |
3746
|
0
|
|
|
|
|
0
|
return @lst; |
3747
|
|
|
|
|
|
|
} |
3748
|
|
|
|
|
|
|
|
3749
|
|
|
|
|
|
|
|
3750
|
|
|
|
|
|
|
## |
3751
|
|
|
|
|
|
|
## Helper function used to get meta data |
3752
|
|
|
|
|
|
|
## |
3753
|
|
|
|
|
|
|
sub Getprop_general($$$$$) { |
3754
|
0
|
|
|
0
|
0
|
0
|
my ($self,$event,$prop,$caller,$type)=@_; |
3755
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3756
|
0
|
0
|
|
|
|
0
|
if (ref($event) ne "HASH") { |
3757
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: Not given a hash reference"; |
3758
|
0
|
|
|
|
|
0
|
return undef; |
3759
|
|
|
|
|
|
|
} |
3760
|
0
|
|
|
|
|
0
|
my $key=join("_","prop",$prop); |
3761
|
0
|
0
|
|
|
|
0
|
if (!exists $event->{$key}) { |
3762
|
0
|
0
|
|
|
|
0
|
if ($type eq "bool") { |
3763
|
0
|
|
|
|
|
0
|
return 0; |
3764
|
|
|
|
|
|
|
} |
3765
|
0
|
|
|
|
|
0
|
return ""; |
3766
|
|
|
|
|
|
|
} |
3767
|
0
|
|
|
|
|
0
|
return $event->{$key}; |
3768
|
|
|
|
|
|
|
} |
3769
|
|
|
|
|
|
|
|
3770
|
|
|
|
|
|
|
=pod |
3771
|
|
|
|
|
|
|
|
3772
|
|
|
|
|
|
|
=item $lj->Getprop_backdate($event) |
3773
|
|
|
|
|
|
|
|
3774
|
|
|
|
|
|
|
Indicates if the journal entry is back dated or not. Back dated |
3775
|
|
|
|
|
|
|
entries do not appear on the friends view of your journal entries. Returns |
3776
|
|
|
|
|
|
|
C<1> if the entry is backdated, C<0> if it is not. C is returned in the |
3777
|
|
|
|
|
|
|
event of an error. |
3778
|
|
|
|
|
|
|
|
3779
|
|
|
|
|
|
|
Example code: |
3780
|
|
|
|
|
|
|
|
3781
|
|
|
|
|
|
|
my $prop=$lj->Getprop_backdate(\%Event); |
3782
|
|
|
|
|
|
|
(defined $prop) || |
3783
|
|
|
|
|
|
|
die "$0: Failed to get property - $LJ::Simple::error\n"; |
3784
|
|
|
|
|
|
|
if ($prop) { |
3785
|
|
|
|
|
|
|
print STDERR "Journal is backdated\n"; |
3786
|
|
|
|
|
|
|
} else { |
3787
|
|
|
|
|
|
|
print STDERR "Journal is not backdated\n"; |
3788
|
|
|
|
|
|
|
} |
3789
|
|
|
|
|
|
|
|
3790
|
|
|
|
|
|
|
|
3791
|
|
|
|
|
|
|
=cut |
3792
|
|
|
|
|
|
|
sub Getprop_backdate($$) { |
3793
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3794
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3795
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"opt_backdated","Getprop_backdate","bool"); |
3796
|
|
|
|
|
|
|
} |
3797
|
|
|
|
|
|
|
|
3798
|
|
|
|
|
|
|
|
3799
|
|
|
|
|
|
|
=pod |
3800
|
|
|
|
|
|
|
|
3801
|
|
|
|
|
|
|
=item $lj->Getprop_current_mood($event) |
3802
|
|
|
|
|
|
|
|
3803
|
|
|
|
|
|
|
Used to get the current mood for the journal being written. This returns the |
3804
|
|
|
|
|
|
|
mood if one exists, an empty string if none exists or C in the event |
3805
|
|
|
|
|
|
|
of an error. |
3806
|
|
|
|
|
|
|
|
3807
|
|
|
|
|
|
|
Example code: |
3808
|
|
|
|
|
|
|
|
3809
|
|
|
|
|
|
|
my $prop=$lj->Getprop_current_mood(\%Event); |
3810
|
|
|
|
|
|
|
(defined $prop) || |
3811
|
|
|
|
|
|
|
die "$0: Failed to get property - $LJ::Simple::error\n"; |
3812
|
|
|
|
|
|
|
if ($prop ne "") { |
3813
|
|
|
|
|
|
|
print STDERR "Journal has mood of $prop\n"; |
3814
|
|
|
|
|
|
|
} else { |
3815
|
|
|
|
|
|
|
print STDERR "Journal has no mood set\n"; |
3816
|
|
|
|
|
|
|
} |
3817
|
|
|
|
|
|
|
|
3818
|
|
|
|
|
|
|
|
3819
|
|
|
|
|
|
|
=cut |
3820
|
|
|
|
|
|
|
sub Getprop_current_mood($$) { |
3821
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3822
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3823
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"current_mood","Getprop_current_mood","char"); |
3824
|
|
|
|
|
|
|
} |
3825
|
|
|
|
|
|
|
|
3826
|
|
|
|
|
|
|
=pod |
3827
|
|
|
|
|
|
|
|
3828
|
|
|
|
|
|
|
=item $lj->Getprop_current_mood_id($event) |
3829
|
|
|
|
|
|
|
|
3830
|
|
|
|
|
|
|
Used to get the current mood_id for the journal being written. Will return |
3831
|
|
|
|
|
|
|
the mood_id if one is set, a null string is one is not set and C in |
3832
|
|
|
|
|
|
|
the event of an error. |
3833
|
|
|
|
|
|
|
|
3834
|
|
|
|
|
|
|
Example code: |
3835
|
|
|
|
|
|
|
|
3836
|
|
|
|
|
|
|
my $prop=$lj->Getprop_current_mood_id(\%Event); |
3837
|
|
|
|
|
|
|
(defined $prop) || |
3838
|
|
|
|
|
|
|
die "$0: Failed to get property - $LJ::Simple::error\n"; |
3839
|
|
|
|
|
|
|
if ($prop ne "") { |
3840
|
|
|
|
|
|
|
print STDERR "Journal has mood_id of $prop\n"; |
3841
|
|
|
|
|
|
|
} else { |
3842
|
|
|
|
|
|
|
print STDERR "Journal has no mood_id set\n"; |
3843
|
|
|
|
|
|
|
} |
3844
|
|
|
|
|
|
|
|
3845
|
|
|
|
|
|
|
|
3846
|
|
|
|
|
|
|
=cut |
3847
|
|
|
|
|
|
|
sub Getprop_current_mood_id($$) { |
3848
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3849
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3850
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"current_moodid","Getprop_current_mood_id","num"); |
3851
|
|
|
|
|
|
|
} |
3852
|
|
|
|
|
|
|
|
3853
|
|
|
|
|
|
|
|
3854
|
|
|
|
|
|
|
=pod |
3855
|
|
|
|
|
|
|
|
3856
|
|
|
|
|
|
|
=item $lj->Getprop_current_music($event) |
3857
|
|
|
|
|
|
|
|
3858
|
|
|
|
|
|
|
Used to get the current music for the journal entry being written. Returns |
3859
|
|
|
|
|
|
|
the music if one is set, a null string is one is not set and C in |
3860
|
|
|
|
|
|
|
the event of an error. |
3861
|
|
|
|
|
|
|
|
3862
|
|
|
|
|
|
|
Example code: |
3863
|
|
|
|
|
|
|
|
3864
|
|
|
|
|
|
|
my $prop=$lj->Getprop_current_music(\%Event); |
3865
|
|
|
|
|
|
|
(defined $prop) || |
3866
|
|
|
|
|
|
|
die "$0: Failed to get property - $LJ::Simple::error\n"; |
3867
|
|
|
|
|
|
|
if ($prop) { |
3868
|
|
|
|
|
|
|
print STDERR "Journal has the following music: $prop\n"; |
3869
|
|
|
|
|
|
|
} else { |
3870
|
|
|
|
|
|
|
print STDERR "Journal has no music set for it\n"; |
3871
|
|
|
|
|
|
|
} |
3872
|
|
|
|
|
|
|
|
3873
|
|
|
|
|
|
|
=cut |
3874
|
|
|
|
|
|
|
sub Getprop_current_music($$) { |
3875
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3876
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3877
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"current_music","Getprop_current_music","char"); |
3878
|
|
|
|
|
|
|
} |
3879
|
|
|
|
|
|
|
|
3880
|
|
|
|
|
|
|
=pod |
3881
|
|
|
|
|
|
|
|
3882
|
|
|
|
|
|
|
=item $lj->Getprop_preformatted($event) |
3883
|
|
|
|
|
|
|
|
3884
|
|
|
|
|
|
|
Used to see if the text for the journal entry being written is preformatted in HTML |
3885
|
|
|
|
|
|
|
or not. This returns true (C<1>) if so, false (C<0>) if not. |
3886
|
|
|
|
|
|
|
|
3887
|
|
|
|
|
|
|
Example code: |
3888
|
|
|
|
|
|
|
|
3889
|
|
|
|
|
|
|
$lj->Getprop_preformatted(\%Event) && |
3890
|
|
|
|
|
|
|
print "Journal entry is preformatted\n"; |
3891
|
|
|
|
|
|
|
|
3892
|
|
|
|
|
|
|
=cut |
3893
|
|
|
|
|
|
|
sub Getprop_preformatted($$) { |
3894
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3895
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3896
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"opt_preformatted","Getprop_preformatted","bool"); |
3897
|
|
|
|
|
|
|
} |
3898
|
|
|
|
|
|
|
|
3899
|
|
|
|
|
|
|
|
3900
|
|
|
|
|
|
|
=pod |
3901
|
|
|
|
|
|
|
|
3902
|
|
|
|
|
|
|
=item $lj->Getprop_nocomments($event) |
3903
|
|
|
|
|
|
|
|
3904
|
|
|
|
|
|
|
Used to see if the journal entry being written can be commented on or not. |
3905
|
|
|
|
|
|
|
This returns true (C<1>) if so, false (C<0>) if not. |
3906
|
|
|
|
|
|
|
|
3907
|
|
|
|
|
|
|
Example code: |
3908
|
|
|
|
|
|
|
|
3909
|
|
|
|
|
|
|
$lj->Getprop_nocomments(\%Event) && |
3910
|
|
|
|
|
|
|
print "Journal entry set to disallow comments\n"; |
3911
|
|
|
|
|
|
|
|
3912
|
|
|
|
|
|
|
=cut |
3913
|
|
|
|
|
|
|
sub Getprop_nocomments($$) { |
3914
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3915
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3916
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"opt_nocomments","Getprop_nocomments","bool"); |
3917
|
|
|
|
|
|
|
} |
3918
|
|
|
|
|
|
|
|
3919
|
|
|
|
|
|
|
|
3920
|
|
|
|
|
|
|
=pod |
3921
|
|
|
|
|
|
|
|
3922
|
|
|
|
|
|
|
=item $lj->Getprop_picture_keyword($event) |
3923
|
|
|
|
|
|
|
|
3924
|
|
|
|
|
|
|
Used to get the picture keyword for the journal entry being written. Returns |
3925
|
|
|
|
|
|
|
the picture keyword if one is set, a null string is one is not set and C in |
3926
|
|
|
|
|
|
|
the event of an error. |
3927
|
|
|
|
|
|
|
|
3928
|
|
|
|
|
|
|
Example code: |
3929
|
|
|
|
|
|
|
|
3930
|
|
|
|
|
|
|
my $prop=$lj->Getprop_picture_keyword(\%Event); |
3931
|
|
|
|
|
|
|
(defined $prop) || |
3932
|
|
|
|
|
|
|
die "$0: Failed to get property - $LJ::Simple::error\n"; |
3933
|
|
|
|
|
|
|
if ($prop) { |
3934
|
|
|
|
|
|
|
print STDERR "Journal has picture keyword $prop set\n"; |
3935
|
|
|
|
|
|
|
} else { |
3936
|
|
|
|
|
|
|
print STDERR "Journal has no picture keyword set\n"; |
3937
|
|
|
|
|
|
|
} |
3938
|
|
|
|
|
|
|
|
3939
|
|
|
|
|
|
|
|
3940
|
|
|
|
|
|
|
=cut |
3941
|
|
|
|
|
|
|
sub Getprop_picture_keyword($$) { |
3942
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3943
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3944
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"picture_keyword","Getprop_picture_keyword","char"); |
3945
|
|
|
|
|
|
|
} |
3946
|
|
|
|
|
|
|
|
3947
|
|
|
|
|
|
|
|
3948
|
|
|
|
|
|
|
=pod |
3949
|
|
|
|
|
|
|
|
3950
|
|
|
|
|
|
|
=item $lj->Getprop_noemail($event) |
3951
|
|
|
|
|
|
|
|
3952
|
|
|
|
|
|
|
Used to see if comments on the journal entry being written should be emailed or |
3953
|
|
|
|
|
|
|
not. This returns true (C<1>) if so comments should B be emailed and false |
3954
|
|
|
|
|
|
|
(C<0>) if they should be emailed. |
3955
|
|
|
|
|
|
|
|
3956
|
|
|
|
|
|
|
Example code: |
3957
|
|
|
|
|
|
|
|
3958
|
|
|
|
|
|
|
$lj->Getprop_noemail(\%Event) && |
3959
|
|
|
|
|
|
|
print "Comments to journal entry not emailed\n"; |
3960
|
|
|
|
|
|
|
|
3961
|
|
|
|
|
|
|
=cut |
3962
|
|
|
|
|
|
|
sub Getprop_noemail($$) { |
3963
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3964
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3965
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"opt_noemail","Getprop_noemail","bool"); |
3966
|
|
|
|
|
|
|
} |
3967
|
|
|
|
|
|
|
|
3968
|
|
|
|
|
|
|
|
3969
|
|
|
|
|
|
|
=pod |
3970
|
|
|
|
|
|
|
|
3971
|
|
|
|
|
|
|
=item $lj->Getprop_unknown8bit($event) |
3972
|
|
|
|
|
|
|
|
3973
|
|
|
|
|
|
|
Used see if there is 8-bit data which is not in UTF-8 in the journal entry |
3974
|
|
|
|
|
|
|
being written. This returns true (C<1>) if so, false (C<0>) if not. |
3975
|
|
|
|
|
|
|
|
3976
|
|
|
|
|
|
|
Example code: |
3977
|
|
|
|
|
|
|
|
3978
|
|
|
|
|
|
|
$lj->Getprop_unknown8bit(\%Event) && |
3979
|
|
|
|
|
|
|
print "Journal entry contains 8-bit data not in UTF-8 format\n"; |
3980
|
|
|
|
|
|
|
|
3981
|
|
|
|
|
|
|
=cut |
3982
|
|
|
|
|
|
|
sub Getprop_unknown8bit($$) { |
3983
|
0
|
|
|
0
|
1
|
0
|
my ($self,$event)=@_; |
3984
|
0
|
|
|
|
|
0
|
$LJ::Simple::error=""; |
3985
|
0
|
|
|
|
|
0
|
return $self->Getprop_general($event,"unknown8bit","Getprop_unknown8bit","bool"); |
3986
|
|
|
|
|
|
|
} |
3987
|
|
|
|
|
|
|
|
3988
|
|
|
|
|
|
|
|
3989
|
|
|
|
|
|
|
|
3990
|
|
|
|
|
|
|
##### Start of helper functions |
3991
|
|
|
|
|
|
|
|
3992
|
|
|
|
|
|
|
## |
3993
|
|
|
|
|
|
|
## A helper function which takes a key and value pair; |
3994
|
|
|
|
|
|
|
## both are encoded for HTTP transit. |
3995
|
|
|
|
|
|
|
## |
3996
|
|
|
|
|
|
|
sub EncVal($$) { |
3997
|
30
|
|
|
30
|
0
|
48
|
my ($key,$val)=@_; |
3998
|
30
|
50
|
|
|
|
54
|
(defined $key) || ($key=""); |
3999
|
30
|
50
|
|
|
|
50
|
(defined $val) || ($val=""); |
4000
|
30
|
|
|
|
|
85
|
$key=~s/([^a-z0-9])/sprintf("%%%x",ord($1))/egsi; |
|
12
|
|
|
|
|
64
|
|
4001
|
30
|
|
|
|
|
47
|
$key=~s/ /\+/go; |
4002
|
30
|
|
|
|
|
52
|
$val=~s/([^a-z0-9])/sprintf("%%%02x",ord($1))/egsi; |
|
40
|
|
|
|
|
131
|
|
4003
|
30
|
|
|
|
|
41
|
$val=~s/ /\+/go; |
4004
|
30
|
|
|
|
|
101
|
return "$key=$val"; |
4005
|
|
|
|
|
|
|
} |
4006
|
|
|
|
|
|
|
|
4007
|
|
|
|
|
|
|
## |
4008
|
|
|
|
|
|
|
## A helper function which takes an encoded value from HTTP |
4009
|
|
|
|
|
|
|
## transit and decodes it |
4010
|
|
|
|
|
|
|
## |
4011
|
|
|
|
|
|
|
sub DecVal($) { |
4012
|
28
|
|
|
28
|
0
|
42
|
my ($val)=@_; |
4013
|
28
|
50
|
|
|
|
56
|
(defined $val) || ($val=""); |
4014
|
28
|
|
|
|
|
69
|
$val=~s/\+/ /go; |
4015
|
28
|
|
|
|
|
38
|
$val=~s/%([0-9A-F]{2})/pack("C", hex($1))/egsi; |
|
0
|
|
|
|
|
0
|
|
4016
|
28
|
|
|
|
|
157
|
return "$val"; |
4017
|
|
|
|
|
|
|
} |
4018
|
|
|
|
|
|
|
|
4019
|
|
|
|
|
|
|
## |
4020
|
|
|
|
|
|
|
## Actually make the LJ request; could be called directly, but isn't |
4021
|
|
|
|
|
|
|
## documented. |
4022
|
|
|
|
|
|
|
## |
4023
|
|
|
|
|
|
|
## The first argument is the the mode to use. The list of currently |
4024
|
|
|
|
|
|
|
## supported modes is: |
4025
|
|
|
|
|
|
|
## o login |
4026
|
|
|
|
|
|
|
## o postevent |
4027
|
|
|
|
|
|
|
## |
4028
|
|
|
|
|
|
|
## The second argument is a hash reference to arguments specific to the |
4029
|
|
|
|
|
|
|
## mode. |
4030
|
|
|
|
|
|
|
## |
4031
|
|
|
|
|
|
|
## The third argument is a reference to a hash which contain the response |
4032
|
|
|
|
|
|
|
## from the LJ server. This can be undef. |
4033
|
|
|
|
|
|
|
## |
4034
|
|
|
|
|
|
|
## Returns 1 on success, 0 on failure. On failure $LJ::Simple::error is |
4035
|
|
|
|
|
|
|
## populated. |
4036
|
|
|
|
|
|
|
## |
4037
|
|
|
|
|
|
|
sub SendRequest($$$$) { |
4038
|
10
|
|
|
10
|
0
|
23
|
my ($self,$mode,$args,$req_hash)=@_; |
4039
|
10
|
|
|
|
|
13
|
$LJ::Simple::error=""; |
4040
|
10
|
|
|
|
|
13
|
my $sub=$LJ::Simple::NonBlock; |
4041
|
10
|
|
|
|
|
12
|
my $bytes_in=0; |
4042
|
10
|
|
|
|
|
11
|
my $bytes_out=0; |
4043
|
10
|
|
|
|
|
19
|
my $timestart=time(); |
4044
|
10
|
50
|
33
|
|
|
27
|
if ((defined $sub) && (ref($sub) ne "CODE")) { |
4045
|
0
|
|
|
|
|
0
|
my $reftype=ref($sub); |
4046
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="\$LJ::Simple::NonBlock given a $reftype reference, not CODE"; |
4047
|
0
|
|
|
|
|
0
|
return 0; |
4048
|
|
|
|
|
|
|
} |
4049
|
10
|
|
|
|
|
21
|
$self->{request}={}; |
4050
|
10
|
50
|
66
|
|
|
133
|
if ((ref($args) ne "HASH")&&($mode ne "getchallenge")) { |
4051
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: SendRequest() not given hashref for arguments"; |
4052
|
0
|
|
|
|
|
0
|
return 0; |
4053
|
|
|
|
|
|
|
} |
4054
|
10
|
50
|
66
|
|
|
44
|
if ((defined $req_hash) && (ref($req_hash) ne "HASH")) { |
4055
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: SendRequest() not given hashref for responses"; |
4056
|
0
|
|
|
|
|
0
|
return 0; |
4057
|
|
|
|
|
|
|
} |
4058
|
10
|
|
|
|
|
19
|
$mode=lc($mode); |
4059
|
10
|
|
|
|
|
82
|
my @request=( |
4060
|
|
|
|
|
|
|
"mode=$mode", |
4061
|
|
|
|
|
|
|
); |
4062
|
10
|
100
|
|
|
|
23
|
if ($mode ne "getchallenge") { |
4063
|
5
|
|
|
|
|
22
|
push(@request, |
4064
|
|
|
|
|
|
|
EncVal("user",$self->{auth}->{user}), |
4065
|
|
|
|
|
|
|
); |
4066
|
|
|
|
|
|
|
# Much fun here - see if we use the challenge-response stuff |
4067
|
5
|
50
|
|
|
|
13
|
if ($LJ::Simple::challenge) { |
4068
|
5
|
|
|
|
|
11
|
Debug("Trying to use challenge-response system"); |
4069
|
5
|
|
|
|
|
15
|
Debug(" Getting new challenge"); |
4070
|
5
|
|
|
|
|
11
|
my %chall=(); |
4071
|
5
|
100
|
|
|
|
42
|
$self->SendRequest("getchallenge",undef,\%chall) || return 0; |
4072
|
4
|
50
|
|
|
|
17
|
if ($chall{auth_scheme} ne "c0") { |
4073
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Server returned unsupported auth_scheme \"$chall{auth_scheme}\""; |
4074
|
0
|
|
|
|
|
0
|
return 0; |
4075
|
|
|
|
|
|
|
} |
4076
|
4
|
|
|
|
|
15
|
Debug(" Got challenge from server:"); |
4077
|
4
|
|
|
|
|
24
|
Debug(" challenge: $chall{challenge}"); |
4078
|
4
|
|
|
|
|
23
|
Debug(" expire_time: $chall{expire_time}"); |
4079
|
4
|
|
|
|
|
17
|
Debug(" server_time: $chall{server_time}"); |
4080
|
|
|
|
|
|
|
|
4081
|
|
|
|
|
|
|
# Work out our own timeout point, basically the livetime of the |
4082
|
|
|
|
|
|
|
# challenge less 10 seconds of fudge factor. |
4083
|
4
|
|
|
|
|
17
|
my $chall_livetime=$chall{expire_time} - $chall{server_time} - 10; |
4084
|
4
|
|
|
|
|
8
|
my $ctime=time(); |
4085
|
4
|
|
|
|
|
18
|
$self->{auth}->{challenge}->{timeout}=$ctime + $chall_livetime; |
4086
|
4
|
|
|
|
|
13
|
Debug(" Challenge lifetime is $chall_livetime seconds"); |
4087
|
4
|
|
|
|
|
14
|
Debug(" Current: $ctime"); |
4088
|
4
|
|
|
|
|
20
|
Debug(" Expire: $self->{auth}->{challenge}->{timeout}"); |
4089
|
|
|
|
|
|
|
|
4090
|
4
|
|
|
|
|
15
|
$self->{auth}->{challenge}->{challenge}=$chall{challenge}; |
4091
|
|
|
|
|
|
|
# We assume that the Digest::MD5 module is loaded already; also |
4092
|
|
|
|
|
|
|
# means that we have an MD5 hash of the password to hand. |
4093
|
4
|
|
|
|
|
49
|
my $md5=Digest::MD5->new; |
4094
|
4
|
|
|
|
|
33
|
$md5->add($chall{challenge}); |
4095
|
4
|
|
|
|
|
19
|
$md5->add($self->{auth}->{hash}); |
4096
|
4
|
|
|
|
|
48
|
$self->{auth}->{challenge}->{hash}=$md5->hexdigest; |
4097
|
|
|
|
|
|
|
} |
4098
|
4
|
50
|
|
|
|
15
|
if (exists $self->{auth}->{challenge}->{hash}) { |
4099
|
4
|
|
|
|
|
17
|
push(@request, |
4100
|
|
|
|
|
|
|
EncVal("auth_method","challenge"), |
4101
|
|
|
|
|
|
|
EncVal("auth_challenge",$self->{auth}->{challenge}->{challenge}), |
4102
|
|
|
|
|
|
|
EncVal("auth_response",$self->{auth}->{challenge}->{hash}), |
4103
|
|
|
|
|
|
|
); |
4104
|
|
|
|
|
|
|
} else { |
4105
|
0
|
0
|
|
|
|
0
|
if (exists $self->{auth}->{hash}) { |
4106
|
0
|
|
|
|
|
0
|
push(@request,EncVal("hpassword",$self->{auth}->{hash})); |
4107
|
|
|
|
|
|
|
} else { |
4108
|
0
|
|
|
|
|
0
|
push(@request,EncVal("password",$self->{auth}->{pass})); |
4109
|
|
|
|
|
|
|
} |
4110
|
|
|
|
|
|
|
} |
4111
|
4
|
|
|
|
|
10
|
my $ljprotver=0; |
4112
|
4
|
50
|
|
|
|
10
|
if ($LJ::Simple::UTF) { $ljprotver=1; } |
|
4
|
|
|
|
|
6
|
|
4113
|
4
|
|
|
|
|
12
|
push(@request, |
4114
|
|
|
|
|
|
|
"ver=$ljprotver", |
4115
|
|
|
|
|
|
|
); |
4116
|
|
|
|
|
|
|
} |
4117
|
9
|
50
|
|
|
|
23
|
(defined $sub) && &{$sub}($mode,0.1,"Preparing request data",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4118
|
9
|
100
|
33
|
|
|
146
|
if ($mode eq "login") { |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4119
|
4
|
|
|
|
|
15
|
push(@request,EncVal("clientversion","Perl-LJ::Simple/$VERSION")); |
4120
|
4
|
100
|
66
|
|
|
30
|
if ((exists $args->{moods}) && ($args->{moods} == 1)) { |
4121
|
3
|
|
|
|
|
7
|
push(@request,EncVal("getmoods",0)); |
4122
|
|
|
|
|
|
|
} |
4123
|
4
|
100
|
66
|
|
|
26
|
if ((exists $args->{getpickws}) && ($args->{getpickws} == 1)) { |
4124
|
3
|
|
|
|
|
7
|
push(@request,EncVal("getpickws",1)); |
4125
|
3
|
|
|
|
|
9
|
push(@request,EncVal("getpickwurls",1)); |
4126
|
|
|
|
|
|
|
} |
4127
|
|
|
|
|
|
|
} elsif ( ($mode eq "postevent") |
4128
|
|
|
|
|
|
|
|| ($mode eq "editevent") |
4129
|
|
|
|
|
|
|
|| ($mode eq "syncitems") |
4130
|
|
|
|
|
|
|
|| ($mode eq "getevents") |
4131
|
|
|
|
|
|
|
|| ($mode eq "getfriends") |
4132
|
|
|
|
|
|
|
|| ($mode eq "friendof") |
4133
|
|
|
|
|
|
|
|| ($mode eq "checkfriends") |
4134
|
|
|
|
|
|
|
|| ($mode eq "getdaycounts") |
4135
|
|
|
|
|
|
|
|| ($mode eq "getfriendgroups") |
4136
|
|
|
|
|
|
|
|| ($mode eq "getusertags") |
4137
|
|
|
|
|
|
|
) { |
4138
|
0
|
0
|
|
|
|
0
|
if (defined $args) { |
4139
|
0
|
|
|
|
|
0
|
my ($k,$v); |
4140
|
0
|
|
|
|
|
0
|
while(($k,$v)=each %{$args}) { |
|
0
|
|
|
|
|
0
|
|
4141
|
0
|
0
|
|
|
|
0
|
if (!defined $k) { |
4142
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: SendRequest() given undefined key value"; |
4143
|
0
|
|
|
|
|
0
|
return 0; |
4144
|
|
|
|
|
|
|
} |
4145
|
0
|
0
|
|
|
|
0
|
if (!defined $v) { |
4146
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="CODE: SendRequest() given undefined value for \"$k\""; |
4147
|
0
|
|
|
|
|
0
|
return 0; |
4148
|
|
|
|
|
|
|
} |
4149
|
0
|
|
|
|
|
0
|
push(@request,EncVal($k,$v)); |
4150
|
|
|
|
|
|
|
} |
4151
|
|
|
|
|
|
|
} |
4152
|
|
|
|
|
|
|
} elsif ($mode eq "getchallenge") { |
4153
|
|
|
|
|
|
|
# NOP - nothing required |
4154
|
|
|
|
|
|
|
} else { |
4155
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="INTERNAL: SendRequest() given unsupported mode \"$mode\""; |
4156
|
0
|
|
|
|
|
0
|
return 0; |
4157
|
|
|
|
|
|
|
} |
4158
|
9
|
|
|
|
|
41
|
my $req=join("&",@request); |
4159
|
9
|
|
|
|
|
12
|
my $ContLen=length($req); |
4160
|
|
|
|
|
|
|
|
4161
|
9
|
50
|
|
|
|
25
|
(defined $sub) && &{$sub}($mode,0.2,"Preparing connection to server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4162
|
|
|
|
|
|
|
|
4163
|
|
|
|
|
|
|
## Now we've got the request ready, time to start talking to the web |
4164
|
|
|
|
|
|
|
# Work out where we're talking to and the URI to do it with |
4165
|
9
|
|
|
|
|
29
|
my $server=$self->{lj}->{host}; |
4166
|
9
|
|
|
|
|
14
|
my $host=$server; |
4167
|
9
|
|
|
|
|
17
|
my $port=$self->{lj}->{port}; |
4168
|
9
|
|
|
|
|
15
|
my $uri="/interface/flat"; |
4169
|
9
|
50
|
|
|
|
31
|
if (defined $self->{proxy}) { |
4170
|
0
|
|
|
|
|
0
|
$uri="http://$server:$port$uri"; |
4171
|
0
|
|
|
|
|
0
|
$server=$self->{proxy}->{host}; |
4172
|
0
|
|
|
|
|
0
|
$port=$self->{proxy}->{port}; |
4173
|
|
|
|
|
|
|
} |
4174
|
|
|
|
|
|
|
|
4175
|
|
|
|
|
|
|
# Prepare the HTTP request now we've got the URI |
4176
|
9
|
|
|
|
|
62
|
my @HTTP=( |
4177
|
|
|
|
|
|
|
"POST $uri HTTP/1.0", |
4178
|
|
|
|
|
|
|
"Host: $host", |
4179
|
|
|
|
|
|
|
"Content-type: application/x-www-form-urlencoded", |
4180
|
|
|
|
|
|
|
"User-Agent: LJ::Simple/$VERSION; http://www.bpfh.net/computing/software/LJ::Simple/; lj-simple\@bpfh.net", |
4181
|
|
|
|
|
|
|
"Content-length: $ContLen", |
4182
|
|
|
|
|
|
|
); |
4183
|
9
|
50
|
|
|
|
29
|
if ($self->{fastserver}) { |
4184
|
0
|
|
|
|
|
0
|
push(@HTTP,"Cookie: ljfastserver=1"); |
4185
|
|
|
|
|
|
|
} |
4186
|
9
|
|
|
|
|
19
|
push(@HTTP, |
4187
|
|
|
|
|
|
|
"", |
4188
|
|
|
|
|
|
|
$req, |
4189
|
|
|
|
|
|
|
"", |
4190
|
|
|
|
|
|
|
); |
4191
|
|
|
|
|
|
|
|
4192
|
|
|
|
|
|
|
# Prepare the socket |
4193
|
9
|
|
|
|
|
1992
|
my $tcp_proto=getprotobyname("tcp"); |
4194
|
9
|
|
|
|
|
327
|
socket(SOCK,PF_INET,SOCK_STREAM,$tcp_proto); |
4195
|
|
|
|
|
|
|
|
4196
|
|
|
|
|
|
|
# Resolve the server name we're connecting to |
4197
|
9
|
50
|
|
|
|
27
|
(defined $sub) && &{$sub}($mode,0.3,"Starting to resolve $server to IP address",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4198
|
9
|
|
|
|
|
124877
|
my $addr=inet_aton($server); |
4199
|
9
|
50
|
|
|
|
72
|
if (!defined $addr) { |
4200
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to resolve server $server"; |
4201
|
0
|
|
|
|
|
0
|
return 0; |
4202
|
|
|
|
|
|
|
} |
4203
|
9
|
|
|
|
|
81
|
my $sin=sockaddr_in($port,$addr); |
4204
|
|
|
|
|
|
|
|
4205
|
9
|
|
|
|
|
290
|
my $ip_addr=join(".",unpack("CCCC",$addr)); |
4206
|
|
|
|
|
|
|
|
4207
|
9
|
|
|
|
|
26
|
my $proto=$LJ::Simple::ProtoSub; |
4208
|
9
|
50
|
|
|
|
29
|
($LJ::Simple::protocol) && &{$proto}(undef,undef,$server,$ip_addr); |
|
0
|
|
|
|
|
0
|
|
4209
|
9
|
50
|
|
|
|
25
|
if ($LJ::Simple::raw_protocol) { |
4210
|
0
|
|
|
|
|
0
|
print STDERR "Connecting to $server [$ip_addr]\n"; |
4211
|
0
|
|
|
|
|
0
|
print STDERR "Lines starting with \"-->\" is data SENT to the server\n"; |
4212
|
0
|
|
|
|
|
0
|
print STDERR "Lines starting with \"<--\" is data RECEIVED from the server\n"; |
4213
|
|
|
|
|
|
|
} |
4214
|
|
|
|
|
|
|
|
4215
|
|
|
|
|
|
|
# Connect to the server |
4216
|
9
|
50
|
|
|
|
25
|
(defined $sub) && &{$sub}($mode,0.4,"Trying to connect to server $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4217
|
9
|
50
|
|
|
|
1266017
|
if (!connect(SOCK,$sin)) { |
4218
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to connect to $server - $!"; |
4219
|
0
|
|
|
|
|
0
|
return 0; |
4220
|
|
|
|
|
|
|
} |
4221
|
|
|
|
|
|
|
|
4222
|
9
|
50
|
|
|
|
55
|
($LJ::Simple::protocol) && &{$proto}(undef,"Connected to $server [$ip_addr]",$server,$ip_addr); |
|
0
|
|
|
|
|
0
|
|
4223
|
9
|
50
|
|
|
|
36
|
($LJ::Simple::raw_protocol) && |
4224
|
|
|
|
|
|
|
print STDERR "Connected to $server [$ip_addr]\n"; |
4225
|
|
|
|
|
|
|
|
4226
|
|
|
|
|
|
|
# Send the HTTP request |
4227
|
9
|
50
|
|
|
|
39
|
(defined $sub) && &{$sub}($mode,0.5,"Starting to send HTTP request to $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4228
|
9
|
|
|
|
|
27
|
my $cp=0.5; |
4229
|
9
|
|
|
|
|
55
|
foreach (@HTTP) { |
4230
|
72
|
|
|
|
|
180
|
my $line="$_\r\n"; |
4231
|
72
|
|
|
|
|
96
|
my $len=length($line); |
4232
|
72
|
|
|
|
|
77
|
my $pos=0; |
4233
|
72
|
|
|
|
|
71
|
my $fail=0; |
4234
|
72
|
|
|
|
|
409
|
while($pos!=$len) { |
4235
|
72
|
|
|
|
|
1216
|
my $nbytes=syswrite(SOCK,$line,$len,$pos); |
4236
|
72
|
50
|
|
|
|
587
|
if (!defined $nbytes) { |
4237
|
0
|
0
|
0
|
|
|
0
|
if ( ($! == EAGAIN) || ($! == EINTR) ) { |
4238
|
0
|
|
|
|
|
0
|
$fail++; |
4239
|
0
|
0
|
|
|
|
0
|
if ($fail>4) { |
4240
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Write to socket failed with EAGAIN/EINTR $fail times"; |
4241
|
0
|
|
|
|
|
0
|
shutdown(SOCK,2); |
4242
|
0
|
|
|
|
|
0
|
close(SOCK); |
4243
|
0
|
|
|
|
|
0
|
return 0; |
4244
|
|
|
|
|
|
|
} |
4245
|
0
|
|
|
|
|
0
|
next; |
4246
|
|
|
|
|
|
|
} else { |
4247
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Write to socket failed - $!"; |
4248
|
0
|
|
|
|
|
0
|
shutdown(SOCK,2); |
4249
|
0
|
|
|
|
|
0
|
close(SOCK); |
4250
|
0
|
|
|
|
|
0
|
return 0; |
4251
|
|
|
|
|
|
|
} |
4252
|
|
|
|
|
|
|
} |
4253
|
72
|
|
|
|
|
326
|
$pos+=$nbytes; |
4254
|
72
|
|
|
|
|
79
|
$bytes_out+=$nbytes; |
4255
|
72
|
|
|
|
|
91
|
$cp=$cp+0.001; |
4256
|
72
|
50
|
|
|
|
241
|
(defined $sub) && &{$sub}($mode,$cp,"Sending HTTP request to $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4257
|
|
|
|
|
|
|
} |
4258
|
72
|
50
|
|
|
|
122
|
($LJ::Simple::protocol) && &{$proto}(0,$_,$server,$ip_addr); |
|
0
|
|
|
|
|
0
|
|
4259
|
72
|
50
|
|
|
|
200
|
($LJ::Simple::raw_protocol) && print STDERR "--> $_\n"; |
4260
|
|
|
|
|
|
|
} |
4261
|
|
|
|
|
|
|
|
4262
|
|
|
|
|
|
|
# Read the response from the server - use select() |
4263
|
9
|
50
|
|
|
|
38
|
(defined $sub) && &{$sub}($mode,0.6,"Getting HTTP response from $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4264
|
9
|
|
|
|
|
15
|
$cp=0.6001; |
4265
|
9
|
|
|
|
|
29
|
my ($rin,$rout,$eout)=("","",""); |
4266
|
9
|
|
|
|
|
114
|
vec($rin,fileno(SOCK),1) = 1; |
4267
|
9
|
|
|
|
|
28
|
my $ein = $rin; |
4268
|
9
|
|
|
|
|
17
|
my $response=""; |
4269
|
9
|
|
|
|
|
19
|
my $done=0; |
4270
|
9
|
|
|
|
|
39
|
while (!$done) { |
4271
|
18
|
|
|
|
|
30
|
my $nfound; |
4272
|
18
|
50
|
|
|
|
51
|
if (defined $sub) { |
4273
|
0
|
|
|
|
|
0
|
$nfound = select($rout=$rin,undef,$eout=$ein,0); |
4274
|
0
|
|
|
|
|
0
|
my $ttaken=time()-$timestart; |
4275
|
0
|
0
|
|
|
|
0
|
if ($nfound!=1) { |
4276
|
0
|
0
|
|
|
|
0
|
if ($ttaken>$LJ::Simple::timeout) { |
4277
|
0
|
|
|
|
|
0
|
&{$sub}($mode,1,"Connection with server $server timed out",$bytes_in,$bytes_out,$ttaken,0); |
|
0
|
|
|
|
|
0
|
|
4278
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to receive data from $server [$ip_addr]"; |
4279
|
0
|
|
|
|
|
0
|
shutdown(SOCK,2); |
4280
|
0
|
|
|
|
|
0
|
close(SOCK); |
4281
|
0
|
|
|
|
|
0
|
return 0; |
4282
|
|
|
|
|
|
|
} |
4283
|
0
|
|
|
|
|
0
|
&{$sub}($mode,$cp,"Waiting for response from $server",$bytes_in,$bytes_out,time()-$timestart,1); |
|
0
|
|
|
|
|
0
|
|
4284
|
0
|
|
|
|
|
0
|
next; |
4285
|
|
|
|
|
|
|
} |
4286
|
|
|
|
|
|
|
} else { |
4287
|
18
|
|
|
|
|
3532566
|
$nfound = select($rout=$rin,undef,$eout=$ein,$LJ::Simple::timeout); |
4288
|
18
|
50
|
|
|
|
112
|
if ($nfound!=1) { |
4289
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to receive data from $server [$ip_addr]"; |
4290
|
0
|
|
|
|
|
0
|
shutdown(SOCK,2); |
4291
|
0
|
|
|
|
|
0
|
close(SOCK); |
4292
|
0
|
|
|
|
|
0
|
return 0; |
4293
|
|
|
|
|
|
|
} |
4294
|
|
|
|
|
|
|
} |
4295
|
18
|
|
|
|
|
40
|
my $resp=""; |
4296
|
18
|
|
|
|
|
250
|
my $nbytes=sysread(SOCK,$resp,$LJ::Simple::buffer); |
4297
|
18
|
50
|
|
|
|
242
|
if (!defined $nbytes) { |
|
|
100
|
|
|
|
|
|
4298
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Error in getting data from $server [$ip_addr] - $!"; |
4299
|
0
|
|
|
|
|
0
|
shutdown(SOCK,2); |
4300
|
0
|
|
|
|
|
0
|
close(SOCK); |
4301
|
0
|
0
|
|
|
|
0
|
(defined $sub) && &{$sub}($mode,1,$LJ::Simple::error,$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4302
|
0
|
|
|
|
|
0
|
return 0; |
4303
|
|
|
|
|
|
|
} elsif ($nbytes==0) { |
4304
|
9
|
|
|
|
|
35
|
$done=1; |
4305
|
|
|
|
|
|
|
} else { |
4306
|
9
|
|
|
|
|
192
|
$bytes_in=$bytes_in+$nbytes; |
4307
|
9
|
50
|
|
|
|
26
|
(defined $sub) && &{$sub}($mode,$cp,"Getting response from server $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4308
|
9
|
|
|
|
|
23
|
$cp=$cp+0.001; |
4309
|
9
|
|
|
|
|
41
|
$response="$response$resp"; |
4310
|
9
|
50
|
|
|
|
77
|
if ($LJ::Simple::raw_protocol) { |
|
|
50
|
|
|
|
|
|
4311
|
0
|
|
|
|
|
0
|
print STDERR "<-- "; |
4312
|
0
|
|
|
|
|
0
|
foreach (split(//,$resp)) { |
4313
|
0
|
|
|
|
|
0
|
s/([\x00-\x20\x7f-\xff])/sprintf("\\%o",ord($1))/ei; |
|
0
|
|
|
|
|
0
|
|
4314
|
0
|
|
|
|
|
0
|
print "$_"; |
4315
|
|
|
|
|
|
|
} |
4316
|
0
|
|
|
|
|
0
|
print STDERR "\n"; |
4317
|
|
|
|
|
|
|
} elsif ($LJ::Simple::protocol) { |
4318
|
0
|
|
|
|
|
0
|
foreach (split(/[\r\n]{1,2}/o,$resp)) { |
4319
|
0
|
|
|
|
|
0
|
&{$proto}(1,$_,$server,$ip_addr); |
|
0
|
|
|
|
|
0
|
|
4320
|
|
|
|
|
|
|
} |
4321
|
|
|
|
|
|
|
} |
4322
|
|
|
|
|
|
|
} |
4323
|
|
|
|
|
|
|
} |
4324
|
9
|
50
|
|
|
|
162
|
(defined $sub) && &{$sub}($mode,0.7,"Finished getting data from server $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4325
|
|
|
|
|
|
|
|
4326
|
|
|
|
|
|
|
# Shutdown the socket |
4327
|
9
|
50
|
|
|
|
739
|
if (!shutdown(SOCK,2)) { |
4328
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to shutdown socket - $!"; |
4329
|
0
|
0
|
|
|
|
0
|
(defined $sub) && &{$sub}($mode,1,$LJ::Simple::error,$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4330
|
0
|
|
|
|
|
0
|
return 0; |
4331
|
|
|
|
|
|
|
} |
4332
|
|
|
|
|
|
|
|
4333
|
|
|
|
|
|
|
# Close the socket |
4334
|
9
|
|
|
|
|
208
|
close(SOCK); |
4335
|
|
|
|
|
|
|
|
4336
|
9
|
50
|
|
|
|
32
|
(defined $sub) && &{$sub}($mode,0.8,"Parsing data from server $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4337
|
|
|
|
|
|
|
## We've got the response from the server, so we now parse it |
4338
|
9
|
50
|
|
|
|
27
|
if (!defined $response) { |
4339
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to get result from server"; |
4340
|
0
|
|
|
|
|
0
|
return 0; |
4341
|
|
|
|
|
|
|
} |
4342
|
|
|
|
|
|
|
|
4343
|
|
|
|
|
|
|
## Ensure that response isn't zero length |
4344
|
9
|
50
|
|
|
|
37
|
if (length($response) == 0) { |
4345
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Zero length response from server"; |
4346
|
0
|
0
|
|
|
|
0
|
(defined $sub) && &{$sub}($mode,1,"$LJ::Simple::error $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4347
|
0
|
|
|
|
|
0
|
return 0; |
4348
|
|
|
|
|
|
|
} |
4349
|
|
|
|
|
|
|
|
4350
|
|
|
|
|
|
|
# Split into headers and body |
4351
|
9
|
|
|
|
|
96
|
my ($http,$body)=split(/\r\n\r\n/,$response,2); |
4352
|
|
|
|
|
|
|
|
4353
|
9
|
50
|
|
|
|
37
|
if (!defined $http) { |
4354
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to get HTTP headers from server"; |
4355
|
0
|
0
|
|
|
|
0
|
(defined $sub) && &{$sub}($mode,1,"$LJ::Simple::error $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4356
|
0
|
|
|
|
|
0
|
return 0; |
4357
|
|
|
|
|
|
|
} |
4358
|
9
|
50
|
|
|
|
27
|
if (!defined $body) { |
4359
|
0
|
|
|
|
|
0
|
$LJ::Simple::error="Failed to get HTTP body from server"; |
4360
|
0
|
0
|
|
|
|
0
|
(defined $sub) && &{$sub}($mode,1,"$LJ::Simple::error $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4361
|
0
|
|
|
|
|
0
|
return 0; |
4362
|
|
|
|
|
|
|
} |
4363
|
|
|
|
|
|
|
|
4364
|
|
|
|
|
|
|
# First lets see if we got a valid response |
4365
|
9
|
|
|
|
|
104
|
$self->{request}->{http}={}; |
4366
|
9
|
|
|
|
|
178
|
$self->{request}->{http}->{headers}=[(split(/\r\n/,$http))]; |
4367
|
9
|
|
|
|
|
39
|
my $srv_resp=$self->{request}->{http}->{headers}->[0]; |
4368
|
9
|
|
|
|
|
136
|
$srv_resp=~/^HTTP\/[^\s]+\s([0-9]+)\s+(.*)/; |
4369
|
9
|
|
|
|
|
51
|
my ($srv_code,$srv_msg)=($1,$2); |
4370
|
9
|
|
|
|
|
34
|
$self->{request}->{http}->{code}=$srv_code; |
4371
|
9
|
|
|
|
|
28
|
$self->{request}->{http}->{msg}=$srv_msg; |
4372
|
9
|
100
|
|
|
|
35
|
if ($srv_code != 200) { |
4373
|
1
|
|
|
|
|
4
|
$LJ::Simple::error="HTTP request failed with $srv_code $srv_msg"; |
4374
|
1
|
|
|
|
|
60
|
return 0; |
4375
|
|
|
|
|
|
|
} |
4376
|
|
|
|
|
|
|
|
4377
|
|
|
|
|
|
|
# We did, so lets pull in the LJ stuff for processing |
4378
|
8
|
|
|
|
|
31
|
$self->{request}->{lj}={}; |
4379
|
|
|
|
|
|
|
|
4380
|
|
|
|
|
|
|
# The response from LJ takes the form of a key\nvalue\n |
4381
|
|
|
|
|
|
|
# Note that the value can be null tho |
4382
|
8
|
|
|
|
|
30
|
$done=0; |
4383
|
8
|
|
|
|
|
34
|
while (!$done) { |
4384
|
36
|
100
|
|
|
|
161
|
if ($body=~/^([^\n]+)\n([^\n]*)\n(.*)$/so) { |
4385
|
28
|
|
|
|
|
62
|
my ($k,$v)=(undef,undef); |
4386
|
28
|
|
|
|
|
108
|
($k,$v,$body)=(lc($1),DecVal($2),$3); |
4387
|
28
|
|
|
|
|
57
|
$v=~s/\r\n/\n/go; |
4388
|
28
|
|
|
|
|
105
|
$self->{request}->{lj}->{$k}=$v; |
4389
|
|
|
|
|
|
|
} else { |
4390
|
8
|
|
|
|
|
28
|
$done=1; |
4391
|
|
|
|
|
|
|
} |
4392
|
|
|
|
|
|
|
} |
4393
|
|
|
|
|
|
|
|
4394
|
|
|
|
|
|
|
# Got it into a hash - lets see if we made a successful request |
4395
|
8
|
100
|
66
|
|
|
155
|
if ( (!exists $self->{request}->{lj}->{success}) || |
4396
|
|
|
|
|
|
|
($self->{request}->{lj}->{success} ne "OK") ) { |
4397
|
4
|
|
|
|
|
9
|
my $errmsg="Server Error, try again later"; |
4398
|
4
|
50
|
|
|
|
20
|
if (exists $self->{request}->{lj}->{errmsg}) { |
4399
|
4
|
|
|
|
|
11
|
$errmsg=$self->{request}->{lj}->{errmsg}; |
4400
|
|
|
|
|
|
|
} |
4401
|
4
|
|
|
|
|
13
|
$LJ::Simple::error="LJ request failed: $errmsg"; |
4402
|
4
|
50
|
|
|
|
10
|
(defined $sub) && &{$sub}($mode,1,"$LJ::Simple::error $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4403
|
4
|
|
|
|
|
126
|
return 0; |
4404
|
|
|
|
|
|
|
} |
4405
|
|
|
|
|
|
|
|
4406
|
|
|
|
|
|
|
# We did! |
4407
|
|
|
|
|
|
|
# Now to populate the hash we were given (if asked to) |
4408
|
4
|
50
|
|
|
|
12
|
if (defined $req_hash) { |
4409
|
4
|
|
|
|
|
5
|
%{$req_hash}=(); |
|
4
|
|
|
|
|
12
|
|
4410
|
4
|
|
|
|
|
6
|
my ($k,$v); |
4411
|
4
|
|
|
|
|
6
|
while(($k,$v)=each %{$self->{request}->{lj}}) { |
|
24
|
|
|
|
|
83
|
|
4412
|
20
|
|
|
|
|
38
|
$req_hash->{$k}=$v; |
4413
|
|
|
|
|
|
|
} |
4414
|
|
|
|
|
|
|
} |
4415
|
|
|
|
|
|
|
|
4416
|
4
|
50
|
|
|
|
15
|
(defined $sub) && &{$sub}($mode,1,"Finished processing request to server $server",$bytes_in,$bytes_out,time()-$timestart,0); |
|
0
|
|
|
|
|
0
|
|
4417
|
4
|
|
|
|
|
39
|
return 1; |
4418
|
|
|
|
|
|
|
} |
4419
|
|
|
|
|
|
|
|
4420
|
|
|
|
|
|
|
## |
4421
|
|
|
|
|
|
|
## Output debugging info |
4422
|
|
|
|
|
|
|
## |
4423
|
|
|
|
|
|
|
sub Debug(@) { |
4424
|
60
|
50
|
|
60
|
0
|
152
|
($LJ::Simple::debug) || return; |
4425
|
0
|
|
|
|
|
0
|
my $msg=join("",@_); |
4426
|
0
|
|
|
|
|
0
|
foreach (split(/\n/,$msg)) { |
4427
|
0
|
|
|
|
|
0
|
print STDERR "DEBUG> $_\n"; |
4428
|
|
|
|
|
|
|
} |
4429
|
|
|
|
|
|
|
} |
4430
|
|
|
|
|
|
|
|
4431
|
|
|
|
|
|
|
|
4432
|
|
|
|
|
|
|
## |
4433
|
|
|
|
|
|
|
## Dump out a list recursively. Will call dump_hash |
4434
|
|
|
|
|
|
|
## for any hash references in the list. |
4435
|
|
|
|
|
|
|
## |
4436
|
|
|
|
|
|
|
## Generally used for debugging |
4437
|
|
|
|
|
|
|
## |
4438
|
|
|
|
|
|
|
sub dump_list($$) { |
4439
|
0
|
|
|
0
|
0
|
0
|
my ($lr,$sp)=@_; |
4440
|
0
|
|
|
|
|
0
|
my $le=""; |
4441
|
0
|
|
|
|
|
0
|
my $res=""; |
4442
|
0
|
|
|
|
|
0
|
foreach $le (@{$lr}) { |
|
0
|
|
|
|
|
0
|
|
4443
|
0
|
0
|
|
|
|
0
|
if (ref($le) eq "HASH") { |
|
|
0
|
|
|
|
|
|
4444
|
0
|
|
|
|
|
0
|
$res="$res$sp\{\n"; |
4445
|
0
|
|
|
|
|
0
|
$res=$res . dump_hash($le,"$sp "); |
4446
|
0
|
|
|
|
|
0
|
$res="$res$sp},\n"; |
4447
|
|
|
|
|
|
|
} elsif (ref($le) eq "ARRAY") { |
4448
|
0
|
|
|
|
|
0
|
$res="$res$sp\[\n" . dump_list($le,"$sp ") . "$sp],\n"; |
4449
|
|
|
|
|
|
|
} else { |
4450
|
0
|
|
|
|
|
0
|
my $lv=$le; |
4451
|
0
|
0
|
|
|
|
0
|
if (defined $lv) { |
4452
|
0
|
|
|
|
|
0
|
$lv=~s/\n/\\n/go; |
4453
|
0
|
|
|
|
|
0
|
$lv=quotemeta($lv); |
4454
|
0
|
|
|
|
|
0
|
$lv=~s/\\-/-/go; |
4455
|
0
|
|
|
|
|
0
|
$lv="\"$lv\""; |
4456
|
|
|
|
|
|
|
} else { |
4457
|
0
|
|
|
|
|
0
|
$lv="undef"; |
4458
|
|
|
|
|
|
|
} |
4459
|
0
|
|
|
|
|
0
|
$res="$res$sp$lv,\n"; |
4460
|
|
|
|
|
|
|
} |
4461
|
|
|
|
|
|
|
} |
4462
|
0
|
|
|
|
|
0
|
return $res; |
4463
|
|
|
|
|
|
|
} |
4464
|
|
|
|
|
|
|
|
4465
|
|
|
|
|
|
|
## |
4466
|
|
|
|
|
|
|
## Dump out a hash recursively. Will call dump_list |
4467
|
|
|
|
|
|
|
## for any list references in the hash values. |
4468
|
|
|
|
|
|
|
## |
4469
|
|
|
|
|
|
|
## Generally used for debugging |
4470
|
|
|
|
|
|
|
## |
4471
|
|
|
|
|
|
|
sub dump_hash($$) { |
4472
|
18
|
|
|
18
|
0
|
27
|
my ($hr,$sp)=@_; |
4473
|
18
|
|
|
|
|
23
|
my ($k,$v)=(); |
4474
|
18
|
|
|
|
|
24
|
my $res=""; |
4475
|
18
|
|
|
|
|
23
|
while(($k,$v)=each %{$hr}) { |
|
57
|
|
|
|
|
201
|
|
4476
|
39
|
|
|
|
|
80
|
$k=quotemeta($k); |
4477
|
39
|
|
|
|
|
50
|
$k=~s/\\-/-/go; |
4478
|
39
|
100
|
|
|
|
85
|
if (ref($v) eq "HASH") { |
|
|
50
|
|
|
|
|
|
4479
|
14
|
|
|
|
|
31
|
$res="$res$sp\"$k\"\t=> {\n"; |
4480
|
14
|
|
|
|
|
54
|
$res=$res . dump_hash($v,"$sp "); |
4481
|
14
|
|
|
|
|
36
|
$res="$res$sp},\n"; |
4482
|
|
|
|
|
|
|
} elsif (ref($v) eq "ARRAY") { |
4483
|
0
|
|
|
|
|
0
|
$res="$res$sp\"$k\"\t=> \[\n" . dump_list($v,"$sp ") . "$sp],\n"; |
4484
|
|
|
|
|
|
|
} else { |
4485
|
25
|
100
|
|
|
|
36
|
if (defined $v) { |
4486
|
24
|
|
|
|
|
41
|
$v=~s/\n/\\n/go; |
4487
|
24
|
|
|
|
|
32
|
$v=quotemeta($v); |
4488
|
24
|
|
|
|
|
30
|
$v=~s/\\\\n/\\n/go; |
4489
|
24
|
|
|
|
|
24
|
$v=~s/\\-/-/go; |
4490
|
24
|
|
|
|
|
43
|
$v="\"$v\""; |
4491
|
|
|
|
|
|
|
} else { |
4492
|
1
|
|
|
|
|
3
|
$v="undef"; |
4493
|
|
|
|
|
|
|
} |
4494
|
25
|
|
|
|
|
53
|
my $out="$sp\"$k\"\t=> $v,"; |
4495
|
25
|
|
|
|
|
62
|
$res="$res$out\n"; |
4496
|
|
|
|
|
|
|
} |
4497
|
|
|
|
|
|
|
} |
4498
|
18
|
|
|
|
|
53
|
return $res; |
4499
|
|
|
|
|
|
|
} |
4500
|
|
|
|
|
|
|
|
4501
|
|
|
|
|
|
|
1; |
4502
|
|
|
|
|
|
|
__END__ |