/[suikacvs]/webroot/commitfeed/mkcommitfeed.pl
Suika

Contents of /webroot/commitfeed/mkcommitfeed.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Mon Nov 24 04:54:25 2008 UTC (15 years, 5 months ago) by wakaba
Branch: MAIN
File MIME type: text/plain
Original version developed as part of Whatpm

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     my $feed_related_url;
16     my $feed_license_url;
17     my $feed_rights;
18     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     'feed-license-url=s' => \$feed_license_url,
34     'feed-related-url=s' => \$feed_related_url,
35     'feed-rights=s' => \$feed_rights,
36     '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     # $entry_date //= timegm (0, 0, 0, $3, $2-1, $1);
57     $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     $feed->set_attribute_ns ('http://www.w3.org/2000/xmlns/',
97     'xmlns', $feed->namespace_uri);
98    
99     unless (@{$feed->author_elements}) {
100     if (defined $feed_author_name) {
101     my $author = $doc->create_element_ns ($feed->namespace_uri, 'author');
102     $author->name ($feed_author_name);
103     $author->email ($feed_author_mail) if defined $feed_author_mail;
104     $author->uri ($feed_author_url) if defined $feed_author_url;
105     $feed->append_child ($author);
106     }
107     }
108     unless (@{$feed->link_elements}) {
109     my $link_self = $doc->create_element_ns ($feed->namespace_uri, 'link');
110     $link_self->rel ('self');
111     $link_self->type ('application/atom+xml');
112     $link_self->hreflang ($feed_lang);
113     $link_self->href ($feed_url);
114     $feed->append_child ($link_self);
115    
116     if (defined $feed_related_url) {
117     my $link = $doc->create_element_ns ($feed->namespace_uri, 'link');
118     $link->rel ('related');
119     $link->href ($feed_related_url);
120     $feed->append_child ($link);
121     }
122    
123     if (defined $feed_license_url) {
124     my $link = $doc->create_element_ns ($feed->namespace_uri, 'link');
125     $link->rel ('license');
126     $link->href ($feed_license_url);
127     $feed->append_child ($link);
128     }
129     }
130    
131     if (defined $feed_rights) {
132     $feed->rights_element->text_content ($feed_rights);
133     }
134    
135     my $entry_id = 'entry-' . time;
136     my $entry = $feed->add_new_entry ($feed_url . '#' . $entry_id,
137     $entry_title);
138     $entry->set_attribute_ns ('http://www.w3.org/XML/1998/namespace',
139     'xml:id' => $entry_id);
140     if (defined $entry_author_name) {
141     my $author = $doc->create_element_ns ($feed->namespace_uri, 'author');
142     $author->name ($entry_author_name);
143     $author->email ($entry_author_mail) if defined $entry_author_mail;
144     $entry->append_child ($author);
145     }
146     $entry->updated_element->value ($entry_date);
147     my $content = $entry->content_element;
148     $content->type ('text');
149     $content->text_content ($entry_content);
150    
151     {
152     open my $file, '>:utf8', $file_name or die "$0: $file_name: $!";
153     print $file $doc->inner_html;
154     }
155    
156     ## $Date: 2008/10/21 08:36:59 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24