\n"; +} + +#do not delete last line! +1; diff --git a/lib/calcms/auth.pm b/lib/calcms/auth.pm new file mode 100644 index 0000000..973b6cb --- /dev/null +++ b/lib/calcms/auth.pm @@ -0,0 +1,354 @@ +#!/bin/perl + +use CGI; +use CGI::Carp qw(warningsToBrowser fatalsToBrowser); +use CGI::Session qw(-ip-match); +use CGI::Cookie; +#$CGI::Session::IP_MATCH=1; + +package auth; + +use warnings "all"; +use strict; + +use Data::Dumper; +use Authen::Passphrase::BlowfishCrypt; +use time; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(get_user login logout crypt_password); +our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] ); + + +my $defaultExpiration=60; +my $tmp_dir='/var/tmp/'; +my $debug=0; + +sub debug; + +sub get_user{ + my $cgi=shift; + my $config=shift; + + my %parms=$cgi->Vars(); + my $parms=\%parms; + + debug("get_user")if ($debug); + + # login or logout on action + if (defined $parms->{action}){ + if ($parms->{action} eq 'login'){ + my $user=login($cgi, $config, $parms->{user}, $parms->{password}); + $cgi->delete('user','password','uri','action'); + return $user; + }elsif($parms->{action} eq 'logout'){ + logout($cgi); + $cgi->delete('user','password','uri','action'); + return undef; + } + } + + # read session id from cookie + my $session_id=read_cookie($cgi); + + # login if no cookie found + return show_login_form($parms->{user}, 'Please login') unless defined $session_id; + + # read session + my $session=read_session($session_id); + + # login if user not found + return show_login_form($parms->{user}, 'unknown User') unless defined $session; + + $parms->{user} = $session->{user}; + $parms->{expires} = $session->{expires}; + debug($parms->{expires}); + return $session->{user}, $session->{expires}; +} + +sub crypt_password{ + my $password=shift; + + my $ppr = Authen::Passphrase::BlowfishCrypt->new( + cost => 8, + salt_random => 1, + passphrase => $password + ); + return{ + salt => $ppr->salt_base64, + crypt => $ppr->as_crypt + }; +} + +sub login{ + my $cgi=shift; + my $config=shift; + my $user=shift; + my $password=shift; + debug("login")if ($debug); + + #print STDERR "login $user $password\n"; + my $result = authenticate($config, $user, $password); + #print STDERR Dumper($result); + + return show_login_form($user,'Could not authenticate you') unless defined $result; + return unless defined $result->{login}eq '1'; + + my $timeout=$result->{timeout} || $defaultExpiration; + $timeout='+'.$timeout.'m'; + + my $session_id=create_session($user, $password, $timeout); + return $user if(create_cookie($cgi, $session_id, $timeout)); + return undef; +} + +sub logout{ + my $cgi=shift; + my $session_id=read_cookie($cgi); + debug("logout")if ($debug); + unless(delete_session($session_id)){ + return show_login_form('Cant delete session', 'logged out'); + }; + unless(delete_cookie($cgi)){ + return show_login_form('Cant remove cookie', 'logged out'); + } + my $uri=$ENV{HTTP_REFERER}||''; + $uri=~s/action=logout//g; + print $cgi->redirect($uri); +# return show_login_form('', 'logged out'); +} + +#read and write data from browser, http://perldoc.perl.org/CGI/Cookie.html +sub create_cookie{ + my $cgi=shift; + my $session_id=shift; + my $timeout=shift; + #debug("create_cookie")if ($debug); + + my $cookie = CGI::Cookie->new( + -name => 'sessionID', + -value => $session_id, + -expires => $timeout, +# -domain => '.capricorn.com', +# -path => '/agenda/admin/', + -secure => 1 + ); + print "Set-Cookie: ",$cookie->as_string,"\n"; + print STDERR "#Set-Cookie: ",$cookie->as_string,"\n"; +# print $cgi->header( -cookie => $cookie ); + return 1; +} + +sub read_cookie{ + my $cgi=shift; + + debug("read_cookie")if ($debug); + my %cookie = CGI::Cookie->fetch; + debug("cookies: ".Dumper(\%cookie))if ($debug); + my $cookie=$cookie{'sessionID'}; + debug("cookie: ".$cookie)if ($debug); + return undef unless (defined $cookie); + my $session_id= $cookie->value || undef; + debug("sid: ".$session_id)if ($debug); + return $session_id; + #return $cgi->cookie('sessionID') || undef; +}; + +sub delete_cookie{ + my $cgi=shift; + + debug("delete_cookie")if ($debug); + my $cookie = $cgi->cookie( + -name => 'sessionID', + -value => '', + -expires => '+1s' + ); + print $cgi->header( -cookie => $cookie ); + return 1; +} + +#read and write server-side session data +sub create_session{ + my $user=shift; + my $password=shift; + my $expiration=shift; + + debug("create_session")if ($debug); + my $session = new CGI::Session(undef, undef, {Directory=>$tmp_dir}); + $session->expire($expiration); + $session->param("user", $user); + $session->param("pid", $$); +# $session->param("password", $password); + return $session->id(); +} + +sub read_session{ + my $session_id=shift; + + debug("read_session")if $debug; + return undef unless(defined $session_id); + + debug("read_session2")if $debug; + my $session = new CGI::Session(undef, $session_id, {Directory=>$tmp_dir}); + return undef unless defined $session; + + debug("read_session3")if $debug; + my $user = $session->param("user") || undef; + return undef unless defined $user; + my $expires = time::time_to_datetime($session->param("_SESSION_ATIME")+$session->param("_SESSION_ETIME")); + return { + user => $user, + expires => $expires + } +} + +sub delete_session{ + my $session_id=shift; + + debug("delete_session")if ($debug); + return undef unless(defined $session_id); + my $session = new CGI::Session(undef, $session_id, {Directory=>$tmp_dir}); + $session->delete(); + return 1; +} + + +#check user authentication +sub authenticate{ + my $config=shift; + my $user=shift; + my $password=shift; + + $config->{access}->{write}=0; + my $dbh = db::connect($config); + my $query = qq{ + select * + from calcms_users + where name=? + }; + my $bind_values = [$user]; + #print STDERR "query:".Dumper($query).Dumper($bind_values); + + my $users = db::get($dbh,$query,$bind_values); + #print STDERR "result:".Dumper($users); + + if (scalar(@$users) != 1){ + print STDERR "auth: did not find user '$user'\n"; + return undef; + } + #print STDERR Dumper($users); + + my $salt=$users->[0]->{salt}; + my $ppr = Authen::Passphrase::BlowfishCrypt->from_crypt( + $users->[0]->{pass}, + $users->[0]->{salt} + ); + + return undef unless $ppr->match($password); + if($users->[0]->{disabled} == 1){ + print STDERR "user '$user' is disabled\n"; + return undef; + } + + my $timeout = $users->[0]->{session_timeout} || 120; + $timeout =10 if $timeout < 10; + $timeout =12*60 if $timeout > 12*60; + + return { + timeout => $timeout, + login => 1 + } +} + +sub show_login_form{ + my $user=shift||''; + my $uri=$ENV{HTTP_REFERER}||''; + my $message=shift||''; + debug("show_login_form")if ($debug); + print qq{Content-type:text/html + + + + + + + + + +
+
\n"; +} + +#do not delete last line! +1; diff --git a/lib/calcms/events.pm b/lib/calcms/events.pm new file mode 100644 index 0000000..4e9b638 --- /dev/null +++ b/lib/calcms/events.pm @@ -0,0 +1,1775 @@ +use warnings "all"; +use strict; + +use DBI; +use template; + +use config; +use time; +use db; +use cache; +use markup; +use log; + +package events; +use Data::Dumper; +use project; +use studios; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = + qw(init get_cached_or_render get modify_results get_query render get_running_event_id delete check_params configure_cache get_duration calc_dates get_keys add_recordings); +our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); + +sub init { +} + +sub get_cached_or_render { + + # my $response=$_[0]; + my $config = $_[1]; + my $request = $_[2]; + + my $params = $request->{params}->{checked}; + my $debug = $config->{system}->{debug}; + + my $cache = {}; + if ( $config->{cache}->{use_cache} == 1 ) { + events::configure_cache($config); + $cache = cache::load( $config, $params ); + log::write( $config, 'cache', $cache->{action} ); + if ( defined $cache->{content} ) { + $_[0] = $cache->{content}; + return; + } + } + + my $results = events::get( $config, $request ); + events::render( $_[0], $config, $request, $results ); + + #write to cache + if ( $config->{cache}->{use_cache} == 1 ) { + + #todo:put out reference only + log::write( $config, 'cache', $cache ); + $cache->{content} = $_[0]; + cache::save($cache); + } + log::mem( $config, 'events not_cached' ) if ( $debug > 2 ); + return $_[0]; +} + +sub get { + my $config = shift; + my $request = shift; + + my $debug = $config->{system}->{debug}; + + my $dbh = db::connect( $config, $request ); + + ( my $query, my $bind_values ) = events::get_query( $dbh, $config, $request ); + + #print STDERR Dumper($query).Dumper($bind_values)."\n"; + + my $results = db::get( $dbh, $$query, $bind_values ); + + #$results = events::add_recordings($dbh, $config, $request, $results); + + #print STDERR Dumper($results); + $results = events::modify_results( $dbh, $config, $request, $results ); + + return $results; +} + +sub modify_results { + my $dbh = shift; + my $config = shift; + my $request = shift; + my $results = shift; + + my $params = $request->{params}->{checked}; + + my $running_event_id = 0; + my $projects = {}; + my $studios = {}; + + # print $running_event_id." ".$running_events->[0]->{start}." ".$running_events->[0]->{title} if ($debug ne''); + my $time_diff = ''; + if ( scalar @$results > 0 ) { + $results->[0]->{__first__} = 1; + $results->[-1]->{__last__} = 1; + $running_event_id = events::get_running_event_id($dbh); + } + + if ( ( defined $params->{template} ) && ( $params->{template} =~ /\.xml/ ) ) { + $time_diff = time::utc_offset( $config->{date}->{time_zone} ); + $time_diff =~ s/(\d\d)(\d\d)/$1\:$2/g; + } + + my $previous_result = { start_date => '' }; + my $counter = 1; + for my $result (@$results) { + if ( defined $params->{template} ) { + if ( $params->{template} =~ /\.ics$/ ) { + $result->{content_ical} = + markup::plain_to_ical( $result->{content} ); + $result->{title_ical} = + markup::plain_to_ical( $result->{title} ); + $result->{user_title_ical} = + markup::plain_to_ical( $result->{user_title} ); + $result->{excerpt_ical} = + markup::plain_to_ical( $result->{excerpt} ); + $result->{user_excerpt_ical} = + markup::plain_to_ical( $result->{user_excerpt} ); + $result->{series_name} = + markup::plain_to_ical( $result->{series_name} ); + $result->{created_at} =~ s/ /T/gi; + $result->{created_at} =~ s/[\:\-]//gi; + $result->{modified_at} =~ s/ /T/gi; + $result->{modified_at} =~ s/[\:\-]//gi; + + } elsif ( $params->{template} =~ /\.atom\.xml/ ) { + $result->{excerpt} = '' unless defined( $result->{excerpt} ); + $result->{excerpt} = "lass dich ueberraschen" + if ( $result->{excerpt} eq '' ); + + # $result->{excerpt} =markup::plain_to_xml($result->{excerpt}); + # $result->{title} =markup::plain_to_xml($result->{title}); + # $result->{series_name} =markup::plain_to_xml($result->{series_name}); + # $result->{program} =markup::plain_to_xml($result->{program}); + + $result->{created_at} =~ s/ /T/gi; + $result->{created_at} .= $time_diff; + $result->{modified_at} =~ s/ /T/gi; + $result->{modified_at} .= $time_diff; + } elsif ( $params->{template} =~ /\.rss\.xml/ ) { + $result->{excerpt} = '' unless defined( $result->{excerpt} ); + $result->{excerpt} = "lass dich ueberraschen" + if ( $result->{excerpt} eq '' ); + + # $result->{excerpt} =markup::plain_to_xml($result->{excerpt}); + # $result->{title} =markup::plain_to_xml($result->{title}); + # $result->{series_name} =markup::plain_to_xml($result->{series_name}); + # $result->{program} =markup::plain_to_xml($result->{program}); + #print STDERR "created:$result->{created_at} modified:$result->{modified_at}\n"; + $result->{modified_at} = + time::datetime_to_rfc822( $result->{modified_at} ); + if ( $result->{created_at} =~ /[1-9]/ ) { + $result->{created_at} = + time::datetime_to_rfc822( $result->{created_at} ); + } else { + $result->{created_at} = $result->{modified_at}; + } + + } + } + $result->{series_name} ||= ''; + $result->{series_name} = '' if $result->{series_name} eq '_single_'; + + $result->{rerun} = '' unless defined $result->{rerun}; + + if ( $result->{title} =~ /\#(\d+)([a-z])?\s*$/ ) { + $result->{episode} = $1 unless defined $result->{episode}; + $result->{rerun} = $2 || '' unless ( $result->{rerun} =~ /\d/ ); + $result->{title} =~ s/\#\d+[a-z]?\s*$//; + $result->{title} =~ s/\s+$//; + } + $result->{rerun} = '' if ( $result->{rerun} eq '0' ); + + if ( ( defined $result->{recurrence_count} ) + && ( $result->{recurrence_count} > 0 ) ) + { + $result->{recurrence_count_alpha} = + markup::base26( $result->{recurrence_count} + 1 ); + $result->{recurrence_id} = $result->{recurrence}; + } else { + $result->{recurrence_count_alpha} = ''; + $result->{recurrence_count} = ''; + } + + # set title keys + my $keys = get_keys($result); + for my $key ( keys %$keys ) { + $result->{$key} = $keys->{$key}; + } + + $result = calc_dates( $config, $result, $params, $previous_result, $time_diff ); + + $result->{event_uri} = ''; + if ( ( defined $result->{program} ) && ( $result->{program} ne '' ) ) { + $result->{event_uri} .= $result->{program}; + $result->{event_uri} .= '-' + if ( ( $result->{series_name} ne '' ) + || ( $result->{title} ne '' ) ); + } + if ( $result->{series_name} ne '' ) { + $result->{event_uri} .= $result->{series_name}; + $result->{event_uri} .= '-' if ( $result->{title} ne '' ); + } + $result->{event_uri} .= $result->{title} if ( $result->{title} ne '' ); + $result->{event_uri} =~ s/\#/Nr./g; + $result->{event_uri} =~ s/\&/und/g; + $result->{event_uri} =~ s/\//\%2f/g; + $result->{event_uri} =~ s/[?]//g; + + $result->{rds_title} = $result->{event_uri}; + $result->{rds_title} =~ s/[^a-zA-Z0-9\-]/\_/gi; + $result->{rds_title} =~ s/\_{2,99}/\_/gi; + $result->{rds_title} = substr( $result->{rds_title}, 0, 63 ); + + # $result->{event_id}=$result->{id}; + + $result->{base_url} = $request->{base_url}; + $result->{base_domain} = $config->{locations}->{base_domain}; + $result->{static_files_url} = $config->{locations}->{static_files_url}; + $result->{source_base_url} = $config->{locations}->{source_base_url}; + $result->{cache_base_url} = $config->{cache}->{base_url}; + + $result->{is_running} = 1 + if ( $running_event_id eq $result->{event_id} ); + $result->{one_comment} = 1 if ( $result->{comment_count} == 1 ); + $result->{no_comment} = 1 if ( $result->{comment_count} == 0 ); + + #fix image url + if ( defined $result->{image} ) { + $result->{thumb} = $result->{image}; + $result->{icon} = $result->{image}; + + $result->{image} =~ s/thumbs/images/g; + $result->{image} =~ s/icons/images/g; + + #fix thumbs url + $result->{thumb} =~ s/images/thumbs/s; + $result->{thumb} =~ s/icons/thumbs/s; + + #fix icon url + $result->{icon} =~ s/thumbs/icons/s; + $result->{icon} =~ s/images/icons/s; + } + + $result->{location_css} = $result->{location} || ''; + $result->{location_css} = lc( $result->{location_css} ); + $result->{location_css} =~ s/\.//g; + $result->{location_css} =~ s/\s//g; + $result->{ 'location_label_' . $result->{location_css} } = 1; + + # add project by name + my $project_name = $result->{project}; + if ( defined $project_name ) { + + #print STDERR "found project:$project_name\n"; + unless ( defined $projects->{$project_name} ) { + my $results = project::get( $config, { name => $project_name } ); + $projects->{$project_name} = $results->[0] || {}; + } + my $project = $projects->{$project_name}; + for my $key ( keys %$project ) { + $result->{ 'project_' . $key } = $project->{$key}; + } + } else { + print STDERR "events::get - unknown project for event $result->{id}\n"; + } + + #if project_id is set add columns from project (cached) + my $project_id = $result->{project_id}; + if ( defined $project_id ) { + unless ( defined $projects->{$project_id} ) { + my $results = project::get( $config, { project_id => $project_id } ); + $projects->{$project_id} = $results->[0] || {}; + } + my $project = $projects->{$project_id}; + for my $key ( keys %$project ) { + $result->{ 'project_' . $key } = $project->{$key}; + } + } + + #if studio_id is set add columns from studio (cached) + my $studio_id = $result->{studio_id}; + if ( defined $studio_id ) { + unless ( defined $studios->{$studio_id} ) { + my $results = studios::get( $config, { studio_id => $studio_id } ); + $studios->{$studio_id} = $results->[0] || {}; + } + my $studio = $studios->{$studio_id}; + for my $key ( keys %$studio ) { + $result->{ 'studio_' . $key } = $studio->{$key}; + } + } + + #$result->{'project_title'}=$project->{title} if (defined $project->{title} && $project->{title} ne ''); + + #print STDERR "project:'$project_name'\n"; + #print STDERR "title:'$result->{project_title}'\n"; + #use Data::Dumper;print STDERR Dumper($result); + + for my $name ( keys %{ $config->{mapping}->{events} } ) { + my $val = ''; + if ( ( defined $name ) + && ( defined $config->{mapping}->{events}->{$name} ) + && ( defined $result->{$name} ) ) + { + $val = $config->{mapping}->{events}->{$name}->{ $result->{$name} } + || ''; + $result->{ $name . '_mapped' } = $val if ( $val ne '' ); + } + } + + #for my $name (keys %{$config->{controllers}}){ + # $result->{"controller_$name"}=$config->{controllers}->{$name}; + #} + + $previous_result = $result; + + #print "Content-type:text/text\n\n"; + #use Data::Dumper;print STDERR Dumper($result); + $result->{ 'counter_' . $counter } = 1; + $counter++; + + if ( ( defined $params->{template} ) + && ( $params->{template} =~ /(list|details)/ ) ){ + if ( ( defined $result->{excerpt} ) && ( length($result->{excerpt}) > 250) ){ + $result->{excerpt} = substr($result->{excerpt}, 0, 250).'...'; + } + + if ( (defined $result->{user_excerpt}) && (length($result->{user_excerpt}) > 250) ){ + $result->{user_excerpt} = substr($result->{user_excerpt}, 0, 250).'...'; + } + } + + #build content + if ( ( defined $params->{template} ) + && ( $params->{template} =~ /\.html/ ) ) + { + if ( defined $result->{content} ) { + $result->{content} = + markup::fix_line_ends( $result->{content} ); + $result->{content} = + markup::creole_to_html( $result->{content} ); + $result->{html_content} = $result->{content}; + + } + if ( defined $result->{topic} ) { + $result->{topic} = markup::fix_line_ends( $result->{topic} ); + $result->{topic} = markup::creole_to_html( $result->{topic} ); + $result->{html_topic} = $result->{topic}; + } + } + + #detect if images are in content or topic field + my $image_in_text = 0; + $image_in_text = 1 + if ( ( defined $result->{content} ) + && ( $result->{content} =~ /![]()
{topic} )
+ && ( $result->{topic} =~ /![]()
{no_image_in_text} = 1 if $image_in_text == 0;
+
+ if (
+ ( defined $params->{template} )
+ && ( ( $params->{template} =~ /event_perl\.txt$/ )
+ || ( $params->{template} =~ /event_file_export\.txt$/ ) )
+
+ )
+ {
+ for my $key ( keys %$result ) {
+ $result->{$key} =~ s/\|/\\\|/g if ( defined $result->{$key} );
+ }
+
+ # $result->{content}='no';
+ }
+
+ } # end for results
+ add_recurrence_dates( $config, $results );
+ return $results;
+}
+
+sub add_recurrence_dates {
+ my $config = shift;
+ my $results = shift;
+
+ # get unique list of recurrence ids from results
+ my $recurrence_dates = {};
+ for my $result (@$results) {
+ next unless defined $result->{recurrence};
+ next if $result->{recurrence} == 0;
+ $recurrence_dates->{ $result->{recurrence} } = 0;
+ }
+
+ my @event_ids = keys %$recurrence_dates;
+ return if @event_ids == 0;
+
+ # query start date of recurrences
+ my $conditions = [];
+ my $bind_values = [];
+ for my $id (@event_ids) {
+ push @$conditions, '?';
+ push @$bind_values, $id;
+ }
+ $conditions = join( ',', @$conditions );
+
+ my $query = qq{
+ select id event_id, start
+ from calcms_events
+ where id in ($conditions)
+ };
+
+ #print STDERR Dumper($query);
+ #return;
+ my $dbh = db::connect($config);
+ my $events = db::get( $dbh, $query, $bind_values );
+
+ # store start dates by recurrence id
+ for my $event (@$events) {
+ $recurrence_dates->{ $event->{event_id} } = $event->{start};
+ }
+
+ # set start dates to results
+ for my $result (@$results) {
+ next unless defined $result->{recurrence};
+ next if $result->{recurrence} == 0;
+ $result->{recurrence_date} =
+ $recurrence_dates->{ $result->{recurrence} };
+ }
+
+ #print STDERR Dumper($recurrence_dates);
+}
+
+sub calc_dates {
+ my $config = shift;
+ my $result = shift;
+ my $params = shift || {};
+ my $previous_result = shift || {};
+ my $time_diff = shift || '';
+
+ $result->{utc_offset} = $time_diff;
+ $result->{time_zone} = $config->{date}->{time_zone};
+ my $language = $config->{date}->{language} || 'en';
+
+ $result->{start_datetime} = $result->{start};
+ $result->{start_datetime} =~ s/ /T/gi;
+ if ( $result->{start_datetime} =~ /(\d\d\d\d)\-(\d\d)\-(\d\d)T(\d\d)\:(\d\d)/ ) {
+ $result->{start_year} = $1;
+ $result->{start_month} = $2;
+ $result->{start_day} = $3;
+ $result->{start_hour} = $4;
+ $result->{start_minute} = $5;
+ }
+
+ unless ( defined $result->{day} ) {
+ my $d = time::datetime_to_array( $result->{start} );
+ my $hour = $d->[3];
+ if ( ( defined $hour ) && ( $hour < 6 ) ) {
+ $result->{day} = time::add_days_to_date( $result->{start}, -1 );
+ } else {
+ $result->{day} = time::datetime_to_date( $result->{start} );
+ }
+ }
+ unless ( defined $result->{start_date} ) {
+ $result->{start_date} = time::datetime_to_date( $result->{start} );
+ }
+ unless ( defined $result->{end_date} ) {
+ $result->{end_date} = time::datetime_to_date( $result->{end} );
+ }
+
+ $result->{dtstart} = $result->{start_datetime};
+ $result->{dtstart} =~ s/[\:\-]//gi;
+
+ if ( ( defined $params->{template} )
+ && ( $params->{template} =~ /(\.txt|\.json)/ ) )
+ {
+ $result->{start_utc_epoch} = time::datetime_to_utc( $result->{start_datetime}, $config->{date}->{time_zone} );
+ }
+ if ( ( defined $params->{template} )
+ && ( $params->{template} =~ /(\.xml)/ ) )
+ {
+ $result->{start_datetime_utc} = time::datetime_to_utc_datetime( $result->{start_datetime}, $config->{date}->{time_zone} );
+ }
+
+ $result->{end_datetime} = $result->{end};
+ $result->{end_datetime} =~ s/ /T/gi;
+
+ $result->{dtend} = $result->{end_datetime};
+ $result->{dtend} =~ s/[\:\-]//gi;
+
+ if ( ( defined $params->{template} )
+ && ( $params->{template} =~ /(\.txt|\.json)/ ) )
+ {
+ $result->{end_utc_epoch} = time::datetime_to_utc( $result->{end_datetime}, $config->{date}->{time_zone} );
+ }
+ if ( ( defined $params->{template} )
+ && ( $params->{template} =~ /(\.xml)/ ) )
+ {
+ $result->{end_datetime_utc} = time::datetime_to_utc_datetime( $result->{end_datetime}, $config->{date}->{time_zone} );
+ }
+
+ if ( ( defined $previous_result )
+ && ( defined $previous_result->{start_date} )
+ && ( $result->{start_date} ne $previous_result->{start_date} ) )
+ {
+ $result->{is_first_of_day} = 1;
+ $previous_result->{is_last_of_day} = 1;
+ }
+
+ $result->{start_date_name} =
+ time::date_format( $result->{start_date}, $language );
+ $result->{end_date_name} =
+ time::date_format( $result->{end_date}, $language );
+
+ if ( $result->{start} =~ /(\d\d\:\d\d)\:\d\d/ ) {
+ $result->{start_time_name} = $1;
+ $result->{start_time} = $1;
+ }
+
+ if ( $result->{end} =~ /(\d\d\:\d\d)\:\d\d/ ) {
+ $result->{end_time_name} = $1;
+ $result->{end_time} = $1;
+ }
+
+ if ( defined $result->{weekday} ) {
+ my $language = $config::config->{date}->{language} || 'en';
+
+ #my $weekdays=time::get_weekdays();
+ my $weekday_index = $time::weekday_index->{ $result->{weekday} . '' } || 0;
+ $result->{weekday_name} =
+ $time::names->{$language}->{weekdays}->[$weekday_index];
+ $result->{weekday_short_name} =
+ $time::names->{$language}->{weekdays_abbr}->[$weekday_index];
+ }
+ return $result;
+}
+
+sub add_recordings{
+ my $dbh = shift;
+ my $config = shift;
+ my $request = shift;
+ my $events = shift;
+
+# print STDERR Dumper($results);
+ return $events unless defined $events;
+
+ my $params = $request->{params}->{checked};
+ return $events unless defined $params;
+ return $events unless defined $params->{recordings};
+
+ my @ids=();
+ my $eventsById={};
+ #my $events = $results;
+
+ for my $event (@$events){
+ my $eventId = $event->{event_id};
+ push @ids, $eventId;
+ $eventsById->{$eventId} = $event;
+ }
+
+
+ my $qms = join( ', ', (map { '?' } @$events));
+ my $bindValues = join( ', ', (map { $_->{event_id} } @$events));
+
+ my $query = qq{
+ select *
+ from calcms_audio_recordings
+ where event_id in ($qms)
+ order by created_at;
+ };
+
+ $dbh = db::connect($config) unless defined $dbh;
+ my $recordings = db::get( $dbh, $query, $bindValues );
+ #print STDERR Dumper($recordings);
+
+ for my $entry (@$recordings){
+ my $eventId = $entry->{event_id};
+ my $event = $eventsById->{$eventId};
+ push @{ $event->{recordings} }, $entry;
+ }
+
+ return $events;
+}
+
+# if recordings is set in params, recordings date and path will be included
+sub get_query {
+ my $dbh = shift;
+ my $config = shift;
+ my $request = shift;
+
+ my $params = $request->{params}->{checked};
+ my $debug = $config->{system}->{debug};
+
+ $params->{recordings} = '' unless defined $params->{recordings};
+
+ my $bind_values = [];
+ my $where_cond = [];
+ my $order_cond = '';
+ my $limit_cond = '';
+
+ if ( $params->{event_id} ne '' ) {
+
+ # conditions by event id
+ push @$where_cond, 'e.id=?';
+ $bind_values = [ $params->{event_id} ];
+
+ #filter by published, default=1 to see published only, set published='all' to see all
+ my $published = $params->{published} || 1;
+ if ( ( $published eq '0' ) || ( $published eq '1' ) ) {
+ push @$where_cond, 'published=?';
+ push @$bind_values, $published;
+ }
+
+ } else {
+
+ # conditions by date
+ my @date_conds = ();
+
+ #date, today, tomorrow, yesterday
+ my $date = '';
+ $date = time::date_cond( $params->{date} ) if ( $params->{date} ne '' );
+
+ my $from_date = '';
+ $from_date = time::date_cond( $params->{from_date} )
+ if ( $params->{from_date} ne '' );
+
+ my $till_date = '';
+ $till_date = time::date_cond( $params->{till_date} )
+ if ( $params->{till_date} ne '' );
+
+ my $from_time = '';
+ $from_time = time::time_cond( $params->{from_time} )
+ if ( $params->{from_time} ne '' );
+
+ my $till_time = '';
+ $till_time = time::time_cond( $params->{till_time} )
+ if ( $params->{till_time} ne '' );
+
+ my $date_range_include = $params->{date_range_include};
+
+ #from_time is defined
+ if ( ( $params->{from_date} ne '' ) && ( $params->{from_time} ne '' ) ) {
+ my $datetime = time::datetime_cond( $from_date . 'T' . $from_time );
+ if ( $datetime ne '' ) {
+ if ( $date_range_include eq '1' ) {
+ push @date_conds, ' end > ? ';
+ push @$bind_values, $datetime;
+ $from_date = '';
+ } else {
+ push @date_conds, ' start >= ? ';
+ push @$bind_values, $datetime;
+ $from_date = '';
+ }
+ }
+ }
+
+ #till_time is defined
+ if ( ( $params->{till_date} ne '' ) && ( $params->{till_time} ne '' ) ) {
+ my $datetime = time::datetime_cond( $till_date . 'T' . $till_time );
+ if ( $datetime ne '' ) {
+ push @date_conds, ' start < ? ';
+ push @$bind_values, $datetime;
+ $till_date = '';
+ }
+ }
+
+ #time is defined
+ if ( ( defined $params->{time} )
+ && ( $params->{time} ne '' )
+ && ( $params->{time} ne 'now' )
+ && ( $params->{time} ne 'future' ) )
+ {
+ my $time = time::time_cond( $params->{time} );
+ if ( $time ne '' ) {
+ push @date_conds, ' time(start) = ? ';
+ push @$bind_values, $time;
+ }
+ }
+
+ #event is not over
+ if ( ( defined $params->{time} ) && ( $params->{time} eq 'now' ) ) {
+ push @date_conds, qq{
+ (
+ ( unix_timestamp(end) > unix_timestamp(now() ) )
+ and
+ ( unix_timestamp(start) <= unix_timestamp(now() ) )
+ )
+ };
+
+ } elsif ( ( defined $params->{time} ) && ( $params->{time} eq 'future' ) ) {
+ push @date_conds, qq{
+ (
+ ( unix_timestamp(end) > unix_timestamp(now() ) )
+ and
+ ( unix_timestamp(end) - unix_timestamp(now() ) ) < 7*24*3600
+ )
+ };
+
+ } elsif ( $date ne '' ) {
+ if ( $date eq 'today' ) {
+ my $date = time::get_event_date($config);
+ if ( $date ne '' ) {
+ push @date_conds, ' ( start_date = ? ) ';
+ push @$bind_values, $date;
+ }
+
+ } else {
+ if ( $date ne '' ) {
+ push @date_conds, ' ( start_date = ? ) ';
+ push @$bind_values, $date;
+ }
+ }
+ } else {
+ if ( $from_date ne '' ) {
+ if ( $date_range_include eq '1' ) {
+
+ # end is after start
+ push @date_conds, ' ( end_date >= ? )';
+ push @$bind_values, $from_date;
+ } else {
+ push @date_conds, ' ( start_date >= ? ) ';
+ push @$bind_values, $from_date;
+ }
+ }
+
+ if ( $till_date ne '' ) {
+ if ( $date_range_include eq '1' ) {
+
+ # start is before end
+ push @date_conds, ' ( start_date <= ? )';
+ push @$bind_values, $till_date;
+ } else {
+ push @date_conds, ' ( end_date <= ? ) ';
+ push @$bind_values, $till_date;
+ }
+ }
+
+ if ( $params->{weekday} ne '' ) {
+ my $weekday = $params->{weekday};
+ $weekday += 1;
+ $weekday -= 7 if ( $weekday > 7 );
+ push @date_conds, ' (dayofweek(start_date)= ?) ';
+ push @$bind_values, $weekday;
+ }
+
+ if ( $params->{archive} eq 'past' ) {
+ my $date = time::get_event_date($config);
+ if ( $date ne '' ) {
+ push @date_conds, ' ( start_date < ? ) ';
+ push @$bind_values, $date;
+ }
+
+ } elsif ( $params->{archive} eq 'future' ) {
+ my $date = time::get_event_date($config);
+ if ( $date ne '' ) {
+ push @date_conds, ' ( start_date >= ? ) ';
+ push @$bind_values, $date;
+ }
+ }
+
+ }
+
+ if ( ( defined $params->{time_of_day} )
+ && ( $params->{time_of_day} ne '' ) )
+ {
+ push @date_conds, ' ( time_of_day = ? ) ';
+ push @$bind_values, $params->{time_of_day};
+
+ }
+
+ my $date_cond = join " and ", @date_conds;
+ push @$where_cond, $date_cond if ( $date_cond ne '' );
+ }
+
+ # location
+ my $location_cond = '';
+ if ( $params->{location} ne '' ) {
+ my $location = ( split( /\,/, $params->{location} ) )[0];
+ $location =~ s/[^a-zA-Z0-9]/%/g;
+ $location =~ s/%{2,99}/%/g;
+ if ( $location ne '' ) {
+ $location_cond = ' location like ? ';
+ push @$bind_values, $location;
+ }
+ }
+
+ # exclude location
+ my $exclude_location_cond = '';
+ if ( $params->{no_exclude} ne '1' ) {
+ if ( $params->{exclude_locations} ne '' ) {
+ my @exclude_locations = split( /,/, $params->{exclude_locations} );
+ $exclude_location_cond = 'location not in (' . join( ",", map { '?' } @exclude_locations ) . ')';
+ for my $location (@exclude_locations) {
+ $location =~ s/^\s+//g;
+ $location =~ s/\s+$//g;
+ push @$bind_values, $location;
+ }
+ }
+ }
+
+ # exclude project
+ my $exclude_project_cond = '';
+ if ( $params->{no_exclude} ne '1' ) {
+ if ( $params->{exclude_projects} ne '' ) {
+ my @exclude_projects = split( /,/, $params->{exclude_projects} );
+ $exclude_project_cond = 'project not in (' . join( ",", map { '?' } @exclude_projects ) . ')';
+ for my $project (@exclude_projects) {
+ $project =~ s/^\s+//g;
+ $project =~ s/\s+$//g;
+ push @$bind_values, $project;
+ }
+ }
+ }
+
+ #filter for category
+ my $category_cond = '';
+ if ( $params->{category} ne '' ) {
+ my $category = ( split( /\,/, $params->{category} ) )[0];
+ $category =~ s/[^a-zA-Z0-9]/%/g;
+ $category =~ s/%{2,99}/%/g;
+ if ( $category ne '' ) {
+ $category_cond = qq{
+ id in(
+ select event_id from calcms_categories
+ where name like ?
+ )
+ };
+ }
+ push @$bind_values, $category;
+ }
+
+ my $series_name_cond = '';
+ if ( ( defined $params->{series_name} )
+ && ( $params->{series_name} ne '' ) )
+ {
+ my $series_name = ( split( /\,/, $params->{series_name} ) )[0];
+ $series_name =~ s/[^a-zA-Z0-9]/%/g;
+ $series_name =~ s/%{2,99}/%/g;
+ if ( $series_name ne '' ) {
+ $series_name_cond = ' series_name like ? ';
+ push @$bind_values, $series_name;
+ }
+ }
+
+ #filter for tags
+ my $tag_cond = '';
+ if ( ( defined $params->{tag} ) && ( $params->{tag} ne '' ) ) {
+ my @tags = ( split( /\,/, $params->{tag} ) );
+ if ( scalar @tags > 0 ) {
+ my $tags = join ",", ( map { '?' } @tags );
+ for my $tag (@tags) {
+ push @$bind_values, $tag;
+ }
+ $tag_cond = qq{
+ id in(
+ select event_id from calcms_tags
+ where name in($tags)
+ )
+ };
+ }
+ }
+ $tag_cond = '';
+
+ my $title_cond = '';
+ if ( ( defined $params->{title} ) && ( $params->{title} ne '' ) ) {
+ my $title = ( split( /\,/, $params->{title} ) )[0];
+ $title =~ s/[^a-zA-Z0-9]/%/g;
+ $title =~ s/%{2,99}/%/g;
+ $title =~ s/^\%//;
+ $title =~ s/\%$//;
+ $title = '%' . $title . '%';
+ if ( $title ne '' ) {
+ $title_cond = ' title like ? ';
+ push @$bind_values, $title;
+ }
+ }
+
+ my $search_cond = '';
+ if ( ( defined $params->{search} ) && ( $params->{search} ne '' ) ) {
+ my $search = lc $params->{search};
+ $search =~ s/[^a-z0-9\_\.\-\:\!öäüßÖÄÜ \&]/%/;
+ $search =~ s/\%+/\%/;
+ $search =~ s/^[\%\s]+//;
+ $search =~ s/[\%\s]+$//;
+ if ( $search ne '' ) {
+ $search = '%' . $search . '%';
+ my @attr = ( 'title', 'series_name', 'excerpt', 'category', 'content', 'topic' );
+ $search_cond = "(" . join( " or ", map { 'lower(' . $_ . ') like ?' } @attr ) . ")";
+ for my $attr (@attr) {
+ push @$bind_values, $search;
+ }
+ }
+ }
+
+ my $project_cond = '';
+
+ # if ($filter_by_project eq'1'){
+ my $project = undef; #$params->{default_project};
+ $project = $params->{project}
+ if ( ( defined $params->{project} ) && ( $params->{project} ne '' ) );
+ my $project_name = '';
+ $project_name = $project->{name}
+ if ( ( defined $project )
+ && ( defined $project->{name} )
+ && ( $project->{name} ne '' ) );
+ if ( ( $project_name ne '' ) && ( $project_name ne 'all' ) ) {
+ $project_cond = '(project=?)';
+ push @$bind_values, $project_name;
+ }
+
+ # }
+
+ #filter by published, default =1, set to 'all' to see all
+ my $published_cond = '';
+ my $published = $params->{published} || 1;
+ if ( ( $published eq '0' ) || ( $published eq '1' ) ) {
+ $published_cond = 'published=?';
+ push @$bind_values, $published;
+ }
+
+ my $disable_event_sync_cond = '';
+ my $disable_event_sync = $params->{disable_event_sync} || '';
+ if ( ( $disable_event_sync eq '0' ) || ( $disable_event_sync eq '1' ) ) {
+ $disable_event_sync_cond = 'disable_event_sync=?';
+ push @$bind_values, $disable_event_sync;
+ }
+
+ #print STDERR $disable_event_sync_cond." ".$bind_values->[-1]."\n";
+
+ #combine date, location, category, series_name, tag, search and project
+
+ push @$where_cond, $location_cond if ( $location_cond =~ /\S/ );
+ push @$where_cond, $exclude_location_cond
+ if ( $exclude_location_cond =~ /\S/ );
+ push @$where_cond, $exclude_project_cond
+ if ( $exclude_project_cond =~ /\S/ );
+ push @$where_cond, $category_cond if ( $category_cond =~ /\S/ );
+ push @$where_cond, $series_name_cond if ( $series_name_cond =~ /\S/ );
+ push @$where_cond, $tag_cond if ( $tag_cond =~ /\S/ );
+ push @$where_cond, $title_cond if ( $title_cond =~ /\S/ );
+ push @$where_cond, $search_cond if ( $search_cond =~ /\S/ );
+ push @$where_cond, $project_cond if ( $project_cond =~ /\S/ );
+ push @$where_cond, $published_cond if ( $published_cond =~ /\S/ );
+ push @$where_cond, $disable_event_sync_cond
+ if ( $disable_event_sync_cond ne '' );
+
+ #print STDERR Dumper($where_cond);
+
+ #order is forced
+ if ( $params->{order} eq 'asc' ) {
+ $order_cond = 'order by start';
+ } elsif ( $params->{order} eq 'desc' ) {
+ $order_cond = 'order by start desc';
+ } else {
+
+ #derivate order from archive flag
+ if ( $params->{archive} eq 'past' ) {
+ $order_cond = 'order by start desc';
+ } else {
+ $order_cond = 'order by start';
+ }
+ }
+
+ if ( ( defined $params->{limit} ne '' ) && ( $params->{limit} ne '' ) ) {
+ $limit_cond = 'limit ' . $params->{limit};
+ }
+
+ my $query = qq{
+ select
+ date(e.start) start_date
+ ,date(e.end) end_date
+ ,weekday(e.start) weekday
+ ,weekofyear(e.start) week_of_year
+ ,dayofyear(e.start) day_of_year
+ ,e.start_date day
+ ,e.id event_id
+ ,e.start
+ ,e.end
+ ,e.time_of_day
+ ,e.program
+ ,e.series_name
+ ,e.title
+ ,e.modified_at
+ ,e.created_at
+ ,e.modified_by
+ ,e.comment_count
+ ,e.image
+ ,e.reference
+ ,e.recurrence
+ ,e.recurrence_count
+ ,e.podcast_url
+ ,e.archive_url
+ ,e.media_url
+ ,e.status
+ ,e.location
+ ,e.project
+ ,e.user_title
+ ,e.user_excerpt
+ ,e.published
+ ,e.playout
+ ,e.archived
+ ,e.rerun
+ ,e.live
+ ,e.disable_event_sync
+ ,e.episode
+ };
+ my $template = $params->{template} || '';
+
+ $query .= ',e.excerpt' unless ( $template =~ /menu/ );
+
+ # $query.=',e.project' unless ($template=~/menu/ || $template=~/list/);
+
+ my $get = $params->{get} || '';
+ unless ( $get eq 'no_content' ) {
+ if ( $template =~ /\.html/ ) {
+ unless ( $template =~ /menu/ || $template =~ /list/ ) {
+ $query .= ', e.content, e.topic, e.html_content, e.html_topic';
+
+ #$query.=',html_content content, html_topic topic' ;
+ }
+ } else {
+ unless ( $template =~ /menu/ || $template =~ /list/ ) {
+ $query .= ', e.content, e.topic, e.html_content, e.html_topic';
+ }
+ }
+ }
+
+ # add project id and series id
+ if ( ( $params->{project_id} ne '' ) || ( $params->{studio_id} ne '' ) ) {
+ if ( $params->{project_id} ne '' ) {
+ push @$where_cond, 'se.project_id=?';
+ push @$bind_values, $params->{project_id};
+ $query .= ', se.project_id';
+ }
+ if ( $params->{studio_id} ne '' ) {
+ push @$where_cond, 'se.studio_id=?';
+ push @$bind_values, $params->{studio_id};
+ $query .= ', se.studio_id';
+ }
+ #push @$where_cond, 'se.event_id=e.id';
+ }
+
+ # add recordings field and conditions
+ if ($params->{recordings} eq '1' ) {
+ $query .= ', ar.path';
+ $query .= ', ar.size';
+ $query .= ', ar.created_by uploaded_by';
+ $query .= ', ar.created_at uploaded_at';
+ #push @$where_cond, 'e.id=ar.event_id';
+ }
+
+ $query .= "\n from";
+
+ # add tables
+ if ( ( $params->{project_id} ne '' ) || ( $params->{studio_id} ne '' ) ) {
+ # prepent series_events
+ $query .= "\n calcms_series_events se inner join calcms_events e on se.event_id=e.id";
+ }else{
+ $query .= "\n calcms_events e";
+ }
+
+ # add recordings table
+ if ( $params->{recordings} eq '1' ) {
+ $query .= "\n left join calcms_audio_recordings ar on e.id=ar.event_id";
+ }
+
+ if ( scalar @$where_cond > 0 ) {
+ $query .= "\nwhere " . join( ' and ', @$where_cond );
+ }
+
+ $query .= "\n" . $order_cond if ( $order_cond ne '' );
+ $query .= "\n" . $limit_cond if ( $limit_cond ne '' );
+
+ #print STDERR Dumper($query).Dumper($bind_values)."\n";
+
+ return ( \$query, $bind_values );
+}
+
+sub render {
+
+ # my $response = $_[0];
+ my $config = $_[1];
+ my $request = $_[2];
+ my $results = $_[3];
+ my $root_params = $_[4];
+
+ my $params = $request->{params}->{checked};
+ if ( ref($root_params) eq 'HASH' ) {
+ for my $param ( keys %$root_params ) {
+ $params->{$param} = $root_params->{$param};
+ }
+ }
+ my $debug = $config->{system}->{debug};
+
+ my %template_parameters = %$params;
+ my $template_parameters = \%template_parameters;
+ $template_parameters->{events} = $results;
+ $template_parameters->{debug} = $debug;
+ $template_parameters->{server_cache} = $config->{cache}->{server_cache}
+ if ( $config->{cache}->{server_cache} );
+ $template_parameters->{use_client_cache} = $config->{cache}->{use_client_cache}
+ if ( $config->{cache}->{use_client_cache} );
+
+ if ( scalar @$results > 0 ) {
+ my $result = $results->[0];
+ $template_parameters->{event_id} = $result->{event_id};
+ $template_parameters->{event_dtstart} = $result->{dtstart};
+ }
+
+ # $template_parameters->{print} =1 if ($params->{print} eq '1');
+ $template_parameters->{base_url} = $config->{locations}->{base_url};
+ $template_parameters->{base_domain} = $config->{locations}->{base_domain};
+ $template_parameters->{cache_base_url} = $config->{cache}->{base_url};
+ $template_parameters->{modified_at} = time::time_to_datetime( time() );
+ if ( ( defined $params->{template} )
+ && ( $params->{template} =~ /(\.xml)/ ) )
+ {
+ $template_parameters->{modified_at_datetime_utc} =
+ time::datetime_to_utc_datetime( $template_parameters->{modified_at}, $config->{date}->{time_zone} );
+ }
+
+ #$template_parameters->{tags} = $tags;
+
+ if ( @$results == 0 ) {
+ if ( ( $params->{search} ne '' )
+ || ( $params->{category} ne '' )
+ || ( $params->{series_name} ne '' ) )
+ {
+ $template_parameters->{no_search_result} = '1';
+ } else {
+ $template_parameters->{no_result} = '1';
+ }
+ } else {
+ if ( ( !defined $params->{event_id} ) || ( $params->{event_id} eq '' ) ) {
+ $template_parameters->{event_count} = @$results . '';
+ $template_parameters->{first_of_list} = $results->[0]->{event_id};
+ }
+ my $start = $results->[0]->{start_datetime} || '';
+ if ( $start =~ /(\d{4}\-\d{2})/ ) {
+ $template_parameters->{month} = $1;
+ }
+ }
+
+ my $time_diff = time::utc_offset( $config->{date}->{time_zone} );
+ $time_diff =~ s/(\d\d)(\d\d)/$1\:$2/g;
+ $template_parameters->{time_zone} = $config->{date}->{time_zone};
+ $template_parameters->{utc_offset} = $time_diff;
+
+ if ( $params->{template} =~ /\.atom\.xml/ ) {
+ $template_parameters->{modified_at} =~ s/ /T/gi;
+ $template_parameters->{modified_at} .= $time_diff;
+ } elsif ( $params->{template} =~ /\.rss\.xml/ ) {
+ $template_parameters->{modified_at} =
+ time::datetime_to_rfc822( $template_parameters->{modified_at} );
+ } elsif ( $params->{template} =~ /\.txt/ ) {
+ $template_parameters->{modified_at_utc} =
+ time::datetime_to_utc( $template_parameters->{modified_at}, $config->{date}->{time_zone} );
+ }
+
+ my $project = $params->{default_project};
+ foreach my $key ( keys %$project ) {
+ $template_parameters->{ 'project_' . $key } = $project->{$key};
+ }
+ $template_parameters->{ 'project_' . $project->{name} } = 1
+ if ( $project->{name} ne '' );
+
+ $template_parameters->{controllers} = $config->{controllers},
+
+ # use Data::Dumper;print STDERR Dumper($template_parameters)."\n";
+ template::process( $_[0], $params->{template}, $template_parameters );
+
+ return $_[0];
+}
+
+sub get_running_event_id {
+ my $dbh = shift;
+
+ my $query = qq{
+ select id event_id, start, title
+ from calcms_events
+ where
+ (
+ ( unix_timestamp(start) <= unix_timestamp(now() ) )
+ and
+ ( unix_timestamp(end) > unix_timestamp(now() ) )
+ and
+ ( unix_timestamp(end) - unix_timestamp(now() ) ) < 24*3600
+ )
+
+ order by start
+ limit 1
+ };
+
+ my $running_events = db::get( $dbh, $query );
+ my @running_events = @$running_events;
+
+ return $running_events->[0]->{event_id} if ( scalar @running_events > 0 );
+ return 0;
+}
+
+# add filters to query
+sub setDefaultEventConditions {
+ my $config = shift;
+ my $conditions = $_[0];
+ my $bind_values = $_[1];
+
+ # exclude projects
+ if ( ( defined $config->{filter} )
+ && ( defined $config->{filter}->{exclude_projects} ) )
+ {
+ my @exclude_projects =
+ split( /,/, $config->{filter}->{exclude_projects} );
+ push @$conditions, 'project not in (' . join( ",", map { '?' } @exclude_projects ) . ')';
+ for my $project (@exclude_projects) {
+ push @$bind_values, $project;
+ }
+ }
+
+ # exclude locations
+ if ( ( defined $config->{filter} )
+ && ( defined $config->{filter}->{exclude_locations} ) )
+ {
+ my @exclude_locations =
+ split( /,/, $config->{filter}->{exclude_locations} );
+ push @$conditions, 'location not in (' . join( ",", map { '?' } @exclude_locations ) . ')';
+ for my $location (@exclude_locations) {
+ push @$bind_values, $location;
+ }
+ }
+
+}
+
+sub getEventById {
+ my $dbh = shift;
+ my $config = shift;
+ my $event_id = shift;
+
+ $dbh = db::connect($config) unless defined $dbh;
+
+ my $conditions = [];
+ my $bind_values = [];
+
+ push @$conditions, "id=?";
+ push @$bind_values, $event_id;
+
+ setDefaultEventConditions( $config, $conditions, $bind_values );
+ $conditions = join( ' and ', @$conditions );
+
+ my $query = qq{
+ select *
+ from calcms_events
+ where $conditions
+ };
+
+ my $events = db::get( $dbh, $query, $bind_values );
+ return $events;
+}
+
+sub get_next_event_of_series {
+ my $dbh = shift;
+ my $config = shift;
+ my $event_id = shift;
+
+ $dbh = db::connect($config) unless defined $dbh;
+
+ my $events = getEventById( $dbh, $config, $event_id );
+ return undef unless @$events == 1;
+ my $event = $events->[0];
+
+ my $conditions = [];
+ my $bind_values = [];
+
+ push @$conditions, "start>?";
+ push @$bind_values, $event->{start};
+
+ push @$conditions, "series_name=?";
+ push @$bind_values, $event->{series_name};
+
+ setDefaultEventConditions( $config, $conditions, $bind_values );
+ $conditions = join( ' and ', @$conditions );
+
+ my $query = qq{
+ select id
+ from calcms_events
+ where $conditions
+ order by start
+ limit 1
+ };
+
+ $events = db::get( $dbh, $query, $bind_values );
+ return undef unless @$events == 1;
+
+ return $events->[0]->{id};
+}
+
+sub get_previous_event_of_series {
+ my $dbh = shift;
+ my $config = shift;
+ my $event_id = shift;
+
+ $dbh = db::connect($config) unless defined $dbh;
+
+ my $events = getEventById( $dbh, $config, $event_id );
+ return undef unless @$events == 1;
+ my $event = $events->[0];
+
+ my $conditions = [];
+ my $bind_values = [];
+
+ push @$conditions, "start{start};
+
+ push @$conditions, "series_name=?";
+ push @$bind_values, $event->{series_name};
+
+ setDefaultEventConditions( $config, $conditions, $bind_values );
+ $conditions = join( ' and ', @$conditions );
+
+ my $query = qq{
+ select id from calcms_events
+ where $conditions
+ order by start desc
+ limit 1
+ };
+ $events = db::get( $dbh, $query, $bind_values );
+
+ return undef unless @$events == 1;
+ return $events->[0]->{id};
+}
+
+sub get_by_date_range {
+ my $dbh = shift;
+ my $config = shift;
+ my $start_date = shift;
+ my $end_date = shift;
+
+ my $conditions = [];
+ push @$conditions, 'start_date between ? and ?';
+ my $bind_values = [ $start_date, $end_date ];
+
+ setDefaultEventConditions( $config, $conditions, $bind_values );
+
+ $conditions = join( ' and ', @$conditions );
+
+ my $query = qq{
+ select start_date
+ from calcms_events
+ where $conditions
+ group by start_date
+ };
+
+ my $events = db::get( $dbh, $query, $bind_values );
+
+ return $events;
+}
+
+sub get_by_image {
+ my $dbh = shift;
+ my $config = shift;
+ my $filename = shift;
+
+ #$filename=$dbh->quote('%'.$filename.'%');
+
+ #$filename='%'.$filename.'%';
+ my $query = qq{
+ select * from calcms_events
+ where content like ?
+ order by start desc
+ limit 1
+ };
+ my $bind_values = [ '%' . $filename . '%' ];
+
+ my $events = db::get( $dbh, $query, $bind_values );
+
+ # print STDERR Dumper($events);
+ return undef if ( @$events == 0 );
+ return $events->[0];
+}
+
+sub delete {
+ return;
+ my $request = shift;
+ my $config = shift;
+ my $event_id = shift;
+
+ my $params = $request->{params}->{checked};
+ my $debug = $config->{system}->{debug};
+
+ my $dbh = db::connect($config);
+
+ my $query = 'delete from calcms_events where id=?';
+ db::put( $dbh, $query, [$event_id] );
+
+ $query = 'delete from calcms_categories where id=?';
+ db::put( $dbh, $query, [$event_id] );
+
+ $query = 'delete from calcms_tags where id=?';
+ db::put( $dbh, $query, [$event_id] );
+
+ $query = 'delete from calcms_series_events where event_id=?';
+ db::put( $dbh, $query, [$event_id] );
+
+}
+
+#TODO: add location to cache map
+sub configure_cache {
+ my $config = shift;
+ my $debug = $config->{system}->{debug};
+
+ my $date_pattern = $cache::date_pattern;
+ my $controllers = $config->{controllers};
+
+ cache::init();
+ cache::add_map( '', 'index.html' );
+
+ my $name = '';
+ my $extension = '';
+ my $templates = $config->{templates}->{events};
+
+ for my $template (@$templates) {
+ if ( $template =~ /^(.+)\.([^\.]+)$/ ) {
+ $name = $1;
+ $extension = $2;
+ }
+ cache::add_map( 'template=' . $template, $controllers->{events} . '/' . $name . '.' . $extension );
+ cache::add_map( 'template=' . $template . '&date=today', $controllers->{events} . '/' . $template . '_today.' . $extension );
+ cache::add_map( 'template=' . $template . '&date=' . $date_pattern,
+ $controllers->{events} . '/' . $name . '_date_$1-$2-$3.' . $extension );
+ cache::add_map( 'template=' . $template . '&time=now', $controllers->{events} . '/' . $template . '_now.html' );
+ cache::add_map( 'template=' . $template . '&time=now&limit=(\d+)',
+ $controllers->{events} . '/' . $name . '_now_limit_$1.' . $extension );
+ cache::add_map(
+ 'template=' . $template . '&from_date=' . $date_pattern . '&till_date=' . $date_pattern,
+ $controllers->{events} . '/' . $name . '_from_$1-$2-$3_till_$4_$5_$6.' . $extension
+ );
+ cache::add_map(
+ 'template=' . $template . '&from_date=' . $date_pattern . '&till_date=' . $date_pattern . '&weekday=(\d)',
+ $controllers->{events} . '/' . $template . '_from_$1-$2-$3_till_$4_$5_$6_weekday_$7.' . $extension
+ );
+ cache::add_map(
+ 'template=' . $template . '&from_date=' . $date_pattern . '&till_date=' . $date_pattern . '&limit=(\d)',
+ $controllers->{events} . '/' . $template . '_from_$1-$2-$3_till_$4_$5_$6_limit_$7.' . $extension
+ );
+ cache::add_map( 'template=' . $template . '&weekday=(\d)', $controllers->{events} . '/' . $name . '_weekday_$1.' . $extension );
+ cache::add_map( 'template=' . $template . '&event_id=(\d+)', $controllers->{event} . '/' . $name . '_page_$1.' . $extension );
+ }
+}
+
+sub get_duration {
+ my $config = shift;
+ my $event = shift;
+ my $timezone = $config->{date}->{time_zone};
+ my $start = time::get_datetime( $event->{start}, $timezone );
+ my $end = time::get_datetime( $event->{end}, $timezone );
+ return undef unless defined $start;
+ return undef unless defined $end;
+ my $duration = $end->epoch() - $start->epoch();
+ return $duration / 60;
+}
+
+sub check_params {
+ my $config = shift;
+ my $params = shift;
+
+ #define running at
+ my $running_at = $params->{running_at} || '';
+ if ( ( defined $running_at ) && ( $running_at ne '' ) ) {
+ my $run_date = time::check_date($running_at);
+ my $run_time = time::check_time($running_at);
+ if ( ( $run_date ne '' ) && ( $run_time ne '' ) ) {
+ $params->{till_date} = $run_date;
+ $params->{till_time} = $run_time;
+ $params->{order} = 'asc';
+ $params->{limit} = 1;
+ $params->{archive} = 'all';
+ }
+ }
+
+ #set time
+ my $time = time::check_time( $params->{time} );
+ my $from_time = time::check_time( $params->{from_time} );
+ my $till_time = time::check_time( $params->{till_time} );
+
+ #set date
+ my $date = '';
+ my $from_date = time::check_date( $params->{from_date} );
+ my $till_date = time::check_date( $params->{till_date} );
+ if ( ( $from_date eq '' ) && ( $till_date eq '' ) ) {
+ $date = time::check_date( $params->{date} );
+ }
+
+ #set date interval (including)
+ my $date_range_include = 0;
+ $date_range_include = 1
+ if ( defined $params->{date_range_include} )
+ && ( $params->{date_range_include} eq '1' );
+
+ my $order = '';
+ if ( defined $params->{order} ) {
+ $order = 'desc' if ( $params->{order} eq 'desc' );
+ $order = 'asc' if ( $params->{order} eq 'asc' );
+ }
+
+ my $weekday = $params->{weekday} || '';
+
+ if ( ( defined $weekday ) && ( $weekday ne '' ) ) {
+ if ( $weekday =~ /\d/ ) {
+ $weekday = int($weekday);
+ log::error( $config, 'invalid weekday' )
+ if ( $weekday < 1 || $weekday > 7 );
+ } else {
+ log::error( $config, 'invalid weekday' );
+ }
+ }
+
+ my $time_of_day = $params->{time_of_day} || '';
+ my $found = 0;
+ if ( defined $time_of_day ) {
+ for my $key ( 'night', 'morning', 'noon', 'afternoon', 'evening' ) {
+ $found = 1 if ( $key eq $time_of_day );
+ }
+ log::error( $config, 'invalid time_of_day' )
+ if ( ( $time_of_day ne '' ) && ( $found == 0 ) );
+ }
+
+ my $tag = $params->{tag} || '';
+ if ( ( defined $tag ) && ( $tag ne '' ) ) {
+ log::error( $config, "invalid tag" ) if ( $tag =~ /\s/ );
+ log::error( $config, "invalid tag" ) if ( $tag =~ /\;/ );
+ $tag =~ s/\'//gi;
+ }
+
+ my $category = $params->{category} || '';
+ if ( ( defined $category ) && ( $category ne '' ) ) {
+ log::error( $config, "invalid category" ) if ( $category =~ /\;/ );
+ $category =~ s/^\s+//gi;
+ $category =~ s/\s+$//gi;
+ $category =~ s/\'//gi;
+ }
+
+ my $series_name = $params->{series_name} || '';
+ if ( ( defined $series_name ) && ( $series_name ne '' ) ) {
+ log::error( $config, "invalid series_name" )
+ if ( $series_name =~ /\;/ );
+ $series_name =~ s/^\s+//gi;
+ $series_name =~ s/\s+$//gi;
+ $series_name =~ s/\'//gi;
+ }
+
+ my $title = $params->{title} || '';
+ if ( ( defined $title ) && ( $title ne '' ) ) {
+ log::error( $config, "invalid title" ) if ( $title =~ /\;/ );
+ $title =~ s/^\s+//gi;
+ $title =~ s/\s+$//gi;
+ $title =~ s/\'//gi;
+ }
+
+ my $location = $params->{location} || '';
+ if ( ( defined $location ) && ( $location ne '' ) ) {
+ log::error( $config, "invalid location" ) if ( $location =~ /\;/ );
+ $location =~ s/^\s+//gi;
+ $location =~ s/\s+$//gi;
+ $location =~ s/\'//gi;
+ }
+
+ #if no location is set, use exclude location filter from default config
+ my $exclude_locations = '';
+ if ( ( $location eq '' )
+ && ( defined $config->{filter} )
+ && ( defined $config->{filter}->{exclude_locations} ) )
+ {
+ $exclude_locations = $config->{filter}->{exclude_locations} || '';
+ $exclude_locations =~ s/\s+/ /g;
+ }
+
+ my $exclude_projects = '';
+ if ( ( defined $config->{filter} )
+ && ( defined $config->{filter}->{exclude_projects} ) )
+ {
+ $exclude_projects = $config->{filter}->{exclude_projects} || '';
+ $exclude_projects =~ s/\s+/ /g;
+ }
+
+ #disable exclude filter by 'no_exlude=1'
+ my $no_exclude = '';
+ $no_exclude = '1'
+ if ( ( defined $params->{no_exclude} )
+ && ( $params->{no_exclude} eq '1' ) );
+
+ #show future events by default
+ my $archive = 'future';
+ if ( defined $params->{archive} ) {
+ $archive = 'all' if ( $params->{archive} eq 'all' );
+ $archive = 'past' if ( $params->{archive} eq 'gone' );
+ $archive = 'future' if ( $params->{archive} eq 'coming' );
+ }
+
+ my $disable_event_sync = '';
+ if ( ( defined $params->{disable_event_sync} )
+ && ( $params->{disable_event_sync} =~ /([01])/ ) )
+ {
+ $disable_event_sync = $1;
+ }
+
+ #show all on defined timespans
+ if ( ( $from_date ne '' ) && ( $till_date ne '' ) ) {
+ $archive = 'all';
+ }
+
+ my $event_id = $params->{event_id} || '';
+ if ( ( defined $event_id ) && ( $event_id ne '' ) ) {
+ if ( $event_id =~ /(\d+)/ ) {
+ $event_id = $1;
+ } else {
+ log::error( $config, "invalid event_id" );
+ }
+ }
+
+ my $get = 'all';
+ $get = 'no_content'
+ if ( ( defined $params->{get} ) && ( $params->{get} eq 'no_content' ) );
+
+ my $search = $params->{search} || '';
+ if ( ( defined $search ) && ( $search ne '' ) ) {
+ $search = substr( $search, 0, 100 );
+ $search =~ s/^\s+//gi;
+ $search =~ s/\s+$//gi;
+ }
+
+ #print STDERR $params->{template}."\n";
+ my $template = '.html';
+ if ( $params->{template} eq 'no' ) {
+ $template = 'no';
+ } else {
+ $template = template::check( $params->{template}, 'event_list.html' );
+ }
+
+ my $limit_config = $config->{permissions}->{result_limit} || 100;
+ my $limit = $params->{limit} || $limit_config;
+ log::error( $config, 'invalid limit!' ) if ( $limit =~ /\D/ );
+ $limit = $limit_config if ( $limit_config < $limit );
+
+ #read project from configuration file
+ my $project_name = $config->{project} || '';
+ log::error( $config, 'no default project configured' )
+ if ( $project_name eq '' );
+
+ #get default project
+ my $default_project = undef;
+ my $projects = project::get( $config, { name => $project_name } );
+ log::error( $config, "no configuration found for project '$project_name'" )
+ unless ( @$projects == 1 );
+ $default_project = $projects->[0];
+
+ # get project from parameter (by name)
+ my $project = '';
+ if ( ( defined $params->{project} )
+ && ( $params->{project} =~ /\w+/ )
+ && ( $params->{project} ne 'all' ) )
+ {
+ my $project_name = $params->{project};
+ my $projects = project::get( $config, { name => $project_name } );
+ log::error( $config, 'invalid project ' . $project_name )
+ unless @$projects == 1;
+ $project = $projects->[0];
+ }
+
+ $project_name = $params->{project_name} || '';
+ my $studio_name = $params->{studio_name} || '';
+
+ my $project_id = $params->{project_id} || '';
+ my $studio_id = $params->{studio_id} || '';
+
+ my $debug = $params->{debug} || '';
+ if ( $debug =~ /([a-z\_\,]+)/ ) {
+ $debug = $1;
+ }
+
+ my $json_callback = $params->{json_callback} || '';
+ if ( $json_callback ne '' ) {
+ $json_callback =~ s/[^a-zA-Z0-9\_]//g;
+ }
+
+ # use relative links
+ my $extern = 0;
+ $extern = 1 if ( defined $params->{extern} ) && ( $params->{extern} eq '1' );
+
+ my $recordings = 0;
+ $recordings = 1 if ( defined $params->{recordings} ) && ( $params->{recordings} eq '1' );
+
+ my $checked = {
+ date => $date,
+ time => $time,
+ time_of_day => $time_of_day,
+ from_date => $from_date,
+ till_date => $till_date,
+ date_range_include => $date_range_include,
+ from_time => $from_time,
+ till_time => $till_time,
+ weekday => $weekday,
+ limit => $limit,
+ template => $template,
+ location => $location,
+ category => $category,
+ series_name => $series_name,
+ tag => $tag,
+ title => $title,
+ event_id => $event_id,
+ search => $search,
+ debug => $debug,
+ archive => $archive,
+ order => $order,
+ project => $project,
+ default_project => $default_project,
+ project_name => $project_name,
+ project_id => $project_id,
+ studio_name => $studio_name,
+ studio_id => $studio_id,
+ json_callback => $json_callback,
+ get => $get,
+ exclude_locations => $exclude_locations,
+ exclude_projects => $exclude_projects,
+ no_exclude => $no_exclude,
+ disable_event_sync => $disable_event_sync,
+ extern => $extern,
+ recordings => $recordings,
+ };
+
+ #print STDERR Dumper($checked);
+ return $checked;
+}
+
+sub get_keys {
+ my $event = shift;
+
+ my $program = $event->{program} || '';
+ my $series_name = $event->{series_name} || '';
+ my $title = $event->{title} || '';
+ my $user_title = $event->{user_title} || '';
+ my $episode = $event->{episode} || '';
+ my $recurrence_count_alpha = $event->{recurrence_count_alpha} || '';
+
+ my $skey = '';
+ $skey .= $series_name if $series_name ne '';
+ $skey .= ' - '
+ if ( $series_name ne '' )
+ && ( ( $title ne '' ) || ( $user_title ne '' ) );
+
+ my $tkey = '';
+ $tkey = $title if $title ne '';
+ $tkey .= ': ' if ( $title ne '' ) && ( $user_title ne '' );
+ $tkey .= $user_title if $user_title ne '';
+ $tkey .= ' #' . $episode if $episode ne '';
+ $tkey .= $recurrence_count_alpha if $recurrence_count_alpha ne '';
+
+ my $pkey = '';
+ $pkey = ' (' . $program . ')' if $program ne '';
+
+ return {
+ key => $skey . $tkey . $pkey,
+ full_title => $skey . $tkey . $pkey,
+ full_title_no_series => $tkey . $pkey,
+ full_title_no_program => $skey . $tkey,
+ full_title_no_program_no_series => $tkey
+ };
+}
+
+#do not delete last line!
+1;
+
diff --git a/lib/calcms/images.pm b/lib/calcms/images.pm
new file mode 100644
index 0000000..c0f8900
--- /dev/null
+++ b/lib/calcms/images.pm
@@ -0,0 +1,297 @@
+use warnings "all";
+use strict;
+use config;
+use template;
+
+package images;
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+#our @EXPORT = qw(all);
+our @EXPORT_OK = qw(get insert update insert_or_update delete delete_files);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+#column 'created_at' will be set at insert
+#column 'modified_at' will be set by default (do not update)
+my $sql_columns =['filename', 'name', 'description', 'created_by', 'modified_by', 'modified_at', 'studio_id', 'project_id'];
+
+sub get{
+ my $config=shift;
+ my $options=shift;
+
+ my @cond=();
+ my $bind_values=[];
+ if ((defined $options->{project_id}) && ($options->{project_id}ne'')){
+ push @cond, 'project_id = ?';
+ push @$bind_values, $options->{project_id};
+ }
+ if ((defined $options->{studio_id}) && ($options->{studio_id}ne'')){
+ push @cond, 'studio_id = ?';
+ push @$bind_values, $options->{studio_id};
+ }
+ if ((defined $options->{filename}) && ($options->{filename}ne'')){
+ push @cond, 'filename = ?';
+ push @$bind_values,$options->{filename};
+ }
+ if ((defined $options->{from}) && ($options->{from}ne'')){
+ push @cond, 'date(created_at) >= ?';
+ push @$bind_values,$options->{from};
+ }
+ if ((defined $options->{till}) && ($options->{till}ne'')){
+ push @cond, 'date(created_at) <= ?';
+ push @$bind_values,$options->{till};
+ }
+ if ((defined $options->{created_by}) && ($options->{created_by}ne'')){
+ push @cond, 'created_by = ?';
+ push @$bind_values,$options->{created_by};
+ }
+ if ((defined $options->{modified_by}) && ($options->{modified_by}ne'')){
+ push @cond, 'modified_by = ?';
+ push @$bind_values,$options->{modified_by};
+ }
+ if ((defined $options->{search}) && ($options->{search}ne'')){
+ push @cond, '(filename like ?'
+ .' or name like ?'
+ .' or description like ?'
+ .' or created_by like ?'
+ .')';
+ my $search='%'.$options->{search}.'%';
+ push @$bind_values,$search;
+ push @$bind_values,$search;
+ push @$bind_values,$search;
+ push @$bind_values,$search;
+# push @$bind_values,$search;
+ }
+
+ my $where='';
+ if (@cond>0){
+ $where = 'where '.join (' and ', @cond);
+ }
+
+ my $limit='';
+ if ( (defined $options->{limit}) && ($options->{limit}=~/(\d+)/) ){
+ $limit=' limit '.$1;
+ }
+
+ my $query=qq{
+ select *
+ from calcms_images
+ $where
+ order by created_at desc
+ $limit
+ };
+ #print STDERR Dumper($query).Dumper($bind_values);
+
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, $bind_values);
+
+ #print STDERR @$results."\n";
+ return $results;
+}
+
+sub insert_or_update{
+ my $dbh=shift;
+ my $image=shift;
+
+ $image->{name}='new' if ($image->{name}eq'');
+ my $entry=get_by_filename($dbh, $image->{filename});
+ if (defined $entry){
+ update($dbh, $image);
+ }else{
+ insert($dbh, $image);
+ }
+}
+
+sub insert{
+ my $dbh=shift;
+ my $image=shift;
+
+ my @sql_columns=@$sql_columns;
+
+ #set created at timestamp
+ push @sql_columns,'created_at';
+ $image->{created_at}=time::time_to_datetime();
+
+ unless (defined $image->{created_by}){
+ print STDERR "missing created_by at image::insert\n";
+ return undef;
+ }
+ unless (defined $image->{studio_id}){
+ print STDERR "missing studio_id at image::insert\n";
+ return undef;
+ }
+ unless (defined $image->{project_id}){
+ print STDERR "missing project_id at image::insert\n";
+ return undef;
+ }
+
+ my $query=q{
+ insert into calcms_images(
+ }.join(',',@sql_columns).qq{
+ )
+ values( }.join(', ', (map {'?'} @sql_columns)).q{ )
+ };
+ my @bind_values=map { $image->{$_} } @sql_columns;
+
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+ return db::put($dbh, $query, \@bind_values);
+}
+
+
+sub update{
+ my $dbh=shift;
+ my $image=shift;
+
+ unless (defined $image->{studio_id}){
+ print STDERR "missing studio_id at images::update\n";
+ return undef;
+ }
+ unless (defined $image->{project_id}){
+ print STDERR "missing project_id at image::update\n";
+ return undef;
+ }
+
+ $image->{modified_at}=time::time_to_datetime();
+
+ my @set=();
+ my $bind_values=[];
+ for my $column (@$sql_columns){
+ if (defined $image->{$column}){
+ push @set, $column.' = ?';
+ push @$bind_values,$image->{$column};
+ }
+ }
+
+ #conditions
+ my $conditions=['filename=?'];
+ push @$bind_values,$image->{filename};
+
+ push @$conditions, 'project_id=?';
+ push @$bind_values, $image->{project_id}||0;
+
+ push @$conditions, 'studio_id=?';
+ push @$bind_values, $image->{studio_id}||0;
+
+ return if (@set==0);
+
+ my $set=join (",",@set);
+ $conditions=join(' and ', @$conditions);
+ my $query=qq{
+ update calcms_images
+ set $set
+ where $conditions
+ };
+ #print STDERR Dumper($query).Dumper($bind_values);
+ return db::put($dbh,$query,$bind_values);
+}
+
+sub delete{
+ my $dbh=shift;
+ my $image=shift;
+
+ unless (defined $image->{project_id}){
+ print STDERR "missing project_id at images::delete\n";
+ return undef;
+ }
+ unless (defined $image->{project_id}){
+ print STDERR "missing project_id at images::delete\n";
+ return undef;
+ }
+ unless (defined $image->{filename}){
+ print STDERR "missing filename at images::delete\n";
+ return undef;
+ }
+
+ my $project_id = $image->{project_id};
+ my $studio_id = $image->{studio_id};
+ my $filename = $image->{filename};
+
+ my $conditions = ['filename=?'];
+ my $bind_values = [$filename];
+
+ push @$conditions, 'project_id=?';
+ push @$bind_values, $studio_id;
+
+ push @$conditions, 'studio_id=?';
+ push @$bind_values, $project_id;
+
+ $conditions=join(' and ', @$conditions);
+ my $query=qq{
+ delete from calcms_images
+ where $conditions
+ };
+ #print STDERR Dumper($query).Dumper($bind_values);
+ return db::put($dbh, $query, $bind_values);
+}
+
+# deactivated
+sub delete_files{
+ my $config = $_[0];
+ my $local_media_dir = $_[1];
+ my $filename = $_[2];
+ my $action_result = $_[3];
+ my $errors = $_[4];
+
+ return undef;
+
+ print log::error($config, 'missing permissions on writing into local media dir')unless(-w $local_media_dir);
+
+ if ($filename=~/[^a-zA-Z0-9\.\_\-]/){
+ log::error($config, "invalid filename: '$filename'");
+ return;
+ }
+ if ($filename=~/\.\./ || $filename=~/^\// || $filename=~/\//){
+ log::error($config, "invalid filename: '$filename'");
+ return;
+ }
+
+ log::error($config, 'missing permissions on writing into local_media_dir/images/')unless(-w $local_media_dir.'images/');
+ log::error($config, 'missing permissions on writing into local_media_dir/thumbs/')unless(-w $local_media_dir.'thumbs/');
+ log::error($config, 'missing permissions on writing into local_media_dir/icons/') unless(-w $local_media_dir.'icons/');
+
+ my $path=$local_media_dir.'/upload/'.$filename;
+ #delete_file($path,"Upload $filename",$action_result,$errors);
+
+ $path=$local_media_dir.'/images/'.$filename;
+ delete_file($path,"Image $filename",$action_result,$errors);
+
+ $path=$local_media_dir.'/thumbs/'.$filename;
+ delete_file($path,"Thumb $filename",$action_result,$errors);
+
+ $path=$local_media_dir.'/icons/'.$filename;
+ delete_file($path,"Icon $filename",$action_result,$errors);
+}
+
+# deactivated
+sub delete_file{
+ my $path = $_[0];
+ my $type = $_[1];
+ my $action_result = $_[2];
+ my $errors = $_[3];
+
+ return undef;
+
+ unless (-e $path){
+ $errors.= qq{Error: File does not exist!
}; + return; + } + + unless (-w $path){ + $errors.= qq{Error: Cannot write $type
}; + return; + } + + unlink($path); + if ($?==0){ + $action_result.= qq{$type deleted
}; + }else{ + $errors.= qq{Error on deleting $type
}; + } +} + + +#do not delete last line! +1; diff --git a/lib/calcms/localization.pm b/lib/calcms/localization.pm new file mode 100644 index 0000000..f1ee00a --- /dev/null +++ b/lib/calcms/localization.pm @@ -0,0 +1,110 @@ +package localization; + +use warnings "all"; +use strict; +use Data::Dumper; +use uac; +use user_settings; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(get getJavascript); +our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] ); + +sub debug; + +# get localisation +# file : po file +# language : get for selected language +# user : get from user settings +# loc : add to existing localization, optional +sub get{ + my $config =shift; + my $options=shift; + + #print STDERR Dumper($options); + + #get pot file + unless (defined $options->{file}){ + print STDERR "missing po file\n"; + return $options->{loc}||{}; + } + + my $language=undef; + #get language from options + $language=$options->{language} if (defined $options->{language}); + + #get language from user + if ( (!(defined $language)) && (defined $options->{user})){ + my $user_settings=user_settings::get($config, {user=>$options->{user}}); + $language=$user_settings->{language}; + } + $language='en' unless defined $language; + $language='en' unless $language eq 'de'; + + my $loc={}; + $loc=$options->{loc} if defined $options->{loc}; + + my $files=$options->{file}; + $files=~s/[^a-zA-Z\,\_\-]//g; + #get all comma separated po files + for my $file (split/\,/,$files){ + #read default language + #my $po_file=$config->{locations}->{admin_pot_dir}.'/en/'.$file.'.po'; + #$loc=read_po_file($po_file, $loc); + + #read selected language + #if($language ne 'en'){ + my $po_file=$config->{locations}->{admin_pot_dir}.'/'.$language.'/'.$file.'.po'; + $loc=read_po_file($po_file, $loc); + #} + } + return $loc; +} + +sub read_po_file{ + my $po_file=shift; + my $loc =shift; + + unless (-e $po_file){ + print STDERR "po file $po_file does not exist\n"; + return $loc; + } + unless (-r $po_file){ + print STDERR "cannot read po file $po_file\n"; + return $loc; + } + + my $key=''; + open my $file, '<:encoding(UTF-8)', $po_file; + while (<$file>){ + my $line=$_; + #print STDERR $line; + if ($line=~/^msgid\s*\"(.*)\"\s*$/){ + $key=$1; + $key=~s/\'//g; + $key=~s/\"//g; + } + if ($line=~/^msgstr\s*\"(.*)\"\s*$/){ + my $val=$1; + $val=~s/\'//g; + $val=~s/\"//g; + $loc->{$key}=$val; + } + } + return $loc; +} + +sub getJavascript{ + my $loc=shift; + + my $out='\n"; + return $out; +} + +1; diff --git a/lib/calcms/log.pm b/lib/calcms/log.pm new file mode 100644 index 0000000..758d3ef --- /dev/null +++ b/lib/calcms/log.pm @@ -0,0 +1,166 @@ +use warnings "all"; +use strict; +use template; +use config; + +package log; +use Data::Dumper; + +require Exporter; +our @ISA = qw(Exporter); +#our @EXPORT = qw(all); +our @EXPORT_OK = qw(init write read error mem); +our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] ); + +#our $debug=0; +our $debug_params=''; +our $header="Content-type:text/html\n\n"; + +our $gtop = undef; +our $proc = undef; + +sub init{ + my $request =$_[0]; + $log::debug_params =$request->{params}->{checked}->{debug}||''; + $log::header =$request->{header}if (defined $request->{header}); + + #if ($config->{system}->{debug_memory}>0){ + #use GTop(); + #$log::gtop=GTop->new; + #$log::proc=$gtop->proc_mem($$); + #} +} + +sub write{ + my $config = shift; + my $key = shift; + my $data = shift; + my $dump = shift; + + return unless(defined $config::config->{system}->{debug}); + return unless(($config::config->{system}->{debug}>0) &&($log::debug_params=~/$key/)); + + my $line=Dumper($data); + $line=~s/^\$VAR1 = \{\n/
+
+ +
+
+
+
+};
+ return undef;
+}
+
+sub debug{
+ my $message=shift;
+ print STDERR "$message\n" if $debug>0;
+}
+
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/cache.pm b/lib/calcms/cache.pm
new file mode 100644
index 0000000..dc00789
--- /dev/null
+++ b/lib/calcms/cache.pm
@@ -0,0 +1,179 @@
+use warnings "all";
+use strict;
+#use Data::Dumper;
+
+use config;
+use time;
+use log;
+use markup;
+
+package cache;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(init add_map get_map get_map_keys load save get_filename escape_regexp escape_regexp_line);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+my $cache_map ={};
+my $cache_map_keys =[];
+my $header_printed =0;
+
+our $date_pattern ='(\d{4})\-(\d{2})\-(\d{2})';
+our $datetime_pattern ='(\d{4})\-(\d{2})\-(\d{2})[T\+](\d{2})\:(\d{2})(\:\d{2})?';
+
+sub init{
+ $cache_map ={};
+ $cache_map_keys =[];
+ $header_printed =0;
+}
+
+sub add_map{
+ my $key =$_[0];
+ my $value =$_[1];
+
+ $key='^'.$key.'$';
+ push @$cache_map_keys,$key;
+ $cache_map->{$key}=$value;
+}
+
+sub get_map{
+ return $cache_map;
+}
+
+sub get_map_keys{
+ return $cache_map_keys;
+}
+
+#get cache from params
+sub load{
+ my $params=shift;
+
+ my $filename=get_filename($params);
+
+ my $result={
+ filename=>$filename
+ };
+
+ if (defined $filename){
+ my @file_info=stat($filename);
+ my $modified=$file_info[9]||'';
+ if ($modified ne ''){
+ #file exists
+ my @now =localtime(time());
+ my @modified =localtime($modified);
+ if ($now[2]==$modified[2]){
+ #file is elder than a hour
+ my $content=log::load_file($filename);
+ if (defined $content){
+ $result->{content} =$content;
+ $result->{action} ='read';
+ return $result;
+ }
+ }
+ }
+ }
+
+ $result->{action}='save';
+ return $result;
+}
+
+#get filename from params
+sub get_filename{
+ my $config = shift;
+ my $params = shift;
+
+# my $url=$ENV{REQUEST_URI};
+ my $url=$ENV{QUERY_STRING}||'';
+ if ($url ne''){
+ $url=~s/(^|\&)update\=\d//gi;
+ $url=~s/(^|\&)debug\=.*//gi;
+ $url=~s/\?\&/\?/g;
+ $url=~s/\&{2,99}/\&/g;
+ $url=~s/\&$//g;
+ $url=~s/^\/\//\//g;
+ }
+ foreach my $pattern (@$cache_map_keys){
+
+ my $filename=$url;
+ log::write($config, 'cache_trace',"look at \"$filename\" for $pattern") if ($config->{system}->{debug});
+ if ($filename =~/$pattern/){
+ my $m1=$1;
+ my $m2=$2;
+ my $m3=$3;
+ my $m4=$4;
+ my $m5=$5;
+ my $m6=$6;
+ my $m7=$7;
+ my $m8=$8;
+# my $m9=$9;
+
+ my $result=$cache_map->{$pattern};
+
+ $filename=~s/$pattern/$result/;
+ $filename=~s/\$1/$m1/ if (defined $m1);
+ $filename=~s/\$2/$m2/ if (defined $m2);
+ $filename=~s/\$3/$m3/ if (defined $m3);
+ $filename=~s/\$4/$m4/ if (defined $m4);
+ $filename=~s/\$5/$m5/ if (defined $m5);
+ $filename=~s/\$6/$m6/ if (defined $m6);
+ $filename=~s/\$7/$m7/ if (defined $m7);
+ $filename=~s/\$8/$m8/ if (defined $m8);
+# $filename=~s/\$9/$m9/ if (defined $m9);
+ $filename=$config->{cache}->{cache_dir}.$filename;
+ return $filename;
+ }
+ }
+ return undef;
+}
+
+#deprecated: set file from params
+sub set{
+ my $params=shift;
+ my $content=shift;
+
+ my $filename=get_filename($params);
+ my $cache={
+ filename => $filename,
+ content => $content
+ };
+# print $filename.":file\n";
+
+ if (defined $filename){
+ cache::save($cache);
+ }
+}
+
+
+sub save{
+ my $cache=shift;
+
+ return if ($cache->{action}ne'save');
+ return if ((!defined $cache->{filename}) || ($cache->{filename}eq''));
+
+ log::save_file($cache->{filename},$cache->{content});
+ chmod 0664, $cache->{filename};
+}
+
+
+sub escape_regexp{
+ my $reg_exp=shift;
+ $reg_exp=~s/([\^\$\\(\)\[\]\{\}\|\/\*\+\.\-\&\:])/\\$1/gi;
+ return $reg_exp;
+}
+
+sub escape_regexp_line{
+ my $reg_exp=shift;
+ $reg_exp=~s/([\^\$\\(\)\[\]\{\}\|\/\*\+\.\-\&\:])/\\$1/gi;
+ return '^'.$reg_exp.'$';
+}
+
+sub configure{
+ my $file_name=shift;
+
+ cache::init();
+ cache::add_map('',$file_name);
+}
+
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/calendar.pm b/lib/calcms/calendar.pm
new file mode 100644
index 0000000..7038713
--- /dev/null
+++ b/lib/calcms/calendar.pm
@@ -0,0 +1,516 @@
+#use Calendar::Simple qw(date_span);
+use Date::Calc;
+
+use config;
+use template;
+use markup;
+use cache;
+use log;
+use time;
+use project;
+use events;
+
+package calendar;
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(init get_cached_or_render get render get_calendar_weeks configure_cache);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+#my $debug='';
+
+sub init{
+}
+
+sub get_cached_or_render{
+# my $output = $_[0]
+ my $config = $_[1];
+ my $request = $_[2];
+
+ my $parms =$request->{params}->{checked};
+ my $debug=$config->{system}->{debug};
+
+ my $cache={};
+ if ($config->{cache}->{use_cache} == 1){
+ calendar::configure_cache($config);
+ $cache=cache::load($config, $parms);
+ log::write($config, 'cache',$cache->{action}) if ($debug);
+ if (defined $cache->{content}){
+ $_[0]=$cache->{content};
+ return;
+ }
+ }
+
+ my $calendar=calendar::get($config, $request);
+ log::write($config, 'calendar',$calendar) if ($debug);
+ #print STDERR Dumper($calendar);
+
+ calendar::render($_[0], $config, $request, $calendar);
+
+ #write to cache
+ if ($config->{cache}->{use_cache} == 1){
+ #todo:put out reference only
+ $cache->{content}=$_[0];
+ log::write($config, 'cache_files',$cache) if ($debug);
+ cache::save($cache);
+ }
+}
+
+
+sub get{
+ my $config = shift;
+ my $request = shift;
+
+ my $params=$request->{params}->{checked};
+ my $debug=$config->{system}->{debug};
+
+ my $language = $config->{date}->{language} || 'en';
+
+ my $date = $params->{date}||'';
+ my $template = $params->{template}||'';
+ my $from_time = $params->{from_time}||'';
+ my $till_time = $params->{till_time}||'';
+
+ my @today=localtime(time());
+ my $today=sprintf('%04d-%02d-%02d', 1900+$today[5], $today[4]+1, $today[3]);
+
+ my $weekday_names = $time::names->{$language}->{weekdays};
+ my $weekday_short_names = $time::names->{$language}->{weekdays_abbr};
+ my $week_label={};
+ my $c=0;
+ for my $weekday (@$weekday_short_names){
+ $week_label->{$weekday}=$weekday_names->[$c]||'';
+ $c++;
+ }
+
+ $template=~s/\'//gi;
+ $from_time=~s/\'//gi;
+ $till_time=~s/\'//gi;
+
+ #put "clear all" filter into final results
+ my $day_result={};
+ my $clear_filter=$day_result;
+
+ #put "week day" filter into final results
+ my $days=[];
+ $c=0;
+ for my $weekday (@$weekday_short_names){
+ my $day_result={
+ label => $week_label->{$weekday},
+ weekday => $c+1,
+ weekday_parameter => 'weekday='.$c,
+ weekday_short_name => $weekday_short_names->[$c] ||'',
+ weekday_name => $weekday_names->[$c] ||'',
+ description => qq{alle $week_label->{$weekday}-Termine anzeigen},
+ };
+ push @$days,$day_result;
+ $c++;
+ }
+
+ #weeks and days array
+ my $weekAndDayResults=[];
+
+ #weekday array
+ my $weekdayResults=$days;
+
+ #week array
+ my $weekResults=[];
+
+ #info hash by timedate
+ my $dateInfo={};
+
+ #generate content for each day in a week in a month in a year
+ #get today
+ my $start_date='';
+ my $end_date='';
+ if ($date=~/(\d{4})\-(\d{2})/){
+ my $year=$1;
+ my $month=$2;
+ $start_date = "$year-$month-01";
+ $end_date = "$year-$month-".Date::Calc::Days_in_Month($year,$month);
+ }else{
+ $start_date = $params->{start_date};
+ $end_date = $params->{end_date};
+ }
+
+ my $previous_month=$start_date;
+ if ($previous_month=~/(\d{4})\-(\d{2})/){
+ my $year =$1;
+ my $month=$2-1;
+ $month='0'.$month if (length($month)<2);
+ if ($month lt '01'){
+ $year-=1;
+ $month='12';
+ }
+ $previous_month="$year-$month-01";
+ $previous_month=$params->{start_date} if ($previous_month lt $params->{start_date});
+ }
+
+ my $next_month=$end_date;
+ if ($next_month=~/(\d{4})\-(\d{2})/){
+ my $year=$1;
+ my $month=$2+1;
+ $month='0'.$month if (length($month)<2);
+ if ($month gt '12'){
+ $year+=1;
+ $month='01';
+ }
+ $next_month="$year-$month-01";
+ $next_month=$params->{end_date} if ($next_month gt $params->{end_date});
+ }
+
+ my $start_year=undef;
+ my $start_month=undef;
+ if ($start_date=~/(\d{4})\-(\d{2})/){
+ $start_year=$1;
+ $start_month=$2;
+ }
+ my $start_month_name=$time::names->{$language}->{months_abbr}->[$start_month-1];
+
+ if($params->{month_only}eq'1'){
+ return {
+ next_month => $next_month,
+ previous_month => $previous_month,
+ start_year => $start_year,
+ start_month => $start_month,
+ start_month_name => $start_month_name
+ };
+ }
+
+ my $years=calendar::get_calendar_weeks($config, $start_date, $end_date);
+
+ my $dbh=db::connect($config, $request);
+
+ my $used_days=events::get_by_date_range($dbh, $config, $start_date, $end_date);
+ my $used_day={};
+ for my $day(@$used_days){
+ $used_day->{$day->{start_date}}=1;
+ }
+
+ for my $year (sort {$a <=> $b} keys %$years){
+ my $months=$years->{$year};
+
+ for my $month (sort {$a <=> $b} keys %$months){
+ my $weeks=$months->{$month};
+
+ my $weekCounter=1;
+ for my $week (@$weeks){
+ my $dayResults=[];
+
+ my $week_end =undef;
+ my $week_start=undef;
+
+ my $week_of_year=undef;
+ my $woy_year = undef;
+
+ for my $date (@$week){
+ my ($year, $month, $day)=split(/\-/,$date);
+ my $weekday=0;
+ my $day_result=undef;
+
+ ($week_of_year,$woy_year) = Date::Calc::Week_of_Year($year,$month,$day) unless defined $week_of_year;
+
+ $day_result={
+ date => $date,
+ date_parameter => 'date='.$date,
+ day => $day,
+ year => $year,
+ month => $month,
+ };
+ $day_result->{time} =$from_time if defined $from_time;
+
+ $day_result->{class}.= ' calcms_today' if $date eq $today;
+ $day_result->{class}.= ' selected' if defined $used_day->{$date};
+ $day_result->{class}.= " week_$weekCounter";
+ $day_result->{class}.= " other_month" if ($weekCounter<2) && ($day gt "15");
+ $day_result->{class}.= " other_month" if ($weekCounter>3) && ($day lt "15");
+ $day_result->{class}=~s/^\s+//g;
+
+ $week_start =$day unless defined $week_start;
+ $week_end =$day;
+
+ log::write($config, 'day_results',$day_result)if ($debug);
+
+ $day_result->{weekday_name}=$weekday_names->[$weekday];
+ $day_result->{weekday_short_name}=$weekday_short_names->[$weekday];
+ $day_result->{weekday}=$weekday+1;
+
+ $dateInfo->{$day_result->{date}}=$day_result->{weekday} if defined $day_result->{date};
+
+ push @$dayResults, $day_result;
+ $weekday++;
+
+ }#end for days
+
+ #week filter
+ my $start_date=$week->[0];
+ my $end_date =$week->[-1];
+
+ my $week_result={
+ from_date => $start_date,
+ till_date => $end_date,
+ week_start => $week_start,
+ week_end => $week_end,
+ week_month => sprintf("%2d",$month),
+ week_year => $year,
+ week_of_year => $week_of_year,
+ };
+
+ $week_result->{class}.= ' selected' if (
+ ((defined $params->{from_date}) && ($start_date eq $params->{from_date}))
+ || ((defined $params->{till_date}) && ($end_date eq $params->{till_date}))
+ );
+ $week_result->{class}.= " week_$weekCounter";
+ $week_result->{class}=~s/^\s+//g;
+
+ push @$weekResults, $week_result;
+
+ push @$weekAndDayResults,{
+ days=>$dayResults,
+ week=>[$week_result]
+ };
+ $weekCounter++;
+
+ }#end week
+
+ }#end month
+
+ }#end year
+
+ for my $weekday (@$weekdayResults){
+ $weekday->{start_date} = $start_date;
+ $weekday->{end_date} = $end_date;
+ }
+
+ return {
+ week_and_days => $weekAndDayResults,
+ weekdays => $weekdayResults,
+ weeks => $weekResults,
+ days => $dateInfo,
+ next_month => $next_month,
+ previous_month => $previous_month,
+ start_date => $start_date,
+ end_date => $end_date,
+ start_month_name => $start_month_name,
+ start_month => $start_month,
+ start_year => $start_year,
+ base_url => $config->{locations}->{base_url},
+ cache_base_url => $config->{cache}->{base_url},
+ controllers => $config->{controllers},
+ };
+
+}
+
+sub render{
+# my $out = $_[0];
+ my $config = $_[1];
+ my $request = $_[2];
+ my $calendar = $_[3];
+
+ my $parms =$request->{params}->{checked};
+ my $debug=$config->{system}->{debug};
+
+ my $template_parameters=$calendar;
+ $template_parameters->{debug} = $config->{system}->{debug};
+ $template_parameters->{base_url} = $config->{locations}->{base_url};
+ $template_parameters->{cache_base_url} = $config->{cache}->{base_url};
+ $template_parameters->{server_cache} = $config->{cache}->{server_cache} if ($config->{cache}->{server_cache});
+ $template_parameters->{use_client_cache} = $config->{cache}->{use_client_cache} if ($config->{cache}->{use_client_cache});
+
+ template::process($_[0], $parms->{template}, $template_parameters);
+}
+
+sub get_calendar_weeks{
+ my $config = shift;
+ my $start = shift;
+ my $end = shift;
+
+ my $debug = $config->{system}->{debug};
+
+ $start = time::date_to_array($start);
+ $end = time::date_to_array($end);
+
+ my $start_year = int($start->[0]);
+ my $end_year = int($end->[0]);
+
+ my $start_month = int($start->[1]);
+ my $end_month = int($end->[1]);
+
+ my $years={};
+ for my $year ($start_year..$end_year){
+ my $months={};
+ for my $month ($start_month..$end_month){
+ #get week arrays of days of the month
+ my $weeks=getWeeksOfMonth($year, $month);
+ $months->{$month}=$weeks;
+ }
+ $years->{$year}=$months;
+ }
+ log::write($config, 'years',$years)if ($debug);
+ return $years;
+}
+
+sub getWeeksOfMonth{
+ my $thisYear = shift;
+ my $thisMonth = shift;
+ my $thisDay = 1;
+
+ # get weekday of 1st of month
+ my $thisMonthWeekday = Date::Calc::Day_of_Week($thisYear,$thisMonth,1);
+
+ # get next month date
+ my($nextYear, $nextMonth, $nextDay)=Date::Calc::Add_Delta_YM($thisYear,$thisMonth,$thisDay, 0,1);
+ # get weekday of 1st of next month
+ my $nextMonthWeekday = Date::Calc::Day_of_Week($nextYear, $nextMonth, $nextDay);
+ my($lastYear, $lastMonth, $lastDayOfMonth)=Date::Calc::Add_Delta_Days($nextYear,$nextMonth,$nextDay, -1);
+
+ # get date of 1st of row
+ my( $week,$year) = Date::Calc::Week_of_Year($thisYear,$thisMonth,$thisDay);
+ ($year,my $month, my $day) = Date::Calc::Monday_of_Week($week,$year);
+
+ my @weeks=();
+ my $weekday=1;
+
+ {
+ # first week
+ my @days=();
+ for $weekday(0 .. $thisMonthWeekday-2){
+ push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
+ $day++;
+ }
+ # set current month
+ $month = $thisMonth;
+ $year = $thisYear;
+ $day = 1;
+ for $weekday($thisMonthWeekday..7){
+ push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
+ $day++;
+ }
+ # next week
+ push @weeks, \@days;
+ }
+
+ # weeks until end of month
+ while(scalar(@weeks)<6){
+ my @days=();
+ $weekday=1;
+ while($weekday<=7){
+ push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
+ $day++;
+ $weekday++;
+ last if $day>$lastDayOfMonth;
+ }
+
+ if ($day>$lastDayOfMonth){
+ # set next month
+ $month=$nextMonth;
+ $year=$nextYear;
+ $day=1;
+
+ if ($nextMonthWeekday!=1){
+ # finish end week
+ if($weekday<=7){
+ while( $weekday<=7){
+ push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
+ $day++;
+ $weekday++;
+ }
+ }
+ }
+ push @weeks, \@days;
+ last;
+ };
+ push @weeks, \@days if $weeks[-1]->[-1] ne $days[-1];
+ }
+
+ #coming weeks
+ while(scalar(@weeks)<6){
+ my @days=();
+ for $weekday(1..7){
+ push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
+ $day++;
+ }
+ push @weeks, \@days;
+ }
+ return \@weeks;
+}
+
+sub configure_cache{
+ my $config = shift;
+ my $debug=$config->{system}->{debug};
+
+ cache::init();
+
+ my $date_pattern = $cache::date_pattern;
+ my $controllers = $config->{controllers};
+
+ cache::add_map('' , $controllers->{calendar}.'/cal.html');
+ cache::add_map('date='.$date_pattern , $controllers->{calendar}.'/$1-$2.html');
+ cache::add_map('from_date='.$date_pattern.'&till_date='.$date_pattern , $controllers->{calendar}.'/$1-$2_$5-$6.html');
+
+ log::write($config, 'cache_files',cache::get_map()) if ($debug);
+}
+
+sub check_params{
+ my $config=shift;
+ my $params=shift;
+
+ #get start and stop from projects
+ my $range= project::get_date_range($config);
+ my $start_date = $range->{start_date};
+ my $end_date = $range->{end_date};
+
+ #switch off limiting end date by project
+ my $open_end=0;
+ if((defined $params->{'open_end'})&&($params->{'open_end'}=~/(\d+)/)){
+ $open_end = $1;
+ $end_date = time::add_days_to_datetime(time::time_to_datetime(), 365);
+ }
+
+ my $month_only=$params->{month_only}||'';
+
+ #filter for date
+ my $date=time::check_date($params->{date});
+
+ $date =$start_date if ($date lt $start_date);
+ $date =$end_date if ($date gt $end_date);
+ log::error($config, "no valid year-month format given!") if ($date eq"-1");
+
+ my $time=time::check_time($params->{time});
+ log::error($config, "no valid time format given!") if ($time eq"-1");
+
+ my $from_date=time::check_date($params->{from_date})||'';
+ log::error($config, "no valid date format given!") if (defined $from_date && $from_date eq"-1");
+ $from_date =$start_date if ($from_date lt $start_date);
+ $from_date =$end_date if ($from_date gt $end_date);
+
+ my $till_date=time::check_date($params->{till_date}||'');
+ log::error($config, "no valid date format given!") if (defined $till_date && $till_date eq"-1");
+ $till_date =$start_date if ($till_date lt $start_date);
+ $till_date =$end_date if ($till_date gt $end_date);
+
+ my $template=template::check($params->{template},'calendar.html');
+
+ my $debug=$params->{debug};
+ if ((defined $debug) && ($debug=~/([a-z\_\,]+)/)){
+ $debug=$1;
+ }
+
+ return {
+ template => $template,
+ date => $date,
+ from_date => $from_date,
+ till_date => $till_date,
+ debug => $debug,
+ month_only => $month_only,
+ open_end => $open_end,
+ start_date => $start_date,
+ end_date => $end_date
+ }
+}
+#do not delete last line!
+1;
+
diff --git a/lib/calcms/comments.pm b/lib/calcms/comments.pm
new file mode 100644
index 0000000..d1078e1
--- /dev/null
+++ b/lib/calcms/comments.pm
@@ -0,0 +1,712 @@
+use warnings "all";
+use strict;
+use Data::Dumper;
+use config;
+use template;
+use time;
+
+package comments;
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+#our @EXPORT = qw(all);
+our @EXPORT_OK = qw(init get_cached_or_render get modify_results render configure_cache get_query get_by_event get_level get_events check insert set_lock_status set_news_status lock update_comment_count sort);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub init{
+}
+
+sub get_cached_or_render{
+# my $response=$_[0];
+ my $config = $_[1];
+ my $request = $_[2];
+ my $mark_locked = $_[3];
+
+ my $params=$request->{params}->{checked};
+ #print STDERR Dumper($params);
+ $config->{app_name}=$config->{controllers}->{comments};
+
+ my $comment=$request->{params}->{checked};
+
+ my $filename='';
+ my $cache={};
+
+ my $results=comments::get($config, $request);
+
+ if((defined $mark_locked) && ($mark_locked eq 'mark_locked')){
+ for my $result(@$results){
+ if($result->{lock_status}ne'show'){
+ $result->{author}='Zensur';
+ $result->{content}='Dieser Eintrag wurde gelöscht.';
+ }
+ }
+ }elsif((defined $mark_locked) && ($mark_locked eq 'filter_locked')){
+ my @results2=();
+ for my $result(@$results){
+ push @results2, $result if($result->{lock_status}eq'show');
+ }
+ $results=\@results2;
+ }
+
+ comments::modify_results($results, $config, $request);
+
+ #print STDERR Dumper($results);
+ $results=comments::sort($config, $results) if ($comment->{type}eq'tree');
+
+ #print STDERR Dumper($results);
+# if ($comment->{sort_order}eq'desc'){
+# my @results= reverse(@$results);
+# $results=\@results;
+# }
+
+ if (
+ ($params->{show_max} ne'')
+ && ($params->{limit} ne'')
+ && ($params->{show_max}<$params->{limit})
+ ){
+ my @results2=();
+ my $c=0;
+ for my $result(@$results){
+ push @results2,$result;
+ $c++;
+ last if ($c>=$params->{show_max});
+ }
+ $results=\@results2;
+ }
+
+ comments::render($_[0], $config, $request, $results);
+
+}
+
+sub get{
+ my $config = shift;
+ my $request= shift;
+
+ my $params=$request->{params}->{checked};
+
+ my $dbh=db::connect($config, $request);
+
+ (my $query, my $bind_values)=comments::get_query($dbh, $config, $request);
+ #print STDERR Dumper($$query);
+ #print STDERR Dumper($bind_values);
+ my $results=db::get($dbh, $$query, $bind_values);
+ #print STDERR Dumper($results);
+ return $results;
+}
+
+sub get_query{
+ my $dbh = shift;
+ my $config = shift;
+ my $request=shift;
+
+ my $params=$request->{params}->{checked};
+
+ my $event_id = undef;
+ my $event_start = undef;
+ my $from = 'calcms_comments c';
+ my $where = '';
+ my $limit = '';
+ my @conditions=();
+ my $bind_values=[];
+
+ #exclude comments from config filter/exclude_locations
+ if (
+ (defined $config->{filter})
+ && (defined $config->{filter}->{exclude_locations})
+ ){
+ my @exclude_locations=split(/[,\s]+/,$config->{filter}->{exclude_locations});
+ my $exclude_locations=join(', ',map {'?'} @exclude_locations);
+
+ $from.=',calcms_events e';
+ push @conditions,'e.id=c.event_id';
+ push @conditions,'e.location not in ('.$exclude_locations.')';
+ for my $location (@exclude_locations){
+ push @$bind_values, $location;
+ }
+ }
+
+ if (
+ (defined $params->{event_id} && $params->{event_id}ne'') &&
+ (defined $params->{event_start} && $params->{event_start}ne'')
+ ){
+ #$where =qq{ and (event_id=? or event_start=?) };
+ push @conditions, q{ (event_id=? or event_start=?) };
+ push @$bind_values, $params->{event_id};
+ push @$bind_values, $params->{event_start};
+ }
+
+ my $sort_order=$params->{sort_order};
+
+ if ($params->{limit} ne''){
+ $limit ='limit ?';
+ push @$bind_values,$params->{limit};
+ }
+
+ if (@conditions>0){
+ $where= 'where '.join(' and ',@conditions);
+ }
+
+ my $dbcols=['id', 'event_start', 'event_id', 'content', 'ip', 'author', 'email',
+ 'lock_status', 'created_at', 'title', 'parent_id', 'level', 'news_status', 'project'];
+ my $cols=join(', ',map { 'c.'.$_ } @$dbcols);
+ my $query=qq{
+ select $cols
+ from $from
+ $where
+ order by created_at $sort_order
+ $limit
+ };
+# where lock_status='show'
+# use Data::Dumper;print STDERR Dumper($query);
+
+ return (\$query, $bind_values);
+}
+
+sub modify_results{
+ my $results = $_[0];
+ my $config = $_[1];
+ my $request = $_[2];
+
+ my $params=$request->{params}->{checked};
+
+ my $time_diff='';
+ if ($params->{template}=~/\.xml/){
+ $time_diff=time::utc_offset($config->{date}->{time_zone});
+ $time_diff=~s/(\d\d)(\d\d)/$1\:$2/g;
+ }
+
+ my $language = $config->{date}->{language} || 'en';
+
+ for my $result (@$results){
+ $result->{allow}->{new_comments} = 1 if ($params->{allow}->{new_comments});
+ $result->{start_date_name} = time::date_format($result->{created_at}, $language);
+ $result->{start_time_name} = time::time_format($result->{created_at});
+ my $comment_limit=100;
+ if (length($result->{content})>$comment_limit){
+ $result->{short_content} = substr($result->{content},0,$comment_limit).'...' ;
+ }else{
+ $result->{short_content} = $result->{content};
+ }
+ $result->{base_url} = $config->{locations}->{base_url};
+ $result->{cache_base_url} = $config->{cache}->{base_url};
+
+ if($params->{template}=~/\.xml/){
+# $result->{content} =~s/(\[\[.*?\]\])//gi;
+# $result->{content} =markup::plain_to_xml($result->{content});
+# $result->{content} =$result->{html_content};
+
+ $result->{content} = markup::html_to_plain($result->{html_content});
+ $result->{short_content}= markup::html_to_plain($result->{short_content});
+ $result->{excerpt} = "lass dich ueberraschen" if ((defined $result->{excerpt}) && ($result->{excerpt}eq''));
+ $result->{excerpt} = markup::html_to_plain($result->{excerpt});
+ $result->{title} = markup::html_to_plain($result->{title});
+ $result->{series_name} = markup::html_to_plain($result->{series_name});
+ $result->{program} = markup::html_to_plain($result->{program});
+
+ if (defined $result->{created_at}){
+ $result->{created_at}=~s/ /T/gi;
+ $result->{created_at}.=$time_diff;
+ }
+
+ if (defined $result->{modified_at}){
+ $result->{modified_at}=~s/ /T/gi;
+ $result->{modified_at}.=$time_diff;
+ }
+ }
+ }
+ return $results;
+}
+
+
+sub render{
+# my $response =$_[0];
+ my $config = $_[1];
+ my $request = $_[2];
+ my $results = $_[3];
+
+ my $params =$request->{params}->{checked};
+
+ my %template_parameters=%$params;
+ my $template_parameters=\%template_parameters;
+
+ $template_parameters->{comments} = $results;
+ $template_parameters->{comment_count} =(@$results)+0;
+ $template_parameters->{one_result} =1 if($template_parameters->{comment_count}==1);
+ $template_parameters->{allow}->{new_comments} =1 if ($params->{allow}->{new_comments});
+
+ $template_parameters->{event_id} = $params->{event_id};
+ $template_parameters->{event_start} = $params->{event_start};
+
+ $template_parameters->{server_cache} = $config->{cache}->{server_cache} if ($config->{cache}->{server_cache});
+ $template_parameters->{use_client_cache}= $config->{cache}->{use_client_cache} if ($config->{cache}->{use_client_cache});
+ $template_parameters->{controllers} = $config->{controllers};
+ template::process($_[0],$params->{template},$template_parameters);
+}
+
+#check if comment exists already
+sub check{
+ my $dbh = shift;
+ my $config = shift;
+ my $comment = shift;
+
+ my $query=qq{
+ select id
+ from calcms_comments
+ where (
+ event_start=?
+ or event_id=?
+ )
+ and parent_id=?
+ and author=?
+ and ip=?
+ and content=?
+ };
+ my $bind_values=[
+ $comment->{event_start},
+ $comment->{event_id},
+ $comment->{parent_id},
+ $comment->{author},
+ $comment->{ip},
+ $comment->{content}
+ ];
+
+ my $comments=db::get($dbh,$query,$bind_values);
+
+ my @comments=@$comments;
+ return 0 if (@comments>0);
+ return 1;
+}
+
+#used for insert
+sub get_level{
+ my $dbh = shift;
+ my $config = shift;
+ my $comment = shift;
+
+ my $parent_id=$comment->{parent_id};
+ return 0 unless defined $parent_id;
+ if($parent_id=~/(\d+)/){
+ $parent_id=$1;
+ }
+ return 0 unless $parent_id=~/^\d+$/;
+ return 0 if $parent_id==0;
+
+ #get level from parent node
+ my $query=qq{
+ select level
+ from calcms_comments
+ where (
+ event_start=?
+ or event_id=?
+ )
+ and id=?
+ limit 1
+ };
+ my $bind_values=[
+ $comment->{event_start},
+ $comment->{event_id},
+ $parent_id
+ ];
+
+ my $comments=db::get($dbh,$query,$bind_values);
+
+ my @comments=@$comments;
+ if (@comments>0){
+ return $comments->[0]->{level}+1;
+ }
+ return 0;
+}
+
+sub get_by_event{
+ my $dbh = shift;
+ my $config = shift;
+ my $request =$_[0];
+
+ my $params = $request->{params}->{checked}->{comment};
+
+ my $event_id = undef;
+ my $search = undef;
+ my $where = '';
+ my $limit = '';
+ my $bind_values=[];
+
+ if ($params->{event_id}ne''){
+ $where =qq{ event_id=? };
+ $bind_values=[$params->{event_id}];
+ }
+
+ if ((defined $params->{search}) && ($params->{search}ne'')){
+ $search ='%'.$params->{search}.'%';
+ $where =qq{ (content like ?) or (email like ?) or (author like ?) or (ip like ?)};
+ $bind_values=[
+ $search,
+ $search,
+ $search,
+ $search
+ ];
+ }
+
+ my $sort_order=$params->{sort_order} || 'desc';
+
+ if ((defined $params->{limit}) && ($params->{limit} ne'')){
+ $limit ='limit ?';
+ push @$bind_values,$params->{limit};
+ }
+
+ my $query=qq{
+ select *
+ from calcms_comments
+ where $where
+ order by created_at $sort_order
+ $limit
+ };
+
+ #print STDERR $query."\n";
+ my $comments=db::get($dbh, $query, $bind_values);
+
+ return $comments;
+}
+
+sub get_by_time{
+ my $dbh = shift;
+ my $config = shift;
+ my $comment = shift;
+
+ my $where='';
+ my $bind_values=[];
+ if ($comment->{age} ne ''){
+ $where=qq{
+ where event_id in (
+ select distinct event_id
+ from calcms_comments
+ where (
+ unix_timestamp(now()) - ? < unix_timestamp(created_at)
+ )
+ )
+ };
+ $bind_values=[
+ $comment->{age}*3600,
+ ];
+ }elsif (($comment->{from} ne '') && ($comment->{till} ne '')){
+ $where=qq{
+ where event_id in (
+ select distinct event_id
+ from calcms_comments
+ where created_at >= ?
+ and created_at <= ?
+ )
+ };
+ $bind_values=[
+ $comment->{from},
+ $comment->{till}
+ ];
+ }
+ my $query=qq{
+ select *
+ from calcms_comments
+ $where
+ order by event_id, id
+ };
+ my $comments=db::get($dbh, $query, $bind_values);
+ return $comments;
+}
+
+sub get_events{
+ my $dbh=shift;
+ my $config = shift;
+ my $request=shift;
+ my $comments=shift;
+
+ my $params=$request->{params}->{checked}->{comment};
+
+ #get event_ids from comments
+ my $event_ids={};
+ for my $comment (@$comments){
+ my $event_id=$comment->{event_id};
+ $event_ids->{$event_id}=1;
+ }
+
+ #get events from comment's event ids
+ return [] if ((keys %{$event_ids})==0);
+
+ #my $quoted_event_ids=join "," ,(map {$dbh->quote($_)}(keys %{$event_ids}));
+ my @bind_values=keys %{$event_ids};
+ my $event_id_values=join "," ,(map {'?'}(keys %{$event_ids}));
+
+ my $query=qq{
+ select id, start, program, series_name, title, excerpt
+ from calcms_events
+ where id in ($event_id_values)
+ };
+
+ my $events=db::get($dbh, $query, \@bind_values);
+
+ #build lookup table for events by id
+ my $events_by_id={};
+ for my $event (@$events){
+ $events_by_id->{$event->{id}}=$event;
+ $event->{max_comment_id}=0;
+ }
+
+ #add unassigned events
+# for my $event_id (keys %{$event_ids}){
+# if ($events_by_id->{$event_id}eq''){
+# my $event={
+# title => "not assigned",
+# max_comment_id => 0
+#
+# };
+# push @$events,$event;
+# $events_by_id->{$event_id}=$event;
+# }
+# }
+
+ for my $comment (@$comments){
+ my $event_id=$comment->{event_id};
+ my $event=$events_by_id->{$event_id};
+ next unless (defined $event);
+ $event->{comment_count}++;
+ push @{$event->{comments}},$comment;# if ($params->{event_id}ne'');
+ $event->{max_comment_id}=$comment->{id} if ($comment->{id} > $event->{max_comment_id});
+ for my $name (keys %{$config->{controllers}}){
+ $comment->{"controller_".$name}=$config->{controllers}->{$name}||'';
+# $event->{"controller_$name"}=$config->{controllers}->{$name};
+ }
+ }
+ my @sorted_events=reverse sort {$a->{max_comment_id} <=> $b->{max_comment_id}} @$events;
+ return \@sorted_events;
+}
+
+sub insert{
+ my $dbh = shift;
+ my $config = shift;
+ my $comment = shift;
+
+ $comment->{level}=comments::get_level($dbh, $config, $comment);
+
+ my $entry={
+ event_start => $comment->{event_start},
+ event_id => $comment->{event_id},
+ parent_id => $comment->{parent_id},
+ level => $comment->{level},
+ title => $comment->{title},
+ content => $comment->{content},
+ author => $comment->{author},
+ email => $comment->{email},
+ ip => $comment->{ip}
+ };
+
+ my $comment_id=db::insert($dbh, 'calcms_comments', $entry);
+ return $comment_id;
+}
+
+sub set_lock_status{
+ my $dbh=shift;
+ my $config = shift;
+ my $comment=shift;
+
+ my $id = $comment->{id};
+ my $lock_status = $comment->{set_lock_status};
+ my $query=qq{
+ update calcms_comments
+ set lock_status = ?
+ where id = ?
+ };
+ my $bind_values=[
+ $lock_status,
+ $id
+ ];
+ db::put($dbh,$query,$bind_values);
+
+ $query=qq{
+ select event_id
+ from calcms_comments
+ where id=?
+ };
+ $bind_values=[$id];
+ my $comments=db::get($dbh,$query,$bind_values);
+ if (@$comments>0){
+ $comment->{event_id}=$comments->[0]->{event_id};
+ update_comment_count($dbh,$comment);
+ }
+}
+
+sub set_news_status{
+ my $dbh=shift;
+ my $config = shift;
+ my $comment=shift;
+
+ my $id = $comment->{id};
+ my $news_status = $comment->{set_news_status};
+ my $query=qq{
+ update calcms_comments
+ set news_status= ?
+ where id = ?
+ };
+ my $bind_values=[$news_status,$id];
+ db::put($dbh,$query,$bind_values);
+}
+
+sub update_comment_count{
+ my $dbh=shift;
+ my $config = shift;
+ my $comment=shift;
+
+ my $query=qq{
+ select count(id) count
+ from calcms_comments
+ where lock_status='show'
+ and event_id=?
+ };
+ my $bind_values=[$comment->{event_id}];
+ my $comments=db::get($dbh,$query,$bind_values);
+
+ my $count=0;
+ $count=$comments->[0]->{count} if (@$comments>0);
+ $query=qq{
+ update calcms_events
+ set comment_count=?
+ where id=?
+ };
+ $bind_values=[
+ $count,
+ $comment->{event_id}
+ ];
+ db::put($dbh,$query,$bind_values);
+}
+
+#precondition: results are presorted by creation date (by sql)
+sub sort{
+ my $config = shift;
+ my $results=shift;
+
+ #define parent nodes
+ my $nodes={};
+ for my $node (@$results){
+ $nodes->{$node->{id}}=$node;
+ }
+ my @root_nodes=();
+ for my $node (@$results){
+ #fill childs into parent nodes
+ push @{$nodes->{$node->{parent_id}}->{childs}},$node;
+ #define root nodes
+ push @root_nodes,$node if ($node->{level}==0);
+ }
+ #print STDERR Dumper(\@root_nodes);
+
+ #sort root nodes from newest to oldest
+ my $sorted_nodes=[];
+ for my $node (@root_nodes){
+ #for my $node (reverse @root_nodes){
+ sort_childs($node,$nodes,$sorted_nodes);
+ }
+ return $sorted_nodes;
+}
+
+sub sort_childs{
+ my $node=shift;
+ my $nodes=shift;
+ my $sorted_nodes=shift;
+
+ #push node into list of sorted nodes
+ push @{$sorted_nodes},$node;
+
+ #return if node is leaf
+ return $sorted_nodes unless (defined $node->{childs});
+
+ #process child nodes
+ for my $child (@{$node->{childs}}){
+ $sorted_nodes=sort_childs($child,$nodes,$sorted_nodes);
+ }
+ return $sorted_nodes;
+}
+
+sub configure_cache{
+ my $config = shift;
+
+ cache::init();
+
+ my $date_pattern = $cache::date_pattern;
+ my $datetime_pattern = $cache::datetime_pattern;
+ my $controllers = $config->{controllers};
+
+ cache::add_map('template=comments_newest&limit=3&type=list' ,$controllers->{comments}.'/neueste.html');
+ cache::add_map('template=comments_atom.xml&limit=20' ,$controllers->{comments}.'/feed.xml');
+ cache::add_map('template=comments.html&event_id=(\d+)&event_start='.$datetime_pattern ,$controllers->{comments}.'/$1_$2-$3-$4_$5-$6.html');
+}
+
+sub check_params{
+ my $config = shift;
+ my $params = shift;
+
+ my $comment={};
+
+ $comment->{event_start}='';
+ if ( (defined $params->{event_start}) && ($params->{event_start}=~/(\d\d\d\d\-\d\d\-\d\d[T ]\d\d\:\d\d)(\:\d\d)?/) ){
+ $comment->{event_start}=$1;
+ }
+
+ $comment->{sort_order}='desc';
+ $comment->{limit}='';
+ if ( (defined $params->{limit}) && ($params->{limit}=~/(\d+)/) ){
+ $comment->{limit}=$1;
+ }
+
+ $comment->{show_max}='';
+ if ( (defined $params->{show_max}) && ($params->{show_max}=~/(\d+)/) ){
+ $comment->{show_max}=$1;
+ }
+
+ if ( (defined $params->{sort_order}) && ($params->{sort_order}eq'asc') ){
+ $comment->{sort_order}='asc';
+ }
+
+ $comment->{event_id}='';
+ if ( (defined $params->{event_id}) && ($params->{event_id}=~/(\d+)/) ){
+ $comment->{event_id}=$1;
+ }
+
+ if ( (defined $params->{parent_id}) && ($params->{parent_id}=~/(\d+)/) ){
+ $comment->{parent_id}=$1;
+ }
+
+ if ((defined $params->{type}) && ($params->{type} eq 'list')){
+ $comment->{type}='list';
+ }else{
+ $comment->{type}='tree';
+ }
+
+ my $debug=$params->{debug}||'';
+ if ($debug=~/([a-z\_\,]+)/){
+ $comment->{debug}=$1;
+ }
+
+ log::error($config, 'missing parameter a') if ( (defined $params->{limit}) && ($comment->{limit} eq'') );
+ log::error($config, 'missing parameter b') if ( (defined $params->{event_id}) && ($comment->{event_id} eq'') );
+ log::error($config, 'missing parameter c') if ( (defined $params->{event_start}) && ($comment->{event_start} eq'') );
+
+ my $delta_days=1;
+ if ($comment->{event_start}ne''){
+ my $today = time::datetime_to_array(time::time_to_datetime());
+ my $date = time::datetime_to_array($comment->{event_start});
+ $delta_days = time::days_between($today,$date);
+ }
+ if(
+ ($delta_days > $config->{permissions}->{no_new_comments_before} )
+ || ($delta_days < -1*$config->{permissions}->{no_new_comments_after} )
+ ){
+ $comment->{allow}->{new_comments}=0;
+ }else{
+ $comment->{allow}->{new_comments}=1;
+ }
+
+ $comment->{template}=template::check($params->{template},'comments.html');
+
+ return $comment;
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/config.pm b/lib/calcms/config.pm
new file mode 100644
index 0000000..64e5cd3
--- /dev/null
+++ b/lib/calcms/config.pm
@@ -0,0 +1,33 @@
+package config;
+
+require Exporter;
+my @ISA = qw(Exporter);
+my @EXPORT_OK = qw(get $config);
+my %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+use Config::General;
+
+our $modified_at=-999;
+our $config= undef;
+
+sub get{
+ my $filename=shift;
+
+ #return config if known
+ #my $age=(-M $filename);
+ #return $config::config if ((defined $config::config) && ($age <= $config::modified_at));
+
+ #reload config if changed
+ my $configuration = new Config::General(
+ -ConfigFile=>$filename,
+ -UTF8=>1
+ );
+ $config::config=$configuration->{DefaultConfig}->{config};
+ $config::modified_at=$age;
+ #print STDERR "reload $filename\n";
+
+ return $config::config;
+}
+
+#do not delete last line
+1;
diff --git a/lib/calcms/creole_wiki.pm b/lib/calcms/creole_wiki.pm
new file mode 100644
index 0000000..e3fe386
--- /dev/null
+++ b/lib/calcms/creole_wiki.pm
@@ -0,0 +1,261 @@
+use warnings;
+use strict;
+use Data::Dumper;
+use markup;
+
+package creole_wiki;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(extractEventFromWikiText removeMeta eventToWikiText extractMeta removeMeta metaToWiki);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+#convert creole wiki text to event
+sub extractEventFromWikiText{
+ my $params=shift;
+ my $event=shift;
+ $event={} unless (defined $event);
+
+ my $title =$params->{title}||'';
+ my $content =$params->{content}||'';
+ my $local_media_url =$params->{local_media_url}||'';
+
+ #split content into excerpt, content and comments
+ $content=~s/\s*\,\s*/, /g;
+ my @lines=split(/\s*\-{10,99}\s*/,$content);
+ my $lines=\@lines;
+ for my $line (@$lines){
+ $line=~s/^\s+|\s+$//g;
+ }
+ if (@lines==1){
+ $event->{content}=shift @lines;
+ }elsif(@lines==2){
+ $event->{excerpt}=shift @lines;
+ $event->{content}=shift @lines;
+ }else{
+ $event->{excerpt}=shift @lines;
+ $event->{content}=shift @lines;
+ $event->{comments}=join("--------------------\n",@lines);
+ }
+ if (defined $event->{excerpt}){
+ $event->{excerpt}=markup::html_to_plain($event->{excerpt});
+ }
+ #extract program from title
+ $event->{program}='';
+
+ if ($title=~/^(.*?)\:/){
+ my $program=$1;
+ unless ($program=~/\s\-\s/){
+ $event->{program}=$program;
+ $event->{program}=~s/^\s+|\s+$//g;
+ $event->{program}=~s/\s+/ /g;
+ $title=~s/^.*?\:\s+//gi;
+ }
+ }
+
+ #extract series_name from title
+ $event->{series_name}='';
+ if ($title=~/^(.*?)\s+\-\s+/){
+ $event->{series_name}=$1;
+ $event->{series_name}=~s/^\s+|\s+$//g;
+ $event->{series_name}=~s/\s+/ /g;
+ $title=~s/^(.*?)\s+\-\s+//gi;
+ }
+
+ #extract categories from title
+ my @categories=();
+ while ($title=~/\((.*?),(.*?)\)/){
+ my $category=$1;
+ $category =~s/\s+/ /g;
+ $category =~s/^\s+|\s+$//g;
+ $category =~s/\&/\+/g;
+ push @categories,$category if (defined $category && $category=~/\S/);
+
+ $category='';
+ $category=$2 if (defined $2);
+ $category =~s/\s+/ /g;
+ $category =~s/^\s+|\s+$//g;
+ $category =~s/\&/\+/g;
+ push @categories,$category if (defined $category && $category=~/\S/);
+ $title=~s/\((.*?),(.*?)\)/\($2\)/;
+ }
+ if ($title=~/\((.*?)\)/){
+ my $category=$1;
+ $category =~s/\s+/ /g;
+ $category =~s/^\s+|\s+$//g;
+ $category =~s/\&/\+/g;
+
+# print $category."\n";
+ push @categories,$category if (defined $category && $category=~/\S/);
+ $title=~s/\((.*?)\)//;
+ }
+ $event->{categories} = \@categories if (@categories>0);
+ $event->{title} = $title;
+ $event->{title} =~s/^\s+|\s+$//g;
+
+ if (defined $event->{content}){
+ #extract podcast_url from content link 'podcast'
+ my $podcast_url='';
+ if ($event->{content}=~/\[\[\s*([^\|\]]+)\s*\|\s*podcast\s*\]\]/i){
+ $podcast_url=$1;
+ # $podcast_url=~s/\|.*//g;
+ # print "found podcast:".$podcast_url."\n";
+ }
+ $event->{podcast_url} = $podcast_url;
+
+ #extract media_url from content link 'download'
+ my $media_url='';
+ if ($event->{content}=~/\[\[\s*([^\|\]]+)\s*\|\s*(direct\s+)?download\s*\]\]/i){
+ $media_url=$1;
+ # $podcast_url=~s/\|.*//g;
+ # print "found media:".$media_url."\n";
+ }
+ $event->{media_url} = $media_url;
+
+ #replace "thumbs/xxx" link by link to local media URI
+ $event->{content}=~s/\{\{\s*thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}/\[\[$local_media_url\/images\/$1\|\{\{$local_media_url\/thumbs\/$1\|$2\}\}\]\]/g;
+
+ #extract image from content
+ if ($event->{content}=~/\{\{(.*?)(\||\}\})/){
+ $event->{image}=$1;
+ }
+ }
+
+ #meta
+ if (defined $event->{comments}){
+ my $meta=extractMeta($event->{comments});
+ $event->{meta} = $meta if (@$meta>0);
+ }
+
+ return $event;
+}
+
+sub eventToWikiText{
+ my $event=shift;
+ my $local_media_url =$event->{local_media_url}||'';
+
+ $event->{program} =~s/^\s+|\s+$//g;
+ $event->{series_name} =~s/^\s+|\s+$//g;
+ $event->{title} =~s/^\s+|\s+$//g;
+ $event->{excerpt} =~s/^\s+|\s+$//g;
+ $event->{content} =~s/^\s+|\s+$//g;
+ $event->{comments} =~s/^\s+|\s+$//g;
+
+ my $title='';
+ if($event->{program} ne''){
+ $title=$event->{program};
+ $title.=': ' if (($event->{series_name} ne'') || ($event->{title} ne''));
+ }
+ if($event->{series_name} ne''){
+ $title.=$event->{series_name};
+ $title.=' - ' if ($event->{title} ne'');
+ }
+ $title.=$event->{title};
+ if ($event->{categories}){
+ $title.=' ('.join(",", @{$event->{categories}} ).')' if (@{$event->{categories}}>0);
+ }
+
+ my $meta=extractMeta($event->{comments}, $event->{meta});
+ #use Data::Dumper;print "extracted meta".Dumper($meta);
+
+ $event->{comments}=removeMeta($event->{comments});
+ $event->{wiki_comments}=$event->{comments}."\n\n".metaToWiki($meta);
+ #use Data::Dumper;print "event content".Dumper($event->{content});
+
+ #rich content editors:
+ #$event->{wiki_content}=markup::html_to_creole($event->{content});
+
+ #markup editors
+ $event->{wiki_content}=$event->{content};
+
+
+# [[http://localhost/agenda_files/media/images/Vl8X7YmaWrmm9RMN_OMywA.jpg|{{http://localhost/agenda_files/media/thumbs/Vl8X7YmaWrmm9RMN_OMywA.jpg|}}]]
+ #replace "thumbs/xxx" link by link to local media URI
+# while ($event->{wiki_content}=~/\[\[.*?\/+media\/+images\/+(.*?)\s*\|.*?\{\{.*?\/+media\/+thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}\]\]/){
+ $event->{wiki_content}=~s/\[\[.*?\/+media\/+images\/+(.*?)\s*\|.*?\{\{.*?\/+media\/+thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}\]\]/\{\{thumbs\/$1\|$3\}\}/g;
+# }
+
+ my $wiki_content=join("\n".("-"x20)."\n",($event->{excerpt}, $event->{wiki_content}) );
+ $wiki_content.="\n".("-"x20)."\n".$event->{wiki_comments} if ($event->{wiki_comments}=~/\S/);
+
+ return {
+ title => $title,
+ content => $event->{content},
+ wiki_content => $wiki_content
+ };
+
+}
+
+#extrace meta tags from comment text
+sub extractMeta{
+ my $comments =shift;
+ my $meta =shift;
+
+ $meta=[] unless (defined $meta);
+
+ #push meta tags into meta list
+ if (defined $comments){
+ #build index for meta already defined
+ my $meta_keys={};
+ for my $pair (@$meta){
+ $meta_keys->{$pair->{name}.'='.$pair->{value}}=1;
+ }
+
+ while ($comments=~/\~\~META\:(.+?)\=(.+?)\~\~/g){
+ my $name=$1;
+ my $value=$2;
+
+ #fix meta values
+ $name=lc($name);
+ $name=~s/^\s+|\s+$//g;
+ $value=~s/^\s+|\s+$//g;
+
+ #insert into list, if not defined yet
+ unless( ($name eq'') || ($value eq'') || (exists $meta_keys->{$name.'='.$value}) ){
+ push @$meta,{
+ name=>$name,
+ value=>$value,
+ };
+ $meta_keys->{$name.'='.$value}=1;
+ }
+ };
+ }
+# use Data::Dumper;print Dumper($meta);
+ return $meta;
+}
+
+#remove meta tags from comment text
+sub removeMeta{
+ my $comments=shift||'';
+
+ my $result='';
+ for my $line (split(/\n/,$comments)){
+ $result.=$line unless ($line=~/\~\~META\:(.+?)\=(.+?)\~\~/g);
+ }
+ #use Data::Dumper;print "removed metsas:".Dumper($result);
+ $result=~s/^\s+//g;
+ $result=~s/\s+$//g;
+
+ return $result;
+}
+
+#add meta tags to comment text
+sub metaToWiki{
+ my $meta =shift;
+
+ my $result='';
+ for my $pair (@$meta){
+# use Data::Dumper;print Dumper($pair);
+ $result.='~~META:'.$pair->{name}.'='.$pair->{value}.'~~'."\n";
+ }
+ return $result;
+ #use Data::Dumper;print Dumper($meta);
+
+}
+
+
+#test:
+#perl -e 'use creole_wiki;$a=creole_wiki::extractEventFromWikiText("teaser\n----------------------\nbody[[asd|download]][[bsd|hallo]][[csd|podcast]]{{a|b}}[[dsd|wer]]\n----------------------\ncomments",{title=>" a : b - c ( d e - f , g h i - j, k - m - l) "});use Data::Dumper;print Dumper($a)';
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/db.pm b/lib/calcms/db.pm
new file mode 100644
index 0000000..087a919
--- /dev/null
+++ b/lib/calcms/db.pm
@@ -0,0 +1,278 @@
+use warnings "all";
+use strict;
+
+#use DBI;
+#use Apache::DBI;
+use DBD::mysql;
+
+package db;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ connect disconnect
+ get insert put
+ next_id get_max_id
+ shift_date_by_hours shift_datetime_by_minutes
+ get_columns get_columns_hash
+ $write
+ $read
+);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+#debug settings
+our $debug_read=0;
+our $debug_write=0;
+
+#database control
+our $read=1;
+our $write=1;
+
+# connect to database
+sub connect{
+ my $options=shift;
+ my $request=shift;
+
+ return $request->{connection} if ((defined $request) && (defined $request->{connection}));
+
+ my $access_options=$options->{access};
+
+ my $hostname =$access_options->{hostname};
+ my $port =$access_options->{port};
+ my $database =$access_options->{database};
+ my $username =$access_options->{username};
+ my $password =$access_options->{password};
+
+ if ((defined $access_options->{write}) && ($access_options->{write}eq'1')){
+ $username =$access_options->{username_write};
+ $password =$access_options->{password_write};
+ }
+
+ my $dbh=undef;
+ my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
+# if ($db::utf8dbi eq '1'){
+# use UTF8DBI;
+# $dbh = UTF8DBI->connect( $dsn,$username,$password) || die "Database connection not made: $DBI::errstr"; # \nfor $dsn, $username
+# }else{
+# use DBI;
+ $dbh = DBI->connect( $dsn,$username,$password,{mysql_enable_utf8 => 1}) || die "could not connect to database: $DBI::errstr"; # \nfor $dsn, $username
+# }
+ #print STDERR "db connect $username\n" if ($debug_read==1);
+ #print STDERR "db connect $username\n";
+ $dbh->{RaiseError} = 1;
+
+ $dbh->{'mysql_enable_utf8'} = 1;
+ put($dbh,"set character set utf8");
+ put($dbh,"set names utf8");
+ put($dbh,"set time_zone='".$options->{date}->{time_zone}."'");
+
+ $request->{connection}=$dbh;
+ return $dbh;
+}
+
+sub disconnect{
+ my $request=shift;
+ my $dbh=$request->{connection};
+ $dbh->disconnect;
+ delete $request->{connection};
+}
+
+# get all database entries of an sql query (as list of hashs)
+sub get{
+ my $dbh=shift;
+ my $sql=shift;
+ my $bind_values=shift;
+
+ if ($debug_read==1){
+ print STDERR $sql."\n";
+ print STDERR Dumper($bind_values)."\n" if defined $bind_values;
+ }
+
+ my $sth = $dbh->prepare( $sql );
+ if ((defined $bind_values)&&(ref($bind_values)eq'ARRAY')){
+# print STDERR Dumper($bind_values)."\n";
+ my $result = $sth->execute(@$bind_values);
+ unless ($result){
+ print STDERR $sql."\n";
+ die "db: $DBI::errstr $sql" if ($read==1);
+ }
+ }else{
+ $sth->execute() || die "db: $DBI::errstr $sql" if ($read==1);
+ }
+
+ my @results=();
+ while ( my $row=$sth->fetchrow_hashref){
+ my $result={};
+ foreach my $key (keys %$row){
+ $result->{$key}=$row->{$key};
+ }
+ push @results, $result;
+ }
+
+ if ($debug_read==1){
+ print STDERR Dumper($results[0])."\n" if (@results==1);
+ print STDERR @results."\n" if (@results!=1);
+ }
+
+ $sth->finish;
+ return \@results;
+}
+
+# get list of table columns
+sub get_columns{
+ my $dbh=shift;
+ my $table=shift;
+
+ my $columns=db::get($dbh, 'select column_name from information_schema.columns where table_name=?',[$table]);
+ my @result=map {$_->{column_name}} (@$columns);
+ return \@result;
+}
+
+# get hash with table columns as keys
+sub get_columns_hash{
+ my $dbh=shift;
+ my $table=shift;
+
+ my $columns=db::get_columns($dbh, $table);
+ my $result={};
+ for my $column (@$columns){
+ $result->{$column}=1;
+ }
+ return $result;
+}
+
+
+# insert an entry into database (select from where)
+sub insert_old{
+ my $dbh=shift;
+ my $tablename=shift;
+ my $entry=shift;
+ my $do_not_quote=shift;
+
+ my $keys =join(",", map {$_} (keys %$entry));
+ my $values =undef;
+ if (defined $do_not_quote && $do_not_quote ne ''){
+ $values =join("\n,", map {$entry->{$_}} (keys %$entry));
+ }else{
+ $values =join("\n,", map {$dbh->quote($entry->{$_})} (keys %$entry));
+ }
+ my $sql ="insert into $tablename \n ($keys) \n values ($values);\n";
+ print STDERR $sql."\n" if ($debug_write==1);
+ put($dbh,$sql);
+
+}
+
+#returns last inserted id
+sub insert{
+ my $dbh=shift;
+ my $tablename=shift;
+ my $entry=shift;
+# my $do_not_quote=shift;
+
+ my $keys =join(",", map {$_} (keys %$entry));
+ my $values =join(",", map {'?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+
+ my $sql ="insert into $tablename \n ($keys) \n values ($values);\n";
+
+ if ($debug_write==1){
+ print STDERR $sql."\n";
+ print STDERR Dumper(\@bind_values)."\n" if (@bind_values);
+ }
+
+ put($dbh, $sql, \@bind_values);
+ my $result=get($dbh, 'SELECT LAST_INSERT_ID() id;');
+ return $result->[0]->{id} if $result->[0]->{id}>0;
+ return undef;
+}
+
+# execute a modifying database command (update,insert,...)
+sub put{
+ my $dbh=shift;
+ my $sql=shift;
+ my $bind_values=shift;
+
+ if ($debug_write==1){
+ print STDERR $sql."\n";
+ print STDERR Dumper($bind_values)."\n" if defined $bind_values;
+ }
+
+ my $sth = $dbh->prepare( $sql );
+ if ($write==1){
+ if ((defined $bind_values)&&(ref($bind_values)eq'ARRAY')){
+ $sth->execute(@$bind_values);
+ }else{
+ $sth->execute();
+ }
+ };
+ $sth->finish;
+ print STDERR "1\n" if ($debug_write==1);
+
+ my $result=get($dbh, 'SELECT ROW_COUNT() changes;');
+ return $result->[0]->{changes} if $result->[0]->{changes}>0;
+ return undef;
+}
+
+sub quote{
+ my $dbh=shift;
+ my $sql=shift;
+
+ $sql=~s/\_/\\\_/g;
+ return $dbh->quote($sql);
+}
+
+#subtract hours, deprecated(!)
+sub shift_date_by_hours{
+ my $dbh=shift;
+ my $date=shift;
+ my $offset=shift;
+
+ my $query='select date(? - INTERVAL ? HOUR) date';
+ my $bind_values=[$date,$offset];
+ my $results=db::get($dbh, $query, $bind_values);
+ return $results->[0]->{date};
+}
+
+#add minutes, deprecated(!)
+sub shift_datetime_by_minutes{
+ my $dbh=shift;
+ my $datetime=shift;
+ my $offset=shift;
+
+ my $query="select ? + INTERVAL ? MINUTE date";
+ my $bind_values=[$datetime,$offset];
+ my $results=db::get($dbh, $query, $bind_values);
+ return $results->[0]->{date};
+}
+
+# get next free id of a database table
+sub next_id{
+ my $dbh=shift;
+ my $table=shift;
+
+ my $query=qq{
+ select max(id) id
+ from $table
+ where 1
+ };
+ my $results=get($dbh,$query);
+ return $results->[0]->{id}+1;
+}
+
+# get max id from table
+sub get_max_id{
+ my $dbh=shift;
+ my $table=shift;
+
+ my $query=qq{
+ select max(id) id
+ from $table
+ where 1
+ };
+ my $results=get($dbh,$query);
+ return $results->[0]->{id};
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/eventOps.pm b/lib/calcms/eventOps.pm
new file mode 100644
index 0000000..9de5cee
--- /dev/null
+++ b/lib/calcms/eventOps.pm
@@ -0,0 +1,134 @@
+package eventOps;
+use warnings "all";
+use strict;
+
+use series;
+use series_dates;
+use time;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ setAttributesFromSeriesTemplate
+ setAttributesFromSchedule
+ setAttributesFromOtherEvent
+ setAttributesForCurrentTime
+ getRecurrenceBaseId
+);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+# functions: to be separated
+sub setAttributesFromSeriesTemplate{
+ my $config=shift;
+ my $params=shift;
+ my $event=shift;
+
+ #get attributes from series
+ my $series=series::get(
+ $config,{
+ project_id => $params->{project_id},
+ studio_id => $params->{studio_id},
+ series_id => $params->{series_id},
+ }
+ );
+ if(@$series!=1){
+ uac::print_error("series not found");
+ return undef;
+ }
+
+ #copy fields from series template
+ my $serie=$series->[0];
+ for my $attr(
+ 'program','series_name','title',
+ 'excerpt', 'topic', 'content', 'html_content',
+ 'project','category','location','image', 'live',
+ 'archive_url', 'podcast_url'
+ ){
+ $event->{$attr}=$serie->{$attr};
+ }
+ return $serie;
+}
+
+sub setAttributesFromSchedule{
+ my $config=shift;
+ my $params=shift;
+ my $event=shift;
+
+ #set attributes from schedule
+ my $schedules=series_dates::get(
+ $config, {
+ project_id => $params->{project_id},
+ studio_id => $params->{studio_id},
+ series_id => $params->{series_id},
+ start_at => $params->{start_date}
+ }
+ );
+
+ if(@$schedules!=1){
+ uac::print_error("schedule not found");
+ return undef;
+ }
+
+ my $schedule=$schedules->[0];
+ for my $attr(
+ 'start','end',
+ 'day', 'weekday',
+ 'start_date', 'end_date'
+ ){
+ $event->{$attr}=$schedule->{$attr};
+ }
+
+ my $timezone=$config->{date}->{time_zone};
+ $event->{duration} = time::get_duration($event->{start}, $event->{end}, $timezone);
+
+ return $event;
+}
+
+sub setAttributesFromOtherEvent{
+ my $config=shift;
+ my $params=shift;
+ my $event=shift;
+
+ my $event2=series::get_event($config, {
+ allow_any => 1,
+ #project_id => $params->{project_id},
+ #studio_id => $params->{studio_id},
+ #series_id => $params->{series_id},
+ event_id => $params->{source_event_id}
+ });
+ if (defined $event2){
+ for my $attr ('title', 'user_title', 'excerpt', 'user_excerpt', 'content', 'html_content', 'topics', 'image', 'live', 'no_event_sync', 'podcast_url', 'archive_url'){
+ $event->{$attr}=$event2->{$attr};
+ }
+ $event->{rerun}=1;
+ $event->{recurrence}=getRecurrenceBaseId($event2);
+ }
+
+ return $event;
+}
+
+sub setAttributesForCurrentTime{
+ my $serie=shift;
+ my $event=shift;
+
+ #on new event not from schedule use current time
+ if($event->{start}eq''){
+ $event->{start}=time::time_to_datetime();
+ if ($event->{start}=~/(\d\d\d\d\-\d\d\-\d\d \d\d)/){
+ $event->{start}=$1.':00';
+ }
+ }
+ $event->{duration}=$serie->{duration}||60;
+ $event->{end} =time::add_minutes_to_datetime($event->{start}, $event->{duration});
+ $event->{end}=~s/(\d\d:\d\d)\:\d\d/$1/;
+
+ return $event;
+}
+
+# get recurrence base id
+sub getRecurrenceBaseId{
+ my $event = shift;
+ return $event->{recurrence} if (defined $event->{recurrence}) && ($event->{recurrence} ne '') && ($event->{recurrence} ne '0');
+ return $event->{event_id};
+}
+
diff --git a/lib/calcms/event_history.pm b/lib/calcms/event_history.pm
new file mode 100644
index 0000000..72ad67b
--- /dev/null
+++ b/lib/calcms/event_history.pm
@@ -0,0 +1,176 @@
+#!/bin/perl
+
+package event_history;
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get get_by_id insert insert_by_event_id delete);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_event_history');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ return undef unless defined $condition->{studio_id};
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{event_id}) && ($condition->{event_id} ne '')){
+ push @conditions, 'event_id=?';
+ push @bind_values, $condition->{event_id};
+ }
+
+ if ((defined $condition->{change_id}) && ($condition->{change_id} ne '')){
+ push @conditions, 'id=?';
+ push @bind_values, $condition->{change_id};
+ }
+
+ my $limit='';
+ if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
+ $limit= 'limit '.$condition->{limit};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_event_history
+ $conditions
+ order by modified_at desc
+ $limit
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $changes=db::get($dbh, $query, \@bind_values);
+ #print STDERR Dumper($changes);
+
+ for my $change (@$changes){
+ $change->{change_id}=$change->{id};
+ delete $change->{id};
+ }
+ return $changes;
+}
+
+sub get_by_id{
+ my $config=shift;
+ my $id=shift;
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ select *
+ from calcms_event_history
+ where event_id=?
+ };
+
+ my $studios=db::get($dbh,$query,[$id]);
+ return undef if (@$studios!=1);
+ return $studios->[0];
+}
+
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ $entry->{event_id}=$entry->{id} if((defined $entry->{id})&&(!(defined $entry->{event_id})));
+ delete $entry->{id};
+
+ #TODO:filter for existing attributes
+ my $columns=get_columns($config);
+ my $event={};
+ for my $column (keys %$columns){
+ $event->{$column}=$entry->{$column} if defined $entry->{$column};
+ }
+
+ my $dbh=db::connect($config);
+ my $id=db::insert($dbh, 'calcms_event_history', $event);
+ return $id;
+}
+
+# insert event
+sub insert_by_event_id{
+ my $config=shift;
+ my $options=shift;
+
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+ return undef unless defined $options->{series_id};
+ return undef unless defined $options->{event_id};
+ return undef unless defined $options->{user};
+
+ my $sql=q{
+ select * from calcms_events
+ where id=?
+ };
+ my $bind_values=[$options->{event_id}];
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $sql, $bind_values);
+ if(@$results!=1){
+ print STDERR "cannot find event with event_id=$options->{event_id}";
+ return 0;
+ }
+
+ # add to history
+ my $event=$results->[0];
+ $event->{project_id} = $options->{project_id};
+ $event->{studio_id} = $options->{studio_id};
+ $event->{series_id} = $options->{series_id};
+ $event->{event_id} = $options->{event_id};
+ $event->{user} = $options->{user};
+ $event->{deleted} = 1;
+ event_history::insert($config, $event);
+}
+
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ my $dbh=db::connect($config);
+ db::put($dbh, 'delete from calcms_event_history where event_id=?', [$entry->{id}]);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg+ +
\n"; +} + +#do not delete last line! +1; diff --git a/lib/calcms/events.pm b/lib/calcms/events.pm new file mode 100644 index 0000000..4e9b638 --- /dev/null +++ b/lib/calcms/events.pm @@ -0,0 +1,1775 @@ +use warnings "all"; +use strict; + +use DBI; +use template; + +use config; +use time; +use db; +use cache; +use markup; +use log; + +package events; +use Data::Dumper; +use project; +use studios; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = + qw(init get_cached_or_render get modify_results get_query render get_running_event_id delete check_params configure_cache get_duration calc_dates get_keys add_recordings); +our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); + +sub init { +} + +sub get_cached_or_render { + + # my $response=$_[0]; + my $config = $_[1]; + my $request = $_[2]; + + my $params = $request->{params}->{checked}; + my $debug = $config->{system}->{debug}; + + my $cache = {}; + if ( $config->{cache}->{use_cache} == 1 ) { + events::configure_cache($config); + $cache = cache::load( $config, $params ); + log::write( $config, 'cache', $cache->{action} ); + if ( defined $cache->{content} ) { + $_[0] = $cache->{content}; + return; + } + } + + my $results = events::get( $config, $request ); + events::render( $_[0], $config, $request, $results ); + + #write to cache + if ( $config->{cache}->{use_cache} == 1 ) { + + #todo:put out reference only + log::write( $config, 'cache', $cache ); + $cache->{content} = $_[0]; + cache::save($cache); + } + log::mem( $config, 'events not_cached' ) if ( $debug > 2 ); + return $_[0]; +} + +sub get { + my $config = shift; + my $request = shift; + + my $debug = $config->{system}->{debug}; + + my $dbh = db::connect( $config, $request ); + + ( my $query, my $bind_values ) = events::get_query( $dbh, $config, $request ); + + #print STDERR Dumper($query).Dumper($bind_values)."\n"; + + my $results = db::get( $dbh, $$query, $bind_values ); + + #$results = events::add_recordings($dbh, $config, $request, $results); + + #print STDERR Dumper($results); + $results = events::modify_results( $dbh, $config, $request, $results ); + + return $results; +} + +sub modify_results { + my $dbh = shift; + my $config = shift; + my $request = shift; + my $results = shift; + + my $params = $request->{params}->{checked}; + + my $running_event_id = 0; + my $projects = {}; + my $studios = {}; + + # print $running_event_id." ".$running_events->[0]->{start}." ".$running_events->[0]->{title} if ($debug ne''); + my $time_diff = ''; + if ( scalar @$results > 0 ) { + $results->[0]->{__first__} = 1; + $results->[-1]->{__last__} = 1; + $running_event_id = events::get_running_event_id($dbh); + } + + if ( ( defined $params->{template} ) && ( $params->{template} =~ /\.xml/ ) ) { + $time_diff = time::utc_offset( $config->{date}->{time_zone} ); + $time_diff =~ s/(\d\d)(\d\d)/$1\:$2/g; + } + + my $previous_result = { start_date => '' }; + my $counter = 1; + for my $result (@$results) { + if ( defined $params->{template} ) { + if ( $params->{template} =~ /\.ics$/ ) { + $result->{content_ical} = + markup::plain_to_ical( $result->{content} ); + $result->{title_ical} = + markup::plain_to_ical( $result->{title} ); + $result->{user_title_ical} = + markup::plain_to_ical( $result->{user_title} ); + $result->{excerpt_ical} = + markup::plain_to_ical( $result->{excerpt} ); + $result->{user_excerpt_ical} = + markup::plain_to_ical( $result->{user_excerpt} ); + $result->{series_name} = + markup::plain_to_ical( $result->{series_name} ); + $result->{created_at} =~ s/ /T/gi; + $result->{created_at} =~ s/[\:\-]//gi; + $result->{modified_at} =~ s/ /T/gi; + $result->{modified_at} =~ s/[\:\-]//gi; + + } elsif ( $params->{template} =~ /\.atom\.xml/ ) { + $result->{excerpt} = '' unless defined( $result->{excerpt} ); + $result->{excerpt} = "lass dich ueberraschen" + if ( $result->{excerpt} eq '' ); + + # $result->{excerpt} =markup::plain_to_xml($result->{excerpt}); + # $result->{title} =markup::plain_to_xml($result->{title}); + # $result->{series_name} =markup::plain_to_xml($result->{series_name}); + # $result->{program} =markup::plain_to_xml($result->{program}); + + $result->{created_at} =~ s/ /T/gi; + $result->{created_at} .= $time_diff; + $result->{modified_at} =~ s/ /T/gi; + $result->{modified_at} .= $time_diff; + } elsif ( $params->{template} =~ /\.rss\.xml/ ) { + $result->{excerpt} = '' unless defined( $result->{excerpt} ); + $result->{excerpt} = "lass dich ueberraschen" + if ( $result->{excerpt} eq '' ); + + # $result->{excerpt} =markup::plain_to_xml($result->{excerpt}); + # $result->{title} =markup::plain_to_xml($result->{title}); + # $result->{series_name} =markup::plain_to_xml($result->{series_name}); + # $result->{program} =markup::plain_to_xml($result->{program}); + #print STDERR "created:$result->{created_at} modified:$result->{modified_at}\n"; + $result->{modified_at} = + time::datetime_to_rfc822( $result->{modified_at} ); + if ( $result->{created_at} =~ /[1-9]/ ) { + $result->{created_at} = + time::datetime_to_rfc822( $result->{created_at} ); + } else { + $result->{created_at} = $result->{modified_at}; + } + + } + } + $result->{series_name} ||= ''; + $result->{series_name} = '' if $result->{series_name} eq '_single_'; + + $result->{rerun} = '' unless defined $result->{rerun}; + + if ( $result->{title} =~ /\#(\d+)([a-z])?\s*$/ ) { + $result->{episode} = $1 unless defined $result->{episode}; + $result->{rerun} = $2 || '' unless ( $result->{rerun} =~ /\d/ ); + $result->{title} =~ s/\#\d+[a-z]?\s*$//; + $result->{title} =~ s/\s+$//; + } + $result->{rerun} = '' if ( $result->{rerun} eq '0' ); + + if ( ( defined $result->{recurrence_count} ) + && ( $result->{recurrence_count} > 0 ) ) + { + $result->{recurrence_count_alpha} = + markup::base26( $result->{recurrence_count} + 1 ); + $result->{recurrence_id} = $result->{recurrence}; + } else { + $result->{recurrence_count_alpha} = ''; + $result->{recurrence_count} = ''; + } + + # set title keys + my $keys = get_keys($result); + for my $key ( keys %$keys ) { + $result->{$key} = $keys->{$key}; + } + + $result = calc_dates( $config, $result, $params, $previous_result, $time_diff ); + + $result->{event_uri} = ''; + if ( ( defined $result->{program} ) && ( $result->{program} ne '' ) ) { + $result->{event_uri} .= $result->{program}; + $result->{event_uri} .= '-' + if ( ( $result->{series_name} ne '' ) + || ( $result->{title} ne '' ) ); + } + if ( $result->{series_name} ne '' ) { + $result->{event_uri} .= $result->{series_name}; + $result->{event_uri} .= '-' if ( $result->{title} ne '' ); + } + $result->{event_uri} .= $result->{title} if ( $result->{title} ne '' ); + $result->{event_uri} =~ s/\#/Nr./g; + $result->{event_uri} =~ s/\&/und/g; + $result->{event_uri} =~ s/\//\%2f/g; + $result->{event_uri} =~ s/[?]//g; + + $result->{rds_title} = $result->{event_uri}; + $result->{rds_title} =~ s/[^a-zA-Z0-9\-]/\_/gi; + $result->{rds_title} =~ s/\_{2,99}/\_/gi; + $result->{rds_title} = substr( $result->{rds_title}, 0, 63 ); + + # $result->{event_id}=$result->{id}; + + $result->{base_url} = $request->{base_url}; + $result->{base_domain} = $config->{locations}->{base_domain}; + $result->{static_files_url} = $config->{locations}->{static_files_url}; + $result->{source_base_url} = $config->{locations}->{source_base_url}; + $result->{cache_base_url} = $config->{cache}->{base_url}; + + $result->{is_running} = 1 + if ( $running_event_id eq $result->{event_id} ); + $result->{one_comment} = 1 if ( $result->{comment_count} == 1 ); + $result->{no_comment} = 1 if ( $result->{comment_count} == 0 ); + + #fix image url + if ( defined $result->{image} ) { + $result->{thumb} = $result->{image}; + $result->{icon} = $result->{image}; + + $result->{image} =~ s/thumbs/images/g; + $result->{image} =~ s/icons/images/g; + + #fix thumbs url + $result->{thumb} =~ s/images/thumbs/s; + $result->{thumb} =~ s/icons/thumbs/s; + + #fix icon url + $result->{icon} =~ s/thumbs/icons/s; + $result->{icon} =~ s/images/icons/s; + } + + $result->{location_css} = $result->{location} || ''; + $result->{location_css} = lc( $result->{location_css} ); + $result->{location_css} =~ s/\.//g; + $result->{location_css} =~ s/\s//g; + $result->{ 'location_label_' . $result->{location_css} } = 1; + + # add project by name + my $project_name = $result->{project}; + if ( defined $project_name ) { + + #print STDERR "found project:$project_name\n"; + unless ( defined $projects->{$project_name} ) { + my $results = project::get( $config, { name => $project_name } ); + $projects->{$project_name} = $results->[0] || {}; + } + my $project = $projects->{$project_name}; + for my $key ( keys %$project ) { + $result->{ 'project_' . $key } = $project->{$key}; + } + } else { + print STDERR "events::get - unknown project for event $result->{id}\n"; + } + + #if project_id is set add columns from project (cached) + my $project_id = $result->{project_id}; + if ( defined $project_id ) { + unless ( defined $projects->{$project_id} ) { + my $results = project::get( $config, { project_id => $project_id } ); + $projects->{$project_id} = $results->[0] || {}; + } + my $project = $projects->{$project_id}; + for my $key ( keys %$project ) { + $result->{ 'project_' . $key } = $project->{$key}; + } + } + + #if studio_id is set add columns from studio (cached) + my $studio_id = $result->{studio_id}; + if ( defined $studio_id ) { + unless ( defined $studios->{$studio_id} ) { + my $results = studios::get( $config, { studio_id => $studio_id } ); + $studios->{$studio_id} = $results->[0] || {}; + } + my $studio = $studios->{$studio_id}; + for my $key ( keys %$studio ) { + $result->{ 'studio_' . $key } = $studio->{$key}; + } + } + + #$result->{'project_title'}=$project->{title} if (defined $project->{title} && $project->{title} ne ''); + + #print STDERR "project:'$project_name'\n"; + #print STDERR "title:'$result->{project_title}'\n"; + #use Data::Dumper;print STDERR Dumper($result); + + for my $name ( keys %{ $config->{mapping}->{events} } ) { + my $val = ''; + if ( ( defined $name ) + && ( defined $config->{mapping}->{events}->{$name} ) + && ( defined $result->{$name} ) ) + { + $val = $config->{mapping}->{events}->{$name}->{ $result->{$name} } + || ''; + $result->{ $name . '_mapped' } = $val if ( $val ne '' ); + } + } + + #for my $name (keys %{$config->{controllers}}){ + # $result->{"controller_$name"}=$config->{controllers}->{$name}; + #} + + $previous_result = $result; + + #print "Content-type:text/text\n\n"; + #use Data::Dumper;print STDERR Dumper($result); + $result->{ 'counter_' . $counter } = 1; + $counter++; + + if ( ( defined $params->{template} ) + && ( $params->{template} =~ /(list|details)/ ) ){ + if ( ( defined $result->{excerpt} ) && ( length($result->{excerpt}) > 250) ){ + $result->{excerpt} = substr($result->{excerpt}, 0, 250).'...'; + } + + if ( (defined $result->{user_excerpt}) && (length($result->{user_excerpt}) > 250) ){ + $result->{user_excerpt} = substr($result->{user_excerpt}, 0, 250).'...'; + } + } + + #build content + if ( ( defined $params->{template} ) + && ( $params->{template} =~ /\.html/ ) ) + { + if ( defined $result->{content} ) { + $result->{content} = + markup::fix_line_ends( $result->{content} ); + $result->{content} = + markup::creole_to_html( $result->{content} ); + $result->{html_content} = $result->{content}; + + } + if ( defined $result->{topic} ) { + $result->{topic} = markup::fix_line_ends( $result->{topic} ); + $result->{topic} = markup::creole_to_html( $result->{topic} ); + $result->{html_topic} = $result->{topic}; + } + } + + #detect if images are in content or topic field + my $image_in_text = 0; + $image_in_text = 1 + if ( ( defined $result->{content} ) + && ( $result->{content} =~ /
}; + return; + } + + unless (-w $path){ + $errors.= qq{Error: Cannot write $type
}; + return; + } + + unlink($path); + if ($?==0){ + $action_result.= qq{$type deleted
}; + }else{ + $errors.= qq{Error on deleting $type
}; + } +} + + +#do not delete last line! +1; diff --git a/lib/calcms/localization.pm b/lib/calcms/localization.pm new file mode 100644 index 0000000..f1ee00a --- /dev/null +++ b/lib/calcms/localization.pm @@ -0,0 +1,110 @@ +package localization; + +use warnings "all"; +use strict; +use Data::Dumper; +use uac; +use user_settings; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(get getJavascript); +our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] ); + +sub debug; + +# get localisation +# file : po file +# language : get for selected language +# user : get from user settings +# loc : add to existing localization, optional +sub get{ + my $config =shift; + my $options=shift; + + #print STDERR Dumper($options); + + #get pot file + unless (defined $options->{file}){ + print STDERR "missing po file\n"; + return $options->{loc}||{}; + } + + my $language=undef; + #get language from options + $language=$options->{language} if (defined $options->{language}); + + #get language from user + if ( (!(defined $language)) && (defined $options->{user})){ + my $user_settings=user_settings::get($config, {user=>$options->{user}}); + $language=$user_settings->{language}; + } + $language='en' unless defined $language; + $language='en' unless $language eq 'de'; + + my $loc={}; + $loc=$options->{loc} if defined $options->{loc}; + + my $files=$options->{file}; + $files=~s/[^a-zA-Z\,\_\-]//g; + #get all comma separated po files + for my $file (split/\,/,$files){ + #read default language + #my $po_file=$config->{locations}->{admin_pot_dir}.'/en/'.$file.'.po'; + #$loc=read_po_file($po_file, $loc); + + #read selected language + #if($language ne 'en'){ + my $po_file=$config->{locations}->{admin_pot_dir}.'/'.$language.'/'.$file.'.po'; + $loc=read_po_file($po_file, $loc); + #} + } + return $loc; +} + +sub read_po_file{ + my $po_file=shift; + my $loc =shift; + + unless (-e $po_file){ + print STDERR "po file $po_file does not exist\n"; + return $loc; + } + unless (-r $po_file){ + print STDERR "cannot read po file $po_file\n"; + return $loc; + } + + my $key=''; + open my $file, '<:encoding(UTF-8)', $po_file; + while (<$file>){ + my $line=$_; + #print STDERR $line; + if ($line=~/^msgid\s*\"(.*)\"\s*$/){ + $key=$1; + $key=~s/\'//g; + $key=~s/\"//g; + } + if ($line=~/^msgstr\s*\"(.*)\"\s*$/){ + my $val=$1; + $val=~s/\'//g; + $val=~s/\"//g; + $loc->{$key}=$val; + } + } + return $loc; +} + +sub getJavascript{ + my $loc=shift; + + my $out='\n"; + return $out; +} + +1; diff --git a/lib/calcms/log.pm b/lib/calcms/log.pm new file mode 100644 index 0000000..758d3ef --- /dev/null +++ b/lib/calcms/log.pm @@ -0,0 +1,166 @@ +use warnings "all"; +use strict; +use template; +use config; + +package log; +use Data::Dumper; + +require Exporter; +our @ISA = qw(Exporter); +#our @EXPORT = qw(all); +our @EXPORT_OK = qw(init write read error mem); +our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] ); + +#our $debug=0; +our $debug_params=''; +our $header="Content-type:text/html\n\n"; + +our $gtop = undef; +our $proc = undef; + +sub init{ + my $request =$_[0]; + $log::debug_params =$request->{params}->{checked}->{debug}||''; + $log::header =$request->{header}if (defined $request->{header}); + + #if ($config->{system}->{debug_memory}>0){ + #use GTop(); + #$log::gtop=GTop->new; + #$log::proc=$gtop->proc_mem($$); + #} +} + +sub write{ + my $config = shift; + my $key = shift; + my $data = shift; + my $dump = shift; + + return unless(defined $config::config->{system}->{debug}); + return unless(($config::config->{system}->{debug}>0) &&($log::debug_params=~/$key/)); + + my $line=Dumper($data); + $line=~s/^\$VAR1 = \{\n/
/g;
+ $line=~s/\};\n$/<\/code>/g;
+ $line=~s/\n/\\n/g;
+ my $msg=localtime()." [$key] ".$ENV{REQUEST_URI}."\\n".$line;
+ $msg.=Dumper($dump) if (defined $dump);
+ $msg.="\n";
+
+ log::print($config, $msg);
+}
+
+sub print{
+ my $config = $_[0];
+ my $message= $_[1];
+
+ unless (defined $config){
+ print STDERR "missing config at log::error\n";
+ return;
+ }
+
+ my $filename=$config->{system}->{log_debug_file}||'';
+ if ($filename eq ''){
+ print STDERR "calcms config parameter 'system/log_debug_file' not set!\n";
+ return;
+ };
+
+ open my $FILE, ">>:utf8", $filename or warn("cant write log file '$filename'");
+ print $FILE $message;
+ close $FILE;
+}
+
+sub error{
+ my $config = $_[0];
+ my $message="Error: $_[1]\n";
+
+ unless (defined $config){
+ print STDERR "missing config at log::error\n";
+ }
+
+ print STDERR $message."\n";
+ if($config::config->{system}->{debug}){
+ log::write($config, '', $message);# if ($config::config->{system}->{debug}>1);
+
+ my $out='';
+ #do not call template::check to avoid deep recursion!
+ template::process('print','templates/default.html', {
+ static_files_url => $config::config->{locations}->{static_files_url},
+ error=>$message
+ });
+ }
+ # TODO: remove exit
+ die();
+ #exit;
+}
+
+sub mem{
+ my $config = $_[0];
+ return unless $config::config->{system}->{debug_memory};
+ my $size=$log::gtop->proc_mem($$)->size();
+ my $format_size=$size;
+ $format_size=~s/(\d)(\d\d\d)$/$1\.$2/g;
+ $format_size=~s/(\d)(\d\d\d)(\d\d\d)$/$1\.$2\.$3/g;
+ my $line=localtime(time())."\t".$$."\t".$format_size."\t".$_[0];
+ $line.="\t\t".($size-$_[1]) if(defined $_[1]);
+ log::error($config, "log_memory_file is not defined!") if (!defined $config::config->{system}->{log_debug_memory_file});
+ log::append_file($config::config->{system}->{log_debug_memory_file} , $line);
+}
+
+sub load_file{
+ my $filename=$_[0];
+# my $content=$_[1];
+
+# binmode STDOUT, ":utf8";
+ my $content='';
+ if (-e $filename){
+ my $FILE=undef;
+ open $FILE, "<:utf8", $filename || warn "cant read file '$filename'";
+ $content=join "",(<$FILE>);
+ close $FILE;
+ return $content;
+ }
+}
+
+sub save_file{
+ my $filename=$_[0];
+ my $content=$_[1];
+
+ #check if directory is writeable
+ if ($filename=~/^(.+?)\/[^\/]+$/){
+ my $dir=$1;
+ unless (-w $dir){
+ print STDERR `pwd;id -a;`;
+ print STDERR "log::save_file : cannot write to directory ($dir)\n";
+ return;
+ }
+ }
+
+ open my $FILE, ">:utf8", $filename || warn("cant write file '$filename'");
+ if (defined $FILE){
+ print $FILE $content."\n";
+ close $FILE;
+ }
+
+}
+
+sub append_file{
+ my $filename =$_[0];
+ my $content =$_[1];
+
+ unless ( (defined $filename) && ($filename ne'') && (-e $filename) ){
+ print STDERR "cannot append, file '$filename' does not exist\n";
+ return;
+ }
+
+ if (defined $content){
+ open my $FILE, ">>:utf8", $filename or warn("cant write file '$filename'");
+ print $FILE $content."\n";
+ close $FILE;
+ }
+}
+
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/markup.pm b/lib/calcms/markup.pm
new file mode 100644
index 0000000..48f3f09
--- /dev/null
+++ b/lib/calcms/markup.pm
@@ -0,0 +1,485 @@
+use warnings "all";
+use strict;
+use Data::Dumper;
+use Text::WikiCreole;
+
+use HTML::Parse;
+use HTML::FormatText;
+
+use log;
+
+package markup;
+
+use Encode;
+
+require Exporter;
+our @ISA = qw(Exporter);
+#our @EXPORT = qw(all);
+our @EXPORT_OK = qw(fix_line_ends html_to_creole creole_to_html creole_to_plain plain_to_ical ical_to_plain ical_to_xml html_to_plain fix_utf8 uri_encode compress base26);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub fix_line_ends{
+ my $s=shift;
+ $s=~s/\r?\n|\r/\n/g;
+ return $s;
+}
+
+# convert 1..26 to a..z, 27 to aa, inspired by ConvertAA
+sub base26{
+ my $num = shift ;
+ return '' if $num <= 0;
+
+ my $s = "";
+ while($num){
+ $s= chr (--$num % 26 + ord "a").$s;
+ $num = int $num/26;
+ }
+
+ return $s;
+}
+
+sub html_to_creole{
+ my $s=shift;
+
+ #remove elements
+# $s=~s/[\r\f\n]+/\n/gi;
+# $s=~s/<\/p.*?>//gi;
+# $s=~s/<\/br.*?>//gi;
+ $s=~s/\<\!\-\-[\s\S]*?\-\-\>//gi;
+ $s=~s/.*?<\/script.*?>//gi;
+# $s=~s/<\/?span.*?>//gi;
+# $s=~s/<\/?font.*?>//gi;
+# $s=~s/<\/?meta.*?>//gi;
+# $s=~s/<\/?title.*?>//gi;
+# $s=~s/<\/?style.*?>//gi;
+# $s=~s/<\/?col.*?>//gi;
+# $s=~s/<\/?thead.*?>//gi;
+# $s=~s/<\/?tbody.*?>//gi;
+ $s=~s/<\/?form.*?>//gi;
+ $s=~s/<\/?select.*?>//gi;
+ $s=~s/<\/?option.*?//gi;
+ $s=~s/<\/?input.*?>//gi;
+# $s=~s/<\/?button.*?>//gi;
+# $s=~s/<\/?textarea.*?>//gi;
+ $s=~s/<\/?script.*?>//gi;
+
+ #table elements
+# $s=~s/\s*<\/?td.*?>//gi;
+# $s=~s/\s*<\/?th.*?>//gi;
+
+ #remove line breaks
+ $s=~s/[\r\n]+/ /gi;
+
+ #formats
+ $s=~s//{{$1\|}}/gi;
+ $s=~s//{{$2\|$1}}/gi;
+ $s=~s/]*?title="(.*?)".*?>/{{$1\|$2}}/gi;
+ $s=~s/]*?src="(.*?)".*?>/{{$2\|$1}}/gi;
+ $s=~s/<\/?img.*?>//gi;
+ #replace line breaks from images
+ $s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
+ $s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
+ $s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
+
+ $s=~s/(.*?)<\/i>/\/\/$1\/\//gi;
+ $s=~s/<\/?i.*?>//gi;
+ $s=~s/(.*?)<\/b>/\*\*$1\*\*/gi;
+# $s=~s/<\/?b.*?>//gi;
+
+ $s=~s/(.*?)<\/strong>/\*\*$1\*\*/gi;
+ $s=~s/(.*?)<\/em>/\/\/$1\/\//gi;
+ $s=~s/((\W+|\w+)*?)<\/blockquote>/{{{$1}}}/gi;
+# $s=~s/((\W+|\w+)*?)<\/a>/\[\[$1\|$2\]\]$3/gi;
+ $s=~s/(.*?)(\s*)<\/a>/\[\[$1\|$2\]\]$3/gi;
+ $s=~s///gi;
+ #replace line breaks from links
+ $s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
+ $s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
+ $s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
+
+# print STDERR Dumper($s) if ($s=~//== /gi;
+ $s=~s/\s*/=== /gi;
+ $s=~s/\s*/==== /gi;
+ $s=~s/\s*/===== /gi;
+# $s=~s/\s*<\/h\d.*?>/\n/gi;
+
+# $s=~s//\\\\
/gi;
+# $s=~s/\s*//gi;
+# $s=~s/\s*<\/div>/\n/gi;
+
+# $s=~s//\n/gi;
+# $s=~s/<\/table>/\n/gi;
+# $s=~s/\s*//gi;
+# $s=~s/\s*<\/tr>//gi;
+
+# $s=~s/\s*/\n/gi;
+# $s=~s/\s*<\/ol>/\n/gi;
+# $s=~s/\s*/\n/gi;
+# $s=~s/\s*<\/ul>/\n/gi;
+# $s=~s/\s*/\n\* /gi;
+# $s=~s/\s*<\/li>//gi;
+
+# $s=~s/\s*\s*/\n\n/gi;
+# $s=~s/\s*\s*/\n /gi;
+
+ my $tree=HTML::Parse::parse_html(''.$s.'');
+ my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 2000);
+ $s= $formatter->format($tree);
+ #use Data::Dumper; print "asd:";
+ $s=~s/\//gi;
+
+ return $s;
+}
+
+sub creole_to_html{
+ my $s=$_[0]||'';
+
+ #$s=~s/\n\#\n/\n/g;
+ #fix_line_ends($s);
+ $s=~s/(.*?)(\s*)<\/a>/\[\[$1\|$2\]\]$3/gi;
+ $s=~s///gi;
+
+ $s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
+ $s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
+ $s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
+ $s=~s/^\s+//g;
+ $s=~s/\s+$//g;
+
+ $s=Text::WikiCreole::creole_parse($s)||'';
+# $s=~s//\n/gi;
+# $s=~s/\{\{\{((\W+|\w+)+?)\}\}\}/
$1<\/blockquote>/g;
+# $s=~s/\{\{(.+?)\|(.*?)\}\}/
/g;
+# $s=~s/\[\[(.+?)\|(.*?)\]\]/$2<\/a>/g;
+# $s=~s/([^\:])\/\/(.*?[^\:])\/\//$1$2<\/em> /g;
+# $s=~s/\n=== (.*?)\n/$1<\/h3>\n/g;
+# $s=~s/\n== (.*?)\n/$1<\/h2>\n/g;
+ #replace line breaks from images
+ $s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
+ $s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
+ $s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
+ #replace line breaks from links
+# $s=~s/\n= (.*?)\n/$1<\/h1>\n/g;
+# $s=~s/\*\*(.*?)\*\*/$1<\/strong> /g;
+# $s=~s/^== (.*?)\n/$1<\/h2>\n/g;
+# $s=~s/\n\* (.*?)([\r\n]+)/
$1<\/li>\n/g;
+# $s=~s/\n\- (.*?)\n/$1<\/lo>\n/g;
+# $s=~s/\n\n//gi;
+# $s=~s/\n+/
/gi;
+# $s=~s/\\s*
|<$elem>|g;
+ $s=~s|
\s*||g;
+ }
+
+ return $s;
+}
+
+sub creole_to_plain{
+ my $s=shift;
+
+ $s=~s/\/\n/gi;
+ $s=~s/\{\{\{((\W+|\w+)+?)\}\}\}/$1<\/blockquote>/g;
+ $s=~s/\{\{(.+?)\|(.*?)\}\}//g;
+ $s=~s/\[\[(.+?)\|(.*?)\]\]/$2/g;
+ $s=~s/\/\/([^\/\/]*?)\/\//$1<\/em> /g;
+ $s=~s/\n=== (.*?)\n/\n$1<\/h3>\n/g;
+ $s=~s/\n== (.*?)\n/\n$1<\/h2>\n/g;
+ $s=~s/\*\*(.*?)\*\*/$1<\/strong> /g;
+ $s=~s/^== (.*?)\n/$1<\/h2>\n/g;
+ $s=~s/\n\* (.*?)\n/\n
$1<\/li>\n/g;
+ $s=~s/\n\* (.*?)\n/\n $1<\/li>\n/g;
+ $s=~s/\n\- (.*?)\n/\n$1<\/lo>\n/g;
+ $s=~s/\n\- (.*?)\n/\n$1<\/lo>\n/g;
+ $s=~s/\n\n/\n/gi;
+ $s=~s/\n/\n
'.$s.'');
+ my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 2000);
+ $s= $formatter->format($tree);
+ return $s;
+}
+
+sub ical_to_plain{
+ return '' unless defined ($_[0]);
+ $_[0]=~s/\\n/\n/gi;
+ $_[0]=~s/ /\t/gi;
+ $_[0]=~s/\\\./\./gi;
+ $_[0]=~s/\\\,/\,/gi;
+ $_[0]=~s/\\\\/\\/gi;
+ return $_[0];
+}
+
+sub plain_to_ical{
+ return '' unless defined ($_[0]);
+ #remove images + links
+ $_[0]=~s/\[\[.+?\|(.+?)\]\]/$1/g;
+ $_[0]=~s/\{\{.+?\}\}//g;
+ $_[0]=~s/^\s+//g;
+ $_[0]=~s/\\/\\\\/gi;
+ $_[0]=~s/\,/\\\,/gi;
+# $_[0]=~s/\./\\\./gi;
+ $_[0]=~s/[\r\n]/\\n/gi;
+ $_[0]=~s/\t/ /gi;
+ return $_[0];
+}
+
+sub plain_to_xml{
+ return '' unless defined ($_[0]);
+ $_[0]=~s/\n\={1,6} (.*?)\s+/\n\[\[$1\]\]\n/gi;
+ #remove images + links
+ $_[0]=~s/\[\[.+?\|(.+?)\]\]/$1/g;
+ $_[0]=~s/\{\{.+?\}\}//g;
+ return encode_xml_element($_[0]);
+
+# $_[0]=~s/\ä/ä/gi;
+# $_[0]=~s/\ö/ö/gi;
+# $_[0]=~s/\ü/ü/gi;
+# $_[0]=~s/\Ä/Ä/gi;
+# $_[0]=~s/\Ö/Ö/gi;
+# $_[0]=~s/\Ü/Ü/gi;
+# $_[0]=~s/\ß/ß/gi;
+# $_[0]=~s/\&/\&/gi;
+# $_[0]=~s/\/\>/gi;
+# $_[0]=~s/\"/\"/gi;
+
+## $_[0]=~s/\n/
\n" if ($debug>0);
+ #print "$message
\n";
+ #log::print($message."\n") if ($debug);
+}
+
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/playout.pm b/lib/calcms/playout.pm
new file mode 100644
index 0000000..72a64c0
--- /dev/null
+++ b/lib/calcms/playout.pm
@@ -0,0 +1,367 @@
+#!/bin/perl
+
+package playout;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use Date::Calc;
+use db;
+use time;
+use series_events;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get sync);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_playout');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+# get playout entries
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ return undef unless defined $condition->{studio_id};
+
+ my $date_range_include=0;
+ $date_range_include=1 if $condition->{date_range_include}==1;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
+ push @conditions, 'start=?';
+ push @bind_values, $condition->{start_at};
+ }
+
+ if ((defined $condition->{from}) && ($condition->{from} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'end_date>=?';
+ push @bind_values, $condition->{from};
+ }else{
+ push @conditions, 'start_date>=?';
+ push @bind_values, $condition->{from};
+ }
+ }
+
+ if ((defined $condition->{till}) && ($condition->{till} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'start_date<=?';
+ push @bind_values, $condition->{till};
+ }else{
+ push @conditions, 'end_date<=?';
+ push @bind_values, $condition->{till};
+ }
+ }
+
+ my $limit='';
+ if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
+ $limit= 'limit '.$condition->{limit};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select date(start) start_date
+ ,date(end) end_date
+ ,dayname(start) weekday
+ ,start_date day
+ ,start
+ ,end
+ ,studio_id
+ ,project_id
+ ,duration
+ ,file
+ ,errors
+ ,channels
+ ,format
+ ,format_version
+ ,format_profile
+ ,format_settings
+ ,stream_size
+ ,bitrate
+ ,bitrate_mode
+ ,sampling_rate
+ ,writing_library
+ ,rms_left
+ ,rms_right
+ ,rms_image
+ from calcms_playout
+ $conditions
+ order by start
+ };
+
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+ my $entries=db::get($dbh, $query, \@bind_values);
+ return $entries;
+}
+
+# update playout entries for a given date span
+# insert, update and delete entries
+sub sync{
+ my $config=shift;
+ my $options=shift;
+
+ #print STDERR Dumper($config);
+ #print STDERR Dumper($options);
+ return undef unless defined $options->{project_id} ;
+ return undef unless defined $options->{studio_id} ;
+ return undef unless defined $options->{from} ;
+ return undef unless defined $options->{till} ;
+ return undef unless defined $options->{events} ;
+
+ my $project_id = $options->{project_id};
+ my $studio_id = $options->{studio_id};
+ my $updates = $options->{events};
+ #print STDERR "sync\n";
+ #print STDERR Dumper($updates);
+
+ # get new entries by date
+ my $update_by_date={};
+ for my $entry (@$updates){
+ $update_by_date->{$entry->{start}}=$entry;
+ }
+
+ # get database entries
+ my $bind_values=[
+ $options->{project_id}, $options->{studio_id}, $options->{from}, $options->{till}
+ ];
+
+ my $query=qq{
+ select *
+ from calcms_playout
+ where project_id=?
+ and studio_id=?
+ and start >=?
+ and end <= ?
+ order by start
+ };
+ print STDERR "from:$options->{from} till:$options->{till}\n";
+ my $dbh=db::connect($config);
+ my $entries=db::get($dbh, $query, $bind_values);
+ #print STDERR "entries:".Dumper($entries);
+
+ # get database entries by date
+ my $entries_by_date={};
+ for my $entry (@$entries){
+ # store entry by date
+ my $start=$entry->{start};
+ $entries_by_date->{$start}=$entry;
+
+ # remove outdated entries
+ unless (defined $update_by_date->{$start}){
+ print STDERR "delete:".Dumper($entry);
+ playout::delete($config, $dbh, $entry);
+ my $result=series_events::set_playout_status($config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ start => $entry->{start},
+ playout => 0,
+ });
+ print STDERR "delete playout_status result=".$result."\n";
+ next;
+ }
+ # update existing entries
+ if (defined $update_by_date->{$start}){
+ next if has_changed($entry, $update_by_date->{$start})==0;
+ print STDERR "update:".Dumper($entry);
+ playout::update($config, $dbh, $entry, $update_by_date->{$start});
+ my $result=series_events::set_playout_status($config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ start => $entry->{start},
+ playout => 1,
+ });
+ print STDERR "update playout_status result=".$result."\n";
+ next;
+ }
+ }
+
+ # insert new entries
+ for my $entry (@$updates){
+ my $start=$entry->{start};
+ unless (defined $entries_by_date->{$start}){
+ $entry->{project_id} = $project_id;
+ $entry->{studio_id} = $studio_id;
+ print STDERR "insert:".Dumper($entry);
+ playout::insert($config, $dbh, $entry);
+ my $result=series_events::set_playout_status($config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ start => $entry->{start},
+ playout => 1,
+ });
+ print STDERR "insert playout_status result=".$result."\n";
+ }
+ }
+ return 1;
+}
+
+sub has_changed{
+ my $oldEntry=shift;
+ my $newEntry=shift;
+
+ my $update=0;
+ for my $key ('duration', 'errors', 'file', 'channels', 'format', 'format_version', 'format_profile', 'format_settings', 'stream_size', 'bitrate', 'bitrate_mode', 'sampling_rate', 'writing_library'){
+ return 1 if ($oldEntry->{$key}||'') ne ($newEntry->{$key}||'');
+ }
+ return 0;
+}
+
+# update playout entry if differs to old values
+sub update{
+ my $config=shift;
+ my $dbh=shift;
+ my $oldEntry=shift;
+ my $newEntry=shift;
+
+ return if has_changed($oldEntry, $newEntry)==0;
+
+ for my $key ('duration', 'errors', 'file', 'channels', 'format', 'format_version', 'format_profile', 'format_settings', 'stream_size', 'bitrate', 'bitrate_mode', 'sampling_rate', 'writing_library', 'rms_left', 'rms_right', 'rms_image', 'replay_gain'){
+ if (($oldEntry->{$key}||'') ne ($newEntry->{$key}||'')){
+ $oldEntry->{$key}=$newEntry->{$key};
+ }
+ }
+
+ my $entry=$oldEntry;
+ print STDERR "update:".Dumper($entry);
+
+ my $day_start=$config->{date}->{day_starting_hour};
+ $entry->{end} = playout::getEnd($entry->{start}, $entry->{duration});
+ $entry->{start_date} = time::add_hours_to_datetime($entry->{start}, -$day_start);
+ $entry->{end_date} = time::add_hours_to_datetime($entry->{end}, -$day_start);
+
+ my $bind_values=[
+ $entry->{end}, $entry->{duration}, $entry->{file}, $entry->{errors},
+ $entry->{start_date}, $entry->{end_date},
+ $entry->{channels}, $entry->{'format'}, $entry->{format_version}, $entry->{format_profile}, $entry->{format_settings}, $entry->{stream_size},
+ $entry->{bitrate}, $entry->{bitrate_mode}, $entry->{sampling_rate}, $entry->{writing_library},
+ $entry->{rms_left}, $entry->{rms_right}, $entry->{rms_image},
+ $entry->{replay_gain},
+ $entry->{project_id}, $entry->{studio_id}, $entry->{start}
+ ];
+ my $query=qq{
+ update calcms_playout
+ set end=?, duration=?, file=?, errors=?,
+ start_date=?, end_date=?,
+ channels=?, format=?, format_version=?, format_profile=?, format_settings=?, stream_size=?,
+ bitrate=?, bitrate_mode=?, sampling_rate=?, writing_library=?,
+ rms_left=?, rms_right=?, rms_image=?,
+ replay_gain=?
+ where project_id=? and studio_id=? and start=?
+ };
+ return db::put($dbh, $query, $bind_values);
+}
+
+# insert playout entry
+sub insert{
+ my $config=shift;
+ my $dbh=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{start};
+ return undef unless defined $entry->{duration};
+ return undef unless defined $entry->{file};
+
+ my $day_start=$config->{date}->{day_starting_hour};
+ $entry->{end} = playout::getEnd($entry->{start}, $entry->{duration});
+ $entry->{start_date} = time::add_hours_to_datetime($entry->{start}, -$day_start);
+ $entry->{end_date} = time::add_hours_to_datetime($entry->{end}, -$day_start);
+
+ return db::insert($dbh, 'calcms_playout', {
+ project_id => $entry->{project_id},
+ studio_id => $entry->{studio_id},
+ start => $entry->{start},
+ end => $entry->{end},
+ start_date => $entry->{start_date},
+ end_date => $entry->{end_date},
+ duration => $entry->{duration},
+ rms_left => $entry->{rms_left},
+ rms_right => $entry->{rms_right},
+ rms_image => $entry->{rms_image},
+ replay_gain => $entry->{replay_gain},
+ file => $entry->{file},
+ errors => $entry->{errors},
+ channels => $entry->{channels},
+ "format" => $entry->{"format"},
+ format_version => $entry->{format_version},
+ format_profile => $entry->{format_profile},
+ format_settings => $entry->{format_settings},
+ stream_size => $entry->{stream_size},
+ bitrate => $entry->{bitrate},
+ bitrate_mode => $entry->{bitrate_mode},
+ sampling_rate => $entry->{sampling_rate},
+ writing_library => $entry->{writing_library}
+ });
+
+}
+
+# delete playout entry
+sub delete{
+ my $config=shift;
+ my $dbh=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{start};
+
+ my $query=qq{
+ delete
+ from calcms_playout
+ where project_id=? and studio_id=? and start=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{start}];
+ return db::put($dbh, $query, $bind_values);
+}
+
+sub getEnd{
+ my $start=shift;
+ my $duration=shift;
+ # calculate end from start + duration
+ my @start = @{time::datetime_to_array($start)};
+ next unless @start>=6;
+ #print STDERR Dumper(\@start);
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $start[0], $start[1], $start[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, 0, int($duration) # delta days, hours, minutes, seconds
+ );
+ #print STDERR Dumper(\@end_datetime);
+ return time::array_to_datetime(\@end_datetime);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/project.pm b/lib/calcms/project.pm
new file mode 100644
index 0000000..151eba4
--- /dev/null
+++ b/lib/calcms/project.pm
@@ -0,0 +1,478 @@
+#!/bin/perl
+
+package project;
+use warnings "all";
+use strict;
+
+use Data::Dumper;
+use Date::Calc;
+use config;
+use log;
+use template;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ check get_columns get insert delete get_date_range
+ get_studios assign_studio unassign_studio is_studio_assigned get_studio_assignments
+ get_series_ids assign_series unassign_series is_series_assigned get_series_assignments
+ get_with_dates get_sorted
+);
+#TODO: globally replace get_studios by get_studio_assignments
+
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+# get project columns
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_projects');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+# get projects
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{name}) && ($condition->{name} ne '')){
+ push @conditions, 'name=?';
+ push @bind_values, $condition->{name};
+ }
+
+ my $limit='';
+ if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
+ $limit= 'limit '.$condition->{limit};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_projects
+ $conditions
+ order by start_date
+ $limit
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $projects=db::get($dbh, $query, \@bind_values);
+ return $projects;
+}
+
+sub get_date_range{
+ my $config=shift;
+ my $query=qq{
+ select min(start_date) start_date, max(end_date) end_date
+ from calcms_projects
+ };
+ my $dbh=db::connect($config);
+
+ my $projects=db::get($dbh, $query);
+ return $projects->[0];
+}
+
+# insert project
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ my $columns=get_columns($config);
+ my $project={};
+ for my $column (keys %$columns){
+ $project->{$column}=$entry->{$column} if defined $entry->{$column};
+ }
+
+ my $dbh=db::connect($config);
+ my $id=db::insert($dbh, 'calcms_projects', $project);
+ return $id;
+}
+
+# delete project
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ my $dbh=db::connect($config);
+ db::put($dbh, 'delete from calcms_projects where project_id=?', [$entry->{project_id}]);
+}
+
+# update project
+sub update{
+ my $config=shift;
+ my $project=shift;
+
+ my $columns=project::get_columns($config);
+ my $entry={};
+ for my $column (keys %$columns){
+ $entry->{$column}=$project->{$column} if defined $project->{$column};
+ }
+
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values,$entry->{project_id};
+
+ my $query=qq{
+ update calcms_projects
+ set $values
+ where project_id=?
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+ my $dbh=db::connect($config);
+ db::put($dbh, $query, \@bind_values);
+}
+
+
+# get studios of a project
+sub get_studios{
+ my $config=shift;
+ my $options=shift;
+
+ return undef unless defined $options->{project_id};
+ my $project_id=$options->{project_id};
+
+ my $query=qq{
+ select *
+ from calcms_project_studios
+ where project_id=?
+ };
+ my $dbh=db::connect($config);
+ my $project_studios=db::get($dbh,$query,[$project_id]);
+
+ return $project_studios;
+}
+
+sub get_studio_assignments{
+ my $config=shift;
+ my $options=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $options->{project_id}) && ($options->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $options->{project_id};
+ }
+
+ if ((defined $options->{studio_id}) && ($options->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $options->{studio_id};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_project_studios
+ $conditions
+ };
+
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, \@bind_values);
+
+ return $results;
+}
+
+# is studio assigned to project
+sub is_studio_assigned{
+ my $config=shift;
+ my $entry=shift;
+
+ return 0 unless defined $entry->{project_id};
+ return 0 unless defined $entry->{studio_id};
+
+ my $project_id=$entry->{project_id};
+ my $studio_id= $entry->{studio_id};
+
+ my $query=qq{
+ select *
+ from calcms_project_studios
+ where project_id=? and studio_id=?
+ };
+ my $bind_values=[$project_id, $studio_id];
+
+ my $dbh=db::connect($config);
+ my $project_studios=db::get($dbh, $query, $bind_values);
+ return 1 if @$project_studios==1;
+ return 0;
+}
+
+# assign studio to project
+sub assign_studio{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ my $project_id=$entry->{project_id};
+ my $studio_id= $entry->{studio_id};
+
+ if (is_studio_assigned($entry)){
+ print STDERR "studio $entry->{studio_id} already assigned to project $entry->{project_id}\n";
+ return 1;
+ }
+ my $dbh=db::connect($config);
+ my $id=db::insert($dbh, 'calcms_project_studios', $entry);
+ return $id;
+}
+
+# unassign studio from project
+sub unassign_studio{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ my $project_id=$entry->{project_id};
+ my $studio_id= $entry->{studio_id};
+
+ my $sql='delete from calcms_project_studios where project_id=? and studio_id=?';
+ my $bind_values=[$project_id, $studio_id];
+ my $dbh=db::connect($config);
+ return db::put($dbh, $sql, $bind_values);
+}
+
+# get series by project and studio
+sub get_series{
+ my $config=shift;
+ my $options=shift;
+
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+ my $project_id=$options->{project_id};
+ my $studio_id= $options->{studio_id};
+
+ my $query=qq{
+ select *
+ from calcms_project_series
+ where project_id=? and studio_id=?
+ };
+ my $bind_values=[$project_id, $studio_id];
+ my $dbh=db::connect($config);
+ my $project_series=db::get($dbh, $query, $bind_values);
+
+ return $project_series;
+}
+
+sub get_series_assignments{
+ my $config=shift;
+ my $options=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $options->{project_id}) && ($options->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $options->{project_id};
+ }
+
+ if ((defined $options->{studio_id}) && ($options->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $options->{studio_id};
+ }
+
+ if ((defined $options->{series_id}) && ($options->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $options->{series_id};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_project_series
+ $conditions
+ };
+
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, \@bind_values);
+
+ return $results;
+}
+
+# is series assigned to project and studio
+sub is_series_assigned{
+ my $config=shift;
+ my $entry=shift;
+
+ return 0 unless defined $entry->{project_id};
+ return 0 unless defined $entry->{studio_id};
+ return 0 unless defined $entry->{series_id};
+
+ my $project_id=$entry->{project_id};
+ my $studio_id= $entry->{studio_id};
+ my $series_id= $entry->{series_id};
+
+ my $query=qq{
+ select *
+ from calcms_project_series
+ where project_id=? and studio_id=? and series_id=?
+ };
+ my $bind_values=[$project_id, $studio_id, $series_id];
+
+ my $dbh=db::connect($config);
+ my $project_series=db::get($dbh,$query, $bind_values);
+ return 1 if @$project_series==1;
+ return 0;
+}
+
+# assign series to project and studio
+sub assign_series{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+
+ my $project_id=$entry->{project_id};
+ my $studio_id= $entry->{studio_id};
+ my $series_id= $entry->{series_id};
+
+ if (is_series_assigned($entry)){
+ print STDERR "series $series_id already assigned to project $project_id and studio $studio_id\n";
+ return return undef;
+ }
+ my $dbh=db::connect($config);
+ my $id=db::insert($dbh, 'calcms_project_series', $entry);
+ print STDERR "assigned series $series_id to project $project_id and studio $studio_id\n";
+ return $id;
+}
+
+# unassign series from project
+# TODO: remove series _single_ if no event is assigned to
+sub unassign_series{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+
+ my $project_id=$entry->{project_id};
+ my $studio_id= $entry->{studio_id};
+ my $series_id= $entry->{series_id};
+
+ my $sql='delete from calcms_project_series where project_id=? and studio_id=? and series_id=?';
+ my $bind_values=[$project_id, $studio_id, $series_id];
+ my $dbh=db::connect($config);
+ return db::put($dbh, $sql, $bind_values);
+}
+
+sub get_with_dates{
+ my $config=shift;
+ my $options=shift;
+
+ my $language = $config->{date}->{language} || 'en';
+ my $projects=project::get($config, {});
+
+ foreach my $project (reverse sort { $a->{end_date} cmp $b->{end_date} } (@$projects) ){
+ $project->{months} = get_months($config, $project, $language);
+ $project->{user} = $ENV{REMOTE_USER};
+ $project->{current} = 1 if ($project->{name} eq $config::config->{project});
+ }
+
+ return $projects;
+}
+
+#TODO: add config
+sub get_sorted{
+ my $config=shift;
+ my $projects=project::get($config, {});
+ my @projects=reverse sort { $a->{end_date} cmp $b->{end_date} } (@$projects);
+
+ unshift @projects,{
+ name => 'all',
+ title => 'alle',
+ priority => '0',
+ start_date => $projects[-1]->{start_date},
+ end_date => $projects[0]->{end_date},
+ };
+ return \@projects;
+}
+
+# internal
+sub get_months{
+ my $config=shift;
+ my $project = shift;
+ my $language = shift || $config->{date}->{language} || 'en';
+
+ my $start = $project->{start_date};
+ my $end = $project->{end_date};
+
+ (my $start_year,my $start_month,my $start_day)=split(/\-/,$start);
+ my $last_day = Date::Calc::Days_in_Month($start_year,$start_month);
+ $start_day = 1 if ($start_day<1);
+ $start_day = $last_day if ($start_day gt $last_day);
+
+ (my $end_year,my $end_month,my $end_day)=split(/\-/,$end);
+ $last_day = Date::Calc::Days_in_Month($end_year,$end_month);
+ $end_day = 1 if ($end_day<1);
+ $end_day = $last_day if ($end_day gt $last_day);
+
+ my @months=();
+ for my $year($start_year..$end_year){
+ my $m1=1;
+ my $m2=12;
+ $m1=$start_month if $year eq $start_year;
+ $m2=$end_month if $year eq $end_year;
+
+ for my $month($m1..$m2){
+ my $d1=1;
+ my $d2=Date::Calc::Days_in_Month($year,$month);
+ $d1=$start_day if $month eq $start_month;
+ $d2=$end_day if $month eq $end_month;
+ push @months,{
+ start => time::array_to_date($year,$month,$d1),
+ end => time::array_to_date($year,$month,$d2),
+ year => $year,
+ month => $month,
+ month_name => $time::names->{$language}->{months_abbr}->[$month-1],
+ title => $project->{title},
+ user => $ENV{REMOTE_USER}
+ };
+ }
+ }
+ @months=reverse @months;
+ return \@months;
+}
+
+# check project_id
+sub check{
+ my $config=shift;
+ my $options=shift;
+ return "missing project_id at checking project" unless defined $options->{project_id};
+ return "Please select a project" if($options->{project_id}eq'-1');
+ return "Please select a project" if($options->{project_id}eq'');
+ my $projects=project::get($config, { project_id=>$options->{project_id} } );
+ return "Sorry. unknown project" unless defined $projects;
+ return 1;
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/projects.pm b/lib/calcms/projects.pm
new file mode 100644
index 0000000..6630b3e
--- /dev/null
+++ b/lib/calcms/projects.pm
@@ -0,0 +1,8 @@
+use warnings "all";
+use strict;
+
+package projects;
+
+print STDERR "projects.pm is not used anymore!\n";
+#do not delete last line!
+1;
diff --git a/lib/calcms/roles.pm b/lib/calcms/roles.pm
new file mode 100644
index 0000000..2ee7a48
--- /dev/null
+++ b/lib/calcms/roles.pm
@@ -0,0 +1,146 @@
+package roles;
+use Apache2::Reload;
+require Exporter;
+my @ISA = qw(Exporter);
+my @EXPORT_OK = qw($roles get_user get_user_permissions get_template_parameters);
+my %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+our $roles={
+ 'admin' => {
+ access_events => 1,
+ access_images => 1,
+ access_comments => 1,
+ access_sync => 1,
+ access_system => 1,
+ read_event_all => 1,
+ create_event => 1,
+ delete_event => 1,
+ update_comment => 1,
+ create_image => 1,
+ read_image_own => 1,
+ read_image_all => 1,
+ update_image_own => 1,
+ update_image_all => 1,
+ delete_image_own => 1,
+ delete_image_all => 1,
+ sync_own => 1,
+ sync_all => 1,
+ sync_select_range => 1,
+ upload_playlist => 1,
+ },
+ 'dev' => {
+ access_events => 1,
+ access_images => 1,
+ access_comments => 1,
+ access_sync => 1,
+ access_system => 0,
+ read_event_all => 1,
+ create_event => 1,
+ delete_event => 1,
+ update_comment => 1,
+ create_image => 1,
+ read_image_own => 1,
+ read_image_all => 1,
+ update_image_own => 1,
+ update_image_all => 1,
+ delete_image_own => 1,
+ delete_image_all => 1,
+ sync_own => 0,
+ sync_all => 1,
+ sync_select_range => 1,
+ upload_playlist => 1,
+ },
+ 'editor' => {
+ access_events => 1,
+ access_images => 1,
+ access_comments => 1,
+ access_sync => 1,
+ access_system => 0,
+ read_event_all => 0,
+ create_event => 1,
+ delete_event => 0,
+ update_comment => 0,
+ create_image => 1,
+ read_image_own => 1,
+ read_image_all => 1,
+ update_image_own => 1,
+ update_image_all => 0,
+ delete_image_own => 1,
+ delete_image_all => 0,
+ sync_own => 1,
+ sync_all => 0,
+ sync_select_range => 0,
+ upload_playlist => 1,
+ },
+ 'nobody' => {
+ access_events => 0,
+ access_images => 0,
+ access_comments => 0,
+ access_sync => 0,
+ access_system => 0,
+ read_event_all => 0,
+ create_event => 0,
+ delete_event => 0,
+ update_comment => 0,
+ create_image => 0,
+ read_image_own => 0,
+ read_image_all => 0,
+ update_image_own => 0,
+ update_image_all => 0,
+ delete_image_own => 0,
+ delete_image_all => 0,
+ sync_own => 0,
+ sync_all => 0,
+ sync_select_range => 0,
+ upload_playlist => 0,
+ }
+};
+
+sub get_user{
+ my $user= $ENV{REMOTE_USER};
+ my $users=$config::config->{users};
+ return $user if (defined $users->{$user});
+ return 'nobody';
+}
+
+sub get_user_permissions{
+ my $user= $ENV{REMOTE_USER}||'';
+ return $roles::roles->{nobody} unless ($user=~/\S/);
+ my $users=$config::config->{users};
+ if (defined $users->{$user}){
+ my $role=$users->{$user};
+ if (defined $roles::roles->{$role}){
+ return $roles::roles->{$role};
+ }
+ }
+ return $roles::roles->{nobody};
+}
+
+sub get_user_jobs{
+ my $user= $ENV{REMOTE_USER}||'';
+ return [] unless($user =~/\S/);
+ my $result=[];
+ my $jobs=$config::config->{jobs}->{job};
+
+ for my $job (@$jobs){
+ for my $job_user (split /\,/,$job->{users}){
+ push @$result,$job if ($user eq $job_user);
+ }
+ }
+ return $result;
+}
+
+sub get_jobs{
+ return $config::config->{jobs}->{job};
+}
+
+sub get_template_parameters{
+ my $user_permissions=shift;
+ $user_permissions=roles::get_user_permissions() unless(defined $user_permissions);
+ my @user_permissions=();
+ for my $usecase (keys %$user_permissions){
+ push @user_permissions, $usecase if ($user_permissions->{$usecase}eq'1');
+ }
+ return \@user_permissions;
+}
+
diff --git a/lib/calcms/series.pm b/lib/calcms/series.pm
new file mode 100644
index 0000000..bb9d289
--- /dev/null
+++ b/lib/calcms/series.pm
@@ -0,0 +1,1208 @@
+package series;
+
+use warnings "all";
+use strict;
+use Data::Dumper;
+use events;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ get_columns get insert update delete
+ get_users add_user remove_user
+ get_events get_event get_next_episode search_events
+ get_event_age is_event_older_than_days
+ get_images
+ assign_event unassign_event
+ add_series_ids_to_events set_event_ids
+ can_user_update_events can_user_create_events
+ is_series_assigned_to_user is_event_assigned_to_user
+ update_recurring_events update_recurring_event
+);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+#TODO: remove studio_id
+#TODO: get project_id, studio_id by join with project_series
+
+sub debug;
+
+# get series columns
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_series');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+# get series content
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{series_name}) && ($condition->{series_name} ne '')){
+ push @conditions, 'series_name=?';
+ push @bind_values, $condition->{series_name};
+ }
+
+ if ((defined $condition->{title}) && ($condition->{title} ne '')){
+ push @conditions, 'title=?';
+ push @bind_values, $condition->{title};
+ }
+
+ if ((defined $condition->{has_single_events}) && ($condition->{has_single_events} ne '')){
+ push @conditions, 'has_single_events=?';
+ push @bind_values, $condition->{has_single_events};
+ }
+
+ my $search_cond='';
+ if ((defined $condition->{search}) && ($condition->{search} ne'')){
+ my $search=lc $condition->{search};
+ $search=~s/[^a-z0-9\_\.\-\:\!öäüßÖÄÜ \&]/%/;
+ $search=~s/\%+/\%/;
+ $search=~s/^[\%\s]+//;
+ $search=~s/[\%\s]+$//;
+ if ($search ne ''){
+ $search='%'.$search.'%';
+ my @attr=('title', 'series_name', 'excerpt', 'category', 'content');
+ push @conditions, "(".join(" or ", map {'lower('.$_.') like ?'} @attr ).")";
+ for my $attr (@attr){
+ push @bind_values,$search;
+ }
+ }
+ }
+
+ my $query='';
+ my $conditions='';
+
+ if ((defined $condition->{project_id}) || (defined $condition->{studio_id})){
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'ps.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'ps.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+ push @conditions, 'ps.series_id=s.id';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+ $query=qq{
+ select *
+ from calcms_series s, calcms_project_series ps
+ $conditions
+ order by has_single_events desc, series_name, title
+ };
+ }else{
+ # simple query
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+ $query=qq{
+ select *
+ from calcms_series
+ $conditions
+ order by has_single_events desc, series_name, title
+ };
+ }
+
+ my $dbh=db::connect($config);
+ my $series=db::get($dbh, $query, \@bind_values);
+ #print STDERR Dumper(time());
+ for my $serie (@$series){
+ $serie->{series_id}=$serie->{id};
+ delete $serie->{id};
+ }
+ #print STDERR Dumper($series);
+ return $series;
+}
+
+# insert series
+sub insert{
+ my $config=shift;
+ my $series=shift;
+
+ #print STDERR Dumper($series);
+ return undef unless defined $series->{project_id};
+ return undef unless defined $series->{studio_id};
+
+ my $project_id=$series->{project_id};
+ my $studio_id =$series->{studio_id};
+
+ my $columns=series::get_columns($config);
+
+ my $entry={};
+ for my $column (keys %$columns){
+ $entry->{$column}=$series->{$column} if defined $series->{$column};
+ }
+
+ $entry->{created_at} = time::time_to_datetime(time());
+ $entry->{modified_at}= time::time_to_datetime(time());
+ #print STDERR Dumper($entry);
+
+ my $dbh=db::connect($config);
+ my $series_id=db::insert($dbh, 'calcms_series', $entry);
+
+ return undef unless defined $series_id;
+
+ my $result=project::assign_series($config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ series_id => $series_id
+ });
+ return undef unless defined $result;
+ return $series_id;
+}
+
+# update series
+sub update{
+ my $config=shift;
+ my $series=shift;
+
+ return undef unless defined $series->{project_id};
+ return undef unless defined $series->{studio_id};
+ return undef unless defined $series->{series_id};
+
+ my $columns=series::get_columns($config);
+
+ my $entry={};
+ for my $column (keys %$columns){
+ $entry->{$column}=$series->{$column} if defined $series->{$column};
+ }
+ $entry->{id} = $series->{series_id};
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values, $entry->{id};
+
+ my $query=qq{
+ update calcms_series
+ set $values
+ where id=?
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $dbh=db::connect($config);
+ return db::put($dbh, $query, \@bind_values);
+}
+
+# delete series, its schedules and series dates
+# unassign its users and events
+sub delete{
+ my $config=shift;
+ my $series=shift;
+
+ return undef unless defined $series->{project_id};
+ return undef unless defined $series->{studio_id};
+ return undef unless defined $series->{series_id};
+
+ my $project_id = $series->{project_id};
+ my $studio_id = $series->{studio_id};
+ my $series_id = $series->{series_id};
+
+ unless(project::is_series_assigned($config, $series)==1){
+ print STDERR "series is not assigned to project $project_id and studio $studio_id\n";
+ return undef;
+ };
+
+ my $query = undef;
+ my $bind_values = undef;
+ my $dbh=db::connect($config);
+
+ $bind_values=[$project_id, $studio_id, $series_id];
+ #delete schedules
+ $query=qq{
+ delete from calcms_series_schedule
+ where project_id=? and studio_id=? and series_id=?
+ };
+ db::put($dbh, $query, $bind_values);
+
+ #delete series dates
+ $query=qq{
+ delete from calcms_series_dates
+ where project_id=? and studio_id=? and series_id=?
+ };
+ db::put($dbh, $query, $bind_values);
+
+ #unassign users
+ series::remove_user(
+ $config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ series_id => $series_id
+ }
+ );
+
+ #unassign events
+ $bind_values=[$project_id, $studio_id, $series_id];
+ $query=qq{
+ delete from calcms_series_events
+ where project_id=? and studio_id=? and series_id=?
+ };
+ #print '$query'.$query.Dumper($bind_values).'
';
+ db::put($dbh, $query, $bind_values);
+
+ project::unassign_series($config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ series_id => $series_id
+ });
+
+ #delete series
+
+ my $series_assignments=project::get_series_assignments(
+ $config, {
+ series_id => $series_id
+ }
+ );
+ if(@$series_assignments>1){
+ print STDERR "do not delete series, due to assigned to other project or studio";
+ return;
+ }
+
+ $bind_values=[$series_id];
+ $query=qq{
+ delete from calcms_series
+ where id=?
+ };
+ #print STDERR $query.$query.Dumper($bind_values);
+ db::put($dbh, $query, $bind_values);
+}
+
+
+# get users directly assigned to project, studio, series (editors)
+sub get_users{
+ my $config = shift;
+ my $condition = shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'us.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'us.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'us.series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{name}) && ($condition->{name} ne '')){
+ push @conditions, 'u.name=?';
+ push @bind_values, $condition->{name};
+ }
+
+ my $conditions='';
+ $conditions=" and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select u.id, u.name, u.full_name, u.email, us.modified_by, us.modified_at
+ from calcms_users u, calcms_user_series us
+ where us.user_id=u.id
+ $conditions
+ };
+ #print STDERR $query." ".Dumper(\@bind_values)."\n";
+ my $dbh =db::connect($config);
+ my $result=db::get($dbh, $query, \@bind_values);
+ #print STDERR $query." ".Dumper($result)."\n";
+ return $result;
+}
+
+# assign user to series
+sub add_user{
+ my $config = shift;
+ my $entry = shift;
+
+ return unless defined $entry->{project_id};
+ return unless defined $entry->{studio_id};
+ return unless defined $entry->{series_id};
+ return unless defined $entry->{user_id};
+ return unless defined $entry->{user};
+
+ my $query=qq{
+ select id
+ from calcms_user_series
+ where project_id=? and studio_id=? and series_id=? and user_id=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{user_id}];
+
+ my $dbh =db::connect($config);
+ my $results=db::get($dbh, $query, $bind_values);
+ return unless (@$results==0);
+
+ $query=qq{
+ insert calcms_user_series
+ set project_id=?, studio_id=?, series_id=?, user_id=?, modified_by=?, modified_at=now()
+ };
+ $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{user_id}, $entry->{user}];
+ db::put($dbh, $query, $bind_values);
+}
+
+# remove user(s) from series.
+sub remove_user{
+ my $config = shift;
+ my $condition = shift;
+
+ return unless(defined $condition->{project_id});
+ return unless(defined $condition->{studio_id});
+ return unless(defined $condition->{series_id});
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{user_id}) && ($condition->{user_id} ne '')){
+ push @conditions, 'user_id=?';
+ push @bind_values, $condition->{user_id};
+ }
+
+ my $conditions='';
+ $conditions=join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ delete from calcms_user_series
+ where $conditions
+ };
+ my $dbh =db::connect($config);
+ db::put($dbh, $query, \@bind_values);
+}
+
+#search events by series_name and title (for events not assigned yet)
+#TODO: add location
+sub search_events{
+ my $config = shift;
+ my $request = shift;
+ my $options = shift;
+
+ my $series_name =$options->{series_name}||'';
+ my $title =$options->{title}||'';
+ return undef if(($series_name eq '') && ($title eq '') );
+
+ $series_name=~s/[^a-zA-Z0-9 \-]+/\?/g;
+ $title =~s/[^a-zA-Z0-9 \-]+/\?/g;
+
+ $series_name=~s/\?+/\?/g;
+ $title =~s/\?+/\?/g;
+
+ my $params={
+ series_name => $series_name,
+ title => $title,
+ template => 'no'
+ };
+ if (defined $options){
+ $params->{from_date} = $options->{from_date} if (defined $options->{from_date});
+ $params->{till_date} = $options->{till_date} if (defined $options->{till_date});
+ $params->{location} = $options->{location} if (defined $options->{location});
+ $params->{limit} = $options->{limit} if (defined $options->{limit});
+ $params->{archive} = $options->{archive} if (defined $options->{archive});
+ $params->{get} = $options->{get} if (defined $options->{get});
+ }
+
+ my $checked_params=events::check_params($config, $params);
+ #print STDERR ''.Dumper($checked_params).'
';
+ my $request2={
+ params=>{
+ checked=>$checked_params
+ },
+ config => $request->{config},
+ permissions => $request->{permissions}
+ };
+ #my $debug=1;
+ #print STDERR Dumper($request2->{params});
+ my $events=events::get($config, $request2);
+ #print Dumper($events);
+ return $events;
+}
+
+#get events (only assigned ones) by project_id,studio_id,series_id,
+sub get_events{
+ my $config=shift;
+ my $options=shift;
+
+ #print STDERR Dumper($options);
+ return [] if defined ($options->{series_id}) && ($options->{series_id} <=0);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if(defined $options->{project_id}){
+ push @conditions, 'se.project_id = ?';
+ push @bind_values, $options->{project_id};
+ }
+ if(defined $options->{studio_id}){
+ push @conditions, 'se.studio_id = ?';
+ push @bind_values, $options->{studio_id};
+ }
+ if( (defined $options->{series_id}) && ($options->{series_id}=~/(\d+)/) ){
+ push @bind_values, $1;
+ push @conditions, 'se.series_id = ?';
+ }
+
+ if(defined $options->{event_id}){
+ push @bind_values, $options->{event_id};
+ push @conditions, 'e.id = ?';
+ }
+
+ if( (defined $options->{from_date}) && ($options->{from_date}=~/(\d\d\d\d\-\d\d\-\d\d)/) ){
+ push @bind_values, $1;
+ push @conditions, 'e.start_date >= ?';
+ }
+ if( (defined $options->{till_date}) && ($options->{till_date}=~/(\d\d\d\d\-\d\d\-\d\d)/) ){
+ push @bind_values, $1;
+ push @conditions, 'e.start_date <= ?';
+ }
+ if(defined $options->{location}){
+ push @conditions, 'e.location = ?';
+ push @bind_values, $options->{location};
+ }
+ my $conditions='';
+ if (@conditions>0){
+ $conditions=' and '.join(' and ', @conditions);
+ }
+ my $limit='';
+ if( (defined $options->{limit}) && ($limit=~/(\d+)/) ){
+ $limit='limit '.$1;
+ }
+
+ my $query=qq{
+ select *
+ ,date(start) start_date
+ ,date(end) end_date
+ ,weekday(start) weekday
+ ,weekofyear(start) week_of_year
+ ,dayofyear(start) day_of_year
+ ,start_date day
+ ,id event_id
+ ,location location
+ from calcms_series_events se, calcms_events e
+ where se.event_id = e.id
+ $conditions
+ order by start_date desc
+ $limit
+ };
+ #print STDERR ''.$query.Dumper(\@bind_values).'
';
+
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, \@bind_values);
+ $results=events::modify_results($dbh, $config, {base_url=>'', params=>{checked=>{template=>''}}}, $results);
+
+ #add studio id to events
+ my $studios=studios::get($config, $options);
+
+ my $studio_id_by_location={};
+ for my $studio (@$studios){
+ $studio_id_by_location->{$studio->{location}}=$studio->{id};
+ }
+ for my $result (@$results){
+ $result->{studio_id}=$studio_id_by_location->{$result->{location}};
+ }
+
+ #print STDERR Dumper($results);
+ return $results;
+}
+
+# load event given by studio_id, series_id and event_id
+# helper for gui - errors are written to gui output
+# return undef on error
+sub get_event{
+ my $config=shift;
+ my $options=shift;
+
+ my $project_id = $options->{project_id}||'';
+ my $studio_id = $options->{studio_id}||'';
+ my $series_id = $options->{series_id}||'';
+ my $event_id = $options->{event_id} ||'';
+
+ unless(defined($options->{allow_any})){
+ if ($project_id eq''){
+ uac::print_error("missing project_id");
+ return undef;
+ }
+ if ($studio_id eq''){
+ uac::print_error("missing studio_id");
+ return undef;
+ }
+ if ($series_id eq''){
+ uac::print_error("missing series_id");
+ return undef;
+ }
+ }
+
+ if ($event_id eq''){
+ uac::print_error("missing event_id");
+ return undef;
+ }
+
+ my $queryOptions={};
+ $queryOptions->{project_id} = $project_id if $project_id ne '';
+ $queryOptions->{studio_id} = $studio_id if $studio_id ne '';
+ $queryOptions->{series_id} = $series_id if $series_id ne '';
+ $queryOptions->{event_id} = $event_id if $event_id ne '';
+
+ my $events=series::get_events($config, $queryOptions);
+
+ unless (defined $events){
+ uac::print_error("error on loading event");
+ return undef;
+ }
+
+ if(@$events==0){
+ uac::print_error("event not found");
+ return undef;
+ }
+
+ if(@$events>1){
+ print STDERR q{multiple assignments found for }
+ .q{project_id=}.$options->{project_id}
+ .q{, studio_id=}.$options->{studio_id}
+ .q{, series_id=}.$options->{series_id}
+ .q{, event_id=}.$options->{event_id}
+ ."\n";
+ }
+ my $event=$events->[0];
+ return $event;
+}
+
+# get name and title of series and age in days ('days_over')
+sub get_event_age{
+ my $config=shift;
+ my $options=shift;
+
+ #print STDERR Dumper($options);
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+
+ my @conditions=();
+ my @bind_values=();
+
+ if( (defined $options->{project_id}) && ($options->{project_id}=~/(\d+)/) ){
+ push @bind_values, $1;
+ push @conditions, 'ps.project_id = ?';
+ }
+
+ if( (defined $options->{studio_id}) && ($options->{studio_id}=~/(\d+)/) ){
+ push @bind_values, $1;
+ push @conditions, 'ps.studio_id = ?';
+ }
+
+ if( (defined $options->{series_id}) && ($options->{series_id}=~/(\d+)/) ){
+ push @bind_values, $1;
+ push @conditions, 's.id = ?';
+ }
+
+ if( (defined $options->{event_id}) && ($options->{event_id}=~/(\d+)/) ){
+ push @bind_values, $1;
+ push @conditions, 'e.id = ?';
+ }
+
+ my $conditions='';
+ if (@conditions>0){
+ $conditions=join(' and ', @conditions);
+ }
+ my $query=qq{
+ select s.id series_id, s.series_name, s.title, s.has_single_events has_single_events, (to_days(now())-to_days(max(e.start))) days_over
+ from calcms_project_series ps
+ left join calcms_series s on ps.series_id=s.id
+ left join calcms_series_events se on s.id=se.series_id
+ left join calcms_events e on e.id=se.event_id
+ where $conditions
+ group by s.id
+ order by has_single_events desc, days_over
+ };
+
+ #print STDERR $query." ".Dumper(\@bind_values);
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, \@bind_values);
+
+ for my $result (@$results){
+ $result->{days_over}=0 unless defined $result->{days_over};
+ }
+ return $results;
+}
+
+# is event older than max_age days
+sub is_event_older_than_days{
+ my $config=shift;
+ my $options=shift;
+ #print STDERR Dumper($options);
+
+ return 1 unless defined $options->{project_id};
+ return 1 unless defined $options->{studio_id};
+ return 1 unless defined $options->{series_id};
+ return 1 unless defined $options->{event_id};
+ return 1 unless defined $options->{max_age};
+
+ my $events=series::get_event_age($config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ event_id => $options->{event_id}
+ });
+
+ if (scalar(@$events)==0){
+ print STDERR "series_events::event_over_in_days: event $options->{event_id} is not assigned to project $options->{project_id}, studio $options->{studio_id}, series $options->{series_id}\n";
+ return 1;
+ }
+ my $event=$events->[0];
+ #print STDERR Dumper($event);
+ return 1 if $event->{days_over} > $options->{max_age};
+ return 0;
+}
+
+sub get_next_episode{
+ my $config=shift;
+ my $options=shift;
+
+ return 0 unless defined $options->{project_id};
+ return 0 unless defined $options->{studio_id};
+ return 0 unless defined $options->{series_id};
+
+ #return if episodes should not be counted for this series
+ my $query=q{
+ select count_episodes
+ from calcms_series
+ where id=?
+ };
+ my $bind_values=[$options->{series_id}];
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, $bind_values);
+ return 0 if (@$results != 1);
+ return 0 if ($results->[0]->{count_episodes}eq'0');
+ #print STDERR Dumper($results);
+
+ #get all
+ $query=q{
+ select title,episode from calcms_events e, calcms_series_events se
+ where se.project_id=? and se.studio_id=? and se.series_id=? and se.event_id=e.id
+ };
+ $bind_values=[$options->{project_id}, $options->{studio_id}, $options->{series_id}];
+ $results=db::get($dbh, $query, $bind_values);
+
+ my $max=0;
+ for my $result (@$results){
+ if ($result->{title}=~/\#(\d+)/){
+ my $value=$1;
+ $max=$value if $value>$max;
+ }
+ next unless defined $result->{episode};
+ $max=$result->{episode} if $result->{episode}>$max;
+ }
+ return $max+1;
+}
+
+sub get_images{
+ my $config=shift;
+ my $options=shift;
+
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+ return undef unless defined $options->{series_id};
+
+ #get images from all events of the series
+ my $dbh=db::connect($config);
+ my $events=series::get_events( $config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id}
+ });
+ my $images={};
+ my $found=0;
+ for my $event (@$events){
+ my $image=$event->{image};
+ $image=~s/.*\///;
+ $images->{$image}=1;
+ $found++;
+ }
+
+ return undef if $found==0;
+
+ # get all images from database
+ my @cond=();
+ my $bind_values=[];
+ for my $image (keys %$images){
+ push @cond, 'filename=?';
+ push @$bind_values, $image;
+ }
+
+ my $where='';
+ if (@cond>0){
+ $where = 'where '.join (' or ', @cond);
+ }
+
+ my $limit='';
+ if ( (defined $options->{limit}) && ($options->{limit}=~/(\d+)/) ){
+ $limit=' limit '.$1;
+ }
+
+ my $query=qq{
+ select *
+ from calcms_images
+ $where
+ order by created_at desc
+ $limit
+ };
+ #print STDERR Dumper($query).Dumper($bind_values);
+ my $results=db::get($dbh, $query, $bind_values);
+
+ #print STDERR @$results."\n";
+ return $results;
+}
+
+#assign event to series
+#TODO: manual assign needs to update automatic one
+sub assign_event{
+ my $config=shift;
+ my $entry=shift;
+
+ #print STDERR Dumper($entry);
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+ return undef unless defined $entry->{event_id};
+ $entry->{manual}=0 unless ((defined $entry->{manual})&&($entry->{manual}eq'1'));
+
+ my $conditions='';
+ $conditions='and manual=1' if ($entry->{manual}eq'1');
+
+ my $query=qq{
+ select * from calcms_series_events
+ where project_id=? and studio_id=? and series_id=? and event_id=? $conditions
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{event_id}];
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, $bind_values);
+
+ if(@$results>1){
+ print STDERR "multiple assignments of project_id=$entry->{project_id}, studio_id=$entry->{studio_id}, series_id=$entry->{series_id}, event_id=$entry->{event_id}\n";
+ return;
+ }
+ if(@$results==1){
+ print STDERR "already assigned: project_id=$entry->{project_id}, studio_id=$entry->{studio_id}, series_id=$entry->{series_id}, event_id=$entry->{event_id}\n";
+ return;
+ }
+
+ $query=qq{
+ insert into calcms_series_events (project_id, studio_id, series_id, event_id, manual)
+ values (?,?,?,?,?)
+ };
+ $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{event_id}, $entry->{manual}];
+ #print STDERR ''.$query.Dumper($bind_values).'
';
+ return db::put($dbh, $query, $bind_values);
+}
+
+#unassign event from series
+sub unassign_event{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless defined $entry->{project_id};
+ return unless defined $entry->{studio_id};
+ return unless defined $entry->{series_id};
+ return unless defined $entry->{event_id};
+
+ my $conditions='';
+ $conditions='and manual=1' if ((defined $entry->{manual}) && ($entry->{manual}eq'1'));
+
+ my $query=qq{
+ delete from calcms_series_events
+ where project_id=? and studio_id=? and series_id=? and event_id=?
+ $conditions
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{event_id}];
+ #print STDERR ''.$query.Dumper($bind_values).'
';
+ my $dbh=db::connect($config);
+ return db::put($dbh, $query, $bind_values);
+}
+
+
+# put series id to given events (for legacy handling)
+# used by calendar
+# TODO: optionally add project_id and studio_id to conditions
+sub add_series_ids_to_events{
+ my $config=shift;
+ my $events=shift;
+
+ #get event ids from given events
+ my @event_ids=();
+ for my $event (@$events){
+ push @event_ids, $event->{event_id};
+ }
+
+ return if (@event_ids==0);
+
+ my @bind_values =@event_ids;
+ my $event_ids =join(',', map {'?'} @event_ids);
+
+ #query series ids
+ my $dbh=db::connect($config);
+ my $query=qq{
+ select project_id, studio_id, series_id, event_id
+ from calcms_series_events
+ where event_id in ($event_ids)
+ };
+ my $results=db::get($dbh, $query, \@bind_values);
+ my @results=@$results;
+ return [] unless (@results>0);
+
+ #build hash of series ids by event ids
+ my $assignments_by_event_id={};
+ for my $entry (@$results){
+ my $event_id=$entry->{event_id};
+ $assignments_by_event_id->{$event_id}=$entry;
+ }
+
+ #fill in ids into events
+ for my $event (@$events){
+ my $event_id=$event->{event_id};
+ my $assignment=$assignments_by_event_id->{$event_id};
+ if (defined $assignment){
+ $event->{project_id} = $assignment->{project_id};
+ $event->{studio_id} = $assignment->{studio_id};
+ $event->{series_id} = $assignment->{series_id};
+ }
+ }
+
+}
+
+
+# add event_ids to series and remove all event ids from series, not given event_ids
+# for scan only, used at series
+sub set_event_ids{
+ my $config=shift;
+ my $project_id=shift;
+ my $studio_id=shift;
+ my $serie=shift;
+ my $event_ids=shift;
+
+ my $serie_id=$serie->{series_id};
+ return unless defined $project_id;
+ return unless defined $studio_id;
+ return unless defined $serie_id;
+ return unless defined $event_ids;
+
+ #make lookup table from events
+ my $event_id_hash={};
+ for my $event_id (@$event_ids){
+ $event_id_hash->{$event_id}=1;
+ }
+
+ #get series_entries from db
+ #my $bind_names=join(',', (map { '?' } @$event_ids));
+ my $query=qq{
+ select event_id from calcms_series_events
+ where project_id=? and studio_id=? and series_id=?
+ };
+ my $bind_values=[$project_id, $studio_id, $serie_id];
+
+ my $dbh=db::connect($config);
+ my $results=db::get($dbh, $query, $bind_values);
+
+ my $found={};
+ #mark events found assigned to series
+ my $i=1;
+ for my $event (@$results){
+ #print "found event $i: $event->{event_id}\n";
+ $found->{$event->{event_id}}=1;
+ $i++;
+ }
+ #insert events from list, not found in db
+ for my $event_id (@$event_ids){
+ #print "insert event_id $event_id\n";
+ series::assign_event(
+ $config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ series_id => $serie_id,
+ event_id => $event_id
+ }
+ ) unless ($found->{$event_id});
+ }
+ #delete events found in db, but not in list
+ for my $event_id (keys %$found){
+ #print "delete event_id $event_id\n";
+ series::unassign_event(
+ $config, {
+ project_id => $project_id,
+ studio_id => $studio_id,
+ series_id => $serie_id,
+ event_id => $event_id,
+ manual => 0
+ }
+ ) unless (defined $event_id_hash->{$event_id});
+ }
+
+}
+
+# check if user allowed to update series events
+# evaluate permissions and consider editors directly assigned to series
+sub can_user_update_events{
+ my $request=shift;
+ my $options=shift;
+
+ my $config = $request->{config};
+ my $permissions = $request->{permissions};
+
+ return 0 unless defined $request->{user};
+ return 0 unless defined $options->{project_id};
+ return 0 unless defined $options->{studio_id};
+ return 0 unless defined $options->{series_id};
+
+ return 1 if ( (defined $permissions->{update_event_of_others}) && ($permissions->{update_event_of_others}eq'1'));
+ return 1 if ( (defined $permissions->{is_admin}) && ($permissions->{is_admin} eq'1'));
+ return 0 if ( $permissions->{update_event_of_series}ne'1');
+
+ return is_series_assigned_to_user($request, $options);
+}
+
+# check if user allowed to create series events
+# evaluate permissions and consider editors directly assigned to series
+sub can_user_create_events{
+ my $request=shift;
+ my $options=shift;
+
+ my $config = $request->{config};
+ my $permissions = $request->{permissions};
+
+ return 0 unless defined $request->{user};
+ return 0 unless defined $options->{project_id};
+ return 0 unless defined $options->{studio_id};
+ return 0 unless defined $options->{series_id};
+
+ return 1 if ( (defined $permissions->{create_event}) && ($permissions->{create_event}eq'1'));
+ return 1 if ( (defined $permissions->{is_admin}) && ($permissions->{is_admin} eq'1'));
+ return 0 if ( $permissions->{create_event_of_series}ne'1');
+
+ return is_series_assigned_to_user($request, $options);
+}
+
+sub is_series_assigned_to_user{
+ my $request=shift;
+ my $options=shift;
+
+ my $config = $request->{config};
+ my $permissions = $request->{permissions};
+
+ return 0 unless defined $options->{project_id};
+ return 0 unless defined $options->{studio_id};
+ return 0 unless defined $options->{series_id};
+ return 0 unless defined $request->{user};
+
+ my $series_users = series::get_users(
+ $config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ name => $request->{user}
+ }
+ );
+ return 0 if (@$series_users==0);
+ return 1;
+}
+
+# check if user is assigned to studio where location matchs to event
+# return 1 on success or error text
+sub is_event_assigned_to_user{
+ my $request=shift;
+ my $options=shift;
+
+ my $config = $request->{config};
+
+ return "missing user" unless defined $request->{user};
+ return "missing project_id" unless defined $options->{project_id};
+ return "missing studio_id" unless defined $options->{studio_id};
+ return "missing series_id" unless defined $options->{series_id};
+ return "missing event_id" unless defined $options->{event_id};
+
+ #check roles
+ my $user_studios=uac::get_studios_by_user(
+ $config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ user => $request->{user},
+ }
+ );
+ return "user is not assigned to studio" if @$user_studios==0;
+ my $studio=$user_studios->[0];
+ my $location=$studio->{location};
+ return "could not get studio location" if $location eq'';
+
+ #TODO: replace legacy support
+ my $events=series::get_events(
+ $config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ event_id => $options->{event_id},
+ location => $location,
+ limit => 1
+ }
+ );
+ #print STDERR Dumper(@$events);
+ return "no event found for"
+ ." project $options->{project_id},"
+ ." studio $options->{studio_id},"
+ ." location $location,"
+ ." series $options->{series_id}"
+ ." and event $options->{event_id}" if @$events==0;
+ return 1;
+}
+
+# to find multiple recurrences this does not include the recurrence_count
+# use events::get_key to add the recurrence
+sub get_event_key{
+ my $event=shift;
+
+ my $program = $event->{program} || '';
+ my $series_name = $event->{series_name} || '';
+ my $title = $event->{title} || '';
+ my $user_title = $event->{user_title} || '';
+ my $episode = $event->{episode} || '';
+
+ my $key='';
+ $key.=$series_name if $series_name ne '';
+ $key.=' - ' if ($series_name ne '') && ($title ne '');
+ $key.=$title if $title ne '';
+ $key.=': ' if ($title ne '') && ($user_title ne '');
+ $key.=$user_title if $user_title ne '';
+ $key.=' #'.$episode if $episode ne '';
+ return $key;
+}
+
+sub update_recurring_events{
+ my $config=shift;
+ my $options=shift;
+
+ return "missing project_id" unless defined $options->{project_id};
+ return "missing studio_id" unless defined $options->{studio_id};
+ return "missing series_id" unless defined $options->{series_id};
+ return "missing event_id" unless defined $options->{event_id};
+
+ my $events=series::get_events(
+ $config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ }
+ );
+ @$events=sort { $a->{start} cmp $b->{start}} @$events;
+
+ # store events with recurrences by key (series_name, title, user_title, episode)
+ my $events_by_key={};
+ for my $event (@$events){
+ my $key=get_event_key($event);
+ next unless $key=~/\#\d+$/;
+ $event->{key}=$key;
+ push @{$events_by_key->{$key}}, $event;
+ }
+
+ # handle all events with the same key
+ for my $key (keys %$events_by_key){
+ my $events=$events_by_key->{$key};
+ next unless scalar @$events >0;
+
+ if(scalar @$events ==1){
+ # one event found -> check if recurrence is to be removed
+ my $event=$events->[0];
+ next if $event->{recurrence}==0;
+ next if $event->{recurrence_count}==0;
+ print STDERR "remove recurrence\t'$event->{event_id}'\t'$event->{start}'\t'$event->{rerun}'\t'$event->{recurrence}'\t'$event->{key}'\n";
+ $event->{recurrence}=0;
+ $event->{recurrence_count}=0;
+ $event->{rerun}=0;
+ series::update_recurring_event($config, $event);
+
+ }elsif(scalar @$events >1){
+ # multiple events found with same key
+ # first event is the original
+ my $event=$events->[0];
+ my $originalId = $event->{event_id};
+ print STDERR "0\t'$event->{recurrence_count}'\t'$event->{event_id}'\t'$event->{start}'\t'$event->{rerun}'\t'$event->{recurrence}'\t'$event->{key}'\n";
+
+ # succeeding events are reruns
+ for (my $c=1; $c < scalar(@$events); $c++){
+ my $event=$events->[$c];
+ print STDERR "$c\t'$event->{recurrence_count}'\t'$event->{event_id}'\t'$event->{start}'\t'$event->{rerun}'\t'$event->{recurrence}'\t'$event->{key}'\n";
+
+ my $update=0;
+ $update = 1 if $event->{recurrence} ne $originalId;
+ $update = 1 if $event->{rerun} ne '1';
+ $update = 1 if $event->{recurrence_count} ne $c;
+ next if $update == 0;
+
+ $event->{recurrence}=$originalId;
+ $event->{recurrence_count}=$c;
+ $event->{rerun}=1;
+ series::update_recurring_event($config, $event);
+ }
+ }
+ }
+}
+
+sub update_recurring_event{
+ my $config=shift;
+ my $event =shift;
+
+ return undef unless defined $event->{event_id};
+ return undef unless defined $event->{recurrence};
+ return undef unless defined $event->{recurrence_count};
+ return undef unless defined $event->{rerun};
+
+ return unless $event->{event_id}=~/^\d+$/;
+ return unless $event->{recurrence}=~/^\d+$/;
+ return unless $event->{recurrence_count}=~/^\d+$/;
+ return unless $event->{rerun}=~/^\d+$/;
+
+ my $bind_values=[];
+ push @$bind_values, $event->{recurrence};
+ push @$bind_values, $event->{recurrence_count};
+ push @$bind_values, $event->{rerun};
+ push @$bind_values, $event->{id};
+
+ my $update_sql=qq{
+ update calcms_events
+ set recurrence=?, recurrence_count=?, rerun=?
+ where id=?
+ };
+ #print STDERR $update_sql."\n".Dumper($bind_values)."\n";
+ my $dbh=db::connect($config);
+ db::put($dbh, $update_sql, $bind_values);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/series_dates.pm b/lib/calcms/series_dates.pm
new file mode 100644
index 0000000..e6f5353
--- /dev/null
+++ b/lib/calcms/series_dates.pm
@@ -0,0 +1,555 @@
+package series_dates;
+
+use warnings "all";
+use strict;
+use Data::Dumper;
+use Date::Calc;
+use time;
+use db;
+use log;
+use studio_timeslot_dates;
+use series_schedule;
+
+# schedule dates for series_schedule
+# table: calcms_series_dates
+# columns: id, studio_id, series_id, start(datetime), end(datetime)
+# TODO: delete column schedule_id
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get insert update delete get_dates get_series);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_series_dates');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+# get all series_dates for studio_id and series_id within given time range
+# calculate start_date, end_date, weeday, day from start and end(datetime)
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
+ push @conditions, 'start=?';
+ push @bind_values, $condition->{start_at};
+ }
+
+ if ((defined $condition->{from}) && ($condition->{from} ne '')){
+ push @conditions, 'start_date>=?';
+ push @bind_values, $condition->{from};
+ }
+
+ if ((defined $condition->{till}) && ($condition->{till} ne '')){
+ push @conditions, 'end_date{till};
+ }
+
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
+ push @conditions, 'exclude=?';
+ push @bind_values, $condition->{exclude};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select date(start) start_date
+ ,date(end) end_date
+ ,dayname(start) weekday
+ ,start_date day
+ ,start
+ ,end
+ ,id schedule_id
+ ,series_id
+ ,studio_id
+ ,project_id
+ ,exclude
+
+ from calcms_series_dates
+ $conditions
+ order by start
+ };
+ #print STDERR $query."\n";
+ #print STDERR Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ for my $entry (@$entries){
+ $entry->{weekday}=substr($entry->{weekday},0,2);
+ }
+
+ return $entries;
+}
+
+#check if event is scheduled (on permission check)
+sub is_event_scheduled{
+ my $request=shift;
+ my $options=shift;
+
+ return 0 unless defined $options->{project_id};
+ return 0 unless defined $options->{studio_id};
+ return 0 unless defined $options->{series_id};
+ return 0 unless defined $options->{start_at};
+
+ my $config = $request->{config};
+ my $schedules=series_dates::get(
+ $config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ start_at => $options->{start_at}
+ }
+ );
+ return 0 if(@$schedules!=1);
+ return 1;
+}
+
+
+#get all series for given studio_id, time range and search
+sub get_series{
+ my $config=shift;
+ my $condition=shift;
+
+ my $date_range_include=0;
+ $date_range_include=1 if $condition->{date_range_include}==1;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ push @conditions, 'd.series_id=s.id';
+# push @conditions, 'd.studio_id=s.studio_id';
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'd.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'd.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'd.series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
+ push @conditions, 'd.start=?';
+ push @bind_values, $condition->{start_at};
+ }
+
+ if ((defined $condition->{from}) && ($condition->{from} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'd.end_date>=?';
+ push @bind_values, $condition->{from};
+ }else{
+ push @conditions, 'd.start_date>=?';
+ push @bind_values, $condition->{from};
+ }
+ }
+
+ if ((defined $condition->{till}) && ($condition->{till} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'd.start_date<=?';
+ push @bind_values, $condition->{till};
+ }else{
+ push @conditions, 'd.end_date{till};
+ }
+ }
+
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'd.id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
+ push @conditions, 'd.exclude=?';
+ push @bind_values, $condition->{exclude};
+ }
+
+ my $search_cond='';
+ if ((defined $condition->{search}) && ($condition->{search} ne'')){
+ my $search=lc $condition->{search};
+ $search=~s/[^a-z0-9\_\.\-\:\!öäüßÖÄÜ \&]/%/;
+ $search=~s/\%+/\%/;
+ $search=~s/^[\%\s]+//;
+ $search=~s/[\%\s]+$//;
+ if ($search ne ''){
+ $search='%'.$search.'%';
+ my @attr=('s.title', 's.series_name', 's.excerpt', 's.category', 's.content');
+ push @conditions, "(".join(" or ", map {'lower('.$_.') like ?'} @attr ).")";
+ for my $attr (@attr){
+ push @bind_values,$search;
+ }
+ }
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select date(d.start) start_date
+ ,date(d.end) end_date
+ ,dayname(d.start) weekday
+ ,d.start_date day
+ ,d.start
+ ,d.end
+ ,d.id schedule_id
+ ,d.series_id
+ ,d.series_schedule_id
+ ,d.exclude
+ ,d.studio_id
+ ,d.project_id
+ ,s.series_name
+ ,s.title
+ ,s.has_single_events
+ from calcms_series_dates d, calcms_series s
+ $conditions
+ order by start
+ };
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+
+ for my $entry (@$entries){
+ $entry->{weekday} = substr($entry->{weekday},0,2);
+ }
+
+ # add series schedule
+ $entries=series_dates::addSeriesScheduleAttributes($config, $entries);
+
+ return $entries;
+}
+
+sub addSeriesScheduleAttributes{
+ my $config=shift;
+ my $entries=shift;
+
+ my $scheduleIds={};
+ # get series schedule ids used at entries
+ for my $entry (@$entries){
+ $scheduleIds->{$entry->{series_schedule_id}}=1;
+ }
+ my @scheduleIds=keys %$scheduleIds;
+ return $entries if scalar(@scheduleIds)==0;
+
+ # get schedules with schedule ids
+ my $schedules=series_schedule::get($config, {
+ schedule_ids => \@scheduleIds
+ });
+
+ # get schedules by id
+ my $scheduleById={};
+ for my $schedule (@$schedules){
+ $scheduleById->{$schedule->{schedule_id}}=$schedule;
+ }
+
+ for my $entry (@$entries){
+ $entry->{frequency} = $scheduleById->{$entry->{series_schedule_id}}->{frequency};
+ $entry->{period_type} = $scheduleById->{$entry->{series_schedule_id}}->{period_type};
+ }
+
+ return $entries;
+}
+
+
+#update series dates for all schedules of a series and studio_id
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id} ;
+ return undef unless defined $entry->{studio_id} ;
+ return undef unless defined $entry->{series_id} ;
+
+ my $dbh=db::connect($config);
+
+ #delete all dates for series (by studio and series id)
+ series_dates::delete($config, $entry);
+
+ my $day_start=$config->{date}->{day_starting_hour};
+
+ #get all schedules for series ordered by exclude, date
+ my $schedules=series_schedule::get($config, {
+ project_id => $entry->{project_id},
+ studio_id => $entry->{studio_id},
+ series_id => $entry->{series_id},
+ });
+
+ #add scheduled series dates and remove exluded dates
+ my $series_dates={};
+
+ #TODO:set schedules exclude to 0 if not 1
+ #insert all normal dates (not excludes)
+ for my $schedule (@$schedules){
+ my $dates=get_schedule_dates($schedule, {exclude => 0});
+ for my $date (@$dates){
+ $date->{exclude}=0;
+ $series_dates->{$date->{start}}=$date;
+ #print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
+ }
+ }
+
+ #insert / overwrite all exlude dates
+ for my $schedule (@$schedules){
+ my $dates=get_schedule_dates($schedule, {exclude => 1});
+ for my $date (@$dates){
+ $date->{exclude}=1;
+ $series_dates->{$date->{start}}=$date;
+ #print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
+ }
+ }
+
+ #print STDERR Dumper($series_dates->{'2014-02-05 19:00:00'});
+
+ my $request={
+ config => $config
+ };
+
+ my $i=0;
+ my $j=0;
+ for my $date (keys %$series_dates){
+ my $series_date=$series_dates->{$date};
+ #insert date
+ my $entry={
+ project_id => $entry->{project_id},
+ studio_id => $entry->{studio_id},
+ series_id => $entry->{series_id},
+ series_schedule_id => $series_date->{series_schedule_id},
+ start => $series_date->{start},
+ end => $series_date->{end},
+ exclude => $series_date->{exclude},
+ };
+ if(studio_timeslot_dates::can_studio_edit_events($config, $entry)==1){ # by studio_id, start, end
+ $entry->{start_date}= time::add_hours_to_datetime($entry->{start}, -$day_start);
+ $entry->{end_date}= time::add_hours_to_datetime($entry->{end}, -$day_start);
+ db::insert($dbh, 'calcms_series_dates', $entry);
+ #print STDERR "$entry->{start_date}\n";
+ $i++;
+ }else{
+ $j++;
+ #print STDERR Dumper($entry);
+ }
+ }
+ #print STDERR "$i series_dates updates\n";
+ return $j." dates out of studio times, ".$i;
+}
+
+sub get_schedule_dates{
+ my $schedule=shift;
+ my $options=shift;
+
+ my $is_exclude=$options->{exclude}||0;
+ my $dates=[];
+ return $dates if (($is_exclude eq'1') && ($schedule->{exclude}ne'1'));
+ return $dates if (($is_exclude eq'0') && ($schedule->{exclude}eq'1'));
+
+ if ($schedule->{period_type}eq'single'){
+ $dates=get_single_date($schedule->{start}, $schedule->{duration}) ;
+ }elsif($schedule->{period_type}eq'days'){
+ $dates=get_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{frequency}) ;
+ }elsif($schedule->{period_type}eq'week_of_month'){
+ $dates=get_week_of_month_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{week_of_month}, $schedule->{weekday}, $schedule->{month}, $schedule->{nextDay});
+ }else{
+ print STDERR "unknown schedule period_type\n";
+ }
+
+ # set series schedule id
+ for my $date (@$dates){
+ $date->{series_schedule_id}=$schedule->{schedule_id};
+ }
+ return $dates;
+}
+
+
+sub get_week_of_month_dates{
+ my $start =shift; # datetime string
+ my $end =shift; # datetime string
+ my $duration =shift; # in minutes
+ my $week =shift; # every nth week of month
+ my $weekday =shift; # weekday [1..7]
+ my $frequency =shift; # every 1st,2nd,3th time
+ my $nextDay =shift; # add 24 hours to start, (for night hours at last weekday of month)
+
+ return undef if $start eq'';
+ return undef if $end eq'';
+ return undef if $duration eq'';
+ return undef if $week eq'';
+ return undef if $weekday eq'';
+ return undef if $frequency eq'';
+ return undef if $frequency==0;
+
+ my $start_dates=time::get_nth_weekday_in_month($start, $end, $week, $weekday-1);
+
+ if ((defined $nextDay) && ($nextDay>0)){
+ for (my $i=0;$i<@$start_dates;$i++){
+ $start_dates->[$i]=time::add_hours_to_datetime($start_dates->[$i],24);
+ }
+ }
+
+ my $results=[];
+
+ my $c=-1;
+ for my $start_datetime (@$start_dates){
+ $c++;
+ my @start = @{time::datetime_to_array($start_datetime)};
+ next unless @start>=6;
+ next if (($c % $frequency)!=0);
+
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $start[0], $start[1], $start[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, $duration, 0 # delta days, hours, minutes, seconds
+ );
+ my $end_datetime=time::array_to_datetime(\@end_datetime);
+
+ push @$results, {
+ start => $start_datetime,
+ end => $end_datetime
+ };
+ }
+ return $results;
+}
+
+#add duration to a single date
+sub get_single_date{
+ my $start_datetime = shift;
+ my $duration = shift;
+
+ my @start = @{time::datetime_to_array($start_datetime)};
+ return unless @start>=6;
+
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $start[0], $start[1], $start[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, $duration, 0 # delta days, hours, minutes, seconds
+ );
+ my $date={
+ start => $start_datetime,
+ end => time::array_to_datetime(\@end_datetime)
+ };
+ return [$date];
+}
+
+#calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days)
+sub get_dates{
+ my $start_datetime = shift;
+ my $end_date = shift;
+ my $duration = shift; # in minutes
+ my $frequency = shift; # in days
+ #print "start_datetime:$start_datetime end_date:$end_date duration:$duration frequency:$frequency\n";
+
+ my @start = @{time::datetime_to_array($start_datetime)};
+ return unless @start>=6;
+ my @start_date = ($start[0], $start[1], $start[2]);
+ my $start_time = sprintf('%02d:%02d:%02d', $start[3], $start[4], $start[5]);
+
+ #print STDERR "$start_datetime,$end_date,$duration,$frequency\n";
+
+ #return on single date
+ my $date={};
+ $date->{start}= sprintf("%04d-%02d-%02d",@start_date).' '.$start_time;
+ return undef if $duration eq '';
+
+ return undef if (($frequency eq '')||($end_date eq''));
+
+ #continue on recurring date
+ my @end = @{time::datetime_to_array($end_date)};
+ return unless @end>=3;
+ my @end_date = ($end[0], $end[1], $end[2]);
+
+ my $today=time::time_to_date();
+ my ($year, $month, $day)=split(/\-/,$today);
+
+ my $dates=[];
+ return $dates if ($end_date lt $today);
+ return $dates if ($frequency<1);
+
+ my $j = Date::Calc::Delta_Days(@start_date, @end_date);
+ my $c=0;
+ for (my $i = 0; $i <= $j; $i+=$frequency ){
+ my @date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
+ my $date={};
+ $date->{start}=sprintf("%04d-%02d-%02d",@date).' '.$start_time;
+
+ #if($date->{start} gt $today){
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $date[0], $date[1], $date[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, $duration, 0 # delta days, hours, minutes, seconds
+ );
+ $date->{end}=time::array_to_datetime(\@end_datetime);
+ push @$dates,$date;
+ #}
+ last if ($c>200);
+ $c++;
+ }
+ return $dates;
+}
+
+#remove all series_dates for studio_id and series_id
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless defined $entry->{project_id};
+ return unless defined $entry->{studio_id};
+ return unless defined $entry->{series_id};
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_series_dates
+ where project_id=? and studio_id=? and series_id=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ db::put($dbh, $query, $bind_values);
+}
+
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/series_events.pm b/lib/calcms/series_events.pm
new file mode 100644
index 0000000..cdadf25
--- /dev/null
+++ b/lib/calcms/series_events.pm
@@ -0,0 +1,467 @@
+package series_events;
+
+use warnings "all";
+use strict;
+
+use Data::Dumper;
+use Date::Calc;
+use markup;
+
+use db;
+use log;
+use time;
+use uac;
+use events;
+use series;
+use series_dates;
+use studios;
+use studio_timeslot_dates;
+use event_history;
+
+# check permissions, insert and update events related to series
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ check_permission
+ save_content
+ save_event_time
+ insert_event
+ delete_event
+ set_playout_status
+);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+# update main fields of the event by id
+# do not check for project,studio,series
+# all changed columns are returned for history handling
+sub save_content{
+ my $config=shift;
+ my $entry=shift;
+
+ my $dbh=db::connect($config);
+
+ return undef unless(defined $entry->{id});
+
+ for my $attr (keys %$entry){
+ $entry->{$attr}=~s/^\s+//g;
+ $entry->{$attr}=~s/\s+$//g;
+ }
+
+ #print STDERR Dumper(\$entry->{content});
+ for my $attr ('content', 'topic'){
+ if (defined $entry->{$attr}){
+ $entry->{'html_'.$attr}=markup::creole_to_html($entry->{$attr});
+ #$entry->{'html_'.$attr}=~s/([^\>])\n+([^\<])/$1)?//g;
+ #$entry->{'html_'.$attr}=~s/(<\/p>)?\s*$//g;
+ }
+ }
+
+ #print STDERR Dumper(\$entry->{html_content});
+ #print STDERR "ok2\n";
+ #return;
+ $entry->{modified_at}= time::time_to_datetime(time());
+ #return;
+ #update only existing atributes
+
+ #TODO: double check series_name (needed for reassignment but not for editing...)
+ my @keys=();
+ for my $key ('series_name', 'title', 'excerpt', 'content', 'html_content',
+ 'user_title', 'user_excerpt', 'topic', 'html_topic',
+ 'episode', 'image', 'podcast_url', 'archive_url',
+ 'live', 'published', 'playout', 'archived', 'rerun', 'disable_event_sync',
+ 'modified_by'
+ ){
+ push @keys, $key if defined $entry->{$key};
+ }
+ $entry->{episode}=undef if((defined $entry->{episode}) && ($entry->{episode}eq'0'));
+
+ my $values =join(",", map {$_.'=?'} (@keys));
+ my @bind_values =map {$entry->{$_}} (@keys);
+
+ push @bind_values,$entry->{id};
+ my $query=qq{
+ update calcms_events
+ set $values
+ where id=?
+ };
+
+ #print STDERR $query.Dumper(\@bind_values);
+ db::put($dbh, $query, \@bind_values);
+ return $entry;
+}
+
+# save event time by id
+# do not check project, studio, series
+# for history handling all changed columns are returned
+sub save_event_time{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless(defined $entry->{id});
+ return undef unless(defined $entry->{duration});
+ return undef unless(defined $entry->{start_date});
+
+ my $dbh=db::connect($config);
+ my $event={
+ id => $entry->{id},
+ start => $entry->{start_date},
+ end => time::add_minutes_to_datetime($entry->{start_date}, $entry->{duration})
+ };
+
+ my $day_start=$config->{date}->{day_starting_hour};
+ my $event_hour=int((split(/[\-\:\sT]/,$event->{start}))[3]);
+
+ my @update_columns=();
+ my $bind_values=[];
+ push @update_columns,'start=?';
+ push @$bind_values,$event->{start};
+
+ push @update_columns, 'end=?';
+ push @$bind_values, $event->{end};
+
+ # add start date
+ my $start_date= time::add_hours_to_datetime($event->{start}, -$day_start);
+ push @update_columns, 'start_date=?';
+ push @$bind_values, $start_date;
+ $event->{start_date} =$start_date;
+
+ # add end date
+ my $end_date= time::add_hours_to_datetime($event->{end}, -$day_start);
+ push @update_columns, 'end_date=?';
+ push @$bind_values, $end_date;
+ $event->{end_date} = $end_date;
+
+ my $update_columns=join(",\n", @update_columns);
+ my $update_sql=qq{
+ update calcms_events
+ set $update_columns
+ where id=?
+ };
+ push @$bind_values, $event->{id};
+ #print STDERR $update_sql."\n".Dumper($bind_values)."\n";
+ db::put($dbh, $update_sql, $bind_values);
+ return $event;
+}
+
+sub set_playout_status{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{start};
+ return undef unless defined $entry->{playout};
+
+ my $dbh=db::connect($config);
+
+ # check if event is assigned to project and studio
+ my $sql=qq{
+ select se.event_id event_id
+ from calcms_series_events se, calcms_events e
+ where
+ se.event_id=e.id
+ and e.start=?
+ and se.project_id=?
+ and se.studio_id=?
+ };
+ my $bind_values=[$entry->{start}, $entry->{project_id}, $entry->{studio_id}];
+ #print STDERR Dumper($sql).Dumper($bind_values);
+ my $events=db::get($dbh, $sql, $bind_values);
+ #print STDERR Dumper($events);
+ return undef if scalar(@$events)!=1;
+ my $event_id=$events->[0]->{event_id};
+ $sql=qq{
+ update calcms_events
+ set playout=?
+ where id=?
+ and start=?
+ };
+ $bind_values=[$entry->{playout}, $event_id, $entry->{start}];
+ #print STDERR $sql."\n".Dumper($bind_values)."\n";
+ my $result=db::put($dbh, $sql, $bind_values);
+ return $result;
+}
+
+# is event assigned to project, studio and series?
+sub is_event_assigned{
+ my $config=shift;
+ my $entry=shift;
+
+ return 0 unless defined $entry->{project_id};
+ return 0 unless defined $entry->{studio_id};
+ return 0 unless defined $entry->{series_id};
+ return 0 unless defined $entry->{event_id};
+
+ my $dbh=db::connect($config);
+
+ my $sql=q{
+ select * from calcms_series_events
+ where project_id=? and studio_id=? and series_id=? and event_id=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{event_id}];
+ my $results=db::get($dbh, $sql, $bind_values);
+
+ return 1 if @$results>=1;
+ return 0;
+}
+
+sub delete_event{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+ return undef unless defined $entry->{event_id};
+ return undef unless defined $entry->{user};
+
+ #is event assigned to project, studio and series?
+ unless(is_event_assigned($config, $entry)==1){
+ print STDERR "cannot delete event with project_id=$entry->{project_id}, studio_id=$entry->{studio_id}, series_id=$entry->{series_id}, event_id=$entry->{event_id}";
+ return 0;
+ }
+
+ event_history::insert_by_event_id($config, $entry);
+
+ #delete the association
+ series::unassign_event($config, $entry);
+
+ # delete the event
+ my $dbh=db::connect($config);
+ my $sql=q{
+ delete from calcms_events
+ where id=?
+ };
+ my $bind_values=[$entry->{event_id}];
+ db::put($dbh, $sql, $bind_values);
+
+ return 1;
+}
+
+
+#check permissions
+# options: conditions (studio_id, series_id,...)
+# key permission: permissions to be checked (one of)
+# key check_for: user, studio, series, events, schedule
+# return error text or 1 if okay
+sub check_permission{
+ my $request=shift;
+ my $options=shift;
+
+ return "missing permission at check" unless defined $options->{permission};
+ return "missing check_for at check" unless defined $options->{check_for};
+ return "missing user at check" unless defined $request->{user};
+ return "missing project_id at check" unless defined $options->{project_id};
+ return "missing studio_id at check" unless defined $options->{studio_id};
+ return "missing series_id at check" unless defined $options->{series_id};
+
+ my $permissions = $request->{permissions};
+ my $config = $request->{config};
+
+ my $studio_check=studios::check($config, $options);
+ return $studio_check if($studio_check ne '1');
+ print STDERR "check studio ok\n";
+
+ my $project_check=project::check($config, $options);
+ return $project_check if($project_check ne '1');
+ print STDERR "check project ok\n";
+
+ #check if permissions are set (like create_event)
+ my $found=0;
+ for my $permission (split /\,/,$options->{permission}){
+ $found=1 if ((defined $permissions->{$permission})&&($permissions->{$permission})eq'1');
+ }
+ return 'missing permission to '.$options->{permission} if $found==0;
+ delete $options->{permission};
+
+ #convert check list to hash
+ my $check={};
+ for my $permission (@{$options->{check_for}}){
+ $check->{$permission}=1;
+ }
+ delete $options->{check_for};
+
+ # is project assigned to studio
+ return "studio is not assigned to project" unless project::is_studio_assigned($config, $options)==1;
+
+ #get studio names
+ my $studios=studios::get($config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id}
+ });
+ return "unknown studio" unless defined $studios;
+ return "unknown studio" unless (@$studios==1);
+ my $studio=$studios->[0];
+ my $studio_name=$studio->{name}||'';
+
+ #get series names
+ my $series=series::get($config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id}
+ });
+ my $series_name=$series->[0]->{series_name}||'';
+ $series_name.=' - '.$series->[0]->{title} if $series->[0]->{series_name} ne '';
+
+ #check all items from checklist
+ if((defined $check->{user})&&(uac::is_user_assigned_to_studio($request, $options)==0)){
+ return "User '$request->{user}' is not assigned to studio $studio_name ($options->{studio_id})";
+ }
+
+ if((defined $check->{studio})&&(project::is_series_assigned($config, $options)==0)){
+ return "Series '$series_name' ($options->{series_id}) is not assigned to studio '$studio_name' ($options->{studio_id})";
+ }
+
+ # check series and can user update events
+ if((defined $check->{series})&&(series::can_user_update_events($request, $options)==0)){
+ return "unknown series" unless defined $series;
+ return "User $request->{user} cannot update events for series '$series_name' ($options->{series_id})";
+ }
+
+ # check series and can user create events
+ if((defined $check->{create_events})&&(series::can_user_create_events($request, $options)==0)){
+ return "unknown series" unless defined $series;
+ return "User $request->{user} cannot create events for series '$series_name' ($options->{series_id})";
+ }
+
+ if((defined $check->{studio_timeslots})&&(studio_timeslot_dates::can_studio_edit_events($config, $options)==0)){
+ return "requested time is not assigned to studio '$studio_name' ($options->{studio_id})";
+ }
+
+ #check if event is assigned to user,project,studio,series,location
+ if(defined $check->{events}){
+ return "missing event_id" unless defined $options->{event_id};
+ my $result=series::is_event_assigned_to_user($request, $options);
+ return $result if $result ne '1';
+ }
+
+ # prevent editing events that are over for more than 14 days
+ if(defined $check->{event_age}){
+ if (series::is_event_older_than_days($config, {
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ event_id => $options->{event_id},
+ max_age => 14
+ })==1){
+ return "show is over for more than 2 weeks" unless(
+ (defined $permissions->{update_event_after_week})
+ && ($permissions->{update_event_after_week} eq '1')
+ );
+ }
+ }
+
+ #check if schedule event exists for given date
+ if(defined $check->{schedule}){
+ return "unknown series" unless defined $series;
+ return "missing start_at at check_permission" unless defined $options->{start_date};
+ #TODO: check "is_event_scheduled" if start_at could be moved to start_date
+ $options->{start_at}=$options->{start_date};
+ return "No event scheduled for series '$series_name' ($options->{series_id})" if(series_dates::is_event_scheduled($request, $options)==0);
+ }
+
+ return '1';
+}
+
+#not handled, yet:
+# responsible, status, rating, podcast_url, media_url, visible, time_of_day, recurrence, reference, created_at
+# category, time_of_day,
+
+#insert event
+sub insert_event{
+ my $config=shift;
+ my $options=shift;
+
+ my $project_id = $options->{project_id};
+ my $studio = $options->{studio};
+ my $serie = $options->{serie};
+ my $params = $options->{event};
+ my $user = $options->{user};
+
+ return 0 unless defined $studio;
+ return 0 unless defined $serie;
+ return 0 unless defined $params;
+ return 0 unless defined $user;
+ return 0 unless defined $studio->{location};
+
+ my $projects=project::get($config, {project_id=>$project_id});
+ if(@$projects==0){
+ print STDERR "project not found at insert event\n";
+ return 0;
+ }
+ my $projectName=$projects->[0]->{name};
+ my $event={
+ project => $projectName,
+ location => $studio->{location}, # location from studio
+ };
+ #print '
';
+ $event=series_events::add_event_dates($config, $event, $params);
+
+ #get event content from series
+ for my $attr ('program', 'series_name', 'title', 'excerpt', 'content', 'topic', 'image', 'episode', 'podcast_url', 'archive_url'){
+ $event->{$attr}=$serie->{$attr} if defined $serie->{$attr};
+ }
+
+ #overwrite series values from parameters
+ for my $attr ('program', 'series_name', 'title', 'user_title', 'excerpt', 'user_except', 'content', 'topic', 'image', 'episode', 'podcast_url', 'archive_url'){
+ $event->{$attr}=$params->{$attr} if defined $params->{$attr};
+ }
+ $event->{'html_content'} = markup::creole_to_html($event->{'content'}) if defined $event->{'content'};
+ $event->{'html_topic'} = markup::creole_to_html($event->{'topic'}) if defined $event->{'topic'};
+
+ #add event status
+ for my $attr ('live', 'published', 'playout', 'archived', 'rerun', 'disable_event_sync'){
+ $event->{$attr}=$params->{$attr}||0;
+ }
+
+ if($serie->{has_single_events}eq'1'){
+ delete $event->{series_name};
+ delete $event->{episode};
+ }
+
+ $event->{modified_at} = time::time_to_datetime(time());
+ $event->{created_at} = time::time_to_datetime(time());
+ $event->{modified_by} = $user;
+
+ #print STDERR Dumper($event);
+ my $dbh=db::connect($config);
+ my $event_id= db::insert($dbh, 'calcms_events', $event);
+
+ #add to history
+ $event->{project_id}= $project_id;
+ $event->{studio_id} = $studio->{id};
+ $event->{series_id} = $serie->{series_id};
+ $event->{event_id} = $event_id;
+ event_history::insert($config, $event);
+ return $event_id;
+}
+
+
+#set start, end, start-date, end_date to an event
+sub add_event_dates{
+ my $config =shift;
+ my $event =shift;
+ my $params =shift;
+
+ #start and end datetime
+ $event->{start} = $params->{start_date};
+ $event->{end} = time::add_minutes_to_datetime($params->{start_date}, $params->{duration});
+
+ #set program days
+ my $day_start=$config->{date}->{day_starting_hour};
+ $event->{start_date} = time::date_cond(time::add_hours_to_datetime($event->{start}, -$day_start));
+ $event->{end_date} = time::date_cond(time::add_hours_to_datetime($event->{end}, -$day_start));
+ return $event;
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/series_schedule.pm b/lib/calcms/series_schedule.pm
new file mode 100644
index 0000000..849e478
--- /dev/null
+++ b/lib/calcms/series_schedule.pm
@@ -0,0 +1,183 @@
+package series_schedule;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use series_dates;
+
+# table: calcms_series_schedule
+# columns: id, studio_id, series_id,
+ # start (datetime),
+ # duration (minutes),
+ # frequency (days),
+ # end (date),
+ # weekday (1..7)
+ # week_of_month (1..5)
+ # month
+ # nextDay (add 24 hours to start)
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get insert update delete);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_series_schedule');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+#map schedule id to id
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ if ((defined $condition->{schedule_ids}) && (ref($condition->{schedule_ids}) eq 'ARRAY')){
+ my @scheduleIds = @{$condition->{schedule_ids}};
+ push @conditions, 'id in ('.(join(',', (map {'?'} @scheduleIds) )).')';
+ for my $id (@scheduleIds){
+ push @bind_values, $id;
+ }
+ }
+
+ if ((defined $condition->{start}) && ($condition->{start} ne '')){
+ push @conditions, 'start=?';
+ push @bind_values, $condition->{start};
+ }
+
+ if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
+ push @conditions, 'exclude=?';
+ push @bind_values, $condition->{exclude};
+ }
+
+ if ((defined $condition->{period_type}) && ($condition->{period_type} ne '')){
+ push @conditions, 'period_type=?';
+ push @bind_values, $condition->{period_type};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_series_schedule
+ $conditions
+ order by exclude, start
+ };
+ #print STDERR $query."\n".Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ for my $entry (@$entries){
+ $entry->{schedule_id}=$entry->{id};
+ delete $entry->{id};
+ }
+ #print STDERR Dumper($entries);
+ return $entries;
+}
+
+
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+ return undef unless defined $entry->{start};
+ my $dbh=db::connect($config);
+ return db::insert($dbh, 'calcms_series_schedule', $entry);
+}
+
+#schedule id to id
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+ return undef unless defined $entry->{schedule_id};
+ return undef unless defined $entry->{start};
+ $entry->{nextDay}=0 unless defined $entry->{nextDay};
+
+ $entry->{id}=$entry->{schedule_id};
+ delete $entry->{schedule_id};
+
+ my $dbh=db::connect($config);
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+
+ push @bind_values,$entry->{project_id};
+ push @bind_values,$entry->{studio_id};
+ push @bind_values,$entry->{id};
+
+ my $query=qq{
+ update calcms_series_schedule
+ set $values
+ where project_id=? and studio_id=? and id=?
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+ db::put($dbh, $query, \@bind_values);
+ print "done\n";
+}
+
+#map schedule id to id
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{series_id};
+ return undef unless defined $entry->{schedule_id};
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_series_schedule
+ where project_id=? and studio_id=? and series_id=? and id=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{schedule_id}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ db::put($dbh, $query, $bind_values);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/startup.pl b/lib/calcms/startup.pl
new file mode 100644
index 0000000..3ebb66c
--- /dev/null
+++ b/lib/calcms/startup.pl
@@ -0,0 +1,32 @@
+use lib qw(/home/calcms/lib/calcms/);
+
+return 1;
+#use B::TerseSize
+
+#load mod_perl modules
+#use Apache2;
+#use ModPerl::RegistryPrefork;
+#use Apache::compat;
+
+#on upload CGI open of tmpfile: Permission denied
+#use CGI;
+
+#load common used modules
+#use Data::Dumper;
+#use DBI;
+use Apache::DBI;
+#$Apache::DBI::DEBUG = 2;
+
+use Time::Local;
+use Date::Calc;
+use Calendar::Simple qw(date_span);
+
+use config;
+use log;
+use time;
+use db;
+use cache;
+use template;
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/studio_timeslot_dates.pm b/lib/calcms/studio_timeslot_dates.pm
new file mode 100644
index 0000000..7cb4006
--- /dev/null
+++ b/lib/calcms/studio_timeslot_dates.pm
@@ -0,0 +1,434 @@
+package studio_timeslot_dates;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use Date::Calc;
+use time;
+
+# schedule dates for calcms_studio_schedule
+# table: calcms_studio_timeslot_dates
+# columns: id, studio_id, start(datetime), end(datetime)
+# TODO: delete column schedule_id
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get insert update delete get_dates);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_studio_timeslot_dates');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+# get all studio_timeslot_dates for studio_id within given time range
+# calculate start_date, end_date, weeday, day from start and end(datetime)
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $date_range_include=0;
+ $date_range_include=1 if $condition->{date_range_include}==1;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'schedule_id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ # from and till range from an event should beween start and end of the studio's permission
+ if ((defined $condition->{start}) && ($condition->{start} ne '')){
+ push @conditions, 'start<=?';
+ push @bind_values, $condition->{start};
+ }
+
+ if ((defined $condition->{end}) && ($condition->{end} ne '')){
+ push @conditions, 'end>=?';
+ push @bind_values, $condition->{end};
+ }
+
+ # check only a given date date range (without time)
+ if ((defined $condition->{from}) && ($condition->{from} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'end_date>=?';
+ push @bind_values, $condition->{from};
+ }else{
+ push @conditions, 'start_date>=?';
+ push @bind_values, $condition->{from};
+ }
+ }
+
+ if ((defined $condition->{till}) && ($condition->{till} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'start_date<=?';
+ push @bind_values, $condition->{till};
+ }else{
+ push @conditions, 'end_date<=?';
+ push @bind_values, $condition->{till};
+ }
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select date(start) start_date
+ ,date(end) end_date
+ ,dayname(start) start_weekday
+ ,dayname(end) end_weekday
+ ,start_date day
+ ,start
+ ,end
+ ,schedule_id
+ ,studio_id
+
+ from calcms_studio_timeslot_dates
+ $conditions
+ order by start
+ };
+ #print STDERR $query."\n";
+ #print STDERR Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ for my $entry (@$entries){
+ $entry->{start_weekday}=substr($entry->{start_weekday},0,2);
+ $entry->{end_weekday}=substr($entry->{end_weekday},0,2);
+ }
+ #print STDERR Dumper($entries);
+ return $entries;
+}
+
+
+
+#get all studio_timeslot_schedules for studio_id and update studio_timeslot_dates
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless(defined $entry->{schedule_id});
+
+ my $dbh=db::connect($config);
+
+ #delete all dates for schedule id
+ studio_timeslot_dates::delete($config, $entry);
+
+ my $day_start=$config->{date}->{day_starting_hour};
+
+ #get the schedule with schedule id ordered by date
+ my $schedules=studio_timeslot_schedule::get($config, {
+ schedule_id => $entry->{schedule_id}
+ });
+ #add scheduled dates
+ my $i=0;
+ my $dates={};
+ for my $schedule (@$schedules){
+ #calculate dates from start to end_date
+ my $dateList=get_dates($schedule->{start}, $schedule->{end}, $schedule->{end_date}, $schedule->{frequency});
+ #print STDERR Dumper($dateList);
+ for my $date (@$dateList){
+ #set studio i from
+ $date->{project_id} = $schedule->{project_id};
+ $date->{studio_id} = $schedule->{studio_id};
+ $date->{schedule_id} = $schedule->{schedule_id};
+ $dates->{$date->{start}.$date->{studio_id}}=$date;
+ }
+ }
+
+ for my $date (keys %$dates){
+ my $timeslot_date=$dates->{$date};
+ #insert date
+ my $entry={
+ project_id => $timeslot_date->{project_id},
+ studio_id => $timeslot_date->{studio_id},
+ schedule_id => $timeslot_date->{schedule_id},
+ start => $timeslot_date->{start},
+ end => $timeslot_date->{end},
+ };
+ $entry->{start_date}= time::add_hours_to_datetime($entry->{start}, -$day_start);
+ $entry->{end_date}= time::add_hours_to_datetime($entry->{end}, -$day_start);
+ db::insert($dbh, 'calcms_studio_timeslot_dates', $entry);
+ #print STDERR "$entry->{start_date}\n";
+ $i++;
+ }
+ #print STDERR "$i studio_timeslot_dates updates\n";
+ return $i;
+}
+
+# calculate all start/end datetimes between start_date and stop_date with a frequency(days)
+# returns list of hashs with start and end
+sub get_dates{
+ my $start_datetime = shift; # start
+ my $end_datetime = shift; # start
+ my $stop_date = shift; # limit recurring events
+ my $frequency = shift; # in days
+
+ my @start = @{time::datetime_to_array($start_datetime)};
+ return unless @start>=6;
+ my @start_date = ($start[0], $start[1], $start[2]);
+ my $start_date = sprintf("%04d-%02d-%02d",@start_date);
+ my $start_time = sprintf('%02d:%02d:%02d', $start[3], $start[4], $start[5]);
+
+ my @end = @{time::datetime_to_array($end_datetime)};
+ return unless @end>=6;
+ my @end_date = ($end[0], $end[1], $end[2]);
+ my $end_date = sprintf("%04d-%02d-%02d",@end_date);
+ my $end_time = sprintf('%02d:%02d:%02d', $end[3], $end[4], $end[5]);
+
+ my @stop = @{time::date_to_array($stop_date)};
+ return unless @end>=3;
+ my @stop_date = ($stop[0], $stop[1], $stop[2]);
+ $stop_date = sprintf("%04d-%02d-%02d",@stop_date);
+
+ my $date={};
+ $date->{start}= $start_date.' '.$start_time;
+ $date->{end} = $end_date.' '.$end_time;
+
+ my $dates=[];
+ return $dates if ($date->{end} le $date->{start});
+
+ return $dates if ($stop_date lt $end_date);
+
+ my $j = Date::Calc::Delta_Days(@start_date, @stop_date);
+ return $dates if $j<0;
+
+ # split full time events into single days
+ if($frequency<1){
+ #start day
+ my @next_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], 1);
+ my $next_date = sprintf("%04d-%02d-%02d",@next_date);
+ push @$dates,{
+ start => $start_date.' '.$start_time,
+ end => $next_date .' 00:00:00',
+ };
+ my $c=0;
+ for (my $i = 1; $i < $j; $i++){
+ my @start_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
+ my $start_date = sprintf("%04d-%02d-%02d",@start_date);
+ my @next_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i+1);
+ my $next_date = sprintf("%04d-%02d-%02d",@next_date);
+ push @$dates,{
+ start => $start_date.' 00:00:00',
+ end => $next_date.' 00:00:00',
+ };
+ last if ($c>1000);
+ $c++;
+ }
+ #end day
+ push @$dates,{
+ start => $end_date.' 00:00:00',
+ end => $end_date.' '.$end_time,
+ } if($end_time ne '00:00:00');
+ return $dates;
+ }
+
+ # multiple time events
+ my $c=0;
+ for (my $i = 0; $i <= $j; $i+=$frequency ){
+ #add frequency to start and end date
+ my @start_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
+ my @end_date = Date::Calc::Add_Delta_Days($end[0], $end[1], $end[2], $i);
+ #print STDERR Dumper(\@start_date);
+ #print STDERR Dumper(\@end_date);
+ my $start_date=sprintf("%04d-%02d-%02d",@start_date);
+ my $end_date =sprintf("%04d-%02d-%02d",@end_date);
+ push @$dates,{
+ start => $start_date.' '.$start_time,
+ end => $end_date.' '.$end_time,
+ };
+ last if ($c>1000);
+ $c++;
+ }
+ return $dates;
+}
+
+#remove all studio_timeslot_dates for studio_id and schedule_id
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ #print STDERR "delete:".Dumper($entry);
+ return unless(defined $entry->{project_id});
+ return unless(defined $entry->{studio_id});
+ return unless(defined $entry->{schedule_id});
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_studio_timeslot_dates
+ where schedule_id=?
+ };
+ my $bind_values=[$entry->{schedule_id}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ db::put($dbh, $query, $bind_values);
+}
+
+# time based filter to check if studio is assigned to an studio at a given time range
+# return 1 if there is a schedule date starting before start and ending after end
+sub can_studio_edit_events{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+ #print Dumper($condition);
+
+ #return 0 unless defined $condition->{project_id};
+ return 0 unless defined $condition->{studio_id};
+ return 0 unless defined $condition->{start};
+ return 0 unless defined $condition->{end};
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{start}) && ($condition->{start} ne '')){
+ push @conditions, 'start<=?';
+ push @bind_values, $condition->{start};
+ }
+
+ if ((defined $condition->{end}) && ($condition->{end} ne '')){
+ push @conditions, 'end>=?';
+ push @bind_values, $condition->{end};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $dbh=db::connect($config);
+ my $query=qq{
+ select count(*) permission
+ from calcms_studio_timeslot_dates
+ $conditions
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ #print STDERR Dumper($entries);
+ return 0 if scalar(@$entries) == 0;
+ return 1 if $entries->[0]->{permission}>0;
+
+ if ($entries->[0]->{permission}==0){
+ my $timeslot=getMergedDays($config, $condition);
+ return 0 unless defined $timeslot;
+ if (
+ ($condition->{start} ge $timeslot->{start})
+ && ($condition->{end} le $timeslot->{end})
+ ){
+ #print STDERR "($condition->{start} ge $timeslot->{start}) ".($condition->{start} ge $timeslot->{start});
+ #print STDERR "($condition->{end} le $timeslot->{end}) ".($condition->{end} le $timeslot->{end});
+ return 1;
+ }
+ }
+ return 0;
+}
+
+# merge two subsequent days if first day ends at same time as next day starts
+# returns hashref with start and end of merged slot
+# returns undef if not slot could be found
+sub getMergedDays{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+ #print Dumper($condition);
+
+ #return 0 unless defined $condition->{project_id};
+ return 0 unless defined $condition->{studio_id};
+ return 0 unless defined $condition->{start};
+ return 0 unless defined $condition->{end};
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ # set start to next day at 00:00
+ my $start=undef;
+ if ($condition->{start}=~/(\d\d\d\d\-\d\d\-\d\d)/){
+ $start=$1.' 00:00';
+ $start=time::add_days_to_datetime($start, 1);
+ push @bind_values, $start;
+ }
+
+ # set end to end days at 00:00
+ my $end=undef;
+ if ($condition->{end}=~/(\d\d\d\d\-\d\d\-\d\d)/){
+ $end=$1.' 00:00';
+ push @bind_values, $end;
+ }
+ return undef unless defined $start;
+ return undef unless defined $end;
+
+ push @conditions, '(start=? or end=?)';
+
+ my $conditions='';
+ $conditions='where '.join(" and ",@conditions) if (@conditions>0);
+
+ # get all days starting on first day or ending at next day
+ my $dbh=db::connect($config);
+ my $query=qq{
+ select start, end
+ from calcms_studio_timeslot_dates
+ $conditions
+ order by start
+ };
+ # print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ # print STDERR Dumper($entries);
+
+ if (scalar(@$entries)==2){
+ if ($entries->[0]->{end} eq $entries->[1]->{start}){
+ $entries={
+ start => $entries->[0]->{start},
+ end => $entries->[1]->{end}
+ };
+ # print STDERR "found".Dumper($entries)."\n";
+ return $entries;
+ }
+ }
+
+ return undef;
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/studio_timeslot_schedule.pm b/lib/calcms/studio_timeslot_schedule.pm
new file mode 100644
index 0000000..7d9a8bc
--- /dev/null
+++ b/lib/calcms/studio_timeslot_schedule.pm
@@ -0,0 +1,144 @@
+package studio_timeslot_schedule;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use studio_timeslot_dates;
+
+# table: calcms_studio_timeslot_schedule
+# columns: id, project_id, studio_id, start(datetime), end(datetime), end_date(date),
+# frequency(days), duration(minutes), create_events(days), publish_events(days)
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get insert update delete);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_studio_timeslot_schedule');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+#map schedule id to id
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_studio_timeslot_schedule
+ $conditions
+ order by start
+ };
+ #print $query."\n";
+ #print Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ for my $entry (@$entries){
+ $entry->{schedule_id}=$entry->{id};
+ delete $entry->{id};
+ }
+ return $entries;
+}
+
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless(defined $entry->{project_id});
+ return unless(defined $entry->{studio_id});
+ return unless(defined $entry->{start});
+ return unless(defined $entry->{end});
+ return unless(defined $entry->{frequency});
+
+ my $dbh=db::connect($config);
+ return db::insert($dbh, 'calcms_studio_timeslot_schedule', $entry);
+}
+
+#schedule id to id
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless(defined $entry->{project_id});
+ return unless(defined $entry->{studio_id});
+ return unless(defined $entry->{schedule_id});
+ return unless(defined $entry->{start});
+ return unless(defined $entry->{end});
+ return unless(defined $entry->{frequency});
+
+ $entry->{id}=$entry->{schedule_id};
+ delete $entry->{schedule_id};
+
+ my $dbh=db::connect($config);
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values,$entry->{id};
+
+ my $query=qq{
+ update calcms_studio_timeslot_schedule
+ set $values
+ where id=?
+ };
+ db::put($dbh, $query, \@bind_values);
+ #print "done\n";
+
+ $entry->{schedule_id}=$entry->{id};
+ delete $entry->{id};
+
+}
+
+#map schedule id to id
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless(defined $entry->{schedule_id});
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_studio_timeslot_schedule
+ where id=?
+ };
+ my $bind_values=[$entry->{schedule_id}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ db::put($dbh, $query, $bind_values);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/studios.pm b/lib/calcms/studios.pm
new file mode 100644
index 0000000..c7a6781
--- /dev/null
+++ b/lib/calcms/studios.pm
@@ -0,0 +1,158 @@
+#!/bin/perl
+
+use CGI;
+use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
+use CGI::Session qw(-ip-match);
+use CGI::Cookie;
+#$CGI::Session::IP_MATCH=1;
+
+package studios;
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get get_by_id insert update delete check check_studio);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_studios');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+sub get{
+ my $config=shift;
+ my $condition=shift||{};
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 's.id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{name}) && ($condition->{name} ne '')){
+ push @conditions, 's.name=?';
+ push @bind_values, $condition->{name};
+ }
+
+ my $limit='';
+ if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
+ $limit= 'limit '.$condition->{limit};
+ }
+
+ my $query='';
+ unless ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+ $query=qq{
+ select *
+ from calcms_studios s
+ $conditions
+ $limit
+ };
+ }else{
+ push @conditions, 's.id=ps.studio_id';
+
+ push @conditions, 'ps.project_id=?';
+ push @bind_values, $condition->{project_id};
+ my $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+ $query=qq{
+ select *
+ from calcms_studios s, calcms_project_studios ps
+ $conditions
+ $limit
+ };
+ }
+ my $dbh=db::connect($config);
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+ my $studios=db::get($dbh, $query,\@bind_values);
+ return $studios;
+}
+
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ $entry->{created_at} = time::time_to_datetime(time());
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $dbh=db::connect($config);
+ my $id=db::insert($dbh, 'calcms_studios', $entry);
+ return $id;
+}
+
+
+sub update{
+ my $config=shift;
+ my $studio=shift;
+
+ $studio->{modified_at}= time::time_to_datetime(time());
+
+ my $columns=get_columns($config);
+ my $entry={};
+ for my $column (keys %$columns){
+ $entry->{$column}=$studio->{$column} if defined $studio->{$column};
+ }
+
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values,$entry->{id};
+
+ my $query=qq{
+ update calcms_studios
+ set $values
+ where id=?
+ };
+
+ my $dbh=db::connect($config);
+ db::put($dbh, $query, \@bind_values);
+}
+
+sub delete{
+ my $config=shift;
+ my $studio=shift;
+
+ my $dbh=db::connect($config);
+ db::put($dbh, 'delete from calcms_studios where id=?', [$studio->{id}]);
+}
+
+#TODO rename to check
+sub check_studio{
+ my $config=shift;
+ my $options=shift;
+ return check($config, $options);
+}
+
+sub check{
+ my $config=shift;
+ my $options=shift;
+ return "missing studio_id" unless defined $options->{studio_id};
+ return "Please select a studio" if($options->{studio_id}eq'-1');
+ return "Please select a studio" if($options->{studio_id}eq'');
+ my $studios=studios::get($config, {studio_id => $options->{studio_id}});
+ return "Sorry. unknown studio" unless defined $studios;
+ return "Sorry. unknown studio" unless @$studios==1;
+ return 1;
+}
+
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
+
diff --git a/lib/calcms/tags.pm b/lib/calcms/tags.pm
new file mode 100644
index 0000000..28b8b56
--- /dev/null
+++ b/lib/calcms/tags.pm
@@ -0,0 +1,24 @@
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+package tags;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_tags);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub get_tags{
+ my $dbh=shift;
+ my $query=qq{
+ select name, count(name) sum from calcms_tags
+ group by name
+ order by sum desc
+ };
+ my $tags=db::get($dbh,$query);
+ return $tags;
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/template.pm b/lib/calcms/template.pm
new file mode 100644
index 0000000..f51c8ce
--- /dev/null
+++ b/lib/calcms/template.pm
@@ -0,0 +1,227 @@
+use warnings "all";
+use strict;
+
+package template;
+use Data::Dumper;
+use HTML::Template::Compiled;
+use HTML::Template::Compiled::Plugin::XMLEscape;
+use JSON;
+use Cwd;
+
+use config;
+use params;
+use project;
+use log;
+use roles;
+
+require Exporter;
+our @ISA = qw(Exporter);
+#our @EXPORT = qw(all);
+our @EXPORT_OK = qw(check process exit_on_missing_permission clear_cache);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub process{
+# my $output=$_[0];
+ my $filename=$_[1];
+ my $params=$_[2];
+
+ my $config=$config::config;
+ for my $key (keys %{$config::config->{locations}}){
+ $params->{$key} =$config::config->{locations}->{$key} if ($key=~/\_url$/);
+ }
+
+ # add current project
+ unless (defined $params->{project_title}){
+ my $projects = project::get_with_dates($config, { name => $config->{project} });
+ if (@$projects==1){
+ my $project= $projects->[0];
+ foreach my $key (keys %$project){
+ $params->{'project_'.$key}=$project->{$key};
+ }
+ }
+ }
+
+ $params->{user}=$ENV{REMOTE_USER} unless defined $params->{user};
+
+ my $user_permissions=roles::get_user_permissions();
+ for my $permission (keys %$user_permissions){
+ $params->{$permission}=$user_permissions->{$permission} if ($user_permissions->{$permission} eq '1');
+ }
+
+ $params->{jobs}=roles::get_user_jobs();
+
+ log::write($config, 'template',$params) if ($config::config->{system}->{debug}>0);
+# my $html_template = HTML::Template->new(
+# filename => $filename,
+# die_on_bad_params =>0,
+## cache =>1,
+## cache_debug => 1
+# );
+
+
+ if (($filename =~/json\-p/) || (params::isJson)){
+ my $header="Content-type:application/json; charset=utf-8\n\n";
+ my $json=to_json($params, {pretty => 1});
+# $json=$header.$params->{json_callback}.'['.$json.']';
+ $json=$header.$params->{json_callback}.$json;
+ if((defined $_[0]) && ($_[0]eq'print')){
+ print $json."\n";
+ }else{
+ $_[0]= $json."\n";
+ }
+ return;
+ }
+ #print STDERR $filename."\n";
+ log::error($config, "cannot find template $filename ") unless -e $filename;
+ log::error($config, "cannot read template $filename ") unless -r $filename;
+
+ my $default_escape='0';
+ $default_escape='JS' if ($filename=~/\.js$/);
+ $default_escape='JS' if ($filename=~/\.json$/);
+ $default_escape='HTML_ALL' if ($filename=~/\.html$/);
+
+ my $html_template=undef;
+
+ unless ($filename=~/\.xml$/){
+ $html_template = HTML::Template::Compiled->new(
+ filename => $filename,
+ die_on_bad_params => 0,
+ case_sensitive => 0,
+ loop_context_vars => 0,
+ global_vars => 0,
+ tagstyle => '-asp -comment',
+ default_escape => $default_escape,
+ cache => 0,
+ utf8 => 1,
+ );
+ }else{
+ $html_template = HTML::Template::Compiled->new(
+ filename => $filename,
+ die_on_bad_params => 0,
+ case_sensitive => 1,
+ loop_context_vars => 0,
+ global_vars => 0,
+ tagstyle => '-asp -comment',
+ default_escape => 'XML',
+ plugin => [qw(HTML::Template::Compiled::Plugin::XMLEscape)],
+ utf8 => 1
+ );
+ }
+
+ #$params=
+ setRelativeUrls($params,0) unless (defined $params->{extern}) && ($params->{extern} eq '1');
+
+# HTML::Template::Compiled->preload($cache_dir);
+ $html_template->param($params);
+ if((defined $_[0]) && ($_[0]eq'print')){
+ print $html_template->output;
+ }else{
+ $_[0]=$html_template->output;
+ }
+}
+
+# set relative urls in nested params structure
+sub setRelativeUrls{
+ my $params=shift;
+ my $depth=shift || 0;
+
+ #print STDERR "setRelativeUrls depth:$depth ".ref($params)."\n";
+
+ return unless defined $params;
+
+ if ($depth>10){
+ print STDERR "prevent deep recursion in template::setRelativeUrls()\n";
+ return ;
+ }
+
+ # set recursive for hash
+ if (ref($params) eq 'HASH'){
+ for my $key (keys %$params){
+ #next unless ($key eq 'icon') || ($key eq 'thumb');
+ my $val=$params->{$key};
+ next unless defined $val;
+ if (ref($val) eq ''){
+ # make link relative
+ $params->{$key} =~s/^https?\:(\/\/[^\/]+)/$1/;
+ }elsif ( (ref($val) eq 'HASH') || (ref($val) eq 'ARRAY') ){
+ setRelativeUrls($params->{$key}, $depth+1);
+ }
+ }
+ return $params;
+ }
+
+ # set recursive for arrays
+ if (ref($params) eq 'ARRAY'){
+ for my $i (0..@$params){
+ my $val=$params->[$i];
+ next unless defined $val;
+ if ( (ref($val) eq 'HASH') || (ref($val) eq 'ARRAY') ){
+ setRelativeUrls($params->[$i], $depth+1);
+ }
+ }
+ return $params;
+ }
+
+ return $params;
+}
+
+#requires read config
+sub check{
+ my $template=shift||'';
+ my $default=shift;
+
+ if($template =~/json\-p/){
+ $template=~s/[^a-zA-Z0-9\-\_\.]//g;
+ $template=~s/\.{2,99}/\./g;
+ return $template;
+ }
+
+ my $config=$config::config;
+ if ($template eq''){
+ $template=$default;
+ }else{
+ $template=~s/^\.\///gi;
+ #template does use ';' in filename
+ log::error($config, 'invalid template!') if ($template=~/;/);
+ #template does use '..' in filename
+ log::error($config, 'invalid template!') if ($template=~/\.\./);
+ }
+ #print STDERR $config::config->{cache}->{compress}."<.compres default:$template\n";
+ $template=(split(/\//,$template))[-1];
+ my $cwd=getcwd();
+
+ $template.='.html' unless ($template=~/\./);
+ if (($config::config->{cache}->{compress}eq'1') && (-e $cwd.'/templates/compressed/'.$template)){
+ $template=$cwd.'/templates/compressed/'.$template;
+ }elsif (-e $cwd.'/templates/'.$template){
+ $template=$cwd.'/templates/'.$template;
+ }else{
+ log::error($config, "template not found: '$cwd/$template'");
+
+ }
+
+ log::error($config, "missing permission to read template '$template'") unless (-r $template);
+ return $template;
+}
+
+#deprecated (for old admin only)
+sub exit_on_missing_permission{
+ my $permission=shift;
+ my $user_permissions=roles::get_user_permissions();
+ if ($user_permissions->{$permission} ne '1'){
+ print STDERR "missing permission to $permission\n";
+ template::process('print', template::check('default.html'), {error => 'sorry, missing permission!'});
+ die();
+ #exit;
+ }
+}
+
+sub clear_cache{
+ HTML::Template::Compiled->clear_cache();
+# return;
+# my $html_template = HTML::Template::Compiled->new();
+# $html_template->clear_cache();
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/time.pm b/lib/calcms/time.pm
new file mode 100644
index 0000000..0a5a118
--- /dev/null
+++ b/lib/calcms/time.pm
@@ -0,0 +1,586 @@
+use warnings "all";
+use strict;
+use Time::Local;
+use DateTime;
+use Date::Calc;
+use Date::Manip;
+use POSIX qw(strftime);
+use config;
+
+package time;
+use Data::Dumper;
+use utf8;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ format_datetime format_time
+ date_format time_format
+ datetime_to_time time_to_datetime time_to_date
+ datetime_to_date
+ add_days_to_datetime add_hours_to_datetime add_minutes_to_datetime
+ add_days_to_date
+ datetime_to_array date_to_array array_to_date array_to_datetime array_to_time array_to_time_hm
+ date_cond time_cond check_date check_time check_datetime check_year_month
+ datetime_to_rfc822 get_datetime datetime_to_utc datetime_to_utc_datetime
+ get_duration get_duration_seconds
+ get_durations get_names get_all_names get_weekdays weekday_index
+ $names
+);
+
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+our $names={
+ 'de' =>{
+ months =>['Januar','Februar','März','April','Mai','Juni','Juli','August','September','Oktober','November','Dezember'],
+ months_abbr =>['Jan','Feb','Mär','Apr','Mai','Jun','Jul','Aug','Sep','Okt','Nov','Dez'],
+ weekdays =>['Montag','Dienstag','Mittwoch','Donnerstag','Freitag','Samstag','Sonntag'],
+ weekdays_abbr =>['Mo','Di','Mi','Do','Fr','Sa','So'],
+ },
+ 'en' =>{
+ months =>['January','February','March','April','May','June','Jule','August','September','October','November','December'],
+ months_abbr =>['Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'],
+ weekdays =>['Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday'],
+ weekdays_abbr =>['Mo','Tu','We','Th','Fr','Sa','Su'],
+ },
+};
+
+our $durations=[
+ 0, 5,10,15,20,30,40,45,50,60,70,75,80,90,100,105,110,115,120,135,150,165,180,195,210,225,240,300,360,420,480,540,600,660,720,1440
+];
+
+sub get_names{
+ my $language=shift||'en';
+ return $time::names->{$language};
+}
+
+sub get_all_names{
+ return $time::names;
+}
+
+sub get_durations{
+ return $time::durations;
+}
+
+#TODO: build from datenames
+our $weekday_index={
+ '0' => 0,
+ '1' => 1,
+ '2' => 2,
+ '3' => 3,
+ '4' => 4,
+ '5' => 5,
+ '6' => 6,
+ 'Mo'=> 0,
+ 'Tu'=> 1,
+ 'Di'=> 1,
+ 'We'=> 2,
+ 'Mi'=> 2,
+ 'Th'=> 3,
+ 'Do'=> 3,
+ 'Fr'=> 4,
+ 'Sa'=> 5,
+ 'Su'=> 6,
+ 'So'=> 6
+};
+
+sub get_weekdays{
+ return{
+ 0 => 0,
+ 1 => 1,
+ 2 => 2,
+ 3 => 3,
+ 4 => 4,
+ 5 => 5,
+ 6 => 6,
+ 'Mo'=>0,
+ 'Tu'=>1,
+ 'Di'=>1,
+ 'We'=>2,
+ 'Mi'=>2,
+ 'Th'=>3,
+ 'Do'=>3,
+ 'Fr'=>4,
+ 'Sa'=>5,
+ 'Su'=>6,
+ 'So'=>6
+ };
+}
+
+
+#deprecated, for wordpress sync
+sub format_datetime{
+ my $datetime=shift;
+ return $datetime if ($datetime eq '');
+ return add_hours_to_datetime($datetime,0);
+};
+
+#deprecated
+sub format_time{
+ my $t=$_[0];
+
+ my $year =$t->[5]+1900;
+ my $month =$t->[4]+1;
+ $month ='0'.$month if(length($month)==1);
+
+ my $day =$t->[3];
+ $day ='0'.$day if(length($day)==1);
+
+
+ my $hour =$t->[2];
+ $hour ='0'.$hour if(length($hour)==1);
+
+ my $minute =$t->[1];
+ $minute ='0'.$minute if(length($minute)==1);
+
+ return [$day,$month,$year,$hour,$minute];
+};
+
+
+# convert datetime to unix time
+sub datetime_to_time{
+ my $datetime=$_[0];
+# print $datetime."\n";
+ if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)[T\s](\d+)\:(\d+)(\:(\d+))?/){
+ my $year=$1;
+ my $month=$2-1;
+ my $day=$3;
+ my $hour=$4;
+ my $minute=$5;
+ my $second=$8||0;
+ return Time::Local::timelocal($second,$minute,$hour,$day,$month,$year);
+
+ }else{
+ print STDERR "datetime_to_time: no valid date time found! ($datetime )\n";
+ return -1;
+ }
+};
+
+#get rfc822 datetime string from datetime string
+sub datetime_to_rfc822{
+ my $datetime=$_[0];
+ my $time=datetime_to_time($datetime);
+ return POSIX::strftime("%a, %d %b %Y %H:%M:%S %z", localtime($time));
+}
+
+#get seconds from epoch
+sub datetime_to_utc{
+ my $datetime=shift;
+ my $time_zone=shift;
+ $datetime=get_datetime($datetime, $time_zone);
+ return $datetime->epoch();
+}
+
+# get full utc datetime including timezone offset
+sub datetime_to_utc_datetime{
+ my $datetime=shift;
+ my $time_zone=shift;
+ $datetime=get_datetime($datetime, $time_zone);
+ return $datetime->format_cldr("yyyy-MM-ddTHH:mm:ssZZZZZ");
+}
+
+
+
+#add hours to datetime string
+sub add_hours_to_datetime{
+ my $datetime=shift;
+ my $hours=shift;
+ return time_to_datetime(datetime_to_time($datetime)+(3600*$hours));
+};
+
+#add minutes to datetime string
+sub add_minutes_to_datetime{
+ my $datetime=shift;
+ my $minutes=shift;
+ return time_to_datetime(datetime_to_time($datetime)+(60*$minutes));
+};
+
+#add days to datetime string
+sub add_days_to_datetime{
+ my $datetime=shift;
+ my $days=shift;
+ my $time=datetime_to_array($datetime);
+ #print STDERR Dumper($time);
+ ($time->[0], $time->[1], $time->[2]) =Date::Calc::Add_Delta_Days($time->[0]+0, $time->[1]+0, $time->[2]+0, $days);
+ return array_to_datetime($time);
+}
+
+sub add_days_to_date{
+ my $datetime=shift;
+ my $days=shift;
+ my $date=date_to_array($datetime);
+ ($date->[0], $date->[1], $date->[2]) =Date::Calc::Add_Delta_Days($date->[0]+0, $date->[1]+0, $date->[2]+0, $days);
+ return array_to_date($date);
+}
+
+# convert unix time to datetime format
+sub time_to_datetime{
+ my $time=shift;
+ $time=time() unless((defined $time) && ($time ne''));
+ my @t=localtime($time);
+ return sprintf('%04d-%02d-%02d %02d:%02d:%02d', $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);
+};
+
+# convert unix time to date format
+sub time_to_date{
+ my $time=shift;
+ $time=time() unless((defined $time) && ($time ne''));
+ my @t=localtime($time);
+ return sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]);
+};
+
+# convert datetime to a array of date/time values
+sub datetime_to_array{
+ my $datetime=$_[0]||'';
+ if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)([T\s]+(\d+)\:(\d+)(\:(\d+))?)?/){
+ my $year=$1;
+ my $month=$2;
+ my $day=$3;
+ my $hour=$5||'00';
+ my $minute=$6||'00';
+ my $second=$8||'00';
+ return [$year,$month,$day,$hour,$minute,$second];
+ }
+ return undef;
+};
+
+# convert datetime to date
+sub datetime_to_date{
+ my $datetime=$_[0]||'';
+ if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)/){
+ my $year=$1;
+ my $month=$2;
+ my $day=$3;
+ return sprintf("%04d-%02d-%02d",$year,$month,$day);
+ }
+ return undef;
+};
+
+#convert datetime array or single value to datetime string
+sub array_to_datetime{
+ my $date =shift;
+ if(ref($date)eq'ARRAY'){
+ return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $date->[0], $date->[1], $date->[2], $date->[3], $date->[4], $date->[5]);
+ }
+ my $month =shift;
+ my $day =shift;
+ my $hour =shift||'0';
+ my $minute =shift||'0';
+ my $second =shift||'0';
+ return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $date, $month, $day, $hour, $minute, $second);
+}
+
+#convert date array or single values to date string
+sub array_to_date{
+ my $date =shift;
+ if(ref($date)eq'ARRAY'){
+ return sprintf("%04d-%02d-%02d", $date->[0], $date->[1], $date->[2]);
+ }
+ my $month=shift;
+ my $day =shift;
+ return sprintf("%04d-%02d-%02d", $date, $month, $day);
+}
+
+sub array_to_time{
+ my $date =shift;
+ if(ref($date)eq'ARRAY'){
+ return sprintf("%02d:%02d:%02d", $date->[3], $date->[4], $date->[5]);
+ }
+ my $minute = shift||0;
+ my $second = shift||0;
+ return sprintf("%02d:%02d:%02d", $date, $minute, $second);
+}
+
+sub array_to_time_hm{
+ my $date =shift;
+ if(ref($date)eq'ARRAY'){
+ return sprintf("%02d:%02d", $date->[3], $date->[4]);
+ }
+ my $minute = shift||0;
+ return sprintf("%02d:%02d", $date, $minute);
+}
+
+
+# get number of days between two days
+sub days_between{
+ my $today=$_[0];
+ my $date=$_[1];
+ my $delta_days=eval{Date::Calc::Delta_Days(
+ $today->[0],$today->[1],$today->[2],
+ $date->[0], $date->[1], $date->[2]
+ )};
+ return $delta_days;
+}
+
+sub dayOfYear{
+ my $datetime=$_[0];
+ if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)/){
+ my $year = $1;
+ my $month = $2;
+ my $day = $3;
+ return Date::Calc::Day_of_Year($year,$month,$day);
+ }
+ return undef;
+}
+
+# get duration in minutes
+sub get_duration{
+ my $start = shift;
+ my $end = shift;
+ my $timezone= shift;
+ $start=time::get_datetime($start, $timezone);
+ $end =time::get_datetime($end, $timezone);
+ my $duration=$end->epoch()-$start->epoch();
+ return $duration/60;
+}
+
+# get duration in seconds
+sub get_duration_seconds{
+ my $start = shift;
+ my $end = shift;
+ my $timezone= shift||'UTC';
+ $start=time::get_datetime($start, $timezone);
+ $end =time::get_datetime($end, $timezone);
+ my $duration=$end->epoch()-$start->epoch();
+ return $duration;
+}
+
+# convert date string to a array of date values
+sub date_to_array{
+ my $datetime=$_[0];
+ if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)/){
+ my $year = $1;
+ my $month = $2;
+ my $day = $3;
+ return [$year,$month,$day];
+ }
+ return undef;
+};
+
+# parse date string and return date string
+# pass 'today', return '' on parse error
+sub date_cond{
+ my $date=shift;
+
+ return '' if ($date eq'');
+ if ($date=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)/){
+ my $year = $1;
+ my $month = $2;
+ my $day = $3;
+ return sprintf("%04d-%02d-%02d", $year, $month, $day);
+ }
+ return 'today' if ($date eq 'today');
+ return '';
+};
+
+#parse time and return time string hh:mm:ss
+#return hh:00 if time is 'now'
+sub time_cond{
+ my $time = shift;
+
+ return '' if ($time eq'');
+ if ($time=~/(\d\d?)\:(\d\d?)(\:(\d\d))?/){
+ my $hour=$1;
+ my $minute=$2;
+ my $second=$4||'00';
+ return sprintf("%02d:%02d:%02d", $hour, $minute, $second);
+ }
+ if ($time eq 'now'){
+ my $date=datetime_to_array(time_to_datetime(time()));
+ my $hour=$date->[3]-2;
+ $hour=0 if ($hour<0);
+ $time=sprintf("%02d:00",$hour);
+ return $time;
+ }
+ return '';
+};
+
+#parse date and time string and return yyyy-mm-ddThh:mm:ss
+sub datetime_cond{
+ my $datetime = shift;
+
+ return '' if ($datetime eq'');
+ (my $date,my $time)=split /[ T]/,$datetime;
+ $date=time::date_cond($date);
+ return '' if ($date eq'');
+ $time=time::time_cond($time);
+ return '' if ($time eq'');
+
+ return $date.'T'.$time;
+}
+
+sub check_date{
+ my $date=shift;
+
+ return "" if((!defined $date) || ($date eq ''));
+ if($date=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)/){
+ return $1.'-'.$2.'-'.$3;
+ }elsif($date=~/(\d\d?)\.(\d\d?)\.(\d\d\d\d)/){
+ return $3.'-'.$2.'-'.$1;
+ }
+ return $date if ($date eq'today' || $date eq'tomorrow' || $date eq'yesterday');
+ return -1;
+ #error("no valid date format given!");
+};
+
+sub check_time{
+ my $time=shift;
+ return "" if((!defined $time) || ($time eq ''));
+ return $time if(($time eq 'now') || ($time eq 'future'));
+ if($time=~/(\d\d?)\:(\d\d?)/){
+ return $1.':'.$2
+ }
+ return -1;
+};
+
+sub check_datetime{
+ my $date=shift;
+
+ return "" if((!defined $date) || ($date eq ''));
+ if($date=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)[T ](\d\d?)\:(\d\d?)/){
+ return sprintf("%04d-%02d-%02dT%02d:%02d",$1,$2,$3,$4,$5);
+ }
+ return -1;
+};
+
+sub check_year_month{
+ my $date=shift;
+ return -1 unless(defined $date);
+ return $date if($date eq '');
+ if($date=~/(\d\d\d\d)\-(\d\d?)/){
+ return $1.'-'.$2.'-'.$3;
+ }
+ return -1;
+};
+
+#TODO: remove config dependency
+sub date_time_format{
+ my $datetime=shift;
+ my $language=shift || $config::config->{date}->{language} || 'en';
+ if (defined $datetime && $datetime=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)[\sT](\d\d?\:\d\d?)/){
+ my $time=$4;
+ my $day=$3;
+ my $month=$2;
+ my $year=$1;
+
+ $month=$time::names->{$language}->{months_abbr}->[$month-1]||'';
+ return "$day. $month $year $time";
+ }
+ return $datetime;
+}
+
+#format datetime to date string
+#TODO: remove config dependency
+sub date_format{
+ my $datetime=shift;
+ my $language=shift || $config::config->{date}->{language} || 'en';
+
+ if (defined $datetime && $datetime=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)/){
+ my $day=$3;
+ my $month=$2;
+ my $year=$1;
+ $month=$time::names->{$language}->{months_abbr}->[$month-1]||'';
+ return "$day. $month $year";
+ }
+ return $datetime;
+};
+
+#format datetime to time string
+sub time_format{
+ my $datetime=shift;
+ if (defined $datetime && $datetime=~/(\d\d?\:\d\d?)/){
+ return $1;
+ }
+ return $datetime;
+};
+
+#get offset from given time_zone
+sub utc_offset{
+ my $time_zone=shift;
+
+ $a=DateTime->now();
+ $a->set_time_zone($time_zone);
+ return $a->strftime("%z");
+}
+
+#get weekday from (yyyy,mm,dd)
+sub weekday{
+ my ($year,$month,$day)=@_;
+ my $time = Time::Local::timelocal(0,0,0,$day,$month-1,$year);
+ return (localtime($time))[6];
+}
+
+#get current date, related to starting day_starting_hour
+#TODO: remove config dependency
+sub get_event_date{
+ my $config=shift;
+ $config=$config::config unless defined $config;
+
+ my $datetime=time::time_to_datetime(time());
+ my $hour=(time::datetime_to_array($datetime))->[3];
+ #today: between 0:00 and starting_hour show last day
+ if ($hour < $config->{date}->{day_starting_hour}){
+ my $date=time::datetime_to_array(time::add_hours_to_datetime($datetime,-24));
+ return $date->[0].'-'.$date->[1].'-'.$date->[2];
+ }else{
+ #today: between starting_hour and end of day show current day
+ my $date=time::datetime_to_array(time::time_to_datetime(time()));
+ return $date->[0]."-".$date->[1]."-".$date->[2];
+ }
+}
+
+#get datetime object from datetime string
+sub get_datetime{
+ my $datetime=shift;
+ my $timezone=shift;
+
+ return unless defined $datetime;
+ return if $datetime eq '';
+ my @l = @{time::datetime_to_array($datetime)};
+ return undef if scalar(@l)==0;
+
+ # catch invalid datees
+ $datetime=undef;
+ eval{
+ $datetime=DateTime->new(
+ year =>$l[0],
+ month =>$l[1],
+ day =>$l[2],
+ hour =>$l[3],
+ minute =>$l[4],
+ second =>$l[5],
+ time_zone=> $timezone
+ );
+ };
+ return undef unless defined $datetime;
+ $datetime->set_locale('de_DE');
+ return $datetime;
+}
+
+#get list of nth weekday in month from start to end
+sub get_nth_weekday_in_month{
+ my $start=shift; # datetime string
+ my $end=shift; # datetime string
+ my $nth=shift; # every nth week of month
+ my $weekday=shift; # weekday [0..6,'Mo'-'Su','Mo'-'Fr']
+
+ my $weekdays=time::get_weekdays();
+ $weekday=$weekdays->{$weekday+1};
+
+ my $dates=[];
+ if ($start=~/(\d\d\d\d)-(\d\d)-(\d\d)[ T](\d\d)\:(\d\d)/){
+ my $hour=int($4);
+ my $min=int($5);
+ my $sec=0;
+ my @date = Date::Manip::ParseRecur("0:1*$nth:$weekday:$hour:$min:$sec", "", $start, $end);
+ for my $date (@date){
+ if ($date=~/(\d\d\d\d)(\d\d)(\d\d)(\d\d)\:(\d\d)\:(\d\d)/){
+ push @$dates,"$1-$2-$3 $4:$5:$6";
+ }
+ }
+ }
+ return $dates;
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/uac.pm b/lib/calcms/uac.pm
new file mode 100644
index 0000000..f35bac2
--- /dev/null
+++ b/lib/calcms/uac.pm
@@ -0,0 +1,818 @@
+#!/bin/perl
+
+use CGI;
+use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
+use CGI::Session qw(-ip-match);
+use CGI::Cookie;
+#$CGI::Session::IP_MATCH=1;
+
+package uac;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use auth;
+use db;
+use template;
+use project;
+use studios;
+#use series;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ get_user get_users update_user insert_user delete_user
+ get_roles insert_role update_role get_role_columns
+ get_studios_by_user get_users_by_studio
+ get_projects_by_user
+ get_user_role get_studio_roles
+ assign_user_role remove_user_role
+ get_user_permissions get_user_presets
+ prepare_request set_template_permissions
+ permission_denied
+);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+# get user by name
+sub get_user{
+ my $config=shift;
+ my $user=shift;
+
+ my $query=qq{
+ select id, name, full_name, email, disabled, modified_at, created_at
+ from calcms_users
+ where name=?
+ };
+ my $bind_values=[$user];
+
+ my $dbh=db::connect($config);
+ my $users=db::get($dbh, $query,$bind_values);
+ if (@$users!=1){
+ print STDERR "cannot find user '$user'\n";
+ return undef;
+ }
+ return $users->[0];
+}
+
+# get all users
+sub get_users{
+ my $config=shift;
+
+ my $query=qq{
+ select id, name, full_name, email, disabled, modified_at, created_at
+ from calcms_users
+ };
+
+ my $dbh=db::connect($config);
+ my $users=db::get($dbh, $query);
+ return $users;
+}
+
+#TODO: get_users_by_project
+
+# get all users of a given studio id
+# used at series (previously named get_studio_users)
+sub get_users_by_studio{
+ my $config=shift;
+ my $condition=shift;
+
+ return unless (defined $condition->{studio_id});
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'ur.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'ur.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ my $conditions='';
+ $conditions=" and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select distinct(u.id), u.name, u.full_name
+ from calcms_user_roles ur, calcms_users u
+ where ur.user_id=u.id
+ $conditions
+ };
+
+ my $dbh=db::connect($config);
+ my $users=db::get($dbh, $query, \@bind_values);
+ return $users;
+}
+
+# get projects a user is assigned by name
+sub get_projects_by_user{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'ur.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'ur.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{user}) && ($condition->{user} ne '')){
+ push @conditions, 'u.name=?';
+ push @bind_values, $condition->{user};
+ }
+
+ my $conditions='';
+ $conditions=" and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select distinct p.*, ur.project_id project_id
+ from calcms_user_roles ur, calcms_users u, calcms_projects p
+ where ur.user_id=u.id and p.project_id=ur.project_id
+ $conditions
+ };
+
+ my $dbh=db::connect($config);
+ my $users=db::get($dbh, $query, \@bind_values);
+ return $users;
+}
+
+# get all studios a user is assigned to by role
+# used at series (previously named get_user_studios)
+sub get_studios_by_user{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'ur.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'ur.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{user}) && ($condition->{user} ne '')){
+ push @conditions, 'u.name=?';
+ push @bind_values, $condition->{user};
+ }
+
+ my $conditions='';
+ $conditions=" and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select distinct s.*, ur.project_id project_id
+ from calcms_user_roles ur, calcms_users u, calcms_studios s
+ where ur.user_id=u.id and s.id=ur.studio_id
+ $conditions
+ };
+ my $dbh=db::connect($config);
+ my $users=db::get($dbh, $query, \@bind_values);
+ return $users;
+}
+
+sub insert_user{
+ my $config=shift;
+ my $entry=shift;
+
+ $entry->{created_at} = time::time_to_datetime(time());
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $dbh=db::connect($config);
+ db::insert($dbh, 'calcms_users', $entry);
+}
+
+sub update_user{
+ my $config=shift;
+ my $entry=shift;
+
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values,$entry->{id};
+
+ my $query=qq{
+ update calcms_users
+ set $values
+ where id=?
+ };
+
+ my $dbh =db::connect($config);
+ db::put($dbh, $query, \@bind_values);
+}
+
+sub delete_user{
+ my $config=shift;
+ my $id=shift;
+ return unless (defined $id && ($id=~/^\d+$/));
+
+ my $query=qq{
+ delete from calcms_users
+ where id=?
+ };
+ my $dbh =db::connect($config);
+ db::put($dbh, $query, [$id]);
+}
+
+
+# get all roles used by all users of a studio
+# available conditions: project_id, studio_id
+sub get_studio_roles{
+ my $config=shift;
+ my $condition=shift;
+
+ return [] if ($condition->{studio_id} eq '');
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'ur.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'ur.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ my $conditions='';
+ $conditions=" and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select r.*, ur.studio_id, ur.project_id
+ from calcms_roles r, calcms_user_roles ur
+ where r.id=ur.role_id
+ $conditions
+ };
+
+ my $dbh=db::connect($config);
+ my $roles=db::get($dbh, $query, \@bind_values);
+ return $roles;
+}
+
+# get role columns (for external use only)
+sub get_role_columns{
+ my $config=shift;
+ my $dbh=db::connect($config);
+ my $columns=db::get_columns_hash($dbh, 'calcms_roles');
+ return $columns
+}
+
+# get roles
+# filter: studio_id project_id
+sub get_roles{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ my $dbh=db::connect($config);
+ my $columns=db::get_columns_hash($dbh, 'calcms_roles');
+
+ for my $column (keys %$columns){
+ if (defined $condition->{$column}){
+ push @conditions, $column.'=?';
+ push @bind_values, $condition->{$column};
+ }
+ }
+ my $conditions='';
+ $conditions=' where '.join(' and ',@conditions) if(@conditions>0);
+
+ my $query=qq{
+ select r.*
+ from calcms_roles r
+ $conditions
+ };
+
+ my $roles=db::get($dbh, $query, \@bind_values);
+
+ return $roles;
+}
+
+#insert role to database, set created_at and modified_at
+sub insert_role{
+ my $config=shift;
+ my $entry=shift;
+
+ $entry->{created_at} = time::time_to_datetime(time());
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $dbh=db::connect($config);
+ my $columns=db::get_columns_hash($dbh, 'calcms_roles');
+;
+ my $role={};
+ for my $column (keys %$columns){
+ $role->{$column}=$entry->{$column} if defined $entry->{$column};
+ }
+ db::insert($dbh, 'calcms_roles', $role);
+}
+
+#update role, set modified_at
+sub update_role{
+ my $config=shift;
+ my $entry=shift;
+
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $dbh =db::connect($config);
+ my $columns=db::get_columns_hash($dbh, 'calcms_roles');
+ my $values =join(",", map {$_.'=?'} (keys %$columns));
+ my @bind_values =map {$entry->{$_}} (keys %$columns);
+ push @bind_values,$entry->{id};
+
+ my $query=qq{
+ update calcms_roles
+ set $values
+ where id=?
+ };
+# print $query."
\n".Dumper(\@bind_values)."
\ņ";
+
+ db::put($dbh, $query, \@bind_values);
+}
+
+# delete role from database
+sub delete_role{
+ my $config=shift;
+ my $id=shift;
+
+ return unless (defined $id && ($id=~/^\d+$/));
+
+ my $query=qq{
+ delete from calcms_roles
+ where id=?
+ };
+ my $dbh =db::connect($config);
+ db::put($dbh, $query, [$id]);
+}
+
+# get all roles for given conditions: project_id, studio_id, user_id, name
+# includes global admin user role
+sub get_user_roles{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if (defined $condition->{user}){
+ push @conditions, 'u.name=?';
+ push @bind_values, $condition->{user};
+ }
+ if (defined $condition->{user_id}){
+ push @conditions, 'ur.user_id=?';
+ push @bind_values, $condition->{user_id};
+ }
+ if (defined $condition->{studio_id}){
+ push @conditions, 'ur.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+ if (defined $condition->{project_id}){
+ push @conditions, 'ur.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ my $conditions='';
+ $conditions= " and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select distinct r.*
+ from calcms_users u, calcms_user_roles ur, calcms_roles r
+ where ur.user_id=u.id and ur.role_id=r.id
+ $conditions
+ };
+
+ my $dbh=db::connect($config);
+ my $user_roles=db::get($dbh, $query, \@bind_values);
+
+ #return roles, if the contain an admin role
+ for my $role(@$user_roles){
+ return $user_roles if $role->{role}eq'Admin';
+ }
+
+ #get all admin roles
+ delete $condition->{studio_id} if defined $condition->{studio_id};
+ delete $condition->{project_id} if defined $condition->{project_id};
+ my $admin_roles=get_admin_user_roles($config, $condition);
+
+ #add admin roles to user roles
+ my @user_roles=(@$admin_roles, @$user_roles);
+ $user_roles=\@user_roles;
+
+ return $user_roles;
+}
+
+#return admin user roles for given conditions: project_id, studio_id, user, user_id
+sub get_admin_user_roles{
+ my $config=shift;
+ my $condition=shift;
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{user}) && ($condition->{user} ne '')){
+ push @conditions, 'u.name=?';
+ push @bind_values, $condition->{user};
+ }
+ if ((defined $condition->{user_id}) && ($condition->{user_id} ne '')){
+ push @conditions, 'ur.user_id=?';
+ push @bind_values, $condition->{user_id};
+ }
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'ur.studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'ur.project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ my $conditions='';
+ $conditions=" and ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select distinct r.*, ur.studio_id, ur.project_id
+ from calcms_users u, calcms_user_roles ur, calcms_roles r
+ where ur.user_id=u.id and ur.role_id=r.id and r.role='Admin'
+ $conditions
+ limit 1
+ };
+
+ my $dbh=db::connect($config);
+ my $user_roles=db::get($dbh, $query, \@bind_values);
+ return $user_roles;
+}
+
+# read permissions for given conditions and add to user_permissions
+# return user_permissions
+# studio_id, user_id, name
+sub get_user_permissions{
+ my $config=shift;
+ my $conditions=shift;
+ my $user_permissions=shift;
+
+ my $user_roles = get_user_roles($config, $conditions);
+ my $admin_roles = get_admin_user_roles($config, $conditions);
+ my @user_roles=(@$admin_roles,@$user_roles);
+
+ #set default permissions
+ $user_permissions={} unless(defined $user_permissions);
+ $user_permissions->{is_admin}=1 if(scalar @$admin_roles>0);
+
+ my $max_level=0;
+ # aggregate max permissions
+ # should be limited by project and studio
+ for my $user_role (@user_roles){
+ if ($user_role->{level}>$max_level){
+ $user_permissions->{level} = $user_role->{level};
+ $user_permissions->{id} = $user_role->{id};
+ $user_permissions->{role} = $user_role->{role};
+ $user_permissions->{studio_id} = $user_role->{studio_id};
+ $user_permissions->{project_id}= $user_role->{project_id};
+ $max_level = $user_role->{level};
+ }
+ for my $permission (keys %$user_role){
+ if (($permission ne 'level') && ($permission ne 'id') && ($permission ne 'role') && ($permission ne 'studio_id') && ($permission ne 'project_id')){
+ $user_permissions->{$permission}=1 if ((defined $user_role->{$permission}) && ($user_role->{$permission} ne '0'));
+ }
+ }
+ }
+ return $user_permissions;
+}
+
+#get user id by user name
+sub get_user_id{
+ my $config=shift;
+ my $user=shift;
+
+ return undef unless (defined $user);
+
+ my $query=qq{
+ select id
+ from calcms_users
+ where binary name=?
+ };
+ my $dbh=db::connect($config);
+ my $users=db::get($dbh, $query, [$user]);
+ return undef if (@$users==0);
+ return $users->[0]->{id};
+}
+
+#get role id by role name
+sub get_role_id{
+ my $config=shift;
+ my $role=shift;
+
+ return undef unless (defined $role);
+
+ my $query=qq{
+ select id
+ from calcms_roles
+ where role=?
+ };
+ my $dbh=db::connect($config);
+ my $roles=db::get($dbh, $query, [$role]);
+ return undef if (@$roles==0);
+ return $roles->[0]->{id};
+}
+
+# assign a role to an user (for a studio)
+sub assign_user_role{
+ my $config=shift;
+ my $options=shift;
+
+ #print STDERR Dumper($options);
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+ return undef unless defined $options->{user_id};
+ return undef unless defined $options->{role_id};
+
+ #return if already exists
+ my $query=qq{
+ select *
+ from calcms_user_roles
+ where project_id=? and studio_id=? and user_id=? and role_id=?
+ };
+ my $dbh=db::connect($config);
+ my $user_roles=db::get($dbh, $query, [$options->{project_id}, $options->{studio_id}, $options->{user_id}, $options->{role_id}]);
+ return undef if (@$user_roles>0);
+
+ #insert entry
+ my $entry={
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ user_id => $options->{user_id},
+ role_id => $options->{role_id},
+ created_at => time::time_to_datetime(time())
+ };
+
+ return db::insert($dbh, 'calcms_user_roles', $entry);
+}
+
+# unassign a user from a role of (for a studio)
+sub remove_user_role{
+ my $config=shift;
+ my $options=shift;
+
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+ return undef unless defined $options->{user_id};
+ return undef unless defined $options->{role_id};
+
+ my $query=qq{
+ delete
+ from calcms_user_roles
+ where project_id=? and studio_id=? and user_id=? and role_id=?
+ };
+ my $bind_values=[ $options->{project_id}, $options->{studio_id}, $options->{user_id}, $options->{role_id} ];
+ #print STDERR Dumper($query).Dumper($bind_values);
+ my $dbh=db::connect($config);
+ my $result=db::put($dbh, $query, $bind_values);
+ # successfully return even if no entry exists
+ return 1;
+}
+
+#checks
+sub is_user_assigned_to_studio{
+ my $request=shift;
+ my $options=shift;
+
+ my $config = $request->{config};
+
+ return 0 unless defined $request->{user};
+ return 0 unless defined $options->{studio_id};
+ return 0 unless defined $options->{project_id};
+
+ my $options2={
+ user => $request->{user},
+ studio_id => $options->{studio_id},
+ project_id => $options->{project_id}
+ };
+
+ my $user_studios=uac::get_studios_by_user($config, $options2);
+ return 1 if(@$user_studios==1);
+ return 0;
+}
+
+# print errors at get_user_presets and check for project id and studio id
+# call after header is printed
+sub check{
+ my $config=shift;
+ my $params=shift;
+ my $user_presets=shift;
+
+ if (defined $user_presets->{error}){
+ uac::print_error($user_presets->{error});
+ return undef;
+ }
+
+ my $project_check=project::check($config, { project_id => $params->{project_id} } );
+ if($project_check ne '1'){
+ uac::print_error($project_check);
+ return undef;
+ }
+
+ my $studio_check=studios::check($config, { studio_id => $params->{studio_id} } );
+ if($studio_check ne '1'){
+ uac::print_error($studio_check);
+ return undef;
+ }
+ return 1;
+}
+
+# get user, projects and studios user is assigned to for selected values from params
+# set permissions for selected project and studio
+# return request
+sub get_user_presets{
+ my $config = shift;
+ my $options = shift;
+
+ my $user = $options->{user}||'';
+ my $error = undef;
+ return {error=>"no user selected"} if ($user eq'');
+
+ my $project_id = $options->{project_id}||'';
+ my $studio_id = $options->{studio_id}||'';
+ $config->{access}->{write}=0;
+
+ #get
+ my $admin_roles = get_admin_user_roles($config, {user=>$user});
+
+ #get all projects by user
+ my $projects = uac::get_projects_by_user($config, {user=>$user});
+ return {error=>"no project is assigned to user"} if(@$projects==0);
+
+ $projects=project::get($config) if(@$admin_roles>0);
+ my @projects=reverse sort {$a->{end_date} cmp $b->{end_date}} (@$projects);
+ $projects=\@projects;
+
+ if ($project_id ne'' && $project_id ne'-1'){
+ my $projectFound=0;
+ for my $project(@$projects){
+ if ($project->{project_id} eq $project_id){
+ $projectFound=1;
+ last;
+ };
+ }
+ return {error=>"project is not assigned to user"} if($projectFound==0);
+ }else{
+ $project_id=$projects->[0]->{project_id};
+ }
+ #print STDERR "project:$project_id\n";
+
+ #check if studios are assigned to project
+ my $studios = project::get_studios($config, {project_id => $project_id});
+ $error="no studio is assigned to project" if (@$studios==0);
+
+ if(@$admin_roles==0){
+ #get all studios by user
+ $studios=uac::get_studios_by_user($config, {user=>$user, project_id=>$project_id});
+ $error="no studio is assigned to user" if (@$studios==0);
+ if (($studio_id ne '')&&($studio_id ne '-1')){
+ my $studioFound=0;
+ for my $studio(@$studios){
+ if ($studio->{id} eq $studio_id){
+ $studioFound=1;
+ last;
+ };
+ }
+ $error="studio is not assigned to user" if($studioFound==0);
+ }else{
+ $studio_id =$studios->[0]->{id};
+ }
+ }else{
+ #for admin get studios by project
+ $studios = studios::get($config, {project_id => $project_id});
+ if (($studio_id ne '')&&($studio_id ne '-1')){
+ my $studioFound=0;
+ for my $studio(@$studios){
+ if ($studio->{id} eq $studio_id){
+ $studioFound=1;
+ last;
+ };
+ }
+ $error="studio is not assigned to project" if($studioFound==0);
+ }else{
+ $studio_id =$studios->[0]->{id};
+ }
+ }
+
+ my $permissions=uac::get_user_permissions($config, {user=>$user, project_id=>$project_id, studio_id=>$studio_id});
+
+ #only admin is allowed to select all projects
+# if($permissions->{is_admin}==1){
+# $projects=project::get($config);
+# }
+
+ #set studios and projects as selected, TODO:do in JS
+ my $selectedProject={};
+ for my $project(@$projects){
+ if ($project_id eq $project->{project_id}){
+ $project->{selected}='selected="selected"';
+ $selectedProject=$project;
+ last;
+ };
+ }
+
+ my $selectedStudio={};
+ for my $studio(@$studios){
+ if ($studio_id eq $studio->{id}){
+ $studio->{selected}='selected="selected"';
+ $selectedStudio=$studio;
+ last;
+ };
+ }
+
+ my $logout_url=(split(/\//, $0))[-1];
+
+ #print STDERR "ok\n";
+ my $result={
+ user => $user,
+ logout_url => $logout_url,
+
+ project_id => $project_id, # from parameter or default
+ projects => $projects,
+ project => $selectedProject,
+
+ studio_id => $studio_id, # from parameter or default
+ studios => $studios,
+ studio => $selectedStudio,
+
+ permissions => $permissions, # from parameter or default
+ config => $config
+ };
+ $result->{error}=$error if defined $error;
+ return $result;
+}
+
+#set user preset properties to request
+sub prepare_request{
+ my $request=shift;
+ my $user_presets=shift;
+
+ for my $key (keys %$user_presets){
+ $request->{$key}=$user_presets->{$key};
+ }
+ #enrich menu parameters
+ for my $key ('studio_id', 'project_id', 'studio', 'project', 'studios', 'projects', 'user', 'logout_url'){
+ $request->{params}->{checked}->{presets}->{$key}=$user_presets->{$key};
+ }
+ return $request;
+}
+
+#TODO: shift to permissions sub entry
+sub set_template_permissions{
+ my $permissions = shift;
+ my $params = shift;
+
+ for my $usecase (keys %$permissions){
+ $params->{'allow'}->{$usecase}=1 if ($permissions->{$usecase}eq'1');
+ }
+ return $params;
+}
+
+#print error message
+sub permissions_denied{
+ my $message=shift;
+ $message=~s/_/ /g;
+ print 'Sorry! Missing permissions to '.$message.''."\n";
+ print STDERR 'Sorry! Missing permissions to '.$message."\n";
+}
+
+sub print_info{
+ print ''
+ .' '
+ .$_[0]
+ .''."\n";
+}
+
+sub print_warn{
+ print ''
+ .' '
+ .$_[0]
+ .''."\n";
+}
+
+sub print_error{
+ print ''
+ .' '
+ .$_[0].
+ ''."\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/user_settings.pm b/lib/calcms/user_settings.pm
new file mode 100644
index 0000000..08db559
--- /dev/null
+++ b/lib/calcms/user_settings.pm
@@ -0,0 +1,214 @@
+package user_settings;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use series_dates;
+
+# table: calcms_user_settings
+# columns: user, colors
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(getColors getColorCss get insert update delete get_columns defaultColors);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+our $defaultColors=[
+ {
+ name => 'color_event',
+ css => '#content .event',
+ color => '#c5e1a5'
+ },{
+ name => 'color_schedule',
+ css => '#content .schedule',
+ color => '#dde4e6',
+ },{
+ name => 'color_published',
+ css => '#content .event.published',
+ color => '#a5d6a7',
+ },{
+ name => 'color_no_series',
+ css => '#content .event.no_series',
+ color => '#fff59d',
+ },{
+ name => 'color_marked',
+ css => '#content .event.marked',
+ color => '#81d4fa',
+ },{
+ name => 'color_event_error',
+ css => '#content.conflicts .event.error',
+ color => '#ffab91',
+ },{
+ name => 'color_schedule_error',
+ css => '#content.conflicts .schedule.error',
+ color => '#ffcc80'
+ },{
+ name => 'color_work',
+ css => '#content .work',
+ color => '#b39ddb'
+ },{
+ name => 'color_playout',
+ css => '#content .play',
+ color => '#90caf9'
+ }
+];
+
+sub getColors{
+ my $config=shift;
+ my $conditions=shift;
+ return unless defined $conditions->{user};
+ my $user=$conditions->{user};
+
+ #get defaultColors
+ my $colors=[];
+ my $colorMap={};
+ for my $defaultColor (@$defaultColors){
+ my $color= {
+ name => $defaultColor->{name},
+ css => $defaultColor->{css},
+ color => $defaultColor->{color},
+ };
+ push @$colors,$color;
+ $colorMap->{$color->{css}}=$color;
+ }
+
+ my $settings = user_settings::get($config, {user => $user });
+ $settings->{colors} |='';
+ #overwrite colors from user settings
+ for my $line (split(/\n+/, $settings->{colors})){
+ my ($key,$value)=split(/\=/,$line);
+ $key=~s/^\s+//;
+ $key=~s/\s+$//;
+ $value=~s/^\s+//;
+ $value=~s/\s+$//;
+ $colorMap->{$key}->{color}=$value if (($key ne '')&&($value ne '')&&(defined $colorMap->{$key}));
+ }
+ return $colors;
+}
+
+sub getColorCss{
+ my $config=shift;
+ my $conditions=shift;
+ return unless defined $conditions->{user};
+
+ my $shift=20;
+ my $limit=220;
+
+ my $colors=getColors($config, $conditions);
+ my $style="\n";
+ return $style;
+}
+
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_user_settings');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{user}) && ($condition->{user} ne '')){
+ push @conditions, 'user=?';
+ push @bind_values, $condition->{user};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_user_settings
+ $conditions
+ };
+ #print $query."\n";
+ #print Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ return $entries->[0]||undef;
+}
+
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless(defined $entry->{user});
+ return unless(defined $entry->{colors});
+ my $dbh=db::connect($config);
+ return db::insert($dbh, 'calcms_user_settings', $entry);
+}
+
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless(defined $entry->{user});
+ return unless(defined $entry->{colors});
+
+ my $dbh=db::connect($config);
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values,$entry->{user};
+
+ my $query=qq{
+ update calcms_user_settings
+ set $values
+ where user=?
+ };
+ db::put($dbh, $query, \@bind_values);
+ print "done\n";
+}
+
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ return unless(defined $entry->{user});
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_user_settings
+ where user=?
+ };
+ my $bind_values=[$entry->{user}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ db::put($dbh, $query, $bind_values);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/user_stats.pm b/lib/calcms/user_stats.pm
new file mode 100644
index 0000000..aa537e4
--- /dev/null
+++ b/lib/calcms/user_stats.pm
@@ -0,0 +1,247 @@
+#!/bin/perl
+
+package user_stats;
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get update insert get_stats increase);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_user_stats');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{user}) && ($condition->{user} ne '')){
+ push @conditions, 'user=?';
+ push @bind_values, $condition->{user};
+ }
+
+ my $limit='';
+ if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
+ $limit= 'limit '.$condition->{limit};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_user_stats
+ $conditions
+ order by modified_at desc
+ $limit
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $results=db::get($dbh, $query, \@bind_values);
+ return $results;
+}
+
+sub get_stats{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
+ push @conditions, 'series_id=?';
+ push @bind_values, $condition->{series_id};
+ }
+
+ if ((defined $condition->{user}) && ($condition->{user} ne '')){
+ push @conditions, 'user=?';
+ push @bind_values, $condition->{user};
+ }
+
+ my $limit='';
+ if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
+ $limit= 'limit '.$condition->{limit};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select user, project_id, studio_id,
+ max(modified_at) modified_at,
+ sum(create_events) create_events,
+ sum(update_events) update_events,
+ sum(delete_events) delete_events,
+ sum(create_series) create_series,
+ sum(update_series) update_series,
+ sum(delete_series) delete_series
+ from calcms_user_stats
+ $conditions
+ group by user, project_id, studio_id
+ $limit
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+
+ my $results=db::get($dbh, $query, \@bind_values);
+ for my $result (@$results){
+ $result->{score}=0;
+ for my $column ('create_events','update_events','delete_events','create_series','update_series','delete_series'){
+ $result->{score}+=$result->{$column};
+ }
+ }
+ my @results=reverse sort {$a->{score} <=> $b->{score}} @$results;
+ return \@results;
+}
+
+sub insert{
+ my $config=shift;
+ my $stats=shift;
+
+ return undef unless defined $stats->{project_id};
+ return undef unless defined $stats->{studio_id};
+ return undef unless defined $stats->{series_id};
+ return undef unless defined $stats->{user};
+
+ #TODO:filter for existing attributes
+ my $columns=get_columns($config);
+ my $entry={};
+ for my $column (keys %$columns){
+ $entry->{$column}=$stats->{$column} if defined $stats->{$column};
+ }
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $dbh=db::connect($config);
+ my $id=db::insert($dbh, 'calcms_user_stats', $entry);
+ return $id;
+}
+
+# update project
+sub update{
+ my $config=shift;
+ my $stats=shift;
+
+ return undef unless defined $stats->{project_id};
+ return undef unless defined $stats->{studio_id};
+ return undef unless defined $stats->{series_id};
+ return undef unless defined $stats->{user};
+
+ my $columns=get_columns($config);
+ my $entry={};
+ for my $column (keys %$columns){
+ $entry->{$column}=$stats->{$column} if defined $stats->{$column};
+ }
+ $entry->{modified_at}= time::time_to_datetime(time());
+
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+ push @bind_values, $entry->{user};
+ push @bind_values, $entry->{project_id};
+ push @bind_values, $entry->{studio_id};
+ push @bind_values, $entry->{series_id};
+
+ my $query=qq{
+ update calcms_user_stats
+ set $values
+ where user=? and project_id=? and studio_id=? and series_id=?
+ };
+ #print STDERR Dumper($query).Dumper(\@bind_values);
+ my $dbh=db::connect($config);
+ return db::put($dbh, $query, \@bind_values);
+}
+
+sub increase{
+ my $config=shift;
+ my $usecase=shift;
+ my $options=shift;
+
+ #print STDERR Dumper($usecase)." ".Dumper($options);
+
+ return undef unless defined $usecase;
+ return undef unless defined $options->{project_id};
+ return undef unless defined $options->{studio_id};
+ return undef unless defined $options->{series_id};
+ return undef unless defined $options->{user};
+
+ #print STDERR "ok\n";
+
+ my $columns=get_columns($config);
+ #print STDERR "columns:".Dumper($columns);
+ return undef unless defined $columns->{$usecase};
+
+ my $entries= get($config,$options);
+ #print STDERR "exist:".Dumper($columns);
+
+ if (@$entries==0){
+ my $entry={
+ project_id => $options->{project_id},
+ studio_id => $options->{studio_id},
+ series_id => $options->{series_id},
+ user => $options->{user},
+ $usecase => 1,
+ };
+ #print STDERR "user_stats::insert\n";
+ return insert($config, $entry);
+ }elsif (@$entries==1){
+ my $entry=$entries->[0];
+ $entry->{$usecase}++ if defined
+ #print STDERR "user_stats::update\n";
+ return update($config, $entry);
+ }else{
+ print STDERR "user_stats: to few options given: $usecase,".Dumper($options)."\n";
+ }
+
+}
+
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/work_dates.pm b/lib/calcms/work_dates.pm
new file mode 100644
index 0000000..c945ad5
--- /dev/null
+++ b/lib/calcms/work_dates.pm
@@ -0,0 +1,385 @@
+package work_dates;
+
+use warnings "all";
+use strict;
+use Data::Dumper;
+use Date::Calc;
+use time;
+use db;
+use log;
+use studio_timeslot_dates;
+use work_schedule;
+
+# schedule dates for work_schedule
+# table: calcms_work_dates
+# columns: id, studio_id, schedule_id, start(datetime), end(datetime)
+# TODO: delete column schedule_id
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get insert update delete get_dates);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_work_dates');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+# get all work_dates for studio_id and schedule_id within given time range
+# calculate start_date, end_date, weeday, day from start and end(datetime)
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $date_range_include=0;
+ $date_range_include=1 if $condition->{date_range_include}==1;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'schedule_id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
+ push @conditions, 'start=?';
+ push @bind_values, $condition->{start_at};
+ }
+
+ if ((defined $condition->{from}) && ($condition->{from} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'end_date>=?';
+ push @bind_values, $condition->{from};
+ }else{
+ push @conditions, 'start_date>=?';
+ push @bind_values, $condition->{from};
+ }
+ }
+
+ if ((defined $condition->{till}) && ($condition->{till} ne '')){
+ if ($date_range_include==1){
+ push @conditions, 'start_date<=?';
+ push @bind_values, $condition->{till};
+ }else{
+ push @conditions, 'end_date<=?';
+ push @bind_values, $condition->{till};
+ }
+ }
+
+ if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
+ push @conditions, 'exclude=?';
+ push @bind_values, $condition->{exclude};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select date(start) start_date
+ ,date(end) end_date
+ ,dayname(start) weekday
+ ,start_date day
+ ,start
+ ,end
+ ,schedule_id
+ ,studio_id
+ ,project_id
+ ,exclude
+ ,type
+ ,title
+
+ from calcms_work_dates
+ $conditions
+ order by start
+ };
+ #print STDERR $query."\n";
+ #print STDERR Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ for my $entry (@$entries){
+ $entry->{weekday}=substr($entry->{weekday},0,2);
+ }
+
+ return $entries;
+}
+
+
+#update work dates for all schedules of a work and studio_id
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id} ;
+ return undef unless defined $entry->{studio_id} ;
+ return undef unless defined $entry->{schedule_id} ;
+
+ my $dbh=db::connect($config);
+
+ #delete all existing work dates (by project, studio and schedule id)
+ work_dates::delete($config, $entry);
+
+ my $day_start=$config->{date}->{day_starting_hour};
+
+ #get all schedules for schedule id ordered by exclude, date
+ my $schedules=work_schedule::get($config, {
+ project_id => $entry->{project_id},
+ studio_id => $entry->{studio_id},
+ schedule_id => $entry->{schedule_id},
+ });
+
+ #add scheduled work dates and remove exluded dates
+ my $work_dates={};
+
+ #TODO:set schedules exclude to 0 if not 1
+ #insert all normal dates (not excludes)
+ for my $schedule (@$schedules){
+ my $dates=get_schedule_dates($schedule, {exclude => 0});
+ for my $date (@$dates){
+ $date->{exclude}=0;
+ $work_dates->{$date->{start}}=$date;
+ #print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
+ }
+ }
+
+ #insert / overwrite all exlude dates
+ for my $schedule (@$schedules){
+ my $dates=get_schedule_dates($schedule, {exclude => 1});
+ for my $date (@$dates){
+ $date->{exclude}=1;
+ $work_dates->{$date->{start}}=$date;
+ #print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
+ }
+ }
+
+ #print STDERR Dumper($work_dates->{'2014-02-05 19:00:00'});
+
+ my $request={
+ config => $config
+ };
+
+ my $i=0;
+ my $j=0;
+ for my $date (keys %$work_dates){
+ my $work_date=$work_dates->{$date};
+ #insert date
+ my $entry={
+ project_id => $entry->{project_id},
+ studio_id => $entry->{studio_id},
+ schedule_id => $entry->{schedule_id},
+ title => $entry->{title},
+ type => $entry->{type},
+ schedule_id => $entry->{schedule_id},
+ start => $work_date->{start},
+ end => $work_date->{end},
+ exclude => $work_date->{exclude}
+ };
+ if(studio_timeslot_dates::can_studio_edit_events($config, $entry)==1){ # by studio_id, start, end
+ $entry->{start_date}= time::add_hours_to_datetime($entry->{start}, -$day_start);
+ $entry->{end_date}= time::add_hours_to_datetime($entry->{end}, -$day_start);
+ db::insert($dbh, 'calcms_work_dates', $entry);
+ #print STDERR "$entry->{start_date}\n";
+ $i++;
+ }else{
+ $j++;
+ #print STDERR Dumper($entry);
+ }
+ }
+ #print STDERR "$i work_dates updates\n";
+ return $j." dates out of studio times, ".$i;
+}
+
+sub get_schedule_dates{
+ my $schedule=shift;
+ my $options=shift;
+
+ my $is_exclude=$options->{exclude}||0;
+ my $dates=[];
+ return $dates if (($is_exclude eq'1') && ($schedule->{exclude}ne'1'));
+ return $dates if (($is_exclude eq'0') && ($schedule->{exclude}eq'1'));
+
+ if ($schedule->{period_type}eq'single'){
+ $dates=get_single_date($schedule->{start}, $schedule->{duration}) ;
+ }elsif($schedule->{period_type}eq'days'){
+ $dates=get_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{frequency}) ;
+ }elsif($schedule->{period_type}eq'week_of_month'){
+ $dates=get_week_of_month_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{week_of_month}, $schedule->{weekday}, $schedule->{month});
+ }else{
+ print STDERR "unknown schedule period_type\n";
+ }
+ return $dates;
+}
+
+
+sub get_week_of_month_dates{
+ my $start =shift; # datetime string
+ my $end =shift; # datetime string
+ my $duration =shift; # in minutes
+ my $week =shift; # every nth week of month
+ my $weekday =shift; # weekday [1..7]
+ my $frequency =shift; # every 1st,2nd,3th time
+
+ return undef if $start eq'';
+ return undef if $end eq'';
+ return undef if $duration eq'';
+ return undef if $week eq'';
+ return undef if $weekday eq'';
+ return undef if $frequency eq'';
+ return undef if $frequency==0;
+
+ my $start_dates=time::get_nth_weekday_in_month($start, $end, $week, $weekday-1);
+
+ my $results=[];
+
+ my $c=-1;
+ for my $start_datetime (@$start_dates){
+ $c++;
+ my @start = @{time::datetime_to_array($start_datetime)};
+ next unless @start>=6;
+ next if (($c % $frequency)!=0);
+
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $start[0], $start[1], $start[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, $duration, 0 # delta days, hours, minutes, seconds
+ );
+ my $end_datetime=time::array_to_datetime(\@end_datetime);
+
+ push @$results, {
+ start => $start_datetime,
+ end => $end_datetime
+ };
+ }
+ return $results;
+}
+
+#add duration to a single date
+sub get_single_date{
+ my $start_datetime = shift;
+ my $duration = shift;
+
+ my @start = @{time::datetime_to_array($start_datetime)};
+ return unless @start>=6;
+
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $start[0], $start[1], $start[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, $duration, 0 # delta days, hours, minutes, seconds
+ );
+ my $date={
+ start => $start_datetime,
+ end => time::array_to_datetime(\@end_datetime)
+ };
+ return [$date];
+}
+
+#calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days)
+sub get_dates{
+ my $start_datetime = shift;
+ my $end_date = shift;
+ my $duration = shift; # in minutes
+ my $frequency = shift; # in days
+ #print "start_datetime:$start_datetime end_date:$end_date duration:$duration frequency:$frequency\n";
+
+ my @start = @{time::datetime_to_array($start_datetime)};
+ return unless @start>=6;
+ my @start_date = ($start[0], $start[1], $start[2]);
+ my $start_time = sprintf('%02d:%02d:%02d', $start[3], $start[4], $start[5]);
+
+ #print STDERR "$start_datetime,$end_date,$duration,$frequency\n";
+
+ #return on single date
+ my $date={};
+ $date->{start}= sprintf("%04d-%02d-%02d",@start_date).' '.$start_time;
+ return undef if $duration eq '';
+
+ return undef if (($frequency eq '')||($end_date eq''));
+
+ #continue on recurring date
+ my @end = @{time::datetime_to_array($end_date)};
+ return unless @end>=3;
+ my @end_date = ($end[0], $end[1], $end[2]);
+
+ my $today=time::time_to_date();
+ my ($year, $month, $day)=split(/\-/,$today);
+
+ #do not show dates one month back
+ my $not_before= sprintf("%04d-%02d-%02d", Date::Calc::Add_Delta_Days($year, $month, $day, -30));
+
+ my $dates=[];
+ return $dates if ($end_date lt $today);
+ return $dates if ($frequency<1);
+
+ my $j = Date::Calc::Delta_Days(@start_date, @end_date);
+ my $c=0;
+ for (my $i = 0; $i <= $j; $i+=$frequency ){
+ my @date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
+ my $date={};
+ $date->{start}=sprintf("%04d-%02d-%02d",@date).' '.$start_time;
+
+ my @end_datetime = Date::Calc::Add_Delta_DHMS(
+ $date[0], $date[1], $date[2], # start date
+ $start[3], $start[4], $start[5], # start time
+ 0, 0, $duration, 0 # delta days, hours, minutes, seconds
+ );
+ $date->{end}=time::array_to_datetime(\@end_datetime);
+
+ last if ($c>200);
+ $c++;
+
+ next if $date->{end} lt $not_before;
+ push @$dates,$date;
+
+ }
+ return $dates;
+}
+
+#remove all work_dates for studio_id and schedule_id
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{schedule_id};
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_work_dates
+ where project_id=? and studio_id=? and schedule_id=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{schedule_id}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ return db::put($dbh, $query, $bind_values);
+}
+
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/lib/calcms/work_schedule.pm b/lib/calcms/work_schedule.pm
new file mode 100644
index 0000000..253ebb7
--- /dev/null
+++ b/lib/calcms/work_schedule.pm
@@ -0,0 +1,156 @@
+package work_schedule;
+use warnings "all";
+use strict;
+use Data::Dumper;
+use series_dates;
+
+# table: calcms_work_schedule
+# columns: id, studio_id, series_id,
+ # start (datetime),
+ # duration (minutes),
+ # frequency (days),
+ # end (date),
+ # weekday (1..7)
+ # week_of_month (1..5)
+ # month
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_columns get insert update delete);
+our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
+
+sub debug;
+
+sub get_columns{
+ my $config=shift;
+
+ my $dbh=db::connect($config);
+ my $cols=db::get_columns($dbh, 'calcms_work_schedule');
+ my $columns={};
+ for my $col (@$cols){
+ $columns->{$col}=1;
+ }
+ return $columns;
+}
+
+#map schedule id to id
+sub get{
+ my $config=shift;
+ my $condition=shift;
+
+ my $dbh=db::connect($config);
+
+ my @conditions=();
+ my @bind_values=();
+
+ if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
+ push @conditions, 'project_id=?';
+ push @bind_values, $condition->{project_id};
+ }
+
+ if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
+ push @conditions, 'studio_id=?';
+ push @bind_values, $condition->{studio_id};
+ }
+
+ if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
+ push @conditions, 'schedule_id=?';
+ push @bind_values, $condition->{schedule_id};
+ }
+
+ if ((defined $condition->{start}) && ($condition->{start} ne '')){
+ push @conditions, 'start=?';
+ push @bind_values, $condition->{start};
+ }
+
+ if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
+ push @conditions, 'exclude=?';
+ push @bind_values, $condition->{exclude};
+ }
+
+ if ((defined $condition->{period_type}) && ($condition->{period_type} ne '')){
+ push @conditions, 'period_type=?';
+ push @bind_values, $condition->{period_type};
+ }
+
+ my $conditions='';
+ $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
+
+ my $query=qq{
+ select *
+ from calcms_work_schedule
+ $conditions
+ order by exclude, start
+ };
+ #print STDERR $query."\n".Dumper(\@bind_values);
+
+ my $entries=db::get($dbh, $query, \@bind_values);
+ return $entries;
+}
+
+sub insert{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{start};
+ my $dbh=db::connect($config);
+ return db::insert($dbh, 'calcms_work_schedule', $entry);
+}
+
+#schedule id to id
+sub update{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{schedule_id};
+ return undef unless defined $entry->{start};
+
+ my $dbh=db::connect($config);
+ my $values =join(",", map {$_.'=?'} (keys %$entry));
+ my @bind_values =map {$entry->{$_}} (keys %$entry);
+
+ push @bind_values,$entry->{project_id};
+ push @bind_values,$entry->{studio_id};
+ push @bind_values,$entry->{schedule_id};
+
+ my $query=qq{
+ update calcms_work_schedule
+ set $values
+ where project_id=? and studio_id=? and schedule_id=?
+ };
+ return db::put($dbh, $query, \@bind_values);
+ print "done\n";
+}
+
+#map schedule id to id
+sub delete{
+ my $config=shift;
+ my $entry=shift;
+
+ return undef unless defined $entry->{project_id};
+ return undef unless defined $entry->{studio_id};
+ return undef unless defined $entry->{schedule_id};
+
+ my $dbh=db::connect($config);
+
+ my $query=qq{
+ delete
+ from calcms_work_schedule
+ where project_id=? and studio_id=? and schedule_id=?
+ };
+ my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{schedule_id}];
+ #print '$query'.$query.Dumper($bind_values).'
';
+ return db::put($dbh, $query, $bind_values);
+}
+
+sub error{
+ my $msg=shift;
+ print "ERROR: $msg
\n";
+}
+
+#do not delete last line!
+1;
diff --git a/tools/compress_templates.cgi b/tools/compress_templates.cgi
new file mode 100755
index 0000000..026de15
--- /dev/null
+++ b/tools/compress_templates.cgi
@@ -0,0 +1,125 @@
+#! /usr/bin/perl -w
+
+BEGIN{
+ my $dir=$ENV{SCRIPT_FILENAME}||'';
+ $dir=~s/(.*\/)[^\/]+/$1/;
+ $dir=$ENV{PWD} if ($dir eq'');
+ $dir=`pwd` if ($dir eq'');
+
+ #if located below extern CMS go on more down
+ #$dir.='../';
+
+ #local perl installation libs
+ unshift(@INC,$dir.'/../../perl/lib/');
+ unshift(@INC,$dir.'/../../calcms/calcms/');
+}
+
+use warnings "all";
+use strict;
+use Data::Dumper;
+
+use File::stat;
+use Time::localtime;
+use CGI qw(header param Vars escapeHTML uploadInfo cgi_error);
+use time;
+use config;
+use log;
+use projects;
+use markup;
+use template;
+
+my $config =config::get('../config/config.cgi');
+
+my $debug =$config->{system}->{debug};
+my $base_dir =$config->{locations}->{base_dir};
+my $local_base_url =$config->{locations}->{local_base_url};
+
+$CGI::POST_MAX = 1024*10;
+my $cgi=new CGI();
+my %params=$cgi->Vars();
+#print $cgi->header();
+#print STDERR Dumper($config);
+
+#print "a\n";
+template::exit_on_missing_permission('access_system');
+#print "b\n";
+
+my $request={
+ url => $ENV{QUERY_STRING}||'',
+ params => {
+ original => \%params,
+ checked => check_params(\%params),
+ },
+ config => $config
+};
+my $params=$request->{params}->{checked};
+
+log::init($request);
+log::mem('pic_manager init')if($debug>2);
+
+my $errors='';
+my $action_result='';
+
+log::error("base_dir '$base_dir' does not exist")unless(-e $base_dir);
+
+my $template_dirs=[
+ $base_dir.'/templates/',
+ $base_dir.'/admin/templates/',
+ $base_dir.'/planung/templates/',
+];
+my @results=();
+#print "\n";
+
+for my $template_dir(@$template_dirs){
+ my $dest_dir=$template_dir.'compressed/';
+ log::error('template directory "'.$dest_dir.'" does not exist') unless(-e $dest_dir);
+ log::error('cannot write into template directory "'.$dest_dir.'"') unless(-w $dest_dir);
+
+ #compress only: html, xml
+ my @files=glob("$template_dir*.*ml");
+ for my $file (@files){
+ $file=~s/[\n\r]+$//g;
+ next if ($file=~/\~$/);
+ next if ($file=~/compressed/);
+ next if ($file=~/\.old$/);
+ push @results,$file;
+
+ my $content=log::load_file($file);
+# print "$file\n";
+ markup::compress($content);
+
+ my $filename=(split(/\//,$file))[-1];
+ my $dest_file=$template_dir.'compressed/'.$filename;
+ log::error("cannot write '$dest_file'") if((-e $dest_file) && (!(-w $dest_file)));
+ log::save_file($dest_file,$content);
+ }
+}
+
+my $out='';
+template::process('print',$params->{template},{
+ 'error' => $errors,
+ 'projects' => projects::get({all=>0}),
+
+ }
+);
+
+print '';
+for my $result(@results){
+ $result=~s/$base_dir//g;
+ print $local_base_url.$result."\n";
+}
+print '';
+log::mem('pic_manager init')if($debug>1);
+
+
+sub check_params{
+ my $params=shift;
+
+ my $result={};
+
+ #avoid checking templates
+ $result->{template}='templates/default.html';
+
+ return $result;
+}
+
diff --git a/tools/get_source_page.pl b/tools/get_source_page.pl
new file mode 100755
index 0000000..16bfd9c
--- /dev/null
+++ b/tools/get_source_page.pl
@@ -0,0 +1,194 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use Data::Dumper;
+
+use HTTP::Request;
+use LWP::UserAgent;
+use config;
+use markup;
+use Getopt::Long;
+
+check_running_processes();
+
+my $wget='/usr/local/bin/wget';
+
+my $insertWidgets = undef;
+my $configFile = undef;
+my $help = undef;
+my $output = undef;
+
+GetOptions (
+ "config=s" => \$configFile,
+ "insert_widgets" => \$insertWidgets,
+ "output=s" => \$output,
+ "help" => \$help
+)or die("Error in command line arguments\n");
+
+if(($help) || (!(defined $configFile)) ){
+ print get_usage();
+ exit 1;
+}
+binmode STDOUT, ":encoding(UTF-8)";
+
+my $config = config::get($configFile);
+
+#what to grab from extern CMS
+my $source_url_http = $config->{locations}->{source_url_http};
+my $source_url_https = $config->{locations}->{source_url_https};
+
+#external base url (relative links/images are located)
+my $source_base_url = $config->{locations}->{source_base_url};
+
+my $source_base_url_http = $source_base_url;
+$source_base_url_http=~s/^http\:\//https\:\//g;
+
+my $source_base_url_https=$source_base_url;
+$source_base_url_https=~s/^http\:\//https\:\//g;
+
+# base url to get widgets from /website/agenda/
+my $base_url =$config->{controllers}->{domain};
+
+# location of /website/agenda/
+my $base_dir =$config->{locations}->{base_dir};
+
+unless (defined $source_url_http){
+ print STDERR "source_url_http is not configured. Please check config.\n";
+ exit 1;
+}
+
+#setup UA
+my $ua = LWP::UserAgent->new;
+
+our $results={};
+my $urls={base => $source_url_http};
+
+#read source url
+$results->{base}= http_get($ua,$urls->{base});
+my $html_page=$results->{base};
+
+#read widgets
+$html_page=load_widgets($ua,$html_page,{
+ calcms_calendar => $base_url."kalender/\$date/",
+ calcms_menu => $base_url."menu/\$date/",
+ calcms_list => $base_url."sendungen/\$date/",
+ calcms_categories => $base_url."kategorien/",
+ calcms_series_names => $base_url."sendereihen/",
+ calcms_newest_comments => $base_url."neueste_kommentare/",
+}) if (defined $insertWidgets);
+
+#replace links
+$html_page=~s/(href\=\"\/)$source_base_url_http/$1/g;
+$html_page=~s/(src\=\"\/)$source_base_url_http/$1/g;
+$html_page=~s/(href\=\"\/)$source_base_url_https/$1/g;
+$html_page=~s/(src\=\"\/)$source_base_url_https/$1/g;
+$html_page=~s/(src\=\"\/)$source_base_url_https/$1/g;
+
+#replace link to uncompressed or compressed drupal (first link in )
+my @parts=split(/<\/head>/,$html_page);
+$parts[0]=~s|/misc/jquery.js|/agenda_files/js/jquery.js|;
+$parts[0]=~s|/sites/default/files/js/[a-z0-9\_]+\.js|/agenda_files/js/jquery.js|;
+$html_page=join('',@parts);
+
+#compress output
+markup::compress($html_page);
+
+#print result
+if(defined $output){
+ unless (-w $output){
+ print STDERR "cannot write to '$output'\n";
+ exit 1;
+ }
+ print STDERR "write to '$output'\n";
+ open my $file,'>'.$output;
+ print $file $html_page."\n";
+ close $file;
+}else{
+ print STDERR "write to STDOUT\n";
+ print $html_page;
+}
+
+
+sub load_widgets{
+ my $ua =shift;
+ my $base=shift;
+ my $urls=shift;
+
+ #set current date (or end date if above)
+ my @date=localtime(time());
+ my $year= $date[5]+1900;
+ my $month= $date[4]+1;
+ my $day = $date[3];
+ $month ='0'.$month if (length($month)<2);
+ $day ='0'.$day if (length($day)<2);
+ my $date=join('-',($year,$month,$day));
+
+ my $project_name=$config->{project};
+ my $project=$config->{projects}->{$project_name};
+
+ $date=$project->{start_date} if ($date lt $project->{start_date});
+ $date=$project->{end_date} if ($date gt $project->{end_date});
+
+ #load widgets
+ for my $block (keys %$urls){
+ my $url=$urls->{$block};
+ $url=~s/\$date/$date/gi;
+ $results->{$block}= http_get($ua,$url);
+ }
+
+ #set javascript
+ my $preload_js=qq{
+ set('preloaded','$date');
+ set('last_list_url','}.$base_url.qq{sendungen/$date/');
+
+
+
+
+calcms
+
+ bitte warten