root/sbm-xpost/trunk/sbm-xpost.cgi

Revision 1669 (checked in by miyagawa, 15 years ago)

use google redirection for not telling referer

  • Property svn:mime-type set to text/script
  • Property svn:executable set to ON
  • Property svn:keywords set to Id Revision
Line 
1 #!/ur/local/bin/perl
2 use strict;
3 use CGI;
4 use DateTime;
5 use HTTP::Request::Common;
6 use LWP::UserAgent;
7 use Template;
8 use XML::Atom::Entry;
9 use XML::Atom::Client;
10 use YAML;
11
12 (my $config = $ENV{SCRIPT_FILENAME}) =~ s/\.cgi$/.yaml/;
13 warn $config;
14 our $conf = YAML::LoadFile($config);
15
16 my $q = CGI->new;
17 if ($q->request_method eq 'POST') {
18     do_post($q);
19 } else {
20     do_form($q);
21 }
22
23 sub do_form {
24     my $q = shift;
25     print $q->header('text/html; charset=utf-8');
26     binmode STDOUT, ":utf8";
27     my $tt = Template->new;
28     $tt->process(\<<TEMPLATE, { q => $q });
29 <html>
30 <head>
31 <title>del.icio.us and Hatena cross-poster</title>
32 <style>body { font-family: trebuchet MS, Arial; font-size: 13px }</style>
33 <body onload="document.forms[0].tags.focus()">
34 <h1>del.icio.us and Hatena cross-poster</h1>
35 <form action="[% q.url('-query'=>0) %]" method="post">
36 <table>
37 <tr><td style="text-align:right">URL:</td><td><input size="64" type="text" name="url" value="[% q.param('url')|html %]" /></td></tr>
38 <tr><td style="text-align:right">Title:</td><td><input size="64" type="text" name="title" value="[% q.param('title') | html %]" /></td></tr>
39 <tr><td style="text-align:right">Comment:</td><td><input size="64" type="text" name="comment" /></td></tr>
40 <tr><td style="text-align:right">Tags:</td><td><input size="64" type="text" name="tags" /></td></tr>
41 </table>
42 <input type="submit" value=" Save " />
43 </form>
44 <div><a href="javascript:location.href='[% q.url %]?url='+encodeURIComponent(location.href)+'&title='+encodeURIComponent(document.title)">bookmarklet</a></div>
45 </body>
46 TEMPLATE
47     ;
48 }
49
50 sub do_post {
51     my $q = shift;
52     post_delicious($q);
53     post_hatena($q);
54     my $url = URI->new("http://www.google.com/url");
55     $url->query_form(sa => 'D', q => $q->param('url'));
56     print $q->redirect($url);
57 }
58
59 sub post_delicious {
60     my $q = shift;
61     my $url = URI->new("http://del.icio.us/api/posts/add");
62     $url->query_form(
63         url => $q->param('url'),
64         description => $q->param('title'),
65         extended => $q->param('comment'),
66         tags => $q->param('tags'),
67         dt   => DateTime->now,
68     );
69     my $ua = LWP::UserAgent->new;
70     $ua->credentials("del.icio.us:80", "del.icio.us API", $conf->{delicious}->{username}, $conf->{delicious}->{password});
71     my $res = $ua->get($url);
72     warn $res->status_line unless $res->is_success;
73 }
74
75 sub post_hatena {
76     my $q = shift;
77     my $summary = join '', map "[$_]", split /\s+/, $q->param('tags');
78     $summary .= " " . $q->param('comment') if $q->param('comment');
79
80     my $entry = XML::Atom::Entry->new;
81     my $link  = XML::Atom::Link->new;
82     $link->rel('related');
83     $link->type('text/html');
84     $link->href($q->param('url'));
85     $entry->add_link($link);
86     $entry->summary($summary);
87
88     my $client = XML::Atom::Client->new;
89     $client->username($conf->{hatena}->{username});
90     $client->password($conf->{hatena}->{password});
91     $client->createEntry("http://b.hatena.ne.jp/atom/post", $entry)
92         or warn $client->errstr;
93 }
Note: See TracBrowser for help on using the browser.