+ my $controller = delete($params{controller}) || $self->controller_name;
+ my $action = $params{action} || 'dispatch';
+ my $fragment = delete $params{fragment};
+
+ my $script;
+ if ($controller =~ m/\.pl$/) {
+ # Old-style controller
+ $script = $controller;
+ } else {
+ $params{action} = "${controller}/${action}";
+ $script = "controller.pl";
+ }
+
+ my $query = join '&', map { uri_encode($_->[0]) . '=' . uri_encode($_->[1]) } @{ flatten(\%params) };
+
+ return "${script}?${query}" . (defined $fragment ? "#$fragment" : '');
+}
+
+sub redirect_to {
+ my $self = shift;
+ my $url = $self->url_for(@_);
+
+ if ($self->delay_flash_on_redirect) {
+ require SL::Helper::Flash;
+ SL::Helper::Flash::delay_flash();
+ }
+
+ return $self->render(SL::ClientJS->new->redirect_to($url)) if $::request->is_ajax;
+
+ print $::request->{cgi}->redirect($url);
+}
+
+sub render {
+ my $self = shift;
+ my $template = shift;
+ my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
+
+ # Special handling/shortcut for an instance of SL::ClientJS:
+ return $self->render(\$template->to_json, { type => 'json' }) if ref($template) eq 'SL::ClientJS';
+
+ # Set defaults for all available options.
+ my %defaults = (
+ type => 'html',
+ output => 1,
+ header => 1,
+ layout => 1,
+ process => 1,
+ status => '200 ok',
+ );
+ $options->{$_} //= $defaults{$_} for keys %defaults;
+ $options->{type} = lc $options->{type};
+
+ # Check supplied options for validity.
+ foreach (keys %{ $options }) {
+ croak "Unsupported option: $_" unless $defaults{$_};
+ }
+
+ # Only certain types are supported.
+ croak "Unsupported type: " . $options->{type} unless $options->{type} =~ m/^(?:html|js|json|text)$/;
+
+ # The "template" argument must be a string or a reference to one.
+ $template = ${ $template } if ((ref($template) || '') eq 'REF') && (ref(${ $template }) eq 'SL::Presenter::EscapedText');
+ croak "Unsupported 'template' reference type: " . ref($template) if ref($template) && (ref($template) !~ m/^(?:SCALAR|SL::Presenter::EscapedText)$/);
+
+ # If all output is turned off then don't output the header either.
+ if (!$options->{output}) {
+ $options->{header} = 0;
+ $options->{layout} = 0;
+
+ } else {
+ # Layout only makes sense if we're outputting HTML.
+ $options->{layout} = 0 if $options->{type} ne 'html';
+ }
+
+ # Let the presenter do the rest of the work.
+ my $output;
+ {
+ local $::form->{title} = $locals{title} if $locals{title};
+ $output = $self->presenter->render(
+ $template,
+ { type => $options->{type}, process => $options->{process} },
+ %locals,
+ SELF => $self,
+ );
+ }
+
+ if ($options->{header}) {
+ # Output the HTTP response and the layout in case of HTML output.
+
+ if ($options->{layout}) {
+ $::form->{title} = $locals{title} if $locals{title};
+ $::form->header;
+
+ } else {
+ # No layout: just the standard HTTP response. Also notify
+ # $::form that the header has already been output so that
+ # $::form->header() won't output it again.
+ $::form->{header} = 1;
+ my $content_type = $options->{type} eq 'html' ? 'text/html'
+ : $options->{type} eq 'js' ? 'text/javascript'
+ : $options->{type} eq 'text' ? 'text/plain'
+ : 'application/json';
+
+ print $::form->create_http_response(content_type => $content_type,
+ charset => 'UTF-8',
+ (status => $options->{status}) x !!$options->{status});
+ }
+ }
+
+ # Print the output if wanted.
+ print $output if $options->{output};
+
+ return $output;
+}
+
+sub send_file {
+ my ($self, $file_name_or_content, %params) = @_;
+
+ my ($file, $size);
+
+ if (!ref $file_name_or_content) {
+ $file = IO::File->new($file_name_or_content, 'r') || croak("Cannot open file '${file_name_or_content}'");
+ $size = -s $file_name_or_content;
+ } else {
+ $size = length $$file_name_or_content;
+ }
+
+ my $content_type = $params{type} || 'application/octet_stream';
+ my $attachment_name = $params{name} || (!ref($file_name_or_content) ? $file_name_or_content : '');
+ $attachment_name =~ s:.*//::g;
+
+ if ($::request->is_ajax || $params{ajax}) {
+ my $octets = ref $file_name_or_content ? $file_name_or_content : \ do { local $/ = undef; <$file> };
+ $self->js->save_file(MIME::Base64::encode_base64($$octets), $content_type, $size, $attachment_name);
+ $self->js->render unless $params{js_no_render};
+ } else {
+ print $::form->create_http_response(content_type => $content_type,
+ content_disposition => 'attachment; filename="' . $attachment_name . '"',
+ content_length => $size);
+
+ if (!ref $file_name_or_content) {
+ $::locale->with_raw_io(\*STDOUT, sub { print while <$file> });
+ $file->close;
+ unlink $file_name_or_content if $params{unlink};
+ } else {
+ $::locale->with_raw_io(\*STDOUT, sub { print $$file_name_or_content });
+ }
+ }
+
+ return 1;
+}
+
+sub presenter {
+ return SL::Presenter->get;
+}