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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations) (download)
Tue Oct 21 06:17:52 2008 UTC (16 years, 6 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +3 -2 lines
File MIME type: text/plain
++ ChangeLog	21 Oct 2008 06:17:46 -0000
	* mkcommitfeed.pl: Don't use date from the ChangeLog content as
	<updated> date.  Set |xmlns| attribute of the root |feed| element.

2008-10-21  Wakaba  <wakaba@suika.fam.cx>

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24