Webpacus/Controller/Editor.pm

package Webpacus::Controller::Editor;

use strict;
use warnings;
use base 'Catalyst::Controller';

use HTML::Tidy;
use Data::Dumper;

=head1 NAME

Webpacus::Controller::Editor - AJAX template and CSS editor

=head1 SYNOPSIS

See L<Webpacus>, L<WebPAC>

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=over 4

=item default

=cut

sub default : Private {
        my ( $self, $c ) = @_;

        my $webpac = $c->comp('Model::WebPAC');
        my $params = $c->req->params;
        my $log = $c->log;

        my $template_filename = 
                $c->req->params->{template_filename} ||
                $c->config->{webpac}->{default_template} ||
                $c->log->fatal("need default_template");

        $c->stash->{template_filename} = $template_filename;

        # get databases from config
        my @databases;
        my $config_dbs = $c->config->{databases};

        if (! $config_dbs) {
                $c->log->fail("didn't find databases in config");
        } else {
                # convert to resonable format for TT
                foreach my $db (keys %{ $config_dbs }) {
                        my $d = $config_dbs->{$db} || die;
                        my $inputs = $d->{input};
$c->log->debug("inputs [1]: ", Dumper($inputs));
                        $inputs = [ $inputs ] if (ref($inputs) ne 'ARRAY');
$c->log->debug("inputs [2]: ", Dumper($inputs));

                        foreach my $i ( @{ $inputs } ) {
                                my $el = {
                                        input   => $i->{name},
                                        name    => $d->{name} || $d,
                                        prefix  => $db . '/' . $i->{name},
                                };
                                push @databases, $el;
                        }
                }
        }

        $c->stash->{databases} = \@databases; 

        $c->stash->{template} = 'editor.tt';
}

=item template

fetch template using C<template_filename> in request or
C<< webpac->default_template >>.

=cut

sub template : Local {
        my ( $self, $c ) = @_;

        my $template_filename = 
                $c->req->params->{template_filename} ||
                $c->config->{webpac}->{default_template} ||
                $c->log->fatal("need default_template");

        my $webpac = $c->comp('Model::WebPAC');

        my $template_path = $webpac->{template_path} || $c->log->fatal("can't find template_path in Model::WebPAC");

        my $template_full_path = "$template_path/$template_filename";

        if ($c->req->params->{save_template}) {

                $c->response->content_type('text/html; charset=utf-8'); 

                my $t = $c->req->params->{template_content};
                my $size = length($t);
                $c->log->debug("saving $template_full_path, $size bytes");
                if ($webpac->save_html( $template_full_path, $t )) {
                        $c->res->output("<span>saved $template_filename, $size bytes</span>");
                } else {
                        $c->res->output("<span class=\"error\">error saving $template_filename!</span>");
                }
                return;
        }

        $c->log->debug("loading $template_full_path");

        if (! -r $template_full_path) {
                $c->log->warn("can't find '$template_full_path': $!");
                $c->response->content_type('text/html; charset=utf-8'); 
                $c->res->output("can't find template '$template_full_path'");
                return;
        }

        # load template html
        $c->stash->{'template_content'} =
                $webpac->load_html( $template_full_path );

        # load template list

        opendir(my $d, $template_path) || $c->log->fatal("can't opendir '$template_path': $!");
        my @templates = grep { /\.tt$/i } readdir($d);

        $c->stash->{template_list} = \@templates;
        $c->stash->{template_filename} = $template_filename;

        $c->stash->{template} = 'editor/template.tt';
}

=item css

Return css.

B<Not finished>

=cut

sub css : Local {
        my ( $self, $c ) = @_;

        my $css_filename = $c->config->{webpac}->{default_css} || die("need default_css");
        my $css_path = $c->config->{webpac}->{css_path} || die("need css_path");
        my $webpac = $c->comp('Model::WebPAC');

        my $css_full_path = "$css_path/$css_filename";

        if ($c->req->params->{save_css}) {

                $c->response->content_type('text/html; charset=utf-8'); 

                my $t = $c->req->params->{css_content};
                my $size = length($t);
                $c->log->debug("saving $css_full_path, $size bytes");
                if ($webpac->save_html( $css_full_path, $t )) {
                        $c->res->output("<span>saved $css_filename, $size bytes</span>");
                } else {
                        $c->res->output("<span class=\"error\">error saving $css_filename!</span>");
                }
                return;
        }

        $c->log->debug("loading $css_full_path");

        $c->stash->{'css_content'} = $webpac->load_html( $css_full_path );

        $c->stash->{'css_list'} = [ qw/user.css foobar.css/ ];

        $c->stash->{template} = 'editor/css.tt';
}

