root/lang/perl/WWW-HatenaDiary/trunk/lib/WWW/HatenaDiary.pm @ 4276

Revision 4276, 8.3 kB (checked in by kentaro, 6 years ago)

lang/perl/WWW-HatenaDiary?: fixed some errorss on the POD and spellings

Line 
1package WWW::HatenaDiary;
2use strict;
3use warnings;
4use Carp;
5use Text::Hatena;
6use Web::Scraper;
7use WWW::Mechanize;
8use JSON::Syck 'Load';
9
10our $VERSION = '0.01';
11
12sub new {
13    my ($class, $args) = @_;
14
15    croak 'Both login_id and login_pw are required'
16        if grep { !$args->{$_} } qw(login_id login_pw);
17
18    my $login_id = $args->{login_id};
19    my $login_pw = $args->{login_pw};
20    my $base     = $args->{group} ? "http://$args->{group}.g.hatena.ne.jp/" : 'http://d.hatena.ne.jp/';
21
22    my $self = bless {
23        base     => $base,
24        mech     => WWW::Mechanize->new,
25        username => $login_id
26    }, $class;
27
28    croak 'Login failed'
29        if !$self->login($login_id, $login_pw) || !($self->{rkm} = $self->get_rkm);
30
31    $self;
32}
33
34sub login {
35    my ($self, $login_id, $login_pw) = @_;
36
37    my $link;
38    $self->{mech}->get('https://www.hatena.ne.jp/login');
39    ($link) = map { $_->url } $self->{mech}->find_link( tag => 'meta' );
40
41    unless ($link) {
42        $self->{mech}->submit_form(
43            fields => +{
44                name     => $login_id,
45                password => $login_pw,
46            }
47        );
48
49        ($link) = map { $_->url } $self->{mech}->find_link( tag => 'meta' );
50    }
51
52    !!$link;
53}
54
55sub get_rkm {
56    my $self = shift;
57    $self->{mech}->get("$self->{base}$self->{username}/?mode=json");
58    Load($self->{mech}->content)->{rkm};
59}
60
61sub create {
62    my ($self, $args) = @_;
63    $self->_post_entry($args);
64}
65
66sub retrieve {
67    my ($self, $args) = @_;
68
69    croak('URI for the entry is required')
70        if !$args->{uri};
71
72    $self->{mech}->get("$args->{uri}?mode=json");
73
74    croak "Request failed: $self->{mech}->status"
75        if !$self->{mech}->success;
76
77    my $entry = Load($self->{mech}->content);
78    if($args->{format}) {
79        $entry->{body} = Text::Hatena->parse($entry->{body});
80    }
81    $entry;
82}
83
84sub retrieve_day {
85    my ($self, $args) = @_;
86    if ($args->{date} =~ /^(\d{4})-(\d{2})-(\d{2})$/) {
87        my ($y, $m, $d) = ($1, $2, $3);
88
89        my $uri = "$self->{base}$self->{username}/edit?date=$y$m$d";
90        $self->{mech}->get($uri);
91        my $form = $self->{mech}->form_name('edit');
92        my $body = $form->value('body');
93        $args->{format} ? Text::Hatena->parse($body) : $body;
94    } else {
95        carp "Invalid ymd format: $args->{date}. YYYY-MM-DD formatted date is required.";
96    }
97}
98
99sub update {
100    my ($self, $args) = @_;
101
102    croak('URI for the entry is required')
103        if !$args->{uri};
104
105    $self->_post_entry($args);
106    $args->{uri};
107}
108
109sub update_day {
110    my ($self, $args) = @_;
111
112    if ($args->{date} =~ /^(\d{4})-(\d{2})-(\d{2})$/) {
113        my ($y, $m, $d) = ($1, $2, $3);
114
115        my $uri = "$self->{base}$self->{username}/edit?date=$y$m$d";
116        $self->{mech}->get($uri);
117        $self->{mech}->submit_form(
118            form_name => 'edit',
119            fields => {
120                body  => $args->{body},
121                year  => $y,
122                month => $m,
123                day   => $d,
124            },
125        );
126    } else {
127        carp "Invalid ymd format: $args->{date}. YYYY-MM-DD formatted date is required.";
128    }
129
130    $self->{mech}->success;
131}
132
133# TODO: implement delete method.
134sub delete {
135    my ($self, $args) = @_;
136
137    croak('URI for the entry is required')
138        if !$args->{uri};
139
140    die "Not implemented yet";
141}
142
143sub delete_day {
144    my ($self, $args) = @_;
145
146    if ($args->{date} =~ /^(\d{4})-(\d{2})-(\d{2})$/) {
147        my ($y, $m, $d) = ($1, $2, $3);
148        my $uri = "$self->{base}$self->{username}/edit?date=$y$m$d";
149        $self->{mech}->get($uri);
150        $self->{mech}->submit_form(form_number => 2);
151    } else {
152        carp "Invalid ymd format: $args->{date}. YYYY-MM-DD formatted date is required.";
153    }
154
155    $self->{mech}->success;
156}
157
158sub _post_entry {
159    my ($self, $args) = @_;
160    my $uri = $args->{uri} || "$self->{base}$self->{username}/";
161
162    $self->{mech}->post($uri, {
163        rkm => $self->{rkm},
164        %$args,
165    });
166
167    croak "Request failed: $self->{mech}->status"
168        if !$self->{mech}->success;
169
170    scraper {
171        process '//div[@class="section"][1]/h3[1]/a[1]', 'uri' => '@href';
172        result 'uri';
173    }->scrape(URI->new($uri));
174}
175
1761;
177
178__END__
179
180=for stopwords aaaatttt dotottto gmail
181
182=head1 NAME
183
184WWW::HatenaDiary - CRUD interface to Hatena::Diary
185
186=head1 SYNOPSIS
187
188  use WWW::HatenaDiary;
189
190  my $diary = WWW::HatenaDiary->new({
191      login_id => $login_id,
192      login_pw => $login_pw,
193  });
194
195  # Create
196  my $edit_uri = $diary->create({
197      title => $title,
198      body  => $body,
199  });
200
201  # Retrieve
202  my $post = $diary->retrieve({
203      uri => $edit_uri,
204  })
205
206  my $day_body = $diary->retrieve_day({
207      date => $date,     # $date must be YYYY-MM-DD formatted string
208  });
209
210  # Update
211  $edit_uri = $diary->update({
212      uri   => $edit_uri,
213      title => $new_title,
214      body  => $new_body,
215  });
216
217  $diary->update_day({
218      date => $date,     # $date must be YYYY-MM-DD formatted string
219      body => $new_body,
220  });
221
222  # Delete
223  $diary->delete({       # not implemented yet
224      uri => $edit_uri,
225  });
226
227  $diary->delete_day({,
228      date => $date,     # $date must be YYYY-MM-DD formatted string
229  });
230
231=head1 DESCRIPTION
232
233WWW::HatenaDiary provides a CRUD interface to Hatena::Diary, aiming to
234help you efficiently communicate with the service with programmatic
235ways.
236
237This module is, so far, for those who want to write some tools not
238only to retrieve data from diaries, but also to create/update/delete
239the posts at the same time. Which is why I adopted the way as if this
240module treats such API like AtomPP, and this module retrieves and
241returns raw formatted post content not a data already converted to
242HTML.
243
244=head1 METHODS
245
246=head2 new ( I<\%args> )
247
248=over 4
249
250  my $diary = WWW::HatenaDiary->new({
251      login_id => $login_id,
252      login_pw => $login_pw,
253  });
254
255Creates and returns a new WWW::HatenaDiary object. Both C<login_id>
256and C<login_pw> are required.
257
258=back
259
260=head2 create ( I<\%args> )
261
262=over 4
263
264  my $edit_uri = $diary->create({
265      title => $title,
266      body  => $body,
267  });
268
269Creates a new post and returns a URI as a L<URI> object for you to
270retrieve/update/delete the post later on.
271
272=back
273
274=head2 retrieve ( I<\%args> )
275
276=over 4
277
278  my $post = $diary->retrieve({
279      uri => $edit_uri,
280  })
281
282Retrieves the post for C<uri>. The return value C<$post> is a
283reference to a hash which contains the fields as follows:
284
285=over 4
286
287=item * title
288
289Title of the post.
290
291=item * body
292
293Content of the post as a raw formatted data.
294
295=item * editable
296
297Flag if you're authorized to edit the post or not.
298
299=item * rkm
300
301Token which is internally used when this module sends a request. You
302needn't care about it.
303
304=back
305
306=back
307
308=head2 retrieve_day ( I<\%args> )
309
310=over 4
311
312  my $day_body = $diary->retrieve_day({
313      date => $date, # $date must be YYYY-MM-DD formatted string
314  });
315
316Retrieves the post body for C<date>. So far, this method gets only the
317raw formatted content of the post.
318
319=back
320
321=head2 update ( I<\%args> )
322
323=over 4
324
325  $edit_uri = $diary->update({
326      uri   => $edit_uri,
327      title => $new_title,
328      body  => $new_body,
329  });
330
331Updates the post for C<uri> and returns the URI as a L<URI> object for
332you to do with the post still more.
333
334=back
335
336=head2 update_day ( I<\%args> )
337
338=over 4
339
340  $diary->update_day({
341      date => $date,     # $date must be YYYY-MM-DD formatted string
342      body => $new_body,
343  });
344
345Updates the whole posts of the C<date>. C<body> must be a
346Hatena::Diary style formatted data, that is, this method emulates the
347way when you write a post on your browser and send it via the form.
348
349=back
350
351=head2 delete ( I<\%args> ) **NOT IMPLEMENTED YET**
352
353=over 4
354
355  $diary->delete({
356      uri => $edit_uri,
357  });
358
359Deletes the post for C<uri>.
360
361=back
362
363=head2 delete_day ( I<\%args> )
364
365=over 4
366
367  $diary->delete_day({
368      date => $date, # $date must be YYYY-MM-DD formatted string
369  });
370
371Deletes the whole posts of the C<date>.
372
373=back
374
375=head1 SEE ALSO
376
377=over 4
378
379=item * Hatena::Diary (Japanese)
380
381L<http://d.hatena.ne.jp/>
382
383=back
384
385=head1 ACKNOWLEDGMENT
386
387typester++ for some codes copied from Fuse::Hatena.
388
389=head1 AUTHOR
390
391Tokuhiro Matsuno E<lt>tokuhirom aaaatttt gmail dotottto commmmmE<gt>
392
393Kentaro Kuribayashi E<lt>kentarok aaaatttt gmail dotottto commmmmE<gt>
394
395=head1 LICENSE
396
397This library is free software; you can redistribute it and/or modify
398it under the same terms as Perl itself.
399
400=cut
Note: See TracBrowser for help on using the browser.