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;

        $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>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>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->{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 $mfn = $c->req->params->{mfn};

        if (! $mfn) {
                $c->log->warn("no mfn, using 1");
                $mfn = 1;
        }

        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( mfn => $mfn, 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/,
                ] );
                if ( $tidy->parse('html', $html) ) {
                        if ( $tidy->messages ) {
                                $html .= '<div class="tidy">HTML Tidy output:';

                                my @lines = split(/[\n\r]+/, $html);

                                # 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 - 2 ) ];
                                        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 .= "<div${class}>$txt | <tt>$c</tt></div>";
                                }
                                $html .= '</div>';
                        }
                } else {
                        $html .= qq{<div class="tidy tidy_error">Can't parse this record with HTML Tidy!</div>};
                }
        }
                
                
        $c->response->content_type('text/html; charset=utf-8'); 
        $c->res->output( $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			$c->stash->{template} = 'editor.tt';
45	dpavlin	134	}
46
47	dpavlin	165	=item template
48
49			fetch template using C<template_filename> in request or
50			C<< webpac->default_template >>.
51
52			=cut
53
54	dpavlin	134	sub template : Local {
55	dpavlin	135	my ( $self, $c ) = @_;
56	dpavlin	134
57	dpavlin	167	my $template_filename =
58	dpavlin	165	$c->req->params->{template_filename} \|\|
59			$c->config->{webpac}->{default_template} \|\|
60			$c->log->fatal("need default_template");
61	dpavlin	135
62			my $webpac = $c->comp('Model::WebPAC');
63
64	dpavlin	167	my $template_path = $webpac->{template_path} \|\| $c->log->fatal("can't find template_path in Model::WebPAC");
65	dpavlin	135
66	dpavlin	167	my $template_full_path = "$template_path/$template_filename";
67
68	dpavlin	172	if ($c->req->params->{save_template}) {
69	dpavlin	179
70			$c->response->content_type('text/html; charset=utf-8');
71
72	dpavlin	172	my $t = $c->req->params->{template_content};
73			my $size = length($t);
74			$c->log->debug("saving $template_full_path, $size bytes");
75			if ($webpac->save_html( $template_full_path, $t )) {
76			$c->res->output("<span>saved $template_filename, $size bytes</span>");
77			} else {
78			$c->res->output("<span>error saving $template_filename!</span>");
79			}
80			return;
81			}
82
83	dpavlin	165	$c->log->debug("loading $template_full_path");
84
85			if (! -r $template_full_path) {
86			$c->log->warn("can't find '$template_full_path': $!");
87	dpavlin	179	$c->response->content_type('text/html; charset=utf-8');
88	dpavlin	165	$c->res->output("can't find template '$template_full_path'");
89			return;
90			}
91
92	dpavlin	167	# load template html
93	dpavlin	135	$c->stash->{'template_content'} =
94			$webpac->load_html( $template_full_path );
95
96	dpavlin	167	# load template list
97
98			opendir(my $d, $template_path) \|\| $c->log->fatal("can't opendir '$template_path': $!");
99			my @templates = grep { /\.tt$/i } readdir($d);
100
101			$c->stash->{template_list} = \@templates;
102			$c->stash->{template_filename} = $template_filename;
103
104	dpavlin	135	$c->stash->{template} = 'editor/template.tt';
105	dpavlin	134	}
106
107	dpavlin	165	=item css
108
109	dpavlin	167	Return css.
110
111			B<Not finished>
112
113	dpavlin	165	=cut
114
115	dpavlin	134	sub css : Local {
116	dpavlin	135	my ( $self, $c ) = @_;
117	dpavlin	134
118	dpavlin	172	my $css_filename = $c->config->{webpac}->{default_css} \|\| die("need default_css");
119	dpavlin	135	my $css_path = $c->config->{webpac}->{css_path} \|\| die("need css_path");
120			my $webpac = $c->comp('Model::WebPAC');
121	dpavlin	165
122	dpavlin	172	my $css_full_path = "$css_path/$css_filename";
123	dpavlin	165
124	dpavlin	172	if ($c->req->params->{save_css}) {
125	dpavlin	179
126			$c->response->content_type('text/html; charset=utf-8');
127
128	dpavlin	172	my $t = $c->req->params->{css_content};
129			my $size = length($t);
130			$c->log->debug("saving $css_full_path, $size bytes");
131			if ($webpac->save_html( $css_full_path, $t )) {
132			$c->res->output("<span>saved $css_filename, $size bytes</span>");
133			} else {
134			$c->res->output("<span>error saving $css_filename!</span>");
135			}
136			return;
137			}
138
139	dpavlin	165	$c->log->debug("loading $css_full_path");
140
141			$c->stash->{'css_content'} = $webpac->load_html( $css_full_path );
142
143	dpavlin	135	$c->stash->{template} = 'editor/css.tt';
144	dpavlin	134	}
145
146	dpavlin	165	=item record
147
148	dpavlin	167	Return html of record taking C<mfn> and C<template_filename> from request.
149
150	dpavlin	165	=cut
151
152			sub record : Local {
153			my ( $self, $c ) = @_;
154
155			$c->log->debug('record params '.Dumper($c->req->params));
156
157			my $mfn = $c->req->params->{mfn};
158
159			if (! $mfn) {
160			$c->log->warn("no mfn, using 1");
161			$mfn = 1;
162			}
163
164			my $template_filename = $c->req->params->{template_filename};
165			if (! $template_filename) {
166			$template_filename = $c->config->{webpac}->{default_template} \|\| $c->log->fatal("no webpac->default_template in configuration!");
167			$c->log->warn("no template_filename using $template_filename");
168			}
169
170			my $webpac = $c->comp('Model::WebPAC');
171
172	dpavlin	180	my $html = $webpac->record( mfn => $mfn, template => $template_filename );
173
174			if ($html) {
175			$c->log->debug('check html with tidy');
176			my $tidy = new HTML::Tidy;
177			$tidy->ignore( text => [
178			qr/DOCTYPE/, qr/unsupported/, qr/proprietary/i,
179			qr/invalid character code/,
180			qr/inserting missing 'title' element/,
181			qr/lacks "summary" attribute/,
182			] );
183			if ( $tidy->parse('html', $html) ) {
184			if ( $tidy->messages ) {
185			$html .= '<div class="tidy">HTML Tidy output:';
186
187			my @lines = split(/[\n\r]+/, $html);
188
189			# Escape <, >, & and ", and to produce valid XML
190			my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"');
191			my $escape_re = join '\|' => keys %escape;
192
193
194			foreach my $m ( $tidy->messages ) {
195			my $c = $lines[ ( $m->line - 2 ) ];
196			my $txt = $m->as_string;
197			$c =~ s/($escape_re)/$escape{$1}/g;
198			$txt =~ s/($escape_re)/$escape{$1}/g;
199			my $class = '';
200			$class = ' class="tidy_'.lc($1).'"' if ($txt =~ /(Warning\|Error):/s);
201			$html .= "<div${class}>$txt \| <tt>$c</tt></div>";
202			}
203			$html .= '</div>';
204			}
205			} else {
206			$html .= qq{<div class="tidy tidy_error">Can't parse this record with HTML Tidy!</div>};
207			}
208			}
209
210
211	dpavlin	179	$c->response->content_type('text/html; charset=utf-8');
212	dpavlin	180	$c->res->output( $html );
213	dpavlin	165	}
214
215	dpavlin	167
216
217	dpavlin	134	=back
218
219			=head1 AUTHOR
220
221	dpavlin	165	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
222	dpavlin	134
223			=head1 LICENSE
224
225			This library is free software, you can redistribute it and/or modify
226			it under the same terms as Perl itself.
227
228			=cut
229
230			1;