/[suikacvs]/markup/html/whatpm/mkcommitfeed.pl
Suika

Contents of /markup/html/whatpm/mkcommitfeed.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Tue Oct 21 05:03:24 2008 UTC (17 years, 2 months ago) by wakaba
Branch: MAIN
File MIME type: text/plain
++ ChangeLog	21 Oct 2008 05:03:12 -0000
2008-10-21  Wakaba  <wakaba@suika.fam.cx>

	* cvscommit.sh: Add a line to invoke |mkcommitfeed.pl|.

	* mkcommitfeed.pl: New script.

1 #!/usr/bin/perl
2 use strict;
3
4 use Getopt::Long;
5 use Pod::Usage;
6 use Time::Local;
7
8 my $file_name;
9 my $feed_url;
10 my $feed_title = 'ChangeLog';
11 my $feed_author_name;
12 my $feed_author_mail;
13 my $feed_author_url;
14 my $feed_lang = 'i-default';
15 my $entry_content;
16 my $entry_author_name;
17 my $entry_author_mail;
18 my $entry_date;
19 my $entry_title;
20
21 GetOptions (
22 'entry-author-mail=s' => \$entry_author_mail,
23 'entry-author-name=s' => \$entry_author_name,
24 'entry-content=s' => \$entry_content,
25 'entry-title=s' => \$entry_title,
26 'feed-author-mail=s' => \$feed_author_mail,
27 'feed-author-name=s' => \$feed_author_name,
28 'feed-author-url=s' => \$feed_author_url,
29 'feed-lang=s' => \$feed_lang,
30 'feed-title=s' => \$feed_title,
31 'feed-url=s' => \$feed_url,
32 'file-name=s' => \$file_name,
33 'help' => sub {
34 pod2usage (-exitval => 0, -verbose => 2);
35 },
36 ) or pod2usage (-exitval => 1, -verbose => 1);
37 pod2usage (-exitval => 1, -verbose => 1,
38 -msg => "Required argument --file-name is not specified.\n")
39 unless defined $file_name;
40 pod2usage (-exitval => 1, -verbose => 1,
41 -msg => "Required argument --feed-url is not specified.\n")
42 unless defined $feed_url;
43
44 unless (defined $entry_content) {
45 $entry_content = '';
46 $entry_content .= $_ while <>;
47 }
48
49 if ($entry_content =~ /^(\d+)-(\d+)-(\d+)\s+(.+)<([^<>]+)>/m) {
50 $entry_date //= timegm (0, 0, 0, $3, $2-1, $1);
51 $entry_author_name //= $4;
52 $entry_author_mail //= $5;
53 $entry_author_name =~ s/\s+$//;
54 }
55 $entry_date //= time;
56
57 pod2usage (-exitval => 1, -verbose => 1,
58 -msg => "Required argument --entry-author-name is not specified.\n")
59 unless defined $entry_author_name;
60
61 unless (defined $entry_title) {
62 my $time = [gmtime $entry_date];
63 $entry_title = sprintf '%04d-%02d-%02d %s', 1900+$time->[5], 1+$time->[4],
64 $time->[3], $entry_author_name;
65 }
66
67 require Message::DOM::DOMImplementation;
68 my $dom = Message::DOM::DOMImplementation->new;
69 my $doc;
70
71 {
72 if (-f $file_name) {
73 open my $file, '<:encoding(utf8)', $file_name or die "$0: $file_name: $!";
74 local $/ = undef;
75 $doc = $dom->create_document;
76 $doc->inner_html (<$file>);
77 } else {
78 $doc = $dom->create_atom_feed_document
79 ($feed_url, $feed_title, $feed_lang);
80 }
81 }
82
83 $doc->dom_config
84 ->{q<http://suika.fam.cx/www/2006/dom-config/create-child-element>} = 1;
85 my $feed = $doc->document_element;
86 unless ($feed) {
87 $feed = $doc->create_element_ns ('http://www.w3.org/2005/Atom', 'feed');
88 $doc->append_child ($feed);
89 }
90
91 unless (@{$feed->author_elements}) {
92 if (defined $feed_author_name) {
93 my $author = $doc->create_element_ns ($feed->namespace_uri, 'author');
94 $author->name ($feed_author_name);
95 $author->email ($feed_author_mail) if defined $feed_author_mail;
96 $author->uri ($feed_author_url) if defined $feed_author_url;
97 $feed->append_child ($author);
98 }
99 }
100 unless (@{$feed->link_elements}) {
101 my $link_self = $doc->create_element_ns ($feed->namespace_uri, 'link');
102 $link_self->rel ('self');
103 $link_self->type ('application/atom+xml');
104 $link_self->hreflang ($feed_lang);
105 $link_self->href ($feed_url);
106 $feed->append_child ($link_self);
107 }
108
109 my $entry_id = 'entry-' . time;
110 my $entry = $feed->add_new_entry ($feed_url . '#' . $entry_id,
111 $entry_title);
112 $entry->set_attribute_ns ('http://www.w3.org/XML/1998/namespace',
113 'xml:id' => $entry_id);
114 if (defined $entry_author_name) {
115 my $author = $doc->create_element_ns ($feed->namespace_uri, 'author');
116 $author->name ($entry_author_name);
117 $author->email ($entry_author_mail) if defined $entry_author_mail;
118 $entry->append_child ($author);
119 }
120 $entry->updated_element->value ($entry_date);
121 my $content = $entry->content_element;
122 $content->type ('text');
123 $content->text_content ($entry_content);
124
125 {
126 open my $file, '>:utf8', $file_name or die "$0: $file_name: $!";
127 print $file $doc->inner_html;
128 }
129
130 ## $Date:$

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24