=item record

Return html of record taking C<mfn> and C<template_filename> from request.

=cut

sub record : Local {
        my ( $self, $c ) = @_;

        $c->log->debug('record params '.Dumper($c->req->params));

        my $record_uri = $c->req->params->{record_uri};
        $record_uri ||= $c->config->{editor}->{default_record_uri} and
                $c->log->warn("using editor: default_record_uri");

        if (! $record_uri) {
                $c->log->fatal("record called without record_uri and default_record_uri not found in config under editor");
                $c->stash->{error} = 'record retrival failed';
                $c->stash->{template} = 'error.tt';
                return;
        }

        my $template_filename = $c->req->params->{template_filename};
        if (! $template_filename) {
                $template_filename = $c->config->{webpac}->{default_template} || $c->log->fatal("no webpac->default_template in configuration!");
                $c->log->warn("no template_filename using $template_filename");
        }

        my $webpac = $c->comp('Model::WebPAC');

        my $html = $webpac->record( record_uri => $record_uri, template => $template_filename );

        if ($html) {
                $c->log->debug('check html with tidy');
                my $tidy = new HTML::Tidy;
                $tidy->ignore( text => [
                        qr/DOCTYPE/, qr/unsupported/, qr/proprietary/i,
                        qr/invalid character code/,
                        qr/inserting missing 'title' element/,
                        qr/lacks "summary" attribute/,
                ] );

                my @lines = split( "\n", $html );
                $_ = "$_\n" for @lines;

                if ( $tidy->parse('tidy', @lines) ) {
                        if ( $tidy->messages ) {
                                $html .= <<__TIDY_CLOSE__;
<div id="tidy_show" class="notice" style="display: none;" onclick="Element.hide('tidy_show'); Element.show('tidy');">?</div>
<div id="tidy" class="tidy">
<a href="#" onclick="Element.hide('tidy'); Element.show('tidy_show'); return false;">close</a>
HTML Tidy output:
<br/>
__TIDY_CLOSE__
                                # Escape <, >, & and ", and to produce valid XML
                                my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
                                my $escape_re  = join '|' => keys %escape;

                                foreach my $m ( $tidy->messages ) {
                                        my $c = $lines[ ( $m->line - 1 ) ];
                                        my $txt = $m->as_string;
                                        $c =~ s/($escape_re)/$escape{$1}/g;
                                        $txt =~ s/($escape_re)/$escape{$1}/g;
                                        my $class = '';
                                        $class = ' class="tidy_'.lc($1).'"' if ($txt =~ /(Warning|Error):/s);
                                        $html .= 'line ' . $m->line . ":<span${class}>$txt<tt>$c</tt></span>";
                                }
                                $html .= '</div>';
                        }
                } else {
                        $html .= qq{<div class="tidy tidy_error">Can't parse this record with HTML Tidy!</div>};
                }
        } else {
                $html .= qq{<div class="no_results">Can't find record</div>};
        }

        $c->response->content_type('text/html; charset=utf-8'); 
        $c->response->body( $html );
}


=back

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
1	dpavlin	134	package Webpacus::Controller::Editor;
2
3			use strict;
4			use warnings;
5			use base 'Catalyst::Controller';
6
7	dpavlin	180	use HTML::Tidy;
8	dpavlin	165	use Data::Dumper;
9
10	dpavlin	134	=head1 NAME
11
12	dpavlin	165	Webpacus::Controller::Editor - AJAX template and CSS editor
13	dpavlin	134
14			=head1 SYNOPSIS
15
16	dpavlin	165	See L<Webpacus>, L<WebPAC>
17	dpavlin	134
18			=head1 DESCRIPTION
19
20			Catalyst Controller.
21
22			=head1 METHODS
23
24			=over 4
25
26			=item default
27
28			=cut
29
30			sub default : Private {
31	dpavlin	165	my ( $self, $c ) = @_;
32	dpavlin	134
33	dpavlin	165	my $webpac = $c->comp('Model::WebPAC');
34			my $params = $c->req->params;
35			my $log = $c->log;
36	dpavlin	134
37	dpavlin	165	my $template_filename =
38			$c->req->params->{template_filename} \|\|
39			$c->config->{webpac}->{default_template} \|\|
40			$c->log->fatal("need default_template");
41
42			$c->stash->{template_filename} = $template_filename;
43
44	dpavlin	250	# get databases from config
45			my @databases;
46			my $config_dbs = $c->config->{databases};
47
48			if (! $config_dbs) {
49	dpavlin	244	$c->log->fail("didn't find databases in config");
50	dpavlin	250	} else {
51			# convert to resonable format for TT
52			foreach my $db (keys %{ $config_dbs }) {
53			my $d = $config_dbs->{$db} \|\| die;
54			my $inputs = $d->{input};
55			$c->log->debug("inputs [1]: ", Dumper($inputs));
56			$inputs = [ $inputs ] if (ref($inputs) ne 'ARRAY');
57			$c->log->debug("inputs [2]: ", Dumper($inputs));
58	dpavlin	244
59	dpavlin	250	foreach my $i ( @{ $inputs } ) {
60			my $el = {
61			input => $i->{name},
62			name => $d->{name} \|\| $d,
63			prefix => $db . '/' . $i->{name},
64			};
65			push @databases, $el;
66			}
67			}
68			}
69
70			$c->stash->{databases} = \@databases;
71
72	dpavlin	165	$c->stash->{template} = 'editor.tt';
73	dpavlin	134	}
74
75	dpavlin	165	=item template
76
77			fetch template using C<template_filename> in request or
78			C<< webpac->default_template >>.
79
80			=cut
81
82	dpavlin	134	sub template : Local {
83	dpavlin	135	my ( $self, $c ) = @_;
84	dpavlin	134
85	dpavlin	167	my $template_filename =
86	dpavlin	165	$c->req->params->{template_filename} \|\|
87			$c->config->{webpac}->{default_template} \|\|
88			$c->log->fatal("need default_template");
89	dpavlin	135
90			my $webpac = $c->comp('Model::WebPAC');
91
92	dpavlin	167	my $template_path = $webpac->{template_path} \|\| $c->log->fatal("can't find template_path in Model::WebPAC");
93	dpavlin	135
94	dpavlin	167	my $template_full_path = "$template_path/$template_filename";
95
96	dpavlin	172	if ($c->req->params->{save_template}) {
97	dpavlin	179
98			$c->response->content_type('text/html; charset=utf-8');
99
100	dpavlin	172	my $t = $c->req->params->{template_content};
101			my $size = length($t);
102			$c->log->debug("saving $template_full_path, $size bytes");
103			if ($webpac->save_html( $template_full_path, $t )) {
104			$c->res->output("<span>saved $template_filename, $size bytes</span>");
105			} else {
106	dpavlin	243	$c->res->output("<span class=\"error\">error saving $template_filename!</span>");
107	dpavlin	172	}
108			return;
109			}
110
111	dpavlin	165	$c->log->debug("loading $template_full_path");
112
113			if (! -r $template_full_path) {
114			$c->log->warn("can't find '$template_full_path': $!");
115	dpavlin	179	$c->response->content_type('text/html; charset=utf-8');
116	dpavlin	165	$c->res->output("can't find template '$template_full_path'");
117			return;
118			}
119
120	dpavlin	167	# load template html
121	dpavlin	135	$c->stash->{'template_content'} =
122			$webpac->load_html( $template_full_path );
123
124	dpavlin	167	# load template list
125
126			opendir(my $d, $template_path) \|\| $c->log->fatal("can't opendir '$template_path': $!");
127			my @templates = grep { /\.tt$/i } readdir($d);
128
129			$c->stash->{template_list} = \@templates;
130			$c->stash->{template_filename} = $template_filename;
131
132	dpavlin	135	$c->stash->{template} = 'editor/template.tt';
133	dpavlin	134	}
134
135	dpavlin	165	=item css
136
137	dpavlin	167	Return css.
138
139			B<Not finished>
140
141	dpavlin	165	=cut
142
143	dpavlin	134	sub css : Local {
144	dpavlin	135	my ( $self, $c ) = @_;
145	dpavlin	134
146	dpavlin	172	my $css_filename = $c->config->{webpac}->{default_css} \|\| die("need default_css");
147	dpavlin	135	my $css_path = $c->config->{webpac}->{css_path} \|\| die("need css_path");
148			my $webpac = $c->comp('Model::WebPAC');
149	dpavlin	165
150	dpavlin	172	my $css_full_path = "$css_path/$css_filename";
151	dpavlin	165
152	dpavlin	172	if ($c->req->params->{save_css}) {
153	dpavlin	179
154			$c->response->content_type('text/html; charset=utf-8');
155
156	dpavlin	172	my $t = $c->req->params->{css_content};
157			my $size = length($t);
158			$c->log->debug("saving $css_full_path, $size bytes");
159			if ($webpac->save_html( $css_full_path, $t )) {
160			$c->res->output("<span>saved $css_filename, $size bytes</span>");
161			} else {
162	dpavlin	243	$c->res->output("<span class=\"error\">error saving $css_filename!</span>");
163	dpavlin	172	}
164			return;
165			}
166
167	dpavlin	165	$c->log->debug("loading $css_full_path");
168
169			$c->stash->{'css_content'} = $webpac->load_html( $css_full_path );
170
171	dpavlin	189	$c->stash->{'css_list'} = [ qw/user.css foobar.css/ ];
172
173	dpavlin	135	$c->stash->{template} = 'editor/css.tt';
174	dpavlin	134	}
175
176	dpavlin	165	=item record
177
178	dpavlin	167	Return html of record taking C<mfn> and C<template_filename> from request.
179
180	dpavlin	165	=cut
181
182			sub record : Local {
183			my ( $self, $c ) = @_;
184
185			$c->log->debug('record params '.Dumper($c->req->params));
186
187	dpavlin	242	my $record_uri = $c->req->params->{record_uri};
188	dpavlin	244	$record_uri \|\|= $c->config->{editor}->{default_record_uri} and
189			$c->log->warn("using editor: default_record_uri");
190	dpavlin	165
191	dpavlin	242	if (! $record_uri) {
192	dpavlin	244	$c->log->fatal("record called without record_uri and default_record_uri not found in config under editor");
193	dpavlin	243	$c->stash->{error} = 'record retrival failed';
194			$c->stash->{template} = 'error.tt';
195	dpavlin	242	return;
196	dpavlin	165	}
197
198			my $template_filename = $c->req->params->{template_filename};
199			if (! $template_filename) {
200			$template_filename = $c->config->{webpac}->{default_template} \|\| $c->log->fatal("no webpac->default_template in configuration!");
201			$c->log->warn("no template_filename using $template_filename");
202			}
203
204			my $webpac = $c->comp('Model::WebPAC');
205
206	dpavlin	242	my $html = $webpac->record( record_uri => $record_uri, template => $template_filename );
207	dpavlin	180
208			if ($html) {
209			$c->log->debug('check html with tidy');
210			my $tidy = new HTML::Tidy;
211			$tidy->ignore( text => [
212			qr/DOCTYPE/, qr/unsupported/, qr/proprietary/i,
213			qr/invalid character code/,
214			qr/inserting missing 'title' element/,
215			qr/lacks "summary" attribute/,
216			] );
217
218	dpavlin	181	my @lines = split( "\n", $html );
219			$_ = "$_\n" for @lines;
220	dpavlin	180
221	dpavlin	181	if ( $tidy->parse('tidy', @lines) ) {
222			if ( $tidy->messages ) {
223			$html .= <<__TIDY_CLOSE__;
224			<div id="tidy_show" class="notice" style="display: none;" onclick="Element.hide('tidy_show'); Element.show('tidy');">?</div>
225			<div id="tidy" class="tidy">
226			<a href="#" onclick="Element.hide('tidy'); Element.show('tidy_show'); return false;">close</a>
227			HTML Tidy output:
228			<br/>
229			__TIDY_CLOSE__
230	dpavlin	180	# Escape <, >, & and ", and to produce valid XML
231			my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"');
232			my $escape_re = join '\|' => keys %escape;
233
234			foreach my $m ( $tidy->messages ) {
235	dpavlin	181	my $c = $lines[ ( $m->line - 1 ) ];
236	dpavlin	180	my $txt = $m->as_string;
237			$c =~ s/($escape_re)/$escape{$1}/g;
238			$txt =~ s/($escape_re)/$escape{$1}/g;
239			my $class = '';
240			$class = ' class="tidy_'.lc($1).'"' if ($txt =~ /(Warning\|Error):/s);
241	dpavlin	181	$html .= 'line ' . $m->line . ":<span${class}>$txt<tt>$c</tt></span>";
242	dpavlin	180	}
243			$html .= '</div>';
244			}
245			} else {
246			$html .= qq{<div class="tidy tidy_error">Can't parse this record with HTML Tidy!</div>};
247			}
248	dpavlin	241	} else {
249			$html .= qq{<div class="no_results">Can't find record</div>};
250	dpavlin	180	}
251	dpavlin	242
252	dpavlin	179	$c->response->content_type('text/html; charset=utf-8');
253	dpavlin	237	$c->response->body( $html );
254	dpavlin	165	}
255
256	dpavlin	167
257
258	dpavlin	134	=back
259
260			=head1 AUTHOR
261
262	dpavlin	165	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
263	dpavlin	134
264			=head1 LICENSE
265
266			This library is free software, you can redistribute it and/or modify
267			it under the same terms as Perl itself.
268
269			=cut
270
271			1;