config cache issues

By default the configuration cached by the mod_perl2 instance.
You can disable cache by setting cache/config=0.
You should disable cache only if you have multiple calcms instances
running on the same mod_perl2 server with different configuration.

The Location of the configuration will be determined by config module
now.

lib/calcms/config.pm

@@ -3,6 +3,7 @@ package config;
 use warnings;
 use strict;
 
+use FindBin();
 use Config::General();
 
 use base 'Exporter';
@@ -19,7 +20,7 @@ sub set {
 sub get {
     my $filename = shift;
 
-    return $config if defined $config;;
+    return $config if ( defined $config ) && ( $config->{cache}->{cache_config} == 1 );
 
     my $configuration = Config::General->new(
         -ConfigFile => $filename,
@@ -29,5 +30,11 @@ sub get {
     return $config;
 }
 
+sub getFromScriptLocation() {
+    FindBin::again();
+    my $configFile = $FindBin::Bin . '/config/config.cgi';
+    return config::get($configFile);
+}
+
 #do not delete last line
 1;

website/agenda/add_comment.cgi

@@ -23,7 +23,7 @@ binmode STDOUT, ":utf8";
 my $r=shift;
 (my $cgi, my $params, my $error)=params::get($r);
 
-my $config = config::get('./config/config.cgi');
+my $config = config::getFromScriptLocation();
 my $debug  = $config->{system}->{debug};
 
 my $request={

website/agenda/aggregate.cgi

@@ -21,7 +21,8 @@ if ( $0 =~ /aggregate.*?\.cgi$/ ) {
 	my %params = $cgi->Vars();
 	my $params = \%params;
 
-	my $config    = config::get('config/config.cgi');
+	my $config = config::getFromScriptLocation();
+
 	my $debug     = $config->{system}->{debug};
 	my $mem_debug = $config->{system}->{debug_memory};
 	my $base_dir  = $config->{locations}->{base_dir};

website/agenda/cal.cgi

@@ -22,7 +22,7 @@ binmode STDOUT, ":encoding(UTF-8)";
 if ( $0 =~ /cal.*?\.cgi$/ ) {
 	( my $cgi, my $params, my $error ) = params::get($r);
 
-	my $config = config::get('config/config.cgi');
+	my $config = config::getFromScriptLocation();
 	my $debug  = $config->{system}->{debug};
 
 	my $request = {

website/agenda/category.cgi

@@ -21,8 +21,7 @@ binmode STDOUT, ":utf8";
 my $r = shift;
 ( my $cgi, my $params, my $error ) = params::get($r);
 
-my $config = config::get('config/config.cgi');
+my $config = config::getFromScriptLocation();
-
 my $debug = $config->{system}->{debug};
 
 my $request = {

website/agenda/events.cgi

@@ -6,7 +6,6 @@ no warnings 'redefine';
 
 use Data::Dumper;
 
-#use utf8;
 use DBI;
 use CGI qw(header param Vars);
 $CGI::POST_MAX        = 1000;
@@ -18,16 +17,13 @@ use log();
 use events();
 use time();
 
-#binmode STDOUT, ":utf8";
 binmode STDOUT, ":encoding(UTF-8)";
 
 my $r = shift;
 ( my $cgi, my $params, my $error ) = params::get($r);
 if ( $0 =~ /events.*?\.cgi$/ ) {
 
-	#my $cgi=new CGI();
+    my $config = config::getFromScriptLocation();
-	#my %params=$cgi->Vars();
-	our $config = config::get('config/config.cgi');
 
     $params->{template} = '' unless defined $params->{template};
     $params->{recordings} = 1 if $params->{template} =~ /events_playout/;

website/agenda/planung/calendar.cgi

@@ -1417,6 +1417,7 @@ sub print_event {
 
     my $attr = '';
     if ( $class =~ /play/ ) {
+        #$event->{rms_image}=~s/\.png/.svg/;
         $attr .= ' rms="' . $event->{rms_image} . '"' if defined $event->{rms_image};
         $attr .= ' start="' . $event->{start} . '"'   if defined $event->{start};
     }

website/agenda/planung/create_events.cgi

@@ -39,9 +39,9 @@ my $user_presets = uac::get_user_presets(
 );
 $params->{default_studio_id} = $user_presets->{studio_id};
 $params->{studio_id}         = $params->{default_studio_id}
-  if ( ( !( defined $params->{action} ) ) || ( $params->{action} eq '' ) || ( $params->{action} eq 'login' ) );
+  if ( !defined $params->{action} ) || ( $params->{action} eq '' ) || ( $params->{action} eq 'login' );
 $params->{project_id} = $user_presets->{project_id}
-  if ( ( !( defined $params->{action} ) ) || ( $params->{action} eq '' ) || ( $params->{action} eq 'login' ) );
+  if ( !defined $params->{action} ) || ( $params->{action} eq '' ) || ( $params->{action} eq 'login' );
 
 #print STDERR $params->{project_id}."\n";
 my $request = {
@@ -87,9 +87,14 @@ sub show_events {
     my $params      = $request->{params}->{checked};
     my $permissions = $request->{permissions};
     unless ( $permissions->{assign_series_events} == 1 ) {
-        uac::permissions_denied('assign_series_events');
+        uac::permissions_denied('read_events');
         return;
     }
+
+    my $events = getDates( $config, $request );
+    $params->{events} = $events;
+    $params->{total}  = scalar(@$events);
+    $params->{action} = 'show';
     template::process( $config, 'print', $params->{template}, $params );
 
 }
@@ -106,6 +111,31 @@ sub create_events {
     }
 
     print STDERR "create events\n";
+    my $dates = getDates( $config, $request );
+
+    print STDERR "<pre>found " . ( scalar @$dates ) . " dates\n";
+    my $events = [];
+    for my $date (@$dates) {
+
+        #print STDERR $date->{start}."\n";
+        push @$events, createEvent( $config, $request, $date );
+    }
+    $params->{events} = $events;
+    $params->{total}  = scalar(@$events);
+    $params->{action} = 'created';
+    template::process( $config, 'print', $params->{template}, $params );
+}
+
+sub getDates {
+    my $config  = shift;
+    my $request = shift;
+
+    my $params      = $request->{params}->{checked};
+    my $permissions = $request->{permissions};
+    unless ( $permissions->{read_event} == 1 ) {
+        uac::permissions_denied('read_event');
+        return;
+    }
 
     my $project_id = $params->{project_id};
     my $studio_id  = $params->{studio_id};
@@ -126,8 +156,7 @@ sub create_events {
     }
     $params->{from_date} = $from_date;
     $params->{till_date} = $till_date;
-
+    print STDERR "$0: get events from $from_date to $till_date\n";
-    print STDERR "create events from $from_date to $till_date\n";
 
     my $dates = series_dates::getDatesWithoutEvent(
         $config,
@@ -138,16 +167,8 @@ sub create_events {
             till       => $till_date
         }
     );
-    print STDERR "<pre>found " . ( scalar @$dates ) . " dates\n";
-    my $events = [];
-    for my $date (@$dates) {
 
-        #print STDERR $date->{start}."\n";
+    return $dates;
-        push @$events, createEvent( $config, $request, $date );
-    }
-    $params->{created_events} = $events;
-    $params->{created_total}  = scalar(@$events);
-    template::process( $config, 'print', $params->{template}, $params );
 }
 
 sub createEvent {
@@ -191,7 +212,7 @@ sub check_params {
     #actions and roles
     $checked->{action} = '';
     if ( defined $params->{action} ) {
-        if ( $params->{action} =~ /^(create_events)$/ ) {
+        if ( $params->{action} =~ /^(create_events|show_events)$/ ) {
             $checked->{action} = $params->{action};
         }
     }

website/agenda/planung/templates/create_events.html

@@ -1,33 +1,17 @@
-<TMPL_IF .allow.scan_series_events>
+<TMPL_IF .allow.read_event> <script type="text/javascript">
-
-<script type="text/javascript">
     <TMPL_IF .getBack>
-    $(document).ready(
+    $(document).ready(function() {
-        function(){
         getBack()
-        }
+    });
-    );
     </TMPL_IF>
-
-function assign_series(project_id, studio_id){
-    if (project_id == '') return false;
-    if (studio_id  == '')  return false;
-
-    var url="create_events.cgi?project_id="+project_id+'&studio_id='+studio_id+'&action=create_events';
-    $('#create_event_form').submit();
-    return false;
-}
 </script>
 
-
 <h1>create events from schedule</h1>
 
-<form id="create_event_form">
+<form id="create_event_form" method="post">
-    <input type="hidden" name="project_id" value="<TMPL_VAR .project_id>">
+    <input type="hidden" name="project_id"
-    <input type="hidden" name="studio_id"  value="<TMPL_VAR .studio_id>">
+        value="<TMPL_VAR .project_id>"> <input type="hidden"
-    <input type="hidden" name="action" value="create_events">
+        name="studio_id" value="<TMPL_VAR .studio_id>"> duration
-
-    duration
     <select name="duration">
         <option value="7">1 week</option>
         <option value="14">2 weeks</option>
@@ -35,20 +19,25 @@ function assign_series(project_id, studio_id){
         <option value="28">4 weeks</option>
     </select>
 
-    <button target="_blank"
+    <TMPL_IF .allow.read_event>
-        onclick="assign_series('<TMPL_VAR .project_id>', '<TMPL_VAR .studio_id>');return false;"
+    <button target="_blank" type='submit' name="action" value="show">show</button>
-    >create</button>
+    </TMPL_IF>
+    <TMPL_IF .allow.assign_series_events>
+    <button target="_blank" type='submit' name="action"
+        value="create_events">create</button>
+    </TMPL_IF>
 </form>
 
 <div class="view" style="clear: both">
-created <TMPL_VAR created_total> events from <TMPL_VAR from_date> till <TMPL_VAR till_date><br>
+    <TMPL_VAR action> <TMPL_VAR created_total>
-<TMPL_LOOP created_events> events created
+    events from <TMPL_VAR from_date> till <TMPL_VAR till_date>
-    <TMPL_var start><TMPL_var full_title><br>
+    <br>
-</TMPL_LOOP>
 
-</view>
+    <TMPL_LOOP events> <TMPL_var start> <TMPL_var
+        full_title> <br></TMPL_LOOP> </view>
 
     </body>
     </html>
 
+    <TMPL_ELSE> missing permission to read events 
 </TMPL_IF>

website/agenda/series.cgi

@@ -16,8 +16,7 @@ print "Content-Type: text/html; charset=utf-8\n\n";
 my $r = shift;
 ( my $cgi, my $params, my $error ) = params::get($r);
 
-my $config = config::get('config/config.cgi');
+my $config = config::getFromScriptLocation();
-
 $params = check_params( $config, $params );
 
 list_series( $config, $params );

website/agenda/series_names.cgi

@@ -2,6 +2,7 @@
 
 #use utf8;
 use warnings "all";
+
 #use diagnostics;
 use strict;
 use Data::Dumper;
@@ -23,8 +24,7 @@ binmode STDOUT, ":utf8";
 
 my $r = shift;
 ( my $cgi, my $params, my $error ) = params::get($r);
-my $config = config::get('config/config.cgi');
+my $config = config::getFromScriptLocation();
-
 my $debug = $config->{system}->{debug};
 
 #get request

website/agenda/upload_playout.cgi

@@ -1,6 +1,5 @@
 #! /usr/bin/perl -w
 
-#use utf8;
 use warnings "all";
 use strict;
 
@@ -10,7 +9,6 @@ $CGI::DISABLE_UPLOADS = 1;
 
 use Data::Dumper;
 
-#use Apache2::Request;
 use JSON();
 use params();
 use config();
@@ -19,7 +17,6 @@ use playout();
 
 my $r = shift;
 
-#binmode STDOUT, ":utf8";
 binmode STDOUT, ":encoding(UTF-8)";
 
 if ( $0 =~ /upload_playout.*?\.cgi$/ ) {
@@ -34,7 +31,7 @@ if ( $0 =~ /upload_playout.*?\.cgi$/ ) {
     # parse GET content
     ( my $cgi, my $params, my $error ) = params::get($r);
 
-	my $config = config::get('config/config.cgi');
+    my $config = config::getFromScriptLocation();
     my $debug  = $config->{system}->{debug};
     my $len    = $r->headers_in()->get('Content-Length');
     print "Content-type:text/plain\n\n";