File Coverage: lib/Yukki/Web/Plugin/Spreadsheet.pm

# File Coverage

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 |  |  | 2 |  | 285 5 | use v5.24;
4 | 2 2 2 |  |  | 2 |  | 7 4 8 | use utf8;
5 | 2 2 2 |  |  | 2 |  | 21 2 9 | use Moo;
6 |
7 | 2 2 2 |  |  | 2 |  | 403 3 13 | use Types::Standard qw( HashRef Str );
8 |
9 | 2 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 |  |  | 2 |  | 373 3 74 | use Scalar::Util qw( blessed );
16 | 2 2 2 |  |  | 2 |  | 7 4 61 | use Try::Tiny;
17 | 2 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 | 1 | 3 | my ($self, $ctx) = @_;
60 |
61 | 1 |  | 33 |  |  | 24 | $ctx->stash->{'Spreadsheet.sheet'} //= Spreadsheet::Engine->new;
62 | 1 |  | 50 |  |  | 106 | $ctx->stash->{'Spreadsheet.map'} //= {};
63 | 1 |  | 50 |  |  | 6 | $ctx->stash->{'Spreadsheet.rowmap'} //= {};
64 | 1 |  | 50 |  |  | 7 | $ctx->stash->{'Spreadsheet.nextrow'} //= 'A';
65 | 1 |  | 50 |  |  | 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 | 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 | 50 |  |  |  | 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 | 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 |  | 33 |  |  | 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 |  |  | 0 | 1 | 0 | my ($self, $ctx, $file, $name, $new_cell) = @_;
120 | 0 |  |  |  |  | 0 | my $map = $ctx->stash->{'Spreadsheet.map'};
121 | 0 | 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 |  |  | 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 |  |  |  | 0 | if ($name =~ /!/) {
140 | 0 |  |  |  |  | 0 | my ($path, $name) = split /!/, $name, 2;
141 |
142 | 0 |  |  |  |  | 0 | my $repository_name;
143 | 0 | 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 | 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 |  |  |  | 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 | 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 |  |  | 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 |  | 0 | $error++;
204 | 0 | 0 | 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 | 50 |  |  |  | 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 | 50 |  |  |  | 10 | my $attrs = defined $name ? qq[ id="spreadsheet-$name"] : '';
218 | 1 |  |  |  |  | 2 | my $value;
219 | 1 | 50 |  |  |  | 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 |  |  | 0 | 1 |  | my ($self, $ctx, $file) = @_;
240 | 0 | 0 |  |  |  |  | http_throw('no such spreadsheet exists') unless $file->exists;
241 | 0 |  |  |  |  |  | $file->fetch_formatted($ctx);
242 |  |  |  |  |  |  | }
243 |
244 |  |  |  |  |  |  | 1;