textile: The Text::Textile perl module has some regexps that fail if input is flagged...
[ikiwiki] / IkiWiki / Plugin / table.pm
1 package IkiWiki::Plugin::table;
2 # by Victor Moral <victor@taquiones.net>
3
4 use warnings;
5 use strict;
6 use Encode;
7 use IkiWiki 2.00;
8
9 sub import { #{{{
10         hook(type => "preprocess", id => "table", call => \&preprocess);
11 } # }}}
12
13 sub preprocess (@) { #{{{
14         my %params =(
15                 format  => 'auto',
16                 header  => 'yes',
17                 @_
18         );
19
20         if (exists $params{file}) {
21                 if (! $pagesources{$params{file}}) {
22                         return "[[table ".gettext("cannot find file")."]]";
23                 }
24                 $params{data} = readfile(srcfile($params{file}));
25                 add_depends($params{page}, $params{file});
26         }
27
28         if (lc $params{format} eq 'auto') {
29                 # first try the more simple format
30                 if (is_dsv_data($params{data})) {
31                         $params{format} = 'dsv';
32                 }
33                 else {
34                         $params{format} = 'csv';
35                 }
36         }
37
38         my @data;
39         if (lc $params{format} eq 'csv') {
40                 @data=split_csv($params{data},
41                         defined $params{delimiter} ? $params{delimiter} : ",",);
42                 # linkify after parsing since html link quoting can
43                 # confuse CSV parsing
44                 if (! exists $params{file}) {
45                         @data=map {
46                                 [ map {
47                                         IkiWiki::linkify($params{page},
48                                                 $params{destpage}, $_);
49                                 } @$_ ]
50                         } @data;
51                 }
52         }
53         elsif (lc $params{format} eq 'dsv') {
54                 # linkify before parsing since wikilinks can contain the
55                 # delimiter
56                 if (! exists $params{file}) {
57                         $params{data} = IkiWiki::linkify($params{page},
58                                 $params{destpage}, $params{data});
59                 }
60                 @data=split_dsv($params{data},
61                         defined $params{delimiter} ? $params{delimiter} : "|",);
62         }
63         else {
64                 return "[[table ".gettext("unknown data format")."]]";
65         }
66
67         my $header;
68         if (lc($params{header}) eq "yes") {
69                 $header=shift @data;
70         }
71         if (! @data) {
72                 return "[[table ".gettext("empty data")."]]";
73         }
74
75         my @lines;
76         push @lines, defined $params{class}
77                         ? "<table class=\"".$params{class}.'">'
78                         : '<table>';
79         push @lines, "\t<thead>",
80                 genrow($params{page}, $params{destpage}, "th", @$header),
81                 "\t</thead>" if defined $header;
82         push @lines, "\t<tbody>" if defined $header;
83         push @lines, genrow($params{page}, $params{destpage}, "td", @$_)
84                 foreach @data;
85         push @lines, "\t</tbody>" if defined $header;
86         push @lines, '</table>';
87         my $html = join("\n", @lines);
88
89         if (exists $params{file}) {
90                 return $html."\n\n".
91                         htmllink($params{page}, $params{destpage}, $params{file},
92                                 linktext => gettext('Direct data download'));
93         }
94         else {  
95                 return $html;
96         }            
97 } #}}}
98
99 sub is_dsv_data ($) { #{{{
100         my $text = shift;
101
102         my ($line) = split(/\n/, $text);
103         return $line =~ m{.+\|};
104 }
105
106 sub split_csv ($$) { #{{{
107         my @text_lines = split(/\n/, shift);
108         my $delimiter = shift;
109
110         eval q{use Text::CSV};
111         error($@) if $@;
112         my $csv = Text::CSV->new({ 
113                 sep_char        => $delimiter,
114                 binary          => 1,
115                 allow_loose_quotes => 1,
116         }) || error("could not create a Text::CSV object");
117         
118         my $l=0;
119         my @data;
120         foreach my $line (@text_lines) {
121                 $l++;
122                 if ($csv->parse($line)) {
123                         push(@data, [ map { decode_utf8 $_ } $csv->fields() ]);
124                 }
125                 else {
126                         debug(sprintf(gettext('parse fail at line %d: %s'), 
127                                 $l, $csv->error_input()));
128                 }
129         }
130
131         return @data;
132 } #}}}
133
134 sub split_dsv ($$) { #{{{
135         my @text_lines = split(/\n/, shift);
136         my $delimiter = shift;
137         $delimiter="|" unless defined $delimiter;
138
139         my @data;
140         foreach my $line (@text_lines) {
141                 push @data, [ split(/\Q$delimiter\E/, $line, -1) ];
142         }
143     
144         return @data;
145 } #}}}
146
147 sub genrow ($$$@) { #{{{
148         my $page = shift;
149         my $destpage = shift;
150         my $elt = shift;
151         my @data = @_;
152
153         my @ret;
154         push @ret, "\t\t<tr>";
155         for (my $x=0; $x < @data; $x++) {
156                 my $cell=htmlize($page, $destpage, $data[$x]);
157                 my $colspan=1;
158                 while ($x+1 < @data && $data[$x+1] eq '') {
159                         $x++;
160                         $colspan++;
161                 }
162                 if ($colspan > 1) {
163                         push @ret, "\t\t\t<$elt colspan=\"$colspan\">$cell</$elt>"
164                 }
165                 else {
166                         push @ret, "\t\t\t<$elt>$cell</$elt>"
167                 }
168         }
169         push @ret, "\t\t</tr>";
170
171         return @ret;
172 } #}}}
173
174 sub htmlize ($$$) { #{{{
175         my $page = shift;
176         my $destpage = shift;
177
178         return IkiWiki::htmlize($page, $destpage, pagetype($pagesources{$page}),
179                 IkiWiki::preprocess($page, $destpage, shift));
180 }
181
182 1