| 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__ |