File: | lib/Yukki/Web/Plugin/Spreadsheet.pm |
Coverage: | 57.1% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Yukki::Web::Plugin::Spreadsheet; | ||||||
2 | |||||||
3 | 2 2 | 285 5 | use v5.24; | ||||
4 | 2 2 2 | 7 4 8 | use utf8; | ||||
5 | 2 2 2 | 21 2 9 | use Moo; | ||||
6 | |||||||
7 | 2 2 2 | 403 3 13 | use Types::Standard qw( HashRef Str ); | ||||
8 | |||||||
9 | 2 2 2 | 997 4 11 | use namespace::clean; | ||||
10 | |||||||
11 | extends 'Yukki::Web::Plugin'; | ||||||
12 | |||||||
13 | # ABSTRACT: add spreadsheet functionality to wiki pages | ||||||
14 | |||||||
15 | 2 2 2 | 373 3 74 | use Scalar::Util qw( blessed ); | ||||
16 | 2 2 2 | 7 4 61 | use Try::Tiny; | ||||
17 | 2 2 2 | 196 4 12 | use Yukki::Error qw( http_throw ); | ||||
18 | |||||||
19 - 37 | =head1 SYNOPSIS {{=:a:5} {{=:b:4}} {{=:SUM([a],[b],[main:Other Page!c])}} =head1 DESCRIPTION Provides a quick format helper to give you spreadsheet variables in your page. This is based upon L<Spreadsheet::Engine>, so all the features and functions there are available here. In addition, this provides a variable mapping. The variables are mapped using square brackets. You can link between variables on different pages using an exclamation mark ("!") as a separated between page name and variable name. =head1 ATTRIBUTES =head2 format_helpers This sets up the "=" format helper mapped to the L</spreadsheet_eval> method. =cut | ||||||
38 | |||||||
39 | has format_helpers => ( | ||||||
40 | is => 'ro', | ||||||
41 | isa => HashRef[Str], | ||||||
42 | required => 1, | ||||||
43 | default => sub { +{ | ||||||
44 | '=' => 'spreadsheet_eval', | ||||||
45 | } }, | ||||||
46 | ); | ||||||
47 | |||||||
48 | with 'Yukki::Web::Plugin::Role::FormatHelper'; | ||||||
49 | |||||||
50 - 56 | =head1 METHODS =head2 initialize_context Used to setup the spreadsheet information for the current context. Do not use. =cut | ||||||
57 | |||||||
58 | sub initialize_context { | ||||||
59 | 1 | 1 | 3 | my ($self, $ctx) = @_; | |||
60 | |||||||
61 | 1 | 24 | $ctx->stash->{'Spreadsheet.sheet'} //= Spreadsheet::Engine->new; | ||||
62 | 1 | 106 | $ctx->stash->{'Spreadsheet.map'} //= {}; | ||||
63 | 1 | 6 | $ctx->stash->{'Spreadsheet.rowmap'} //= {}; | ||||
64 | 1 | 7 | $ctx->stash->{'Spreadsheet.nextrow'} //= 'A'; | ||||
65 | 1 | 6 | $ctx->stash->{'Spreadsheet.nextcol'} //= {}; | ||||
66 | |||||||
67 | 1 | 2 | return $ctx->stash->{'Spreadsheet.sheet'}; | ||||
68 | } | ||||||
69 | |||||||
70 - 74 | =head2 setup_spreadsheet Sets up spreadsheet for the current request context. Do not use. =cut | ||||||
75 | |||||||
76 | sub setup_spreadsheet { | ||||||
77 | 1 | 1 | 2 | my ($self, $params) = @_; | |||
78 | |||||||
79 | 1 | 2 | my $ctx = $params->{context}; | ||||
80 | 1 | 2 | my $file = $params->{file}; | ||||
81 | 1 | 2 | my $arg = $params->{arg}; | ||||
82 | |||||||
83 | 1 | 3 | my $sheet = $ctx->stash->{'Spreadsheet.sheet'}; | ||||
84 | 1 | 3 | my $row = $self->row($ctx, $file); | ||||
85 | |||||||
86 | 1 | 9 | my ($name, $formula) = $arg =~ /^(?:([\w -]+):)?(.*)/; | ||||
87 | |||||||
88 | 1 | 4 | my $new_cell = $row . ($sheet->raw->{sheetattribs}{lastrow} + 1); | ||||
89 | |||||||
90 | 1 | 9 | $self->cell($ctx, $file, $name, $new_cell) if $name; | ||||
91 | |||||||
92 | 1 | 3 | return ($new_cell, $name, $formula); | ||||
93 | } | ||||||
94 | |||||||
95 - 99 | =head2 row Used to lookup the current row letter for a file. Do not use. =cut | ||||||
100 | |||||||
101 | sub row { | ||||||
102 | 1 | 1 | 2 | my ($self, $ctx, $file) = @_; | |||
103 | |||||||
104 | 1 | 2 | my $rowmap = $ctx->stash->{'Spreadsheet.rowmap'}; | ||||
105 | |||||||
106 | my $row = $rowmap->{ $file->repository_name }{ $file->full_path } | ||||||
107 | 1 | 8 | // $ctx->stash->{'Spreadsheet.nextrow'}++; | ||||
108 | |||||||
109 | 1 | 13 | return $rowmap->{ $file->repository_name }{ $file->full_path } = $row; | ||||
110 | } | ||||||
111 | |||||||
112 - 116 | =head2 cell Used to lookup the cell for a variable. Do not use. =cut | ||||||
117 | |||||||
118 | sub cell { | ||||||
119 | 0 | 1 | 0 | my ($self, $ctx, $file, $name, $new_cell) = @_; | |||
120 | 0 | 0 | my $map = $ctx->stash->{'Spreadsheet.map'}; | ||||
121 | 0 | 0 | $map->{ $file->repository_name }{ $file->full_path }{ $name } = $new_cell | ||||
122 | if defined $new_cell; | ||||||
123 | 0 | 0 | return $map->{ $file->repository_name }{ $file->full_path }{ $name }; | ||||
124 | } | ||||||
125 | |||||||
126 - 130 | =head2 lookup_name Used to convert the square bracket names to cell names. Do not use. =cut | ||||||
131 | |||||||
132 | sub lookup_name { | ||||||
133 | 0 | 1 | 0 | my ($self, $params) = @_; | |||
134 | |||||||
135 | 0 | 0 | my $ctx = $params->{context}; | ||||
136 | 0 | 0 | my $file = $params->{file}; | ||||
137 | 0 | 0 | my $name = $params->{name}; | ||||
138 | |||||||
139 | 0 | 0 | if ($name =~ /!/) { | ||||
140 | 0 | 0 | my ($path, $name) = split /!/, $name, 2; | ||||
141 | |||||||
142 | 0 | 0 | my $repository_name; | ||||
143 | 0 | 0 | if ($path =~ /^(\w+):/) { | ||||
144 | 0 | 0 | ($repository_name, $path) = split /:/, $path, 2; | ||||
145 | } | ||||||
146 | else { | ||||||
147 | 0 | 0 | $repository_name = $file->repository_name; | ||||
148 | } | ||||||
149 | |||||||
150 | 0 | 0 | $path = $self->app->munge_label($path); | ||||
151 | |||||||
152 | 0 | 0 | my $other_repo = $self->model('Repository', { | ||||
153 | name => $repository_name, | ||||||
154 | }); | ||||||
155 | |||||||
156 | 0 | 0 | my $other_file = $other_repo->file({ | ||||
157 | full_path => $path, | ||||||
158 | }); | ||||||
159 | |||||||
160 | 0 | 0 | $self->load_spreadsheet($ctx, $other_file) | ||||
161 | unless $other_file->repository_name eq $file->repository_name | ||||||
162 | and $other_file->full_path eq $file->full_path;; | ||||||
163 | |||||||
164 | 0 | 0 | return $self->cell($ctx, $other_file, $name); | ||||
165 | } | ||||||
166 | |||||||
167 | 0 | 0 | my $cell = $self->cell($ctx, $file, $name); | ||||
168 | |||||||
169 | 0 | 0 | http_throw('unknown name') if not defined $cell; | ||||
170 | |||||||
171 | 0 | 0 | return $cell; | ||||
172 | } | ||||||
173 | |||||||
174 - 178 | =head2 spreadsheet_eval This is used to format the double-curly brace C< {{=:...}} >. Do not use. =cut | ||||||
179 | |||||||
180 | sub spreadsheet_eval { | ||||||
181 | 1 | 1 | 3 | my ($self, $params) = @_; | |||
182 | |||||||
183 | 1 | 2 | my $ctx = $params->{context}; | ||||
184 | 1 | 2 | my $file = $params->{file}; | ||||
185 | 1 | 2 | my $arg = $params->{arg}; | ||||
186 | |||||||
187 | 1 | 3 | my $sheet = $self->initialize_context($ctx); | ||||
188 | |||||||
189 | 1 | 4 | my ($new_cell, $name, $formula) = $self->setup_spreadsheet($params); | ||||
190 | |||||||
191 | 1 | 2 | my $error = 0; | ||||
192 | |||||||
193 | try { | ||||||
194 | 1 | 48 | $formula =~ s/ \[ ([^\]]+) \] / | ||||
195 | 0 | 0 | $self->lookup_name({ | ||||
196 | %$params, | ||||||
197 | name => $1, | ||||||
198 | }) | ||||||
199 | /gex; | ||||||
200 | } | ||||||
201 | |||||||
202 | catch { | ||||||
203 | 0 | 0 | $error++; | ||||
204 | 0 | 0 | if (blessed $_ and $_->isa('Yukki::Error')) { | ||||
205 | 0 | 0 | my $msg = $_->message; | ||||
206 | 0 | 0 | $sheet->execute("set $new_cell constant e#NAME? $msg"); | ||||
207 | } | ||||||
208 | else { | ||||||
209 | 0 | 0 | die $_; | ||||
210 | } | ||||||
211 | 1 | 9 | }; | ||||
212 | |||||||
213 | 1 | 26 | $sheet->execute("set $new_cell formula $formula") unless $error; | ||||
214 | 1 | 134 | $sheet->recalc; | ||||
215 | |||||||
216 | 1 | 367 | my $raw = $sheet->raw; | ||||
217 | 1 | 10 | my $attrs = defined $name ? qq[ id="spreadsheet-$name"] : ''; | ||||
218 | 1 | 2 | my $value; | ||||
219 | 1 | 3 | if ($raw->{cellerrors}{ $new_cell }) { | ||||
220 | 0 | 0 | $attrs .= qq[ title="$arg (ERROR: $raw->{formulas}{ $new_cell })"] | ||||
221 | . qq[ class="spreadsheet-cell error" ]; | ||||||
222 | 0 | 0 | $value = $raw->{cellerrors}{ $new_cell }; | ||||
223 | } | ||||||
224 | else { | ||||||
225 | 1 | 3 | $attrs .= qq[ title="$arg" class="spreadsheet-cell"]; | ||||
226 | 1 | 2 | $value = $raw->{datavalues}{ $new_cell }; | ||||
227 | } | ||||||
228 | |||||||
229 | 1 | 4 | return qq[<span$attrs>$value</span>]; | ||||
230 | } | ||||||
231 | |||||||
232 - 236 | =head2 load_spreadsheet Used to load spreadsheet variables from an externally referenced wiki page. Do not use. =cut | ||||||
237 | |||||||
238 | sub load_spreadsheet { | ||||||
239 | 0 | 1 | my ($self, $ctx, $file) = @_; | ||||
240 | 0 | http_throw('no such spreadsheet exists') unless $file->exists; | |||||
241 | 0 | $file->fetch_formatted($ctx); | |||||
242 | } | ||||||
243 | |||||||
244 | 1; |