SL:Webdav:File.pm->store: ungeänderte Dokumente nicht doppelt speichern.

[kivitendo-erp.git] / SL / Controller / Base.pm

diff --git a/SL/Controller/Base.pm b/SL/Controller/Base.pm
index d80fca1..63f153f 100644 (file)
--- a/SL/Controller/Base.pm
+++ b/SL/Controller/Base.pm
@@ -5,7 +5,18 @@ use strict;
 use parent qw(Rose::Object);
 
 use Carp;
 use parent qw(Rose::Object);
 
 use Carp;

+use IO::File;

 use List::Util qw(first);
 use List::Util qw(first);

+use MIME::Base64;
+use SL::Request qw(flatten);
+use SL::MoreCommon qw(uri_encode);
+use SL::Presenter;
+
+use Rose::Object::MakeMethods::Generic
+(
+  scalar                  => [ qw(action_name) ],
+  'scalar --get_set_init' => [ qw(js p) ],
+);

 
 #
 # public/helper functions
 
 #
 # public/helper functions


@@ -17,19 +28,36 @@ sub url_for {
   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
 
   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
 
   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;

-  my $controller  = delete($params{controller}) || $self->_controller_name;
-  my $action      = delete($params{action})     || 'dispatch';
-  $params{action} = "${controller}/${action}";
-  my $query       = join('&', map { $::form->escape($_) . '=' . $::form->escape($params{$_}) } keys %params);
+  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";
+  }

 
 

-  return "controller.pl?${query}";
+  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(@_);
 
 }
 
 sub redirect_to {
   my $self = shift;
   my $url  = $self->url_for(@_);
 

-  print $::cgi->redirect($url);
+  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 {
 }
 
 sub render {


@@ -37,50 +65,137 @@ sub render {
   my $template           = shift;
   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
 
   my $template           = shift;
   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
 

-  $options->{type}       = lc($options->{type} || 'html');
-  $options->{no_layout}  = 1 if $options->{type} eq 'js';
+  # 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)$/;

 
 

-  my $source;
-  if ($options->{inline}) {
-    $source = \$template;
+  # 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 {
 
   } else {

-    $source = "templates/webpages/${template}." . $options->{type};
-    croak "Template file ${source} not found" unless -f $source;
+    # 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->{partial} && !$options->{inline} && !$::form->{header}) {
-    if ($options->{no_layout}) {
+  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;
       $::form->{header} = 1;

-      my $content_type  = $options->{type} eq 'js' ? 'text/javascript' : 'text/html';
+      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,
 
       print $::form->create_http_response(content_type => $content_type,

-                                          charset      => $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET());
+                                          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 {
     } else {

-      $::form->{title} = $locals{title} if $locals{title};
-      $::form->header;
+      $::locale->with_raw_io(\*STDOUT, sub { print $$file_name_or_content });

     }
   }
 
     }
   }
 

-  my %params = ( %locals,
-                 AUTH     => $::auth,
-                 FLASH    => $::form->{FLASH},
-                 FORM     => $::form,
-                 LOCALE   => $::locale,
-                 LXCONFIG => \%::lx_office_conf,
-                 LXDEBUG  => $::lxdebug,
-                 MYCONFIG => \%::myconfig,
-                 SELF     => $self,
-               );
+  return 1;
+}

 
 

-  my $output;
-  my $parser = $self->_template_obj;
-  $parser->process($source, \%params, \$output) || croak $parser->error;
+sub presenter {
+  return SL::Presenter->get;
+}

 
 

-  print $output unless $options->{inline} || $options->{no_output};
+sub init_p {
+  return SL::Presenter->get;
+}

 
 

-  return $output;
+sub controller_name {
+  my $class = ref($_[0]) || $_[0];
+  $class    =~ s/^SL::Controller:://;
+  return $class;
+}
+
+sub init_js {
+  SL::ClientJS->new(controller => $_[0])

 }
 
 #
 }
 
 #


@@ -119,14 +234,31 @@ sub _run_hooks {
          || ($hook->{except} &&  $hook->{except}->{$action});
 
     if (ref($hook->{code}) eq 'CODE') {
          || ($hook->{except} &&  $hook->{except}->{$action});
 
     if (ref($hook->{code}) eq 'CODE') {

-      $hook->{code}->($self);
+      $hook->{code}->($self, $action);

     } else {
       my $sub = $hook->{code};
     } else {
       my $sub = $hook->{code};

-      $self->$sub;
+      $self->$sub($action);

     }
   }
 }
 
     }
   }
 }
 

+#
+#  behaviour. override these
+#
+
+sub delay_flash_on_redirect {
+  0;
+}
+
+sub get_auth_level {
+  # Ignore the 'action' parameter.
+  return 'user';
+}
+
+sub keep_auth_vars_in_form {
+  return 0;
+}
+

 #
 # private functions -- for use in Base only
 #
 #
 # private functions -- for use in Base only
 #


@@ -140,15 +272,12 @@ sub _run_action {
 
   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
 
 
   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
 

+  $self->action_name($action);

   $self->_run_hooks('before', $action);
   $self->$sub(@_);
   $self->_run_hooks('after', $action);
 }
 
   $self->_run_hooks('before', $action);
   $self->$sub(@_);
   $self->_run_hooks('after', $action);
 }
 

-sub _controller_name {
-  return (split(/::/, ref($_[0])))[-1];
-}
-

 sub _dispatch {
   my $self    = shift;
 
 sub _dispatch {
   my $self    = shift;
 


@@ -157,26 +286,14 @@ sub _dispatch {
   my $action  = first { $::form->{"action_${_}"} } @actions;
   my $sub     = "action_${action}";
 
   my $action  = first { $::form->{"action_${_}"} } @actions;
   my $sub     = "action_${action}";
 

-  $self->_run_hooks('before', $action);
-  $self->$sub(@_);
-  $self->_run_hooks('after', $action);
-}
-
-sub _template_obj {
-  my ($self) = @_;
-
-  $self->{__basepriv_template_obj} ||=
-    Template->new({ INTERPOLATE  => 0,
-                    EVAL_PERL    => 0,
-                    ABSOLUTE     => 1,
-                    CACHE_SIZE   => 0,
-                    PLUGIN_BASE  => 'SL::Template::Plugin',
-                    INCLUDE_PATH => '.:templates/webpages',
-                    COMPILE_EXT  => '.tcc',
-                    COMPILE_DIR  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
-                  }) || croak;
-
-  return $self->{__basepriv_template_obj};
+  if ($self->can($sub)) {
+    $self->action_name($action);
+    $self->_run_hooks('before', $action);
+    $self->$sub(@_);
+    $self->_run_hooks('after', $action);
+  } else {
+    $::form->error($::locale->text('Oops. No valid action found to dispatch. Please report this case to the kivitendo team.'));
+  }

 }
 
 1;
 }
 
 1;


@@ -266,6 +383,10 @@ hooks themselves are run as instance methods.
 
 Hooks are run in the order they're added.
 
 
 Hooks are run in the order they're added.
 

+The hooks receive a single parameter: the name of the action that is
+about to be called (for C<before> hooks) / was called (for C<after>
+hooks).
+

 The return value of the hooks is discarded.
 
 Hooks can be defined to run for all actions, for only specific actions
 The return value of the hooks is discarded.
 
 Hooks can be defined to run for all actions, for only specific actions


@@ -292,61 +413,69 @@ C<Form::parse_html_template> does.
 C<$options>, if present, must be a hash reference. All remaining
 parameters are slurped into C<%locals>.
 
 C<$options>, if present, must be a hash reference. All remaining
 parameters are slurped into C<%locals>.
 

-What is rendered and how C<$template> is interpreted is determined by
-the options I<type>, I<inline>, I<partial> and I<no_layout>.
+What is rendered and how C<$template> is interpreted is determined
+both by C<$template>'s reference type and by the supplied options. The
+actual rendering is handled by L<SL::Presenter/render>.

 
 

-If C<< $options->{inline} >> is trueish then C<$template> is a string
-containing the template code to interprete. Additionally the output
-will not be sent to the browser. Instead it is only returned to the
-caller.
+If C<$template> is a normal scalar (not a reference) then it is meant
+to be a template file name relative to the C<templates/webpages>
+directory. The file name to use is determined by the C<type> option.

 
 

-If C<< $options->{inline} >> is falsish then C<$template> is
-interpreted as the name of a template file. It is prefixed with
-"templates/webpages/" and postfixed with a file extension based on
-C<< $options->{type} >>. C<< $options->{type} >> can be either C<html>
-or C<js> and defaults to C<html>. An exception will be thrown if that
-file does not exist.
+If C<$template> is a reference to a scalar then the referenced
+scalar's content is used as the content to process. The C<type> option
+is not considered in this case.

 
 

-If C<< $options->{partial} >> or C<< $options->{inline} >> is trueish
-then neither the HTTP response header nor the standard HTML header is
-generated.
+C<$template> can also be an instance of L<SL::Presenter::EscapedText>
+or a reference to such an instance. Both of these cases are handled
+the same way as if C<$template> were a reference to a scalar: its
+content is processed, and C<type> is not considered.

 
 

-Otherwise at least the HTTP response header will be generated based on
-the template type (C<< $options->{type} >>).
+Other reference types, unknown options and unknown arguments to the
+C<type> option cause the function to L<croak>.

 
 

-If the template type is C<html> then the standard HTML header will be
-output via C<< $::form->header >> with C<< $::form->{title} >> set to
-C<$locals{title}> (the latter only if C<$locals{title}> is
-trueish). Setting C<< $options->{no_layout} >> to trueish will prevent
-this.
-
-The template itself has access to the following variables:
+The following options are available (defaults: C<type> = 'html',
+C<process> = 1, C<output> = 1, C<header> = 1, C<layout> = 1):

 
 =over 2
 
 
 =over 2
 

-=item * C<AUTH> -- C<$::auth>
+=item C<type>
+
+The template type. Can be C<html> (the default), C<js> for JavaScript,
+C<json> for JSON and C<text> for plain text content. Affects the
+extension that's added to the file name given with a non-reference
+C<$template> argument, the content type HTTP header that is output and
+whether or not the layout will be output as well (see description of
+C<layout> below).
+
+=item C<process>

 
 

-=item * C<FORM> -- C<$::form>
+If trueish (which is also the default) it causes the template/content
+to be processed by the Template toolkit. Otherwise the
+template/content is output as-is.

 
 

-=item * C<LOCALE> -- C<$::locale>
+=item C<output>

 
 

-=item * C<LXCONFIG> -- all parameters from C<config/lx_office.conf>
-with the same name they appear in the file (first level is the
-section, second the actual variable, e.g. C<system.dbcharset>,
-C<features.webdav> etc)
+If trueish (the default) then the generated output will be sent to the
+browser in addition to being returned. If falsish then the options
+C<header> and C<layout> are set to 0 as well.

 
 

-=item * C<LXDEBUG> -- C<$::lxdebug>
+=item C<header>

 
 

-=item * C<MYCONFIG> -- C<%::myconfig>
+Determines whether or not to output the HTTP response
+headers. Defaults to the same value that C<output> is set to. If set
+to falsish then the layout is not output either.

 
 

-=item * C<SELF> -- the controller instance
+=item C<layout>

 
 

-=item * All items from C<%locals>
+Determines whether or not the basic HTML layout structure should be
+output (HTML header, common JavaScript and stylesheet inclusions, menu
+etc.). Defaults to 0 if C<type> is not C<html> and to the same value
+C<header> is set to otherwise.

 
 =back
 
 
 =back
 

-Unless C<< $options->{inline} >> is trueish the function will send the
-output to the browser.
+The template itself has access to several variables. These are listed
+in the documentation to L<SL::Presenter/render>.

 
 The function will always return the output.
 
 
 The function will always return the output.
 


@@ -357,17 +486,42 @@ Example: Render a HTML template with a certain title and a few locals
                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
 
 Example: Render a string and return its content for further processing
                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
 
 Example: Render a string and return its content for further processing

-by the calling function. No header is generated due to C<inline>.
+by the calling function. No header is generated due to C<output>.

 
 

-  my $content = $self->render('[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
-                              { type => 'js', inline => 1 });
+  my $content = $self->render(\'[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
+                              { output => 0 });

 
 

-Example: Render a JavaScript template and send it to the
+Example: Render a JavaScript template
+"templates/webpages/todo/single_item.js" and send it to the

 browser. Typical use for actions called via AJAX:
 
   $self->render('todo/single_item', { type => 'js' },
                 item => $employee->most_important_todo_item);
 
 browser. Typical use for actions called via AJAX:
 
   $self->render('todo/single_item', { type => 'js' },
                 item => $employee->most_important_todo_item);
 

+=item C<send_file $file_name_or_content, [%params]>
+
+Sends the file C<$file_name_or_content> to the browser including
+appropriate HTTP headers for a download. If C<$file_name_or_content>
+is a scalar then it is interpreted as a file name which is opened and
+whose content is sent. Otherwise (C<$file_name_or_content> being a
+reference) the referenced scalar's data itself is sent.
+
+C<%params> can include the following:
+
+=over 2
+
+=item * C<type> -- the file's content type; defaults to
+'application/octet_stream'
+
+=item * C<name> -- the name presented to the browser; defaults to
+C<$file_name>; mandatory if C<$file_name_or_content> is a reference
+
+=item * C<unlink> -- if trueish and C<$file_name_or_content> refers to
+a file name then unlink the file after it has been sent to the browser
+(e.g. for temporary files)
+
+=back
+

 =item C<url_for $url>
 
 =item C<url_for $params>
 =item C<url_for $url>
 
 =item C<url_for $params>


@@ -383,11 +537,14 @@ parameter or as a normal hash.
 
 The controller to call is given by C<$params{controller}>. It defaults
 to the current controller as returned by
 
 The controller to call is given by C<$params{controller}>. It defaults
 to the current controller as returned by

-L</_controller_name>.
+L</controller_name>.

 
 The action to call is given by C<$params{action}>. It defaults to
 C<dispatch>.
 
 
 The action to call is given by C<$params{action}>. It defaults to
 C<dispatch>.
 

+If C<$params{fragment}> is present, it's used as the fragment of the resulting
+URL.
+

 All other key/value pairs in C<%params> are appended as GET parameters
 to the URL.
 
 All other key/value pairs in C<%params> are appended as GET parameters
 to the URL.
 


@@ -397,9 +554,15 @@ Usage from a template might look like this:
 
 =item C<redirect_to %url_params>
 
 
 =item C<redirect_to %url_params>
 

-Redirects the browser to a new URL by outputting a HTTP redirect
-header. The URL is generated by calling L</url_for> with
-C<%url_params>.
+Redirects the browser to a new URL. The URL is generated by calling
+L</url_for> with C<%url_params>.
+
+This function implements the redirection depending on whether or not
+the current request is an AJAX request as determined by
+L<SL::Request/is_ajax>. If it is a normal request then it outputs a
+standard HTTP redirect header (HTTP code 302). If it is an AJAX
+request then it outputs an AJAX response suitable for the
+C<kivi.eval_json_result> function from the L<SL::ClientJS> module.

 
 =item C<run_before $sub, %params>
 
 
 =item C<run_before $sub, %params>
 


@@ -434,6 +597,52 @@ action.
 
 The hook's return values are discarded.
 
 
 The hook's return values are discarded.
 

+=item C<delay_flash_on_redirect>
+
+May be overridden by a controller. If this method returns true, redirect_to
+will delay all flash messages for the current request. Defaults to false for
+compatibility reasons.
+
+=item C<get_auth_level $action>
+
+May be overridden by a controller. Determines what kind of
+authentication is required for a particular action. Must return either
+C<admin> (which means that authentication as an admin is required),
+C<user> (authentication as a normal user suffices) with a possible
+future value C<none> (which would require no authentication but is not
+yet implemented).
+
+=item C<keep_auth_vars_in_form %params>
+
+May be overridden by a controller. If falsish (the default) all form
+variables whose name starts with C<{AUTH}> are removed before the
+request is routed. Only controllers that handle login requests
+themselves should return trueish for this function.
+
+C<$params{action}> contains the action name that the request will be
+dispatched to.
+
+=item C<controller_name>
+
+Returns the name of the curernt controller package without the
+C<SL::Controller::> prefix. This method can be called both as a class
+method and an instance method.
+
+=item C<action_name>
+
+Returns the name of the currently executing action. If the dispatcher
+mechanism was used then this is not C<dispatch> but the actual method
+name the dispatching resolved to.
+
+=item C<presenter>
+
+Returns the global presenter object by calling
+L<SL::Presenter/get>.
+
+=item C<js>
+
+Returns an L<SL::ClientJS> instance for this controller.
+

 =back
 
 =head2 PRIVATE FUNCTIONS
 =back
 
 =head2 PRIVATE FUNCTIONS


@@ -442,11 +651,6 @@ These functions are supposed to be used from this base class only.
 
 =over 4
 
 
 =over 4
 

-=item C<_controller_name>
-
-Returns the name of the curernt controller package without the
-C<SL::Controller::> prefix.
-

 =item C<_dispatch>
 
 Implements the method lookup for indirect dispatching mentioned in the
 =item C<_dispatch>
 
 Implements the method lookup for indirect dispatching mentioned in the