+ my $controller = delete($params{controller}) || $self->controller_name;
+ my $action = $params{action} || 'dispatch';
+
+ 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}";
+}
+
+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($self->url_for(@_))) 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,
+ );
+ $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');
+ }
+ }
+
+ # 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;
+
+ 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 });
+ }
+}
+
+sub presenter {
+ return SL::Presenter->get;
+}
+
+sub controller_name {
+ my $class = ref($_[0]) || $_[0];
+ $class =~ s/^SL::Controller:://;
+ return $class;
+}
+
+sub init_js {
+ SL::ClientJS->new(controller => $_[0])
+}
+
+#
+# Before/after run hooks
+#
+
+sub run_before {
+ _add_hook('before', @_);
+}
+
+sub run_after {
+ _add_hook('after', @_);
+}
+
+my %hooks;
+
+sub _add_hook {
+ my ($when, $class, $sub, %params) = @_;
+
+ foreach my $key (qw(only except)) {
+ $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
+ }
+
+ my $idx = "${when}/${class}";
+ $hooks{$idx} ||= [ ];
+ push @{ $hooks{$idx} }, { %params, code => $sub };
+}
+
+sub _run_hooks {
+ my ($self, $when, $action) = @_;
+
+ my $idx = "${when}/" . ref($self);
+
+ foreach my $hook (@{ $hooks{$idx} || [] }) {
+ next if ($hook->{only } && !$hook->{only }->{$action})
+ || ($hook->{except} && $hook->{except}->{$action});
+
+ if (ref($hook->{code}) eq 'CODE') {
+ $hook->{code}->($self, $action);
+ } else {
+ my $sub = $hook->{code};
+ $self->$sub($action);
+ }
+ }
+}
+
+#
+# behaviour. override these
+#
+
+sub delay_flash_on_redirect {
+ 0;
+}
+
+sub get_auth_level {
+ # Ignore the 'action' parameter.
+ return 'user';
+}
projects / mfinanz.git / blobdiff