kalipso/racalmas
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge https://github.com/rapilodev/racalmas

Browse Source
This commit is contained in:
www-data
2023-05-23 15:01:55 +00:00
parent 89aa2845d1 4cba61bf06
commit c1877ff18e
55 changed files with 557 additions and 808 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
install/INSTALL.md
View File

@@ -85,14 +85,13 @@ apt-get install <deb-package>
libdate-manip-perl libdate-manip-perl
libdbi-perl libdbi-perl
libdbd-mysql-perl libdbd-mysql-perl
libemail-sender-perl
libencode-perl libencode-perl
libjson-perl libjson-perl
libhtml-formattext-withlinks-andtables-perl libhtml-formattext-withlinks-andtables-perl
libhtml-parser-perl libhtml-parser-perl
libhtml-template-perl libhtml-template-perl
libhtml-template-compiled-perl libhtml-template-compiled-perl
libmime-base64-urlsafe-perl
libmime-lite-perl
libsession-token-perl libsession-token-perl
libtext-multimarkdown-perl libtext-multimarkdown-perl
libtext-wikicreole-perl libtext-wikicreole-perl
@@ -132,7 +131,6 @@ apt-get install <deb-package>
Image::Magick Image::Magick
Image::Magick::Square Image::Magick::Square
JSON JSON
MIME::Lite
ModPerl::Util ModPerl::Util
Session::Token Session::Token
Text::Diff::FormatedHtml Text::Diff::FormatedHtml

2
lib/calcms/ListenerAccess.pm
View File

@@ -12,7 +12,7 @@ use Apache2::Connection ();
use Apache2::Const -compile => qw(FORBIDDEN OK); use Apache2::Const -compile => qw(FORBIDDEN OK);
sub handler { sub handler {
my $r = shift; my ($r) = @_;
my $DAYS = 24 * 60 * 60; my $DAYS = 24 * 60 * 60;
my $OK = Apache2::Const::OK; my $OK = Apache2::Const::OK;

19
lib/calcms/aggregator.pm
View File

@@ -14,9 +14,7 @@ use Date::Calc;
our @EXPORT_OK = qw(get_cache configure_cache put_cache get_list check_params); our @EXPORT_OK = qw(get_cache configure_cache put_cache get_list check_params);
sub get_list($$) { sub get_list($$) {
my $config = shift; my ($config, $request) = @_;
my $request = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
#customize prefiltered request parameters #customize prefiltered request parameters
@@ -63,10 +61,7 @@ sub get_list($$) {
} }
sub get_menu($$$$) { sub get_menu($$$$) {
my $config = shift; my ($config, $request, $date, $results) = @_;
my $request = shift;
my $date = shift;
my $results = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
@@ -89,9 +84,7 @@ sub get_menu($$$$) {
} }
sub get_calendar($$$) { sub get_calendar($$$) {
my $config = shift; my ($config, $request, $date) = @_;
my $request = shift;
my $date = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
@@ -114,8 +107,7 @@ sub get_calendar($$$) {
} }
sub get_newest_comments($$) { sub get_newest_comments($$) {
my $config = shift; my ($config, $request) = @_;
my $request = shift;
my $params = { my $params = {
template => 'comments_newest.html', template => 'comments_newest.html',
@@ -138,8 +130,7 @@ sub get_newest_comments($$) {
} }
sub check_params($$) { sub check_params($$) {
my $config = shift; my ($config, $params) = @_;
my $params = shift;
#get start and stop from projects #get start and stop from projects
my $range = project::get_date_range($config); my $range = project::get_date_range($config);

28
lib/calcms/audio.pm
View File

@@ -3,7 +3,7 @@ use warnings;
use strict; use strict;
sub durationToSeconds($) { sub durationToSeconds($) {
my $duration = shift; my ($duration) = @_;
if ( $duration =~ /(\d+):(\d\d):(\d\d).(\d\d)/ ) { if ( $duration =~ /(\d+):(\d\d):(\d\d).(\d\d)/ ) {
return $1 * 3600 + $2 * 60 + $3 + $4 / 100; return $1 * 3600 + $2 * 60 + $3 + $4 / 100;
@@ -12,10 +12,7 @@ sub durationToSeconds($) {
} }
sub formatDuration($$$;$) { sub formatDuration($$$;$) {
my $audioDuration = shift; my ($audioDuration, $eventDuration, $value, $mouseOver) = @_;
my $eventDuration = shift;
my $value = shift;
my $mouseOver = shift;
return '' unless $audioDuration; return '' unless $audioDuration;
return '' unless $eventDuration; return '' unless $eventDuration;
@@ -52,7 +49,8 @@ sub formatDuration($$$;$) {
} }
sub formatChannels($) { sub formatChannels($) {
my $channels = shift; my ($channels) = @_;
return '' unless $channels; return '' unless $channels;
my $class = "ok"; my $class = "ok";
$class = "error" if $channels != 2; $class = "error" if $channels != 2;
@@ -60,7 +58,8 @@ sub formatChannels($) {
} }
sub formatSamplingRate($) { sub formatSamplingRate($) {
my $samplingRate = shift; my ($samplingRate) = @_;
return '' unless $samplingRate; return '' unless $samplingRate;
my $class = "ok"; my $class = "ok";
$class = "error" if $samplingRate != 44100; $class = "error" if $samplingRate != 44100;
@@ -68,7 +67,8 @@ sub formatSamplingRate($) {
} }
sub formatBitrate($) { sub formatBitrate($) {
my $bitrate = shift; my ($bitrate) = @_;
return '' unless $bitrate; return '' unless $bitrate;
my $class = 'ok'; my $class = 'ok';
$class = 'warn' if $bitrate >= 200; $class = 'warn' if $bitrate >= 200;
@@ -77,7 +77,8 @@ sub formatBitrate($) {
} }
sub formatBitrateMode($) { sub formatBitrateMode($) {
my $mode = shift; my ($mode) = @_;
return '' unless $mode; return '' unless $mode;
my $class = 'ok'; my $class = 'ok';
$class = 'error' if $mode ne 'CBR'; $class = 'error' if $mode ne 'CBR';
@@ -85,9 +86,9 @@ sub formatBitrateMode($) {
} }
sub formatLoudness { sub formatLoudness {
my $value = shift; my ($value, $prefix, $round) = @_;
my $prefix = shift || ''; $prefix ||= '';
my $round = shift || ''; $round ||= '';
return '' unless $value; return '' unless $value;
$value = sprintf( "%.1f", $value ); $value = sprintf( "%.1f", $value );
@@ -103,8 +104,7 @@ sub formatLoudness {
} }
sub formatFile{ sub formatFile{
my $file = shift; my ($file, $event_id) = @_;
my $event_id = shift;
return '' unless $file; return '' unless $file;

22
lib/calcms/audio_recordings.pm
View File

@@ -17,16 +17,14 @@ our @EXPORT_OK = qw(get_columns get);
# audioDuration, eventDuration, rmsLeft, rmsRight # audioDuration, eventDuration, rmsLeft, rmsRight
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_audio_recordings' ); return db::get_columns_hash( $dbh, 'calcms_audio_recordings' );
} }
# get playout entries # get playout entries
sub get($$) { sub get($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $date_range_include = 0; my $date_range_include = 0;
$date_range_include = 1 $date_range_include = 1
@@ -97,9 +95,7 @@ sub get($$) {
# update playout entry if differs to old values # update playout entry if differs to old values
sub update($$$) { sub update($$$) {
my $config = shift; my ($config, $dbh, $entry) = @_;
my $dbh = shift;
my $entry = shift;
my $day_start = $config->{date}->{day_starting_hour}; my $day_start = $config->{date}->{day_starting_hour};
@@ -134,9 +130,7 @@ sub update($$$) {
# insert playout entry # insert playout entry
sub insert ($$$) { sub insert ($$$) {
my $config = shift; my ($config, $dbh, $entry) = @_;
my $dbh = shift;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -165,9 +159,7 @@ sub insert ($$$) {
# delete playout entry # delete playout entry
sub delete ($$$) { sub delete ($$$) {
my $config = shift; my ($config, $dbh, $entry) = @_;
my $dbh = shift;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -187,9 +179,7 @@ sub delete ($$$) {
} }
sub update_active($$$) { sub update_active($$$) {
my $config = shift; my ($config, $dbh, $entry) = @_;
my $dbh = shift;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};

40
lib/calcms/auth.pm
View File

@@ -52,7 +52,7 @@ sub get_user($$$) {
} }
sub crypt_password($) { sub crypt_password($) {
my $password = shift; my ($password) = @_;
my $ppr = Authen::Passphrase::BlowfishCrypt->new( my $ppr = Authen::Passphrase::BlowfishCrypt->new(
cost => 8, cost => 8,
@@ -66,10 +66,7 @@ sub crypt_password($) {
} }
sub login($$$) { sub login($$$) {
my $config = shift; my ($config, $user, $password) = @_;
my $user = shift;
my $password = shift;
my $result = authenticate( $config, $user, $password ); my $result = authenticate( $config, $user, $password );
return show_login_form( $user, 'Could not authenticate you' ) unless defined $result; return show_login_form( $user, 'Could not authenticate you' ) unless defined $result;
@@ -86,9 +83,7 @@ sub login($$$) {
#TODO: remove cgi #TODO: remove cgi
sub logout($$) { sub logout($$) {
my $config = shift; my ($config, $cgi) = @_;
my $cgi = shift;
my $session_id = read_cookie(); my $session_id = read_cookie();
unless ( delete_session($config, $session_id) ) { unless ( delete_session($config, $session_id) ) {
return show_login_form( 'Cant delete session', 'logged out' ); return show_login_form( 'Cant delete session', 'logged out' );
@@ -104,9 +99,7 @@ sub logout($$) {
#read and write data from browser, http://perldoc.perl.org/CGI/Cookie.html #read and write data from browser, http://perldoc.perl.org/CGI/Cookie.html
sub create_cookie($$) { sub create_cookie($$) {
my $session_id = shift; my ($session_id, $timeout) = @_;
my $timeout = shift;
my $cookie = CGI::Cookie->new( my $cookie = CGI::Cookie->new(
-name => 'sessionID', -name => 'sessionID',
-value => $session_id, -value => $session_id,
@@ -129,8 +122,7 @@ sub read_cookie() {
#TODO: remove CGI #TODO: remove CGI
sub delete_cookie($) { sub delete_cookie($) {
my $cgi = shift; my ($cgi) = @_;
my $cookie = $cgi->cookie( my $cookie = $cgi->cookie(
-name => 'sessionID', -name => 'sessionID',
-value => '', -value => '',
@@ -143,10 +135,7 @@ sub delete_cookie($) {
# read and write server-side session data # read and write server-side session data
# timeout is in seconds # timeout is in seconds
sub create_session ($$$) { sub create_session ($$$) {
my $config = shift; my ($config, $user, $timeout) = @_;
my $user = shift;
my $timeout = shift;
my $session_id = user_sessions::start( my $session_id = user_sessions::start(
$config, { $config, {
user => $user, user => $user,
@@ -157,8 +146,7 @@ sub create_session ($$$) {
} }
sub read_session($$) { sub read_session($$) {
my $config = shift; my ($config, $session_id) = @_;
my $session_id = shift;
return undef unless defined $session_id; return undef unless defined $session_id;
@@ -172,20 +160,15 @@ sub read_session($$) {
} }
sub delete_session($$) { sub delete_session($$) {
my $config = shift; my ($config, $session_id) = @_;
my $session_id = shift; return unless defined $session_id;
return undef unless defined $session_id;
user_sessions::stop( $config, { session_id => $session_id } ); user_sessions::stop( $config, { session_id => $session_id } );
return 1; return 1;
} }
#check user authentication #check user authentication
sub authenticate($$$) { sub authenticate($$$) {
my $config = shift; my ($config, $user, $password) = @_;
my $user = shift;
my $password = shift;
$config->{access}->{write} = 0; $config->{access}->{write} = 0;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -223,9 +206,8 @@ sub authenticate($$$) {
} }
sub show_login_form ($$) { sub show_login_form ($$) {
my $user = shift || ''; my ($user, $message) = @_;
my $uri = $ENV{HTTP_REFERER} || ''; my $uri = $ENV{HTTP_REFERER} || '';
my $message = shift || '';
my $requestReset = ''; my $requestReset = '';
if ( ( $user ne '' ) && ( $message ne '' ) ) { if ( ( $user ne '' ) && ( $message ne '' ) ) {

14
lib/calcms/calendar.pm
View File

@@ -27,8 +27,7 @@ sub get_cached_or_render($$$) {
} }
sub get($$) { sub get($$) {
my $config = shift; my ($config, $request) = @_;
my $request = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
my $language = $config->{date}->{language} || 'en'; my $language = $config->{date}->{language} || 'en';
@@ -289,9 +288,7 @@ sub render($$$$) {
} }
sub get_calendar_weeks($$$) { sub get_calendar_weeks($$$) {
my $config = shift; my ($config, $start, $end) = @_;
my $start = shift;
my $end = shift;
$start = time::date_to_array($start); $start = time::date_to_array($start);
$end = time::date_to_array($end); $end = time::date_to_array($end);
@@ -317,8 +314,8 @@ sub get_calendar_weeks($$$) {
} }
sub getWeeksOfMonth($$) { sub getWeeksOfMonth($$) {
my $thisYear = shift; my ($thisYear, $thisMonth) = @_;
my $thisMonth = shift;
my $thisDay = 1; my $thisDay = 1;
# get weekday of 1st of month # get weekday of 1st of month
@@ -407,8 +404,7 @@ sub getWeeksOfMonth($$) {
} }
sub check_params($$) { sub check_params($$) {
my $config = shift; my ($config, $params) = @_;
my $params = shift;
#get start and stop from projects #get start and stop from projects
my $range = project::get_date_range($config); my $range = project::get_date_range($config);

54
lib/calcms/comments.pm
View File

@@ -70,8 +70,7 @@ sub get_cached_or_render($$$;$) {
} }
sub get($$) { sub get($$) {
my $config = shift; my ($config, $request) = @_;
my $request = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
my $dbh = db::connect( $config, $request ); my $dbh = db::connect( $config, $request );
@@ -81,9 +80,7 @@ sub get($$) {
} }
sub get_query($$$) { sub get_query($$$) {
my $dbh = shift; my ($dbh, $config, $request) = @_;
my $config = shift;
my $request = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
@@ -229,9 +226,7 @@ sub render($$$$) {
#check if comment exists already #check if comment exists already
sub check ($$$) { sub check ($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
my $query = qq{ my $query = qq{
select id select id
@@ -259,9 +254,7 @@ sub check ($$$) {
#used for insert #used for insert
sub get_level($$$) { sub get_level($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
my $parent_id = $comment->{parent_id}; my $parent_id = $comment->{parent_id};
return 0 unless defined $parent_id; return 0 unless defined $parent_id;
@@ -294,9 +287,7 @@ sub get_level($$$) {
} }
sub get_by_event($$$) { sub get_by_event($$$) {
my $dbh = shift; my ($dbh, $config, $request) = @_;
my $config = shift;
my $request = $_[0];
my $params = $request->{params}->{checked}->{comment}; my $params = $request->{params}->{checked}->{comment};
@@ -336,9 +327,7 @@ sub get_by_event($$$) {
} }
sub get_by_time($$$) { sub get_by_time($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
my $where = ''; my $where = '';
my $bind_values = []; my $bind_values = [];
@@ -375,10 +364,7 @@ sub get_by_time($$$) {
} }
sub get_events($$$$) { sub get_events($$$$) {
my $dbh = shift; my ($dbh, $config, $request, $comments) = @_;
my $config = shift;
my $request = shift;
my $comments = shift;
my $params = $request->{params}->{checked}->{comment}; my $params = $request->{params}->{checked}->{comment};
@@ -438,9 +424,7 @@ sub get_events($$$$) {
} }
sub insert ($$$) { sub insert ($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
$comment->{level} = comments::get_level( $dbh, $config, $comment ); $comment->{level} = comments::get_level( $dbh, $config, $comment );
@@ -461,9 +445,7 @@ sub insert ($$$) {
} }
sub set_lock_status ($$$) { sub set_lock_status ($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
my $id = $comment->{id}; my $id = $comment->{id};
my $lock_status = $comment->{set_lock_status}; my $lock_status = $comment->{set_lock_status};
@@ -489,9 +471,7 @@ sub set_lock_status ($$$) {
} }
sub set_news_status($$$) { sub set_news_status($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
my $id = $comment->{id}; my $id = $comment->{id};
my $news_status = $comment->{set_news_status}; my $news_status = $comment->{set_news_status};
@@ -505,9 +485,7 @@ sub set_news_status($$$) {
} }
sub update_comment_count ($$$) { sub update_comment_count ($$$) {
my $dbh = shift; my ($dbh, $config, $comment) = @_;
my $config = shift;
my $comment = shift;
my $query = qq{ my $query = qq{
select count(id) count select count(id) count
@@ -530,9 +508,7 @@ sub update_comment_count ($$$) {
} }
sub sort_childs { sub sort_childs {
my $node = shift; my ($node, $nodes, $sorted_nodes) = @_;
my $nodes = shift;
my $sorted_nodes = shift;
#push node into list of sorted nodes #push node into list of sorted nodes
push @{$sorted_nodes}, $node; push @{$sorted_nodes}, $node;
@@ -549,8 +525,7 @@ sub sort_childs {
#precondition: results are presorted by creation date (by sql) #precondition: results are presorted by creation date (by sql)
sub sort($$) { sub sort($$) {
my $config = shift; my ($config, $results) = @_;
my $results = shift;
#define parent nodes #define parent nodes
my $nodes = {}; my $nodes = {};
@@ -578,8 +553,7 @@ sub sort($$) {
} }
sub check_params ($$) { sub check_params ($$) {
my $config = shift; my ($config, $params) = @_;
my $params = shift;
my $comment = {}; my $comment = {};
$comment->{event_start} = ''; $comment->{event_start} = '';

4
lib/calcms/config.pm
View File

@@ -14,7 +14,7 @@ my $config = undef;
sub get($) { sub get($) {
my $filename = shift; my ($filename) = @_;
return read_config($filename); return read_config($filename);
} }
@@ -25,7 +25,7 @@ sub getFromScriptLocation() {
} }
sub read_config { sub read_config {
my $file = $_[0]; my ($file) = @_;
my $vars = {}; my $vars = {};
my @stack = (); my @stack = ();

13
lib/calcms/creole_wiki.pm
View File

@@ -13,8 +13,7 @@ our @EXPORT_OK =
#convert creole wiki text to event #convert creole wiki text to event
sub extractEventFromWikiText($;$) { sub extractEventFromWikiText($;$) {
my $params = shift; my ($params, $event) = @_;
my $event = shift;
$event = {} unless defined $event; $event = {} unless defined $event;
my $title = $params->{title} || ''; my $title = $params->{title} || '';
@@ -111,7 +110,7 @@ s/\{\{\s*thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}/\[\[$local_media_url\/images\/$1\|\{
} }
sub eventToWikiText($$) { sub eventToWikiText($$) {
my $event = shift; my ($event) = @_;
my $local_media_url = $event->{local_media_url} || ''; my $local_media_url = $event->{local_media_url} || '';
$event->{program} =~ s/^\s+|\s+$//g; $event->{program} =~ s/^\s+|\s+$//g;
@@ -163,8 +162,7 @@ s/\[\[.*?\/+media\/+images\/+(.*?)\s*\|.*?\{\{.*?\/+media\/+thumbs\/+(.*?)\s*\|\
#extrace meta tags from comment text #extrace meta tags from comment text
sub extractMeta ($$) { sub extractMeta ($$) {
my $comments = shift; my ($comments, $meta) = @_;
my $meta = shift;
$meta = [] unless defined $meta; $meta = [] unless defined $meta;
@@ -202,7 +200,8 @@ sub extractMeta ($$) {
#remove meta tags from comment text #remove meta tags from comment text
sub removeMeta($) { sub removeMeta($) {
my $comments = shift || ''; my ($comments) = @_;
$comments ||= '';
my $result = ''; my $result = '';
for my $line ( split( /\n/, $comments ) ) { for my $line ( split( /\n/, $comments ) ) {
@@ -216,7 +215,7 @@ sub removeMeta($) {
#add meta tags to comment text #add meta tags to comment text
sub metaToWiki { sub metaToWiki {
my $meta = shift; my ($meta) = @_;
my $result = ''; my $result = '';
for my $pair (@$meta) { for my $pair (@$meta) {

11
lib/calcms/db.pm
View File

@@ -150,8 +150,7 @@ sub put($$$) {
# deprecated # deprecated
sub quote($$) { sub quote($$) {
my $dbh = shift; my ($dbh, $sql) = @_;
my $sql = shift;
$sql =~ s/\_/\\\_/g; $sql =~ s/\_/\\\_/g;
return $dbh->quote($sql); return $dbh->quote($sql);
@@ -159,9 +158,7 @@ sub quote($$) {
#subtract hours, deprecated(!) #subtract hours, deprecated(!)
sub shift_date_by_hours($$$) { sub shift_date_by_hours($$$) {
my $dbh = shift; my ($dbh, $date, $offset) = @_;
my $date = shift;
my $offset = shift;
my $query = 'select date(? - INTERVAL ? HOUR) date'; my $query = 'select date(? - INTERVAL ? HOUR) date';
my $bind_values = [ $date, $offset ]; my $bind_values = [ $date, $offset ];
@@ -171,9 +168,7 @@ sub shift_date_by_hours($$$) {
#add minutes, deprecated(!) #add minutes, deprecated(!)
sub shift_datetime_by_minutes($$$) { sub shift_datetime_by_minutes($$$) {
my $dbh = shift; my ($dbh, $datetime, $offset) = @_;
my $datetime = shift;
my $offset = shift;
my $query = "select ? + INTERVAL ? MINUTE date"; my $query = "select ? + INTERVAL ? MINUTE date";
my $bind_values = [ $datetime, $offset ]; my $bind_values = [ $datetime, $offset ];

25
lib/calcms/eventOps.pm
View File

@@ -24,9 +24,7 @@ our @EXPORT_OK = qw(
# functions: to be separated # functions: to be separated
sub setAttributesFromSeriesTemplate($$$) { sub setAttributesFromSeriesTemplate($$$) {
my $config = shift; my ($config, $params, $event) = @_;
my $params = shift;
my $event = shift;
#get attributes from series #get attributes from series
my $series = series::get( my $series = series::get(
@@ -57,9 +55,7 @@ sub setAttributesFromSeriesTemplate($$$) {
} }
sub setAttributesFromSchedule ($$$){ sub setAttributesFromSchedule ($$$){
my $config = shift; my ($config, $params, $event) = @_;
my $params = shift;
my $event = shift;
#set attributes from schedule #set attributes from schedule
my $schedules = series_dates::get( my $schedules = series_dates::get(
@@ -89,9 +85,7 @@ sub setAttributesFromSchedule ($$$){
} }
sub setAttributesFromOtherEvent ($$$){ sub setAttributesFromOtherEvent ($$$){
my $config = shift; my ($config, $params, $event) = @_;
my $params = shift;
my $event = shift;
my $event2 = series::get_event( my $event2 = series::get_event(
$config, $config,
@@ -121,8 +115,7 @@ sub setAttributesFromOtherEvent ($$$){
} }
sub setAttributesForCurrentTime ($$){ sub setAttributesForCurrentTime ($$){
my $serie = shift; my ($serie, $event) = @_;
my $event = shift;
#on new event not from schedule use current time #on new event not from schedule use current time
if ( $event->{start} eq '' ) { if ( $event->{start} eq '' ) {
@@ -140,16 +133,14 @@ sub setAttributesForCurrentTime ($$){
# get recurrence base id # get recurrence base id
sub getRecurrenceBaseId ($){ sub getRecurrenceBaseId ($){
my $event = shift; my ($event) = @_;
return $event->{recurrence} if ( defined $event->{recurrence} ) && ( $event->{recurrence} ne '' ) && ( $event->{recurrence} ne '0' ); return $event->{recurrence} if ( defined $event->{recurrence} ) && ( $event->{recurrence} ne '' ) && ( $event->{recurrence} ne '0' );
return $event->{event_id}; return $event->{event_id};
} }
# get a new event for given series # get a new event for given series
sub getNewEvent($$$) { sub getNewEvent($$$) {
my $config = shift; my ($config, $params, $action) = @_;
my $params = shift;
my $action = shift;
# check for missing parameters # check for missing parameters
my $required_fields = [ 'project_id', 'studio_id', 'series_id' ]; my $required_fields = [ 'project_id', 'studio_id', 'series_id' ];
@@ -206,9 +197,7 @@ sub getNewEvent($$$) {
# add user, action # add user, action
sub createEvent($$$) { sub createEvent($$$) {
my $request = shift; my ($request, $event, $action) = @_;
my $event = shift;
my $action = shift;
my $config = $request->{config}; my $config = $request->{config};
my $permissions = $request->{permissions}; my $permissions = $request->{permissions};

18
lib/calcms/event_history.pm
View File

@@ -10,15 +10,14 @@ use Data::Dumper;
our @EXPORT_OK = qw(get_columns get get_by_id insert insert_by_event_id delete); our @EXPORT_OK = qw(get_columns get get_by_id insert insert_by_event_id delete);
sub get_columns ($){ sub get_columns ($){
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_event_history' ); return db::get_columns_hash( $dbh, 'calcms_event_history' );
} }
sub get ($$){ sub get ($$){
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
return undef unless defined $condition->{studio_id}; return undef unless defined $condition->{studio_id};
@@ -78,9 +77,7 @@ sub get ($$){
} }
sub get_by_id($$) { sub get_by_id($$) {
my $config = shift; my ($config, $id) = @_;
my $id = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
my $query = qq{ my $query = qq{
@@ -95,8 +92,7 @@ sub get_by_id($$) {
} }
sub insert($$) { sub insert($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
$entry->{modified_at} = time::time_to_datetime( time() ); $entry->{modified_at} = time::time_to_datetime( time() );
@@ -117,8 +113,7 @@ sub insert($$) {
# insert event # insert event
sub insert_by_event_id ($$){ sub insert_by_event_id ($$){
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -150,8 +145,7 @@ sub insert_by_event_id ($$){
} }
sub delete ($$){ sub delete ($$){
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
db::put( $dbh, 'delete from calcms_event_history where event_id=?', [ $entry->{id} ] ); db::put( $dbh, 'delete from calcms_event_history where event_id=?', [ $entry->{id} ] );

14
lib/calcms/events.pm
View File

@@ -482,11 +482,10 @@ sub add_recurrence_dates {
} }
sub calc_dates { sub calc_dates {
my $config = shift; my ($config, $result, $params, $previous_result, $time_diff) = @_;
my $result = shift; $params ||= {};
my $params = shift || {}; $previous_result ||= {};
my $previous_result = shift || {}; $time_diff ||= '';
my $time_diff = shift || '';
$result->{utc_offset} = $time_diff; $result->{utc_offset} = $time_diff;
$result->{time_zone} = $config->{date}->{time_zone}; $result->{time_zone} = $config->{date}->{time_zone};
@@ -643,7 +642,6 @@ sub set_listen_key{
sub set_upload_status($$){ sub set_upload_status($$){
my ($config, $event) = @_; my ($config, $event) = @_;
print STDERR "set upload_status=$event->{upload_status} for ".$event->{event_id}."\n";
return undef unless defined $event->{event_id}; return undef unless defined $event->{event_id};
return undef unless defined $event->{upload_status}; return undef unless defined $event->{upload_status};
my $bindValues = [ $event->{upload_status}, $event->{event_id}, $event->{upload_status} ]; my $bindValues = [ $event->{upload_status}, $event->{event_id}, $event->{upload_status} ];
@@ -1500,9 +1498,7 @@ sub get_by_image ($$$) {
# deleting an event is currently disabled # deleting an event is currently disabled
sub delete ($$$) { sub delete ($$$) {
return; return;
my $request = shift; my ($request, $config, $event_id) = @_;
my $config = shift;
my $event_id = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
my $dbh = db::connect($config); my $dbh = db::connect($config);

58
lib/calcms/images.pm
View File

@@ -19,8 +19,7 @@ my $sql_columns = [
]; ];
sub get($$) { sub get($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my @cond = (); my @cond = ();
my $bind_values = []; my $bind_values = [];
@@ -99,8 +98,7 @@ sub get($$) {
} }
sub insert_or_update($$) { sub insert_or_update($$) {
my $dbh = shift; my ($dbh, $image) = @_;
my $image = shift;
$image->{name} = 'new' if $image->{name} eq ''; $image->{name} = 'new' if $image->{name} eq '';
my $entry = get_by_filename( $dbh, $image->{filename} ); my $entry = get_by_filename( $dbh, $image->{filename} );
@@ -112,8 +110,7 @@ sub insert_or_update($$) {
} }
sub insert ($$) { sub insert ($$) {
my $dbh = shift; my ($dbh, $image) = @_;
my $image = shift;
my @sql_columns = @$sql_columns; my @sql_columns = @$sql_columns;
@@ -154,8 +151,7 @@ sub insert ($$) {
} }
sub update($$) { sub update($$) {
my $dbh = shift; my ($dbh, $image) = @_;
my $image = shift;
unless ( defined $image->{studio_id} ) { unless ( defined $image->{studio_id} ) {
print STDERR "missing studio_id at images::update\n"; print STDERR "missing studio_id at images::update\n";
@@ -213,8 +209,7 @@ sub update($$) {
} }
sub delete($$) { sub delete($$) {
my $dbh = shift; my ($dbh, $image) = @_;
my $image = shift;
unless ( defined $image->{project_id} ) { unless ( defined $image->{project_id} ) {
print STDERR "missing project_id at images::delete\n"; print STDERR "missing project_id at images::delete\n";
@@ -252,11 +247,7 @@ sub delete($$) {
# deactivated # deactivated
sub delete_files($$$$$) { sub delete_files($$$$$) {
my $config = $_[0]; my ($config, $local_media_dir, $filename, $action_result, $errors) = @_;
my $local_media_dir = $_[1];
my $filename = $_[2];
my $action_result = $_[3];
my $errors = $_[4];
return undef; return undef;
@@ -320,8 +311,7 @@ sub delete_file ($$$$) {
} }
sub getPath { sub getPath {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my $dir = $config->{locations}->{local_media_dir}; my $dir = $config->{locations}->{local_media_dir};
return undef unless defined $dir; return undef unless defined $dir;
@@ -340,8 +330,7 @@ sub getPath {
} }
sub getInternalPath ($$) { sub getInternalPath ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my $dir = $config->{locations}->{local_media_dir}; my $dir = $config->{locations}->{local_media_dir};
return undef unless defined $dir; return undef unless defined $dir;
@@ -360,14 +349,16 @@ sub getInternalPath ($$) {
} }
sub normalizeName (;$) { sub normalizeName (;$) {
my $name = shift; my ($name) = @_;
return undef unless defined $name; return undef unless defined $name;
$name =~ s/.*\///g; $name =~ s/.*\///g;
return $name; return $name;
} }
sub readFile($) { sub readFile($) {
my $path = shift; my ($path) = @_;
my $content = ''; my $content = '';
print STDERR "read '$path'\n"; print STDERR "read '$path'\n";
@@ -382,8 +373,7 @@ sub readFile($) {
} }
sub writeFile ($$) { sub writeFile ($$) {
my $path = shift; my ($path, $content) = @_;
my $content = shift;
print STDERR "save '$path'\n"; print STDERR "save '$path'\n";
open my $fh, '> :raw', $path or return { error => 'could not save image. ' . $! . " $path" }; open my $fh, '> :raw', $path or return { error => 'could not save image. ' . $! . " $path" };
@@ -394,7 +384,8 @@ sub writeFile ($$) {
} }
sub deleteFile($) { sub deleteFile($) {
my $path = shift; my ($path) = @_;
return { error => "source '$path' does not exist" } unless -e $path; return { error => "source '$path' does not exist" } unless -e $path;
#unlink $path; #unlink $path;
@@ -403,9 +394,7 @@ sub deleteFile($) {
} }
sub copyFile ($$$) { sub copyFile ($$$) {
my $source = shift; my ($source, $target, $errors) = @_;
my $target = shift;
my $errors = shift;
my $read = images::readFile($source); my $read = images::readFile($source);
return $read if defined $read->{error}; return $read if defined $read->{error};
@@ -415,8 +404,7 @@ sub copyFile ($$$) {
} }
sub publish($$) { sub publish($$) {
my $config = shift; my ($config, $filename) = @_;
my $filename = shift;
print STDERR "publish\n"; print STDERR "publish\n";
return undef unless defined $config; return undef unless defined $config;
@@ -435,8 +423,7 @@ sub publish($$) {
} }
sub depublish ($$) { sub depublish ($$) {
my $config = shift; my ($config, $filename) = @_;
my $filename = shift;
print STDERR "depublish\n"; print STDERR "depublish\n";
return undef unless defined $config; return undef unless defined $config;
@@ -454,8 +441,7 @@ sub depublish ($$) {
} }
sub checkLicence ($$) { sub checkLicence ($$) {
my $config = shift; my ($config, $result) = @_;
my $result = shift;
print STDERR "depublish\n"; print STDERR "depublish\n";
return undef unless defined $config; return undef unless defined $config;
@@ -469,8 +455,7 @@ sub checkLicence ($$) {
} }
sub setEventLabels($$) { sub setEventLabels($$) {
my $dbh = shift; my ($dbh, $image) = @_;
my $image = shift;
unless ( defined $image->{project_id} ) { unless ( defined $image->{project_id} ) {
print STDERR "missing project_id at images::setEventLabels\n"; print STDERR "missing project_id at images::setEventLabels\n";
@@ -496,8 +481,7 @@ sub setEventLabels($$) {
} }
sub setSeriesLabels($$) { sub setSeriesLabels($$) {
my $dbh = shift; my ($dbh, $image) = @_;
my $image = shift;
unless ( defined $image->{project_id} ) { unless ( defined $image->{project_id} ) {
print STDERR "missing project_id at images::setSeriesLabels\n"; print STDERR "missing project_id at images::setSeriesLabels\n";

8
lib/calcms/localization.pm
View File

@@ -17,8 +17,7 @@ our @EXPORT_OK = qw(get getJavascript);
# user : get from user settings # user : get from user settings
# loc : add to existing localization, optional # loc : add to existing localization, optional
sub get($$) { sub get($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
#get pot file #get pot file
unless ( defined $options->{file} ) { unless ( defined $options->{file} ) {
@@ -63,8 +62,7 @@ sub get($$) {
} }
sub read_po_file($$) { sub read_po_file($$) {
my $po_file = shift; my ($po_file, $loc) = @_;
my $loc = shift;
unless ( -e $po_file ) { unless ( -e $po_file ) {
print STDERR "po file $po_file does not exist\n"; print STDERR "po file $po_file does not exist\n";
@@ -99,7 +97,7 @@ sub read_po_file($$) {
} }
sub getJavascript ($){ sub getJavascript ($){
my $loc = shift; my ($loc) = @_;
my $out = '<script>'; my $out = '<script>';
$out .= "var loc={};\n"; $out .= "var loc={};\n";

8
lib/calcms/log.pm
View File

@@ -23,7 +23,7 @@ sub error($$) {
} }
sub load_file($) { sub load_file($) {
my $filename = shift; my ($filename) = @_;
my $content = ''; my $content = '';
if ( -e $filename ) { if ( -e $filename ) {
@@ -36,8 +36,7 @@ sub load_file($) {
} }
sub save_file($$) { sub save_file($$) {
my $filename = shift; my ($filename, $content) = @_;
my $content = shift;
#check if directory is writeable #check if directory is writeable
if ( $filename =~ /^(.+?)\/[^\/]+$/ ) { if ( $filename =~ /^(.+?)\/[^\/]+$/ ) {
@@ -57,8 +56,7 @@ sub save_file($$) {
} }
sub append_file($$) { sub append_file($$) {
my $filename = shift; my ($filename, $content) = @_;
my $content = shift;
unless ( ( defined $filename ) && ( $filename ne '' ) && ( -e $filename ) ) { unless ( ( defined $filename ) && ( $filename ne '' ) && ( -e $filename ) ) {
print STDERR "cannot append, file '$filename' does not exist\n"; print STDERR "cannot append, file '$filename' does not exist\n";

20
lib/calcms/mail.pm
View File

@@ -3,23 +3,27 @@ package mail;
use strict; use strict;
use warnings; use warnings;
no warnings 'redefine'; no warnings 'redefine';
use utf8;
use MIME::Lite(); use Email::Sender::Simple();
use Email::Simple();
use MIME::Words qw(encode_mimeword);
sub send($) { sub send($) {
my $mail = shift; my ($mail) = @_;
my $msg = MIME::Lite->new( my $email = Email::Simple->create(
'Content-Type' => 'text/plain; charset=utf-8',
header => [
'From' => $mail->{'From'}, 'From' => $mail->{'From'},
'To' => $mail->{'To'}, 'To' => $mail->{'To'},
'Cc' => $mail->{'Cc'}, 'Cc' => $mail->{'Cc'},
'Reply-To' => $mail->{'Reply-To'}, 'Reply-To' => $mail->{'Reply-To'},
'Subject' => $mail->{'Subject'}, 'Subject' => encode_mimeword($mail->{'Subject'}, 'b', 'UTF-8')
'Data' => $mail->{'Data'}, ],
body => $mail->{'Data'},
); );
Email::Sender::Simple->send($email);
$msg->print( \*STDERR );
$msg->send;
} }
# do not delete next line # do not delete next line

18
lib/calcms/markup.pm
View File

@@ -19,14 +19,14 @@ 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); 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);
sub fix_line_ends ($) { sub fix_line_ends ($) {
my $s = shift; my ($s) = @_;
$s =~ s/\r?\n|\r/\n/g; $s =~ s/\r?\n|\r/\n/g;
return $s; return $s;
} }
# convert 1..26 to a..z, 27 to aa, inspired by ConvertAA # convert 1..26 to a..z, 27 to aa, inspired by ConvertAA
sub base26($) { sub base26($) {
my $num = shift; my ($num) = @_;
return '' if $num <= 0; return '' if $num <= 0;
my $s = ""; my $s = "";
@@ -39,7 +39,7 @@ sub base26($) {
} }
sub html_to_creole($) { sub html_to_creole($) {
my $s = shift; my ($s) = @_;
#remove elements #remove elements
$s =~ s/\<\!\-\-[\s\S]*?\-\-\>//gi; $s =~ s/\<\!\-\-[\s\S]*?\-\-\>//gi;
@@ -153,7 +153,7 @@ sub markdown_to_html($){
} }
sub creole_to_plain($) { sub creole_to_plain($) {
my $s = shift; my ($s) = @_;
$s =~ s/\<p\>/\n/gi; $s =~ s/\<p\>/\n/gi;
$s =~ s/\{\{\{((\W+|\w+)+?)\}\}\}/<blockquote>$1<\/blockquote>/g; $s =~ s/\{\{\{((\W+|\w+)+?)\}\}\}/<blockquote>$1<\/blockquote>/g;
@@ -174,7 +174,8 @@ sub creole_to_plain($) {
} }
sub html_to_plain ($) { sub html_to_plain ($) {
my $s = shift; my ($s) = @_;
return '' unless defined $s; return '' unless defined $s;
my $tree = HTML::Parse::parse_html( '<body>' . $s . '</body>' ); my $tree = HTML::Parse::parse_html( '<body>' . $s . '</body>' );
my $formatter = HTML::FormatText->new( leftmargin => 0, rightmargin => 2000 ); my $formatter = HTML::FormatText->new( leftmargin => 0, rightmargin => 2000 );
@@ -381,7 +382,7 @@ my %entity = (
my $entities = join( '|', keys %entity ); my $entities = join( '|', keys %entity );
sub encode_xml_element($) { sub encode_xml_element($) {
my $text = shift; my ($text) = @_;
my $encoded_text = ''; my $encoded_text = '';
@@ -394,7 +395,7 @@ sub encode_xml_element($) {
} }
sub encode_xml_element_text ($) { sub encode_xml_element_text ($) {
my $text = shift; my ($text) = @_;
$text =~ s/&(?!(#[0-9]+|#x[0-9a-fA-F]+|\w+);)/&amp;/g; $text =~ s/&(?!(#[0-9]+|#x[0-9a-fA-F]+|\w+);)/&amp;/g;
$text =~ s/&($entities);/$entity{$1}/g; $text =~ s/&($entities);/$entity{$1}/g;
@@ -405,7 +406,8 @@ sub encode_xml_element_text ($) {
} }
sub escapeHtml($) { sub escapeHtml($) {
my $s = shift; my ($s) = @_;
return HTML::Entities::encode_entities( $s, q{&<>"'} ); return HTML::Entities::encode_entities( $s, q{&<>"'} );
} }

2
lib/calcms/params.pm
View File

@@ -17,7 +17,7 @@ sub isJson () {
} }
sub get ($) { sub get ($) {
my $r = shift; my ($r) = @_;
my $tmp_dir = '/var/tmp/'; my $tmp_dir = '/var/tmp/';
my $upload_limit = 1000 * 1024; my $upload_limit = 1000 * 1024;

24
lib/calcms/password_requests.pm
View File

@@ -17,15 +17,13 @@ use db;
use auth; use auth;
sub get_columns ($) { sub get_columns ($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_password_requests' ); return db::get_columns_hash( $dbh, 'calcms_password_requests' );
} }
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -56,8 +54,7 @@ sub get ($$) {
} }
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
@@ -76,8 +73,7 @@ sub update($$) {
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{user}; return undef unless defined $entry->{user};
@@ -86,8 +82,7 @@ sub insert ($$) {
} }
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -117,8 +112,7 @@ sub delete ($$) {
} }
sub sendToken ($$) { sub sendToken ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{user}; return undef unless defined $entry->{user};
@@ -161,9 +155,7 @@ sub sendToken ($$) {
} }
sub changePassword ($$$) { sub changePassword ($$$) {
my $config = shift; my ($config, $request, $userName) = @_;
my $request = shift;
my $userName = shift;
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
my $permissions = $request->{permissions}; my $permissions = $request->{permissions};
@@ -198,7 +190,7 @@ sub changePassword ($$$) {
} }
sub isPasswordInvalid($) { sub isPasswordInvalid($) {
my $password = shift; my ($password) = @_;
unless ( defined $password || $password eq '' ) { unless ( defined $password || $password eq '' ) {
return "The password must not be empty."; return "The password must not be empty.";
} }

38
lib/calcms/playout.pm
View File

@@ -14,8 +14,7 @@ use series_events();
our @EXPORT_OK = qw(get_columns get sync); our @EXPORT_OK = qw(get_columns get sync);
sub get_columns ($) { sub get_columns ($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_playout' ); return db::get_columns_hash( $dbh, 'calcms_playout' );
} }
@@ -24,9 +23,7 @@ sub get_columns ($) {
# get playout entries # get playout entries
sub get_scheduled($$) { sub get_scheduled($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
return undef unless defined $condition->{studio_id}; return undef unless defined $condition->{studio_id};
my $date_range_include = 0; my $date_range_include = 0;
@@ -129,8 +126,7 @@ sub get_scheduled($$) {
# get playout entries # get playout entries
sub get($$) { sub get($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
return undef unless defined $condition->{studio_id}; return undef unless defined $condition->{studio_id};
@@ -229,8 +225,7 @@ sub get($$) {
# update playout entries for a given date span # update playout entries for a given date span
# insert, update and delete entries # insert, update and delete entries
sub sync ($$) { sub sync ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -329,9 +324,7 @@ sub sync ($$) {
} }
sub has_changed ($$) { sub has_changed ($$) {
my $oldEntry = shift; my ($oldEntry, $newEntry) = @_;
my $newEntry = shift;
for my $key ( for my $key (
'duration', 'errors', 'file', 'channels', 'duration', 'errors', 'file', 'channels',
'format', 'format_version', 'format_profile', 'format_settings', 'format', 'format_version', 'format_profile', 'format_settings',
@@ -346,13 +339,7 @@ sub has_changed ($$) {
# update playout entry if differs to old values # update playout entry if differs to old values
sub update ($$$$) { sub update ($$$$) {
my $config = shift; my ($config, $dbh, $oldEntry, $newEntry) = @_;
my $dbh = shift;
my $oldEntry = shift;
my $newEntry = shift;
#return if has_changed( $oldEntry, $newEntry ) == 0;
for my $key ( for my $key (
'duration', 'errors', 'file', 'channels', 'duration', 'errors', 'file', 'channels',
'format', 'format_version', 'format_profile', 'format_settings', 'format', 'format_version', 'format_profile', 'format_settings',
@@ -395,9 +382,7 @@ sub update ($$$$) {
# insert playout entry # insert playout entry
sub insert ($$$) { sub insert ($$$) {
my $config = shift; my ($config, $dbh, $entry) = @_;
my $dbh = shift;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -445,10 +430,7 @@ sub insert ($$$) {
# delete playout entry # delete playout entry
sub delete($$$) { sub delete($$$) {
my $config = shift; my ($config, $dbh, $entry) = @_;
my $dbh = shift;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
return undef unless defined $entry->{start}; return undef unless defined $entry->{start};
@@ -463,9 +445,7 @@ sub delete($$$) {
} }
sub getEnd ($$) { sub getEnd ($$) {
my $start = shift; my ($start, $duration) = @_;
my $duration = shift;
# calculate end from start + duration # calculate end from start + duration
my @start = @{ time::datetime_to_array($start) }; my @start = @{ time::datetime_to_array($start) };
next unless @start >= 6; next unless @start >= 6;

63
lib/calcms/project.pm
View File

@@ -24,7 +24,7 @@ our @EXPORT_OK = qw(
# get project columns # get project columns
sub get_columns ($) { sub get_columns ($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_projects' ); return db::get_columns_hash( $dbh, 'calcms_projects' );
@@ -32,8 +32,7 @@ sub get_columns ($) {
# get projects # get projects
sub get ($;$) { sub get ($;$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -72,8 +71,7 @@ sub get ($;$) {
# requires at least project_id # requires at least project_id
sub getImageById($$) { sub getImageById($$) {
my $config = shift; my ($config, $conditions) = @_;
my $conditions = shift;
return undef unless defined $conditions->{project_id}; return undef unless defined $conditions->{project_id};
my $projects = project::get( $config, $conditions ); my $projects = project::get( $config, $conditions );
@@ -82,7 +80,7 @@ sub getImageById($$) {
} }
sub get_date_range($) { sub get_date_range($) {
my $config = shift; my ($config) = @_;
my $query = qq{ my $query = qq{
select min(start_date) start_date, max(end_date) end_date select min(start_date) start_date, max(end_date) end_date
@@ -96,8 +94,7 @@ sub get_date_range($) {
# insert project # insert project
sub insert($$) { sub insert($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
my $columns = get_columns($config); my $columns = get_columns($config);
my $project = {}; my $project = {};
@@ -114,8 +111,7 @@ sub insert($$) {
# update project # update project
sub update($$) { sub update($$) {
my $config = shift; my ($config, $project) = @_;
my $project = shift;
my $columns = project::get_columns($config); my $columns = project::get_columns($config);
my $entry = {}; my $entry = {};
@@ -141,17 +137,14 @@ sub update($$) {
# delete project # delete project
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
db::put( $dbh, 'delete from calcms_projects where project_id=?', [ $entry->{project_id} ] ); db::put( $dbh, 'delete from calcms_projects where project_id=?', [ $entry->{project_id} ] );
} }
# get studios of a project # get studios of a project
sub get_studios($$) { sub get_studios($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
my $project_id = $options->{project_id}; my $project_id = $options->{project_id};
@@ -168,8 +161,7 @@ sub get_studios($$) {
} }
sub get_studio_assignments($$) { sub get_studio_assignments($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -201,8 +193,7 @@ sub get_studio_assignments($$) {
# is studio assigned to project # is studio assigned to project
sub is_studio_assigned ($$) { sub is_studio_assigned ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return 0 unless defined $entry->{project_id}; return 0 unless defined $entry->{project_id};
return 0 unless defined $entry->{studio_id}; return 0 unless defined $entry->{studio_id};
@@ -225,8 +216,7 @@ sub is_studio_assigned ($$) {
# assign studio to project # assign studio to project
sub assign_studio($$) { sub assign_studio($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -244,8 +234,7 @@ sub assign_studio($$) {
# unassign studio from project # unassign studio from project
sub unassign_studio($$) { sub unassign_studio($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -260,8 +249,7 @@ sub unassign_studio($$) {
# get series by project and studio # get series by project and studio
sub get_series ($$) { sub get_series ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -281,8 +269,7 @@ sub get_series ($$) {
} }
sub get_series_assignments ($$) { sub get_series_assignments ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -319,8 +306,7 @@ sub get_series_assignments ($$) {
# is series assigned to project and studio # is series assigned to project and studio
sub is_series_assigned ($$) { sub is_series_assigned ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return 0 unless defined $entry->{project_id}; return 0 unless defined $entry->{project_id};
return 0 unless defined $entry->{studio_id}; return 0 unless defined $entry->{studio_id};
@@ -345,8 +331,7 @@ sub is_series_assigned ($$) {
# assign series to project and studio # assign series to project and studio
sub assign_series($$) { sub assign_series($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -369,8 +354,7 @@ sub assign_series($$) {
# unassign series from project # unassign series from project
# TODO: remove series _single_ if no event is assigned to # TODO: remove series _single_ if no event is assigned to
sub unassign_series ($$) { sub unassign_series ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -387,8 +371,7 @@ sub unassign_series ($$) {
} }
sub get_with_dates($;$) { sub get_with_dates($;$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my $language = $config->{date}->{language} || 'en'; my $language = $config->{date}->{language} || 'en';
my $projects = project::get( $config, {} ); my $projects = project::get( $config, {} );
@@ -404,7 +387,7 @@ sub get_with_dates($;$) {
#TODO: add config #TODO: add config
sub get_sorted($) { sub get_sorted($) {
my $config = shift; my ($config) = @_;
my $projects = project::get( $config, {} ); my $projects = project::get( $config, {} );
my @projects = reverse sort { $a->{end_date} cmp $b->{end_date} } (@$projects); my @projects = reverse sort { $a->{end_date} cmp $b->{end_date} } (@$projects);
@@ -421,9 +404,8 @@ sub get_sorted($) {
# internal # internal
sub get_months ($$;$) { sub get_months ($$;$) {
my $config = shift; my ($config, $project, $language) = @_;
my $project = shift; $language ||= $config->{date}->{language} || 'en';
my $language = shift || $config->{date}->{language} || 'en';
my $start = $project->{start_date}; my $start = $project->{start_date};
my $end = $project->{end_date}; my $end = $project->{end_date};
@@ -469,8 +451,7 @@ sub get_months ($$;$) {
# check project_id # check project_id
sub check ($$) { sub check ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return "missing project_id at checking project" unless defined $options->{project_id}; 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 '-1' );
return "Please select a project" if ( $options->{project_id} eq '' ); return "Please select a project" if ( $options->{project_id} eq '' );

83
lib/calcms/series.pm
View File

@@ -28,7 +28,7 @@ our @EXPORT_OK = qw(
# get series columns # get series columns
sub get_columns ($) { sub get_columns ($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_series' ); return db::get_columns_hash( $dbh, 'calcms_series' );
@@ -36,8 +36,7 @@ sub get_columns ($) {
# get series content # get series content
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -124,8 +123,7 @@ sub get ($$) {
# insert series # insert series
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $series) = @_;
my $series = shift;
return undef unless defined $series->{project_id}; return undef unless defined $series->{project_id};
return undef unless defined $series->{studio_id}; return undef unless defined $series->{studio_id};
@@ -162,8 +160,7 @@ sub insert ($$) {
# update series # update series
sub update ($$) { sub update ($$) {
my $config = shift; my ($config, $series) = @_;
my $series = shift;
return undef unless defined $series->{project_id}; return undef unless defined $series->{project_id};
return undef unless defined $series->{studio_id}; return undef unless defined $series->{studio_id};
@@ -199,8 +196,7 @@ sub update ($$) {
# delete series, its schedules and series dates # delete series, its schedules and series dates
# unassign its users and events # unassign its users and events
sub delete($$) { sub delete($$) {
my $config = shift; my ($config, $series) = @_;
my $series = shift;
return undef unless defined $series->{project_id}; return undef unless defined $series->{project_id};
return undef unless defined $series->{studio_id}; return undef unless defined $series->{studio_id};
@@ -287,8 +283,7 @@ sub delete($$) {
# get users directly assigned to project, studio, series (editors) # get users directly assigned to project, studio, series (editors)
sub get_users ($$) { sub get_users ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -331,8 +326,7 @@ sub get_users ($$) {
# assign user to series # assign user to series
sub add_user ($$) { sub add_user ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
return unless defined $entry->{studio_id}; return unless defined $entry->{studio_id};
@@ -362,8 +356,7 @@ sub add_user ($$) {
# remove user(s) from series. # remove user(s) from series.
sub remove_user ($$) { sub remove_user ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
return unless defined $condition->{project_id}; return unless defined $condition->{project_id};
return unless defined $condition->{studio_id}; return unless defined $condition->{studio_id};
@@ -406,9 +399,7 @@ sub remove_user ($$) {
#search events by series_name and title (for events not assigned yet) #search events by series_name and title (for events not assigned yet)
#TODO: add location #TODO: add location
sub search_events ($$$) { sub search_events ($$$) {
my $config = shift; my ($config, $request, $options) = @_;
my $request = shift;
my $options = shift;
my $series_name = $options->{series_name} || ''; my $series_name = $options->{series_name} || '';
my $title = $options->{title} || ''; my $title = $options->{title} || '';
@@ -449,8 +440,7 @@ sub search_events ($$$) {
#get events (only assigned ones) by project_id,studio_id,series_id, #get events (only assigned ones) by project_id,studio_id,series_id,
sub get_events ($$) { sub get_events ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return [] if defined( $options->{series_id} ) && ( $options->{series_id} <= 0 ); return [] if defined( $options->{series_id} ) && ( $options->{series_id} <= 0 );
@@ -555,8 +545,7 @@ sub get_events ($$) {
# helper for gui - errors are written to gui output # helper for gui - errors are written to gui output
# return undef on error # return undef on error
sub get_event ($$) { sub get_event ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my $project_id = $options->{project_id} || ''; my $project_id = $options->{project_id} || '';
my $studio_id = $options->{studio_id} || ''; my $studio_id = $options->{studio_id} || '';
@@ -620,8 +609,7 @@ sub get_event ($$) {
# get name and title of series and age in days ('days_over') # get name and title of series and age in days ('days_over')
sub get_event_age($$) { sub get_event_age($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -675,8 +663,7 @@ sub get_event_age($$) {
# is event older than max_age days # is event older than max_age days
sub is_event_older_than_days ($$) { sub is_event_older_than_days ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return 1 unless defined $options->{project_id}; return 1 unless defined $options->{project_id};
return 1 unless defined $options->{studio_id}; return 1 unless defined $options->{studio_id};
@@ -705,8 +692,7 @@ sub is_event_older_than_days ($$) {
} }
sub get_next_episode($$) { sub get_next_episode($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return 0 unless defined $options->{project_id}; return 0 unless defined $options->{project_id};
return 0 unless defined $options->{studio_id}; return 0 unless defined $options->{studio_id};
@@ -745,8 +731,7 @@ sub get_next_episode($$) {
} }
sub get_images ($$) { sub get_images ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -806,8 +791,7 @@ sub get_images ($$) {
#assign event to series #assign event to series
#TODO: manual assign needs to update automatic one #TODO: manual assign needs to update automatic one
sub assign_event($$) { sub assign_event($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -849,8 +833,7 @@ sub assign_event($$) {
#unassign event from series #unassign event from series
sub unassign_event($$) { sub unassign_event($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
return unless defined $entry->{studio_id}; return unless defined $entry->{studio_id};
@@ -875,8 +858,7 @@ sub unassign_event($$) {
# used by calendar # used by calendar
# TODO: optionally add project_id and studio_id to conditions # TODO: optionally add project_id and studio_id to conditions
sub add_series_ids_to_events ($$) { sub add_series_ids_to_events ($$) {
my $config = shift; my ($config, $events) = @_;
my $events = shift;
#get event ids from given events #get event ids from given events
my @event_ids = (); my @event_ids = ();
@@ -923,11 +905,7 @@ sub add_series_ids_to_events ($$) {
# add event_ids to series and remove all event ids from series, not given event_ids # add event_ids to series and remove all event ids from series, not given event_ids
# for scan only, used at series # for scan only, used at series
sub set_event_ids ($$$$$) { sub set_event_ids ($$$$$) {
my $config = shift; my ($config, $project_id, $studio_id, $serie, $event_ids) = @_;
my $project_id = shift;
my $studio_id = shift;
my $serie = shift;
my $event_ids = shift;
my $serie_id = $serie->{series_id}; my $serie_id = $serie->{series_id};
return unless defined $project_id; return unless defined $project_id;
@@ -988,8 +966,7 @@ sub set_event_ids ($$$$$) {
# check if user allowed to update series events # check if user allowed to update series events
# evaluate permissions and consider editors directly assigned to series # evaluate permissions and consider editors directly assigned to series
sub can_user_update_events ($$) { sub can_user_update_events ($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
my $config = $request->{config}; my $config = $request->{config};
my $permissions = $request->{permissions}; my $permissions = $request->{permissions};
@@ -1009,8 +986,7 @@ sub can_user_update_events ($$) {
# check if user allowed to create series events # check if user allowed to create series events
# evaluate permissions and consider editors directly assigned to series # evaluate permissions and consider editors directly assigned to series
sub can_user_create_events ($$) { sub can_user_create_events ($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
my $config = $request->{config}; my $config = $request->{config};
my $permissions = $request->{permissions}; my $permissions = $request->{permissions};
@@ -1028,8 +1004,7 @@ sub can_user_create_events ($$) {
} }
sub is_series_assigned_to_user ($$) { sub is_series_assigned_to_user ($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
my $config = $request->{config}; my $config = $request->{config};
my $permissions = $request->{permissions}; my $permissions = $request->{permissions};
@@ -1055,8 +1030,7 @@ sub is_series_assigned_to_user ($$) {
# check if user is assigned to studio where location matchs to event # check if user is assigned to studio where location matchs to event
# return 1 on success or error text # return 1 on success or error text
sub is_event_assigned_to_user ($$) { sub is_event_assigned_to_user ($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
my $config = $request->{config}; my $config = $request->{config};
@@ -1105,8 +1079,7 @@ sub is_event_assigned_to_user ($$) {
} }
sub get_rebuilt_episodes ($$) { sub get_rebuilt_episodes ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return "missing project_id" unless defined $options->{project_id}; return "missing project_id" unless defined $options->{project_id};
return "missing studio_id" unless defined $options->{studio_id}; return "missing studio_id" unless defined $options->{studio_id};
@@ -1157,7 +1130,7 @@ sub get_rebuilt_episodes ($$) {
# to find multiple recurrences this does not include the recurrence_count # to find multiple recurrences this does not include the recurrence_count
# use events::get_key to add the recurrence # use events::get_key to add the recurrence
sub get_event_key ($) { sub get_event_key ($) {
my $event = shift; my ($event) = @_;
my $program = $event->{program} || ''; my $program = $event->{program} || '';
my $series_name = $event->{series_name} || ''; my $series_name = $event->{series_name} || '';
@@ -1176,8 +1149,7 @@ sub get_event_key ($) {
} }
sub update_recurring_events ($$) { sub update_recurring_events ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return "missing project_id" unless defined $options->{project_id}; return "missing project_id" unless defined $options->{project_id};
return "missing studio_id" unless defined $options->{studio_id}; return "missing studio_id" unless defined $options->{studio_id};
@@ -1247,8 +1219,7 @@ sub update_recurring_events ($$) {
} }
sub update_recurring_event($$) { sub update_recurring_event($$) {
my $config = shift; my ($config, $event) = @_;
my $event = shift;
return undef unless defined $event->{event_id}; return undef unless defined $event->{event_id};
return undef unless defined $event->{recurrence}; return undef unless defined $event->{recurrence};

45
lib/calcms/series_dates.pm
View File

@@ -20,7 +20,7 @@ use series_schedule();
our @EXPORT_OK = qw(get_columns get insert update delete get_dates get_series); our @EXPORT_OK = qw(get_columns get insert update delete get_dates get_series);
sub get_columns ($) { sub get_columns ($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_series_dates' ); return db::get_columns_hash( $dbh, 'calcms_series_dates' );
@@ -29,8 +29,7 @@ sub get_columns ($) {
# get all series_dates for studio_id and series_id within given time range # 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) # calculate start_date, end_date, weeday, day from start and end(datetime)
sub get ($;$) { sub get ($;$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -107,8 +106,7 @@ sub get ($;$) {
#check if event is scheduled (on permission check) #check if event is scheduled (on permission check)
sub is_event_scheduled($$) { sub is_event_scheduled($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
return 0 unless defined $options->{project_id}; return 0 unless defined $options->{project_id};
return 0 unless defined $options->{studio_id}; return 0 unless defined $options->{studio_id};
@@ -131,8 +129,7 @@ sub is_event_scheduled($$) {
#get all series for given studio_id, time range and search #get all series for given studio_id, time range and search
sub get_series($;$) { sub get_series($;$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $date_range_include = 0; my $date_range_include = 0;
$date_range_include = 1 $date_range_include = 1
@@ -251,8 +248,7 @@ sub get_series($;$) {
} }
sub addSeriesScheduleAttributes ($$) { sub addSeriesScheduleAttributes ($$) {
my $config = shift; my ($config, $entries) = @_;
my $entries = shift;
# get series schedule ids used at entries # get series schedule ids used at entries
my $scheduleIds = { map { $_->{series_schedule_id} => 1 } @$entries }; my $scheduleIds = { map { $_->{series_schedule_id} => 1 } @$entries };
@@ -283,8 +279,7 @@ sub addSeriesScheduleAttributes ($$) {
#update series dates for all schedules of a series and studio_id #update series dates for all schedules of a series and studio_id
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -361,8 +356,7 @@ sub update($$) {
} }
sub get_schedule_dates($$) { sub get_schedule_dates($$) {
my $schedule = shift; my ($schedule, $options) = @_;
my $options = shift;
my $is_exclude = $options->{exclude} || 0; my $is_exclude = $options->{exclude} || 0;
my $dates = []; my $dates = [];
@@ -390,13 +384,8 @@ sub get_schedule_dates($$) {
} }
sub get_week_of_month_dates ($$$$$$$) { sub get_week_of_month_dates ($$$$$$$) {
my $start = shift; # datetime string my ($start, $end, $duration, $week, $weekday, $frequency, $nextDay) = @_;
my $end = shift; # datetime string #datetime, datetime, minutes, every nth week of month, weekday [1..7], every 1st,2nd,3th time, add 24 hours to start, (for night hours at last weekday of month)
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 $start eq '';
return undef if $end eq ''; return undef if $end eq '';
@@ -441,8 +430,7 @@ sub get_week_of_month_dates ($$$$$$$) {
#add duration to a single date #add duration to a single date
sub get_single_date ($$) { sub get_single_date ($$) {
my $start_datetime = shift; my ($start_datetime, $duration) = @_;
my $duration = shift;
my @start = @{ time::datetime_to_array($start_datetime) }; my @start = @{ time::datetime_to_array($start_datetime) };
return unless @start >= 6; return unless @start >= 6;
@@ -461,11 +449,8 @@ sub get_single_date ($$) {
#calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days) #calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days)
sub get_dates($$$$) { sub get_dates($$$$) {
my $start_datetime = shift; my ($start_datetime, $end_date, $duration, $frequency) = @_;
my $end_date = shift; # in minutes, in days
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) }; my @start = @{ time::datetime_to_array($start_datetime) };
return unless @start >= 6; return unless @start >= 6;
@@ -518,8 +503,7 @@ sub get_dates($$$$) {
#remove all series_dates for studio_id and series_id #remove all series_dates for studio_id and series_id
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
return unless defined $entry->{studio_id}; return unless defined $entry->{studio_id};
@@ -539,8 +523,7 @@ sub delete ($$) {
# get all series dates where no event has been created for # get all series dates where no event has been created for
sub getDatesWithoutEvent ($$) { sub getDatesWithoutEvent ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return unless defined $options->{project_id}; return unless defined $options->{project_id};
return unless defined $options->{studio_id}; return unless defined $options->{studio_id};

32
lib/calcms/series_events.pm
View File

@@ -39,9 +39,7 @@ sub get_content_columns($) {
# do not check for project,studio,series # do not check for project,studio,series
# all changed columns are returned for history handling # all changed columns are returned for history handling
sub save_content($$) { sub save_content($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{id}; return undef unless defined $entry->{id};
for my $attr ( keys %$entry ) { for my $attr ( keys %$entry ) {
@@ -96,8 +94,7 @@ sub save_content($$) {
} }
sub set_episode{ sub set_episode{
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{id}; return undef unless defined $entry->{id};
return undef unless defined $entry->{episode}; return undef unless defined $entry->{episode};
@@ -121,8 +118,7 @@ sub set_episode{
# do not check project, studio, series # do not check project, studio, series
# for history handling all changed columns are returned # for history handling all changed columns are returned
sub save_event_time($$) { sub save_event_time($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{id}; return undef unless defined $entry->{id};
return undef unless defined $entry->{duration}; return undef unless defined $entry->{duration};
@@ -171,8 +167,7 @@ sub save_event_time($$) {
} }
sub set_playout_status ($$) { sub set_playout_status ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -209,8 +204,7 @@ sub set_playout_status ($$) {
# is event assigned to project, studio and series? # is event assigned to project, studio and series?
sub is_event_assigned($$) { sub is_event_assigned($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return 0 unless defined $entry->{project_id}; return 0 unless defined $entry->{project_id};
return 0 unless defined $entry->{studio_id}; return 0 unless defined $entry->{studio_id};
@@ -231,8 +225,7 @@ sub is_event_assigned($$) {
} }
sub delete_event ($$) { sub delete_event ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -270,8 +263,7 @@ sub delete_event ($$) {
# key check_for: user, studio, series, events, schedule # key check_for: user, studio, series, events, schedule
# return error text or 1 if okay # return error text or 1 if okay
sub check_permission($$) { sub check_permission($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
return "missing permission at check" unless defined $options->{permission}; return "missing permission at check" unless defined $options->{permission};
return "missing check_for at check" unless defined $options->{check_for}; return "missing check_for at check" unless defined $options->{check_for};
@@ -410,8 +402,7 @@ sub check_permission($$) {
#insert event #insert event
sub insert_event ($$) { sub insert_event ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my $project_id = $options->{project_id}; my $project_id = $options->{project_id};
my $studio = $options->{studio}; my $studio = $options->{studio};
@@ -496,9 +487,7 @@ sub insert_event ($$) {
#set start, end, start-date, end_date to an event #set start, end, start-date, end_date to an event
sub add_event_dates($$$) { sub add_event_dates($$$) {
my $config = shift; my ($config, $event, $params) = @_;
my $event = shift;
my $params = shift;
#start and end datetime #start and end datetime
$event->{start} = $params->{start_date}; $event->{start} = $params->{start_date};
@@ -512,8 +501,7 @@ sub add_event_dates($$$) {
} }
sub update_series_images ($$) { sub update_series_images ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return "missing project_id" unless defined $options->{project_id}; return "missing project_id" unless defined $options->{project_id};
return "missing studio_id" unless defined $options->{studio_id}; return "missing studio_id" unless defined $options->{studio_id};

14
lib/calcms/series_schedule.pm
View File

@@ -22,7 +22,7 @@ use series_dates();
our @EXPORT_OK = qw(get_columns get insert update delete); our @EXPORT_OK = qw(get_columns get insert update delete);
sub get_columns ($) { sub get_columns ($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_series_schedule' ); return db::get_columns_hash( $dbh, 'calcms_series_schedule' );
@@ -30,8 +30,7 @@ sub get_columns ($) {
#map schedule id to id #map schedule id to id
sub get($$) { sub get($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -99,8 +98,7 @@ sub get($$) {
} }
sub insert($$) { sub insert($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -112,8 +110,7 @@ sub insert($$) {
#schedule id to id #schedule id to id
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -146,8 +143,7 @@ sub update($$) {
#map schedule id to id #map schedule id to id
sub delete($$) { sub delete($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};

6
lib/calcms/startup.pl
View File

@@ -3,6 +3,12 @@ use lib qw(/home/radio/calcms/calcms/);
use lib qw(/home/calcms/lib/calcms/); use lib qw(/home/calcms/lib/calcms/);
use lib qw(/srv/www/sites/testing-calcms.datenkollektiv.net/lib/calcms/); use lib qw(/srv/www/sites/testing-calcms.datenkollektiv.net/lib/calcms/);
use Apache2::Log;
local *CORE::GLOBAL::warn = \&Apache2::ServerRec::warn;
local $SIG{__WARN__} = \&Apache2::ServerRec::warn;
# ^ use ErrorLog file set at Apache2 configuration
# see https://perl.apache.org/docs/2.0/api/Apache2/Log.html for details
use Data::Dumper; use Data::Dumper;
#use Apache::DBI(); #use Apache::DBI();
use Time::Local(); use Time::Local();

23
lib/calcms/studio_timeslot_dates.pm
View File

@@ -16,7 +16,7 @@ use time();
our @EXPORT_OK = qw(get_columns get insert update delete get_dates); our @EXPORT_OK = qw(get_columns get insert update delete get_dates);
sub get_columns ($){ sub get_columns ($){
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_studio_timeslot_dates' ); return db::get_columns_hash( $dbh, 'calcms_studio_timeslot_dates' );
@@ -25,8 +25,7 @@ sub get_columns ($){
# get all studio_timeslot_dates for studio_id within given time range # get all studio_timeslot_dates for studio_id within given time range
# calculate start_date, end_date, weeday, day from start and end(datetime) # calculate start_date, end_date, weeday, day from start and end(datetime)
sub get ($$){ sub get ($$){
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $date_range_include = 0; my $date_range_include = 0;
$date_range_include = 1 if ( defined $condition->{date_range_include} ) && ( $condition->{date_range_include} == 1 ); $date_range_include = 1 if ( defined $condition->{date_range_include} ) && ( $condition->{date_range_include} == 1 );
@@ -113,8 +112,7 @@ sub get ($$){
#get all studio_timeslot_schedules for studio_id and update studio_timeslot_dates #get all studio_timeslot_schedules for studio_id and update studio_timeslot_dates
sub update { sub update {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{schedule_id}; return undef unless defined $entry->{schedule_id};
@@ -172,10 +170,8 @@ sub update {
# calculate all start/end datetimes between start_date and stop_date with a frequency(days) # calculate all start/end datetimes between start_date and stop_date with a frequency(days)
# returns list of hashs with start and end # returns list of hashs with start and end
sub get_dates { sub get_dates {
my $start_datetime = shift; # start my ($start_datetime, $end_datetime, $stop_date, $frequency) = @_;
my $end_datetime = shift; # start #days
my $stop_date = shift; # limit recurring events
my $frequency = shift; # in days
my @start = @{ time::datetime_to_array($start_datetime) }; my @start = @{ time::datetime_to_array($start_datetime) };
return unless @start >= 6; return unless @start >= 6;
@@ -264,8 +260,7 @@ sub get_dates {
#remove all studio_timeslot_dates for studio_id and schedule_id #remove all studio_timeslot_dates for studio_id and schedule_id
sub delete { sub delete {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
return unless defined $entry->{studio_id}; return unless defined $entry->{studio_id};
@@ -286,8 +281,7 @@ sub delete {
# time based filter to check if studio is assigned to an studio at a given time range # 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 # return 1 if there is a schedule date starting before start and ending after end
sub can_studio_edit_events { sub can_studio_edit_events {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -350,8 +344,7 @@ sub can_studio_edit_events {
# returns hashref with start and end of merged slot # returns hashref with start and end of merged slot
# returns undef if not slot could be found # returns undef if not slot could be found
sub getMergedDays { sub getMergedDays {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();

14
lib/calcms/studio_timeslot_schedule.pm
View File

@@ -14,7 +14,7 @@ use studio_timeslot_dates();
our @EXPORT_OK = qw(get_columns get insert update delete); our @EXPORT_OK = qw(get_columns get insert update delete);
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_studio_timeslot_schedule' ); return db::get_columns_hash( $dbh, 'calcms_studio_timeslot_schedule' );
@@ -22,8 +22,7 @@ sub get_columns($) {
#map schedule id to id #map schedule id to id
sub get($$) { sub get($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -62,8 +61,7 @@ sub get($$) {
} }
sub insert($$) { sub insert($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
return unless defined $entry->{studio_id}; return unless defined $entry->{studio_id};
@@ -77,8 +75,7 @@ sub insert($$) {
#schedule id to id #schedule id to id
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
return unless defined $entry->{studio_id}; return unless defined $entry->{studio_id};
@@ -112,8 +109,7 @@ sub update($$) {
#map schedule id to id #map schedule id to id
sub delete ($$){ sub delete ($$){
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{schedule_id}; return unless defined $entry->{schedule_id};

26
lib/calcms/studios.pm
View File

@@ -11,14 +11,14 @@ use images();
our @EXPORT_OK = qw(get_columns get get_by_id insert update delete check check_studio); our @EXPORT_OK = qw(get_columns get get_by_id insert update delete check check_studio);
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_studios' ); return db::get_columns_hash( $dbh, 'calcms_studios' );
} }
sub get($;$) { sub get($;$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift || {}; $condition ||= {};
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -72,8 +72,7 @@ sub get($;$) {
} }
sub getImageById($$) { sub getImageById($$) {
my $config = shift; my ($config, $conditions) = @_;
my $conditions = shift;
return undef unless defined $conditions->{project_id}; return undef unless defined $conditions->{project_id};
return undef unless defined $conditions->{studio_id}; return undef unless defined $conditions->{studio_id};
@@ -83,8 +82,7 @@ sub getImageById($$) {
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
$entry->{created_at} = time::time_to_datetime( time() ); $entry->{created_at} = time::time_to_datetime( time() );
$entry->{modified_at} = time::time_to_datetime( time() ); $entry->{modified_at} = time::time_to_datetime( time() );
@@ -96,8 +94,7 @@ sub insert ($$) {
} }
sub update ($$) { sub update ($$) {
my $config = shift; my ($config, $studio) = @_;
my $studio = shift;
$studio->{modified_at} = time::time_to_datetime( time() ); $studio->{modified_at} = time::time_to_datetime( time() );
@@ -124,23 +121,20 @@ sub update ($$) {
} }
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $studio) = @_;
my $studio = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
db::put( $dbh, 'delete from calcms_studios where id=?', [ $studio->{id} ] ); db::put( $dbh, 'delete from calcms_studios where id=?', [ $studio->{id} ] );
} }
#TODO rename to check #TODO rename to check
sub check_studio($$) { sub check_studio($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return check( $config, $options ); return check( $config, $options );
} }
sub check ($$) { sub check ($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return "missing studio_id" unless defined $options->{studio_id}; 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 '-1' );
return "Please select a studio" if ( $options->{studio_id} eq '' ); return "Please select a studio" if ( $options->{studio_id} eq '' );

9
lib/calcms/template.pm
View File

@@ -120,8 +120,8 @@ sub initTemplate($) {
sub setRelativeUrls; sub setRelativeUrls;
sub setRelativeUrls { sub setRelativeUrls {
my $params = shift; my ($params, $depth) = @_;
my $depth = shift || 0; $depth ||= 0;
return unless defined $params; return unless defined $params;
@@ -164,10 +164,9 @@ sub setRelativeUrls {
} }
sub check($;$$) { sub check($;$$) {
my $config = shift; my ($config, $template, $default) = @_;
my $template = shift || '';
my $default = shift;
$template ||= '';
if ( $template =~ /json\-p/ ) { if ( $template =~ /json\-p/ ) {
$template =~ s/[^a-zA-Z0-9\-\_\.]//g; $template =~ s/[^a-zA-Z0-9\-\_\.]//g;
$template =~ s/\.{2,99}/\./g; $template =~ s/\.{2,99}/\./g;

121
lib/calcms/time.pm
View File

@@ -79,28 +79,33 @@ sub getDurations() {
} }
sub getWeekdayNames(;$) { sub getWeekdayNames(;$) {
my $language = shift || 'en'; my ($language) = @_;
$language ||= 'en';
return $NAMES->{$language}->{weekdays}; return $NAMES->{$language}->{weekdays};
} }
sub getWeekdayNamesShort(;$) { sub getWeekdayNamesShort(;$) {
my $language = shift || 'en'; my ($language) = @_;
$language ||= 'en';
return $NAMES->{$language}->{weekdays_abbr}; return $NAMES->{$language}->{weekdays_abbr};
} }
sub getMonthNames(;$) { sub getMonthNames(;$) {
my $language = shift || 'en'; my ($language) = @_;
$language ||= 'en';
return $NAMES->{$language}->{months}; return $NAMES->{$language}->{months};
} }
sub getMonthNamesShort(;$) { sub getMonthNamesShort(;$) {
my $language = shift || 'en'; my ($language) = @_;
$language ||= 'en';
return $NAMES->{$language}->{months_abbr}; return $NAMES->{$language}->{months_abbr};
} }
sub getWeekdayIndex(;$) { sub getWeekdayIndex(;$) {
my $weekday = shift || ''; my ($weekday) = @_;
$weekday ||= '';
return $WEEKDAY_INDEX->{$weekday}; return $WEEKDAY_INDEX->{$weekday};
} }
@@ -130,7 +135,7 @@ sub getWeekdays {
#deprecated, for wordpress sync #deprecated, for wordpress sync
sub format_datetime(;$) { sub format_datetime(;$) {
my $datetime = shift; my ($datetime) = @_;
return $datetime if ( $datetime eq '' ); return $datetime if ( $datetime eq '' );
return add_hours_to_datetime( $datetime, 0 ); return add_hours_to_datetime( $datetime, 0 );
} }
@@ -184,40 +189,35 @@ sub datetime_to_rfc822($) {
#get seconds from epoch #get seconds from epoch
sub datetime_to_utc($$) { sub datetime_to_utc($$) {
my $datetime = shift; my ($datetime, $time_zone) = @_;
my $time_zone = shift;
$datetime = get_datetime( $datetime, $time_zone ); $datetime = get_datetime( $datetime, $time_zone );
return $datetime->epoch(); return $datetime->epoch();
} }
# get full utc datetime including timezone offset # get full utc datetime including timezone offset
sub datetime_to_utc_datetime($$) { sub datetime_to_utc_datetime($$) {
my $datetime = shift; my ($datetime, $time_zone) = @_;
my $time_zone = shift;
$datetime = get_datetime( $datetime, $time_zone ); $datetime = get_datetime( $datetime, $time_zone );
return $datetime->format_cldr("yyyy-MM-ddTHH:mm:ssZZZZZ"); return $datetime->format_cldr("yyyy-MM-ddTHH:mm:ssZZZZZ");
} }
#add hours to datetime string #add hours to datetime string
sub add_hours_to_datetime($;$) { sub add_hours_to_datetime($;$) {
my $datetime = shift; my ($datetime, $hours) = @_;
my $hours = shift;
$hours = 0 unless defined $hours; $hours = 0 unless defined $hours;
return time_to_datetime( datetime_to_time($datetime) + ( 3600 * $hours ) ); return time_to_datetime( datetime_to_time($datetime) + ( 3600 * $hours ) );
} }
#add minutes to datetime string #add minutes to datetime string
sub add_minutes_to_datetime($;$) { sub add_minutes_to_datetime($;$) {
my $datetime = shift; my ($datetime, $minutes) = @_;
my $minutes = shift;
$minutes = 0 unless defined $minutes; $minutes = 0 unless defined $minutes;
return time_to_datetime( datetime_to_time($datetime) + ( 60 * $minutes ) ); return time_to_datetime( datetime_to_time($datetime) + ( 60 * $minutes ) );
} }
#add days to datetime string #add days to datetime string
sub add_days_to_datetime($;$) { sub add_days_to_datetime($;$) {
my $datetime = shift; my ($datetime, $days) = @_;
my $days = shift;
$days = 0 unless defined $days; $days = 0 unless defined $days;
my $time = datetime_to_array($datetime); my $time = datetime_to_array($datetime);
@@ -226,8 +226,7 @@ sub add_days_to_datetime($;$) {
} }
sub add_days_to_date($;$) { sub add_days_to_date($;$) {
my $datetime = shift; my ($datetime, $days) = @_;
my $days = shift;
$days = 0 unless defined $days; $days = 0 unless defined $days;
my $date = date_to_array($datetime); 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 ); ( $date->[0], $date->[1], $date->[2] ) = Date::Calc::Add_Delta_Days( $date->[0] + 0, $date->[1] + 0, $date->[2] + 0, $days );
@@ -236,7 +235,7 @@ sub add_days_to_date($;$) {
# convert unix time to datetime format # convert unix time to datetime format
sub time_to_datetime(;$) { sub time_to_datetime(;$) {
my $time = shift; my ($time) = @_;
$time = time() unless ( defined $time ) && ( $time ne '' ); $time = time() unless ( defined $time ) && ( $time ne '' );
my @t = localtime($time); 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] ); return sprintf( '%04d-%02d-%02d %02d:%02d:%02d', $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0] );
@@ -244,7 +243,7 @@ sub time_to_datetime(;$) {
# convert unix time to date format # convert unix time to date format
sub time_to_date(;$) { sub time_to_date(;$) {
my $time = shift; my ($time) = @_;
$time = time() unless ( defined $time ) && ( $time ne '' ); $time = time() unless ( defined $time ) && ( $time ne '' );
my @t = localtime($time); my @t = localtime($time);
return sprintf( '%04d-%02d-%02d', $t[5] + 1900, $t[4] + 1, $t[3] ); return sprintf( '%04d-%02d-%02d', $t[5] + 1900, $t[4] + 1, $t[3] );
@@ -252,7 +251,8 @@ sub time_to_date(;$) {
# convert datetime to a array of date/time values # convert datetime to a array of date/time values
sub datetime_to_array(;$) { sub datetime_to_array(;$) {
my $datetime = $_[0] || ''; my ($datetime) = @_;
$datetime ||= '';
if ( $datetime =~ /(\d\d\d\d)\-(\d+)\-(\d+)([T\s]+(\d+)\:(\d+)(\:(\d+))?)?/ ) { if ( $datetime =~ /(\d\d\d\d)\-(\d+)\-(\d+)([T\s]+(\d+)\:(\d+)(\:(\d+))?)?/ ) {
my $year = $1; my $year = $1;
my $month = $2; my $month = $2;
@@ -279,58 +279,55 @@ sub datetime_to_date(;$) {
#convert datetime array or single value to datetime string #convert datetime array or single value to datetime string
sub array_to_datetime(;$) { sub array_to_datetime(;$) {
my $date = shift; my ($date, $month, $day, $hour, $minute, $second) = @_;
if ( ref($date) eq 'ARRAY' ) { 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] ); 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; $hour ||= '0';
my $hour = shift || '0'; $minute ||= '0';
my $minute = shift || '0'; $second ||= '0';
my $second = shift || '0';
return sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $date, $month, $day, $hour, $minute, $second ); return sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $date, $month, $day, $hour, $minute, $second );
} }
#convert date array or single values to date string #convert date array or single values to date string
sub array_to_date($;$$) { sub array_to_date($;$$) {
my $date = shift; my ($date, $month, $day) = @_;
if ( ref($date) eq 'ARRAY' ) { if ( ref($date) eq 'ARRAY' ) {
return sprintf( "%04d-%02d-%02d", $date->[0], $date->[1], $date->[2] ); 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 ); return sprintf( "%04d-%02d-%02d", $date, $month, $day );
} }
sub array_to_time(;$) { sub array_to_time(;$) {
my $date = shift; my ($date, $minute, $second) = @_;
if ( ref($date) eq 'ARRAY' ) { if ( ref($date) eq 'ARRAY' ) {
return sprintf( "%02d:%02d:%02d", $date->[3], $date->[4], $date->[5] ); return sprintf( "%02d:%02d:%02d", $date->[3], $date->[4], $date->[5] );
} }
my $minute = shift || 0; $minute ||= '0';
my $second = shift || 0; $second ||= '0';
return sprintf( "%02d:%02d:%02d", $date, $minute, $second ); return sprintf( "%02d:%02d:%02d", $date, $minute, $second );
} }
sub array_to_time_hm(;$) { sub array_to_time_hm(;$) {
my $date = shift; my ($date, $minute) = @_;
if ( ref($date) eq 'ARRAY' ) { if ( ref($date) eq 'ARRAY' ) {
return sprintf( "%02d:%02d", $date->[3], $date->[4] ); return sprintf( "%02d:%02d", $date->[3], $date->[4] );
} }
my $minute = shift || 0; $minute ||= '0';
return sprintf( "%02d:%02d", $date, $minute ); return sprintf( "%02d:%02d", $date, $minute );
} }
# get number of days between two days # get number of days between two days
sub days_between($$) { sub days_between($$) {
my $today = $_[0]; my ($today, $date) = @_;
my $date = $_[1];
my $delta_days = eval { Date::Calc::Delta_Days( $today->[0], $today->[1], $today->[2], $date->[0], $date->[1], $date->[2] ) }; my $delta_days = eval { Date::Calc::Delta_Days( $today->[0], $today->[1], $today->[2], $date->[0], $date->[1], $date->[2] ) };
return $delta_days; return $delta_days;
} }
sub dayOfYear($) { sub dayOfYear($) {
my $datetime = $_[0]; my ($datetime) = @_;
if ( $datetime =~ /(\d\d\d\d)\-(\d+)\-(\d+)/ ) { if ( $datetime =~ /(\d\d\d\d)\-(\d+)\-(\d+)/ ) {
my $year = $1; my $year = $1;
my $month = $2; my $month = $2;
@@ -342,9 +339,7 @@ sub dayOfYear($) {
# get duration in minutes # get duration in minutes
sub get_duration($$$) { sub get_duration($$$) {
my $start = shift; my ($start, $end, $timezone) = @_;
my $end = shift;
my $timezone = shift;
$start = time::get_datetime( $start, $timezone ); $start = time::get_datetime( $start, $timezone );
$end = time::get_datetime( $end, $timezone ); $end = time::get_datetime( $end, $timezone );
my $duration = $end->epoch() - $start->epoch(); my $duration = $end->epoch() - $start->epoch();
@@ -353,9 +348,8 @@ sub get_duration($$$) {
# get duration in seconds # get duration in seconds
sub get_duration_seconds($$;$) { sub get_duration_seconds($$;$) {
my $start = shift; my ($start, $end, $timezone) = @_;
my $end = shift; $timezone ||= 'UTC';
my $timezone = shift || 'UTC';
unless ( defined $start ) { unless ( defined $start ) {
print STDERR "time::get_duration_seconds(): start is missing\n"; print STDERR "time::get_duration_seconds(): start is missing\n";
@@ -395,7 +389,7 @@ sub date_to_array($) {
# parse date string and return date string # parse date string and return date string
# pass 'today', return '' on parse error # pass 'today', return '' on parse error
sub date_cond($) { sub date_cond($) {
my $date = shift; my ($date) = @_;
return '' if ( $date eq '' ); return '' if ( $date eq '' );
if ( $date =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)/ ) { if ( $date =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)/ ) {
@@ -411,7 +405,7 @@ sub date_cond($) {
#parse time and return time string hh:mm:ss #parse time and return time string hh:mm:ss
#return hh:00 if time is 'now' #return hh:00 if time is 'now'
sub time_cond($) { sub time_cond($) {
my $time = shift; my ($time) = @_;
return '' if ( $time eq '' ); return '' if ( $time eq '' );
if ( $time =~ /(\d\d?)\:(\d\d?)(\:(\d\d))?/ ) { if ( $time =~ /(\d\d?)\:(\d\d?)(\:(\d\d))?/ ) {
@@ -432,7 +426,7 @@ sub time_cond($) {
#parse date and time string and return yyyy-mm-ddThh:mm:ss #parse date and time string and return yyyy-mm-ddThh:mm:ss
sub datetime_cond($) { sub datetime_cond($) {
my $datetime = shift; my ($datetime) = @_;
return '' if ( $datetime eq '' ); return '' if ( $datetime eq '' );
( my $date, my $time ) = split /[ T]/, $datetime; ( my $date, my $time ) = split /[ T]/, $datetime;
@@ -445,7 +439,7 @@ sub datetime_cond($) {
} }
sub check_date($) { sub check_date($) {
my $date = shift; my ($date) = @_;
return "" if ( !defined $date ) || ( $date eq '' ); return "" if ( !defined $date ) || ( $date eq '' );
if ( $date =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)/ ) { if ( $date =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)/ ) {
@@ -460,7 +454,7 @@ sub check_date($) {
} }
sub check_time($) { sub check_time($) {
my $time = shift; my ($time) = @_;
return "" if ( !defined $time ) || ( $time eq '' ); return "" if ( !defined $time ) || ( $time eq '' );
return $time if ( $time eq 'now' ) || ( $time eq 'future' ); return $time if ( $time eq 'now' ) || ( $time eq 'future' );
if ( $time =~ /(\d\d?)\:(\d\d?)/ ) { if ( $time =~ /(\d\d?)\:(\d\d?)/ ) {
@@ -470,7 +464,7 @@ sub check_time($) {
} }
sub check_datetime($) { sub check_datetime($) {
my $date = shift; my ($date) = @_;
return "" if ( !defined $date ) || ( $date eq '' ); return "" if ( !defined $date ) || ( $date eq '' );
if ( $date =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)[T ](\d\d?)\:(\d\d?)/ ) { if ( $date =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)[T ](\d\d?)\:(\d\d?)/ ) {
@@ -480,7 +474,7 @@ sub check_datetime($) {
} }
sub check_year_month($) { sub check_year_month($) {
my $date = shift; my ($date) = @_;
return -1 unless defined $date; return -1 unless defined $date;
return $date if ( $date eq '' ); return $date if ( $date eq '' );
if ( $date =~ /(\d\d\d\d)\-(\d\d?)/ ) { if ( $date =~ /(\d\d\d\d)\-(\d\d?)/ ) {
@@ -491,9 +485,8 @@ sub check_year_month($) {
#TODO: remove config dependency #TODO: remove config dependency
sub date_time_format($$;$) { sub date_time_format($$;$) {
my $config = shift; my ($config, $datetime, $language) = @_;
my $datetime = shift; $language ||= $config->{date}->{language} || 'en';
my $language = shift || $config->{date}->{language} || 'en';
if ( defined $datetime && $datetime =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)[\sT](\d\d?\:\d\d?)/ ) { if ( defined $datetime && $datetime =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)[\sT](\d\d?\:\d\d?)/ ) {
my $time = $4; my $time = $4;
my $day = $3; my $day = $3;
@@ -509,9 +502,8 @@ sub date_time_format($$;$) {
#format datetime to date string #format datetime to date string
#TODO: remove config dependency #TODO: remove config dependency
sub date_format($$;$) { sub date_format($$;$) {
my $config = shift; my ($config, $datetime, $language) = @_;
my $datetime = shift; $language ||= $config->{date}->{language} || 'en';
my $language = shift || $config->{date}->{language} || 'en';
if ( defined $datetime && $datetime =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)/ ) { if ( defined $datetime && $datetime =~ /(\d\d\d\d)\-(\d\d?)\-(\d\d?)/ ) {
my $day = $3; my $day = $3;
@@ -525,7 +517,7 @@ sub date_format($$;$) {
#format datetime to time string #format datetime to time string
sub time_format($) { sub time_format($) {
my $datetime = shift; my ($datetime) = @_;
if ( defined $datetime && $datetime =~ /(\d\d?\:\d\d?)/ ) { if ( defined $datetime && $datetime =~ /(\d\d?\:\d\d?)/ ) {
return $1; return $1;
} }
@@ -534,7 +526,7 @@ sub time_format($) {
#get offset from given time_zone #get offset from given time_zone
sub utc_offset($) { sub utc_offset($) {
my $time_zone = shift; my ($time_zone) = @_;
my $datetime = DateTime->now(); my $datetime = DateTime->now();
$datetime->set_time_zone($time_zone); $datetime->set_time_zone($time_zone);
@@ -551,7 +543,7 @@ sub weekday($$$) {
#get current date, related to starting day_starting_hour #get current date, related to starting day_starting_hour
#TODO: remove config dependency #TODO: remove config dependency
sub get_event_date($) { sub get_event_date($) {
my $config = shift; my ($config) = @_;
my $datetime = time::time_to_datetime( time() ); my $datetime = time::time_to_datetime( time() );
my $hour = ( time::datetime_to_array($datetime) )->[3]; my $hour = ( time::datetime_to_array($datetime) )->[3];
@@ -571,8 +563,7 @@ sub get_event_date($) {
#get datetime object from datetime string #get datetime object from datetime string
sub get_datetime(;$$) { sub get_datetime(;$$) {
my $datetime = shift; my ($datetime, $timezone) = @_;
my $timezone = shift;
return unless defined $datetime; return unless defined $datetime;
return if $datetime eq ''; return if $datetime eq '';
@@ -599,10 +590,8 @@ sub get_datetime(;$$) {
#get list of nth weekday in month from start to end #get list of nth weekday in month from start to end
sub get_nth_weekday_in_month(;$$$$) { sub get_nth_weekday_in_month(;$$$$) {
my $start = shift; # datetime string my ($start, $end, $nth, $weekday) = @_;
my $end = shift; # datetime string #datetime, datetime, every nth week of month, weekday [1..7,'Mo'-'Su','Mo'-'Fr']
my $nth = shift; # every nth week of month
my $weekday = shift; # weekday [1..7,'Mo'-'Su','Mo'-'Fr']
return [] unless defined $start; return [] unless defined $start;
return [] unless defined $end; return [] unless defined $end;

93
lib/calcms/uac.pm
View File

@@ -30,8 +30,7 @@ our @EXPORT_OK = qw(
# get user by name # get user by name
sub get_user($$) { sub get_user($$) {
my $config = shift; my ($config, $user) = @_;
my $user = shift;
my $query = qq{ my $query = qq{
select id, name, full_name, email, disabled, modified_at, created_at select id, name, full_name, email, disabled, modified_at, created_at
@@ -51,8 +50,7 @@ sub get_user($$) {
# get all users # get all users
sub get_users($;$) { sub get_users($;$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -84,9 +82,7 @@ sub get_users($;$) {
# get all users of a given studio id # get all users of a given studio id
# used at series (previously named get_studio_users) # used at series (previously named get_studio_users)
sub get_users_by_studio ($$) { sub get_users_by_studio ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
return unless defined $condition->{studio_id}; return unless defined $condition->{studio_id};
my @conditions = (); my @conditions = ();
@@ -119,8 +115,7 @@ sub get_users_by_studio ($$) {
# get projects a user is assigned by name # get projects a user is assigned by name
sub get_projects_by_user ($$) { sub get_projects_by_user ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -158,8 +153,7 @@ sub get_projects_by_user ($$) {
# get all studios a user is assigned to by role # get all studios a user is assigned to by role
# used at series (previously named get_user_studios) # used at series (previously named get_user_studios)
sub get_studios_by_user ($$) { sub get_studios_by_user ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -194,8 +188,7 @@ sub get_studios_by_user ($$) {
} }
sub insert_user($$) { sub insert_user($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
$entry->{created_at} = time::time_to_datetime( time() ); $entry->{created_at} = time::time_to_datetime( time() );
$entry->{modified_at} = time::time_to_datetime( time() ); $entry->{modified_at} = time::time_to_datetime( time() );
@@ -205,8 +198,7 @@ sub insert_user($$) {
} }
sub update_user($$) { sub update_user($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
$entry->{modified_at} = time::time_to_datetime( time() ); $entry->{modified_at} = time::time_to_datetime( time() );
@@ -226,8 +218,7 @@ sub update_user($$) {
} }
sub delete_user($$) { sub delete_user($$) {
my $config = shift; my ($config, $id) = @_;
my $id = shift;
return unless ( defined $id && ( $id =~ /^\d+$/ ) ); return unless ( defined $id && ( $id =~ /^\d+$/ ) );
my $query = qq{ my $query = qq{
@@ -241,8 +232,7 @@ sub delete_user($$) {
# get all roles used by all users of a studio # get all roles used by all users of a studio
# available conditions: project_id, studio_id # available conditions: project_id, studio_id
sub get_studio_roles($$) { sub get_studio_roles($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
return [] if ( $condition->{studio_id} eq '' ); return [] if ( $condition->{studio_id} eq '' );
@@ -276,7 +266,7 @@ sub get_studio_roles($$) {
# get role columns (for external use only) # get role columns (for external use only)
sub get_role_columns($) { sub get_role_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
my $columns = db::get_columns_hash( $dbh, 'calcms_roles' ); my $columns = db::get_columns_hash( $dbh, 'calcms_roles' );
return $columns; return $columns;
@@ -285,8 +275,7 @@ sub get_role_columns($) {
# get roles # get roles
# filter: studio_id project_id # filter: studio_id project_id
sub get_roles($$) { sub get_roles($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -316,8 +305,7 @@ sub get_roles($$) {
#insert role to database, set created_at and modified_at #insert role to database, set created_at and modified_at
sub insert_role ($$) { sub insert_role ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
$entry->{created_at} = time::time_to_datetime( time() ); $entry->{created_at} = time::time_to_datetime( time() );
$entry->{modified_at} = time::time_to_datetime( time() ); $entry->{modified_at} = time::time_to_datetime( time() );
@@ -333,8 +321,7 @@ sub insert_role ($$) {
#update role, set modified_at #update role, set modified_at
sub update_role($$) { sub update_role($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
$entry->{modified_at} = time::time_to_datetime( time() ); $entry->{modified_at} = time::time_to_datetime( time() );
@@ -356,8 +343,7 @@ sub update_role($$) {
# delete role from database # delete role from database
sub delete_role($$) { sub delete_role($$) {
my $config = shift; my ($config, $id) = @_;
my $id = shift;
return unless ( defined $id && ( $id =~ /^\d+$/ ) ); return unless ( defined $id && ( $id =~ /^\d+$/ ) );
@@ -372,8 +358,7 @@ sub delete_role($$) {
# get all roles for given conditions: project_id, studio_id, user_id, name # get all roles for given conditions: project_id, studio_id, user_id, name
# includes global admin user role # includes global admin user role
sub get_user_roles($$) { sub get_user_roles($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -427,8 +412,7 @@ sub get_user_roles($$) {
#return admin user roles for given conditions: project_id, studio_id, user, user_id #return admin user roles for given conditions: project_id, studio_id, user, user_id
sub get_admin_user_roles ($$) { sub get_admin_user_roles ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -470,9 +454,7 @@ sub get_admin_user_roles ($$) {
# return user_permissions # return user_permissions
# studio_id, user_id, name # studio_id, user_id, name
sub get_user_permissions ($$;$) { sub get_user_permissions ($$;$) {
my $config = shift; my ($config, $conditions, $user_permissions) = @_;
my $conditions = shift;
my $user_permissions = shift;
my $user_roles = get_user_roles( $config, $conditions ); my $user_roles = get_user_roles( $config, $conditions );
my $admin_roles = get_admin_user_roles( $config, $conditions ); my $admin_roles = get_admin_user_roles( $config, $conditions );
@@ -512,9 +494,7 @@ sub get_user_permissions ($$;$) {
#get user id by user name #get user id by user name
sub get_user_id ($$) { sub get_user_id ($$) {
my $config = shift; my ($config, $user) = @_;
my $user = shift;
return undef unless defined $user; return undef unless defined $user;
my $query = qq{ my $query = qq{
@@ -530,9 +510,7 @@ sub get_user_id ($$) {
#get role id by role name #get role id by role name
sub get_role_id ($$) { sub get_role_id ($$) {
my $config = shift; my ($config, $role) = @_;
my $role = shift;
return undef unless defined $role; return undef unless defined $role;
my $query = qq{ my $query = qq{
@@ -548,8 +526,7 @@ sub get_role_id ($$) {
# assign a role to an user (for a studio) # assign a role to an user (for a studio)
sub assign_user_role($$) { sub assign_user_role($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -581,8 +558,7 @@ sub assign_user_role($$) {
# unassign a user from a role of (for a studio) # unassign a user from a role of (for a studio)
sub remove_user_role($$) { sub remove_user_role($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
return undef unless defined $options->{studio_id}; return undef unless defined $options->{studio_id};
@@ -604,8 +580,7 @@ sub remove_user_role($$) {
#checks #checks
sub is_user_assigned_to_studio ($$) { sub is_user_assigned_to_studio ($$) {
my $request = shift; my ($request, $options) = @_;
my $options = shift;
my $config = $request->{config}; my $config = $request->{config};
@@ -627,10 +602,7 @@ sub is_user_assigned_to_studio ($$) {
# print errors at get_user_presets and check for project id and studio id # print errors at get_user_presets and check for project id and studio id
# call after header is printed # call after header is printed
sub check($$$) { sub check($$$) {
my $config = shift; my ($config, $params, $user_presets) = @_;
my $params = shift;
my $user_presets = shift;
if ( defined $user_presets->{error} ) { if ( defined $user_presets->{error} ) {
uac::print_error( $user_presets->{error} ); uac::print_error( $user_presets->{error} );
return 0; return 0;
@@ -654,8 +626,7 @@ sub check($$$) {
# set permissions for selected project and studio # set permissions for selected project and studio
# return request # return request
sub get_user_presets($$) { sub get_user_presets($$) {
my $config = shift; my ($config, $options) = @_;
my $options = shift;
my $user = $options->{user} || ''; my $user = $options->{user} || '';
my $error = undef; my $error = undef;
@@ -787,8 +758,7 @@ sub get_user_presets($$) {
} }
sub setDefaultProject ($$) { sub setDefaultProject ($$) {
my $params = shift; my ($params, $user_presets) = @_;
my $user_presets = shift;
$params->{project_id} = $user_presets->{project_id} $params->{project_id} = $user_presets->{project_id}
if ( !defined $params->{authAction} ) || ( $params->{authAction} eq '' ) || ( $params->{authAction} eq 'login' ); if ( !defined $params->{authAction} ) || ( $params->{authAction} eq '' ) || ( $params->{authAction} eq 'login' );
@@ -796,8 +766,7 @@ sub setDefaultProject ($$) {
} }
sub setDefaultStudio($$) { sub setDefaultStudio($$) {
my $params = shift; my ($params, $user_presets) = @_;
my $user_presets = shift;
$params->{studio_id} = $user_presets->{studio_id} $params->{studio_id} = $user_presets->{studio_id}
if ( !defined $params->{authAction} ) || ( $params->{authAction} eq '' ) || ( $params->{authAction} eq 'login' ); if ( !defined $params->{authAction} ) || ( $params->{authAction} eq '' ) || ( $params->{authAction} eq 'login' );
@@ -806,8 +775,7 @@ sub setDefaultStudio($$) {
#set user preset properties to request #set user preset properties to request
sub prepare_request ($$) { sub prepare_request ($$) {
my $request = shift; my ($request, $user_presets) = @_;
my $user_presets = shift;
for my $key ( keys %$user_presets ) { for my $key ( keys %$user_presets ) {
$request->{$key} = $user_presets->{$key}; $request->{$key} = $user_presets->{$key};
@@ -822,8 +790,7 @@ sub prepare_request ($$) {
#TODO: shift to permissions sub entry #TODO: shift to permissions sub entry
sub set_template_permissions ($$) { sub set_template_permissions ($$) {
my $permissions = shift; my ($permissions, $params) = @_;
my $params = shift;
for my $usecase ( keys %$permissions ) { for my $usecase ( keys %$permissions ) {
$params->{'allow'}->{$usecase} = 1 if ( $permissions->{$usecase} eq '1' ); $params->{'allow'}->{$usecase} = 1 if ( $permissions->{$usecase} eq '1' );
@@ -833,7 +800,7 @@ sub set_template_permissions ($$) {
#print error message #print error message
sub permissions_denied($) { sub permissions_denied($) {
my $message = shift; my ($message) = @_;
$message =~ s/_/ /g; $message =~ s/_/ /g;
print '<div class="error">Sorry! Missing permissions to ' . $message . '</div>' . "\n"; print '<div class="error">Sorry! Missing permissions to ' . $message . '</div>' . "\n";
print STDERR 'Sorry! Missing permissions to ' . $message . "\n"; print STDERR 'Sorry! Missing permissions to ' . $message . "\n";
@@ -854,7 +821,7 @@ sub print_warn($) {
} }
sub print_error ($) { sub print_error ($) {
my $message = shift; my ($message) = @_;
print STDERR "ERROR:" . $message . "\n"; print STDERR "ERROR:" . $message . "\n";
print '<div class="error" head>' print '<div class="error" head>'
. '<span class="ui-icon ui-icon-alert" style="float:left"></span>&nbsp;' . '<span class="ui-icon ui-icon-alert" style="float:left"></span>&nbsp;'

18
lib/calcms/user_day_start.pm
View File

@@ -10,15 +10,14 @@ use Data::Dumper;
# columns: user, project_id, studio_id, series_id, day_start # columns: user, project_id, studio_id, series_id, day_start
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_user_day_start' ); return db::get_columns_hash( $dbh, 'calcms_user_day_start' );
} }
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -49,9 +48,7 @@ sub get ($$) {
} }
sub insert_or_update($$){ sub insert_or_update($$){
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
print STDERR Dumper $entry;
if ( get($config, $entry) ){ if ( get($config, $entry) ){
update ($config, $entry); update ($config, $entry);
} else { } else {
@@ -60,8 +57,7 @@ sub insert_or_update($$){
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
@@ -74,8 +70,7 @@ sub insert ($$) {
} }
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
my $fields = [ 'user', 'project_id', 'studio_id' ]; my $fields = [ 'user', 'project_id', 'studio_id' ];
for (@$fields){ for (@$fields){
@@ -99,8 +94,7 @@ sub update($$) {
} }
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};

14
lib/calcms/user_default_studios.pm
View File

@@ -10,15 +10,14 @@ use Data::Dumper;
# columns: user, project_id, studio_id # columns: user, project_id, studio_id
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_user_default_studios' ); return db::get_columns_hash( $dbh, 'calcms_user_default_studios' );
} }
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -51,8 +50,7 @@ sub get ($$) {
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
@@ -61,8 +59,7 @@ sub insert ($$) {
} }
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
@@ -84,8 +81,7 @@ sub update($$) {
} }
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};

14
lib/calcms/user_selected_events.pm
View File

@@ -12,15 +12,14 @@ use Data::Dumper;
# selected_project, selected_studio, selected_series, selected_event <-result # selected_project, selected_studio, selected_series, selected_event <-result
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_user_selected_events' ); return db::get_columns_hash( $dbh, 'calcms_user_selected_events' );
} }
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my @conditions = (); my @conditions = ();
my @bind_values = (); my @bind_values = ();
@@ -54,8 +53,7 @@ sub get ($$) {
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};
@@ -69,8 +67,7 @@ sub insert ($$) {
} }
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
my $fields = [ my $fields = [
'user', 'project_id', 'studio_id', 'series_id', 'user', 'project_id', 'studio_id', 'series_id',
@@ -97,8 +94,7 @@ sub update($$) {
} }
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
return unless defined $entry->{project_id}; return unless defined $entry->{project_id};

26
lib/calcms/user_sessions.pm
View File

@@ -22,7 +22,7 @@ use time;
our @EXPORT_OK = qw(get_columns get insert update delete); our @EXPORT_OK = qw(get_columns get insert update delete);
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_user_sessions' ); return db::get_columns_hash( $dbh, 'calcms_user_sessions' );
@@ -30,8 +30,7 @@ sub get_columns($) {
#map schedule id to id #map schedule id to id
sub get($$) { sub get($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -74,8 +73,7 @@ sub get($$) {
# insert entry and return database id # insert entry and return database id
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{user}; return undef unless defined $entry->{user};
return undef unless defined $entry->{timeout}; return undef unless defined $entry->{timeout};
@@ -95,8 +93,7 @@ sub insert ($$) {
# start session and return generated session id # start session and return generated session id
sub start($$) { sub start($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{user}; return undef unless defined $entry->{user};
return undef unless defined $entry->{timeout}; return undef unless defined $entry->{timeout};
@@ -121,8 +118,7 @@ sub start($$) {
# expand session by timeout # expand session by timeout
sub keep_alive ($$) { sub keep_alive ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry; return undef unless defined $entry;
@@ -135,8 +131,7 @@ sub keep_alive ($$) {
# get session by session id and expand session if valid # get session by session id and expand session if valid
sub check($$) { sub check($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry; return undef unless defined $entry;
my $entries = get( $config, { session_id => $entry->{session_id} } ); my $entries = get( $config, { session_id => $entry->{session_id} } );
@@ -158,8 +153,7 @@ sub check($$) {
# stop session # stop session
sub stop ($$) { sub stop ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry; return undef unless defined $entry;
@@ -177,8 +171,7 @@ sub stop ($$) {
#schedule id to id #schedule id to id
sub update ($$) { sub update ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{session_id}; return undef unless defined $entry->{session_id};
@@ -199,8 +192,7 @@ sub update ($$) {
#map schedule id to id #map schedule id to id
sub delete($$) { sub delete($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{session_id}; return undef unless defined $entry->{session_id};

21
lib/calcms/user_settings.pm
View File

@@ -66,8 +66,7 @@ our $defaultColors = [
]; ];
sub getColors($$) { sub getColors($$) {
my $config = shift; my ($config, $conditions) = @_;
my $conditions = shift;
return unless defined $conditions->{user}; return unless defined $conditions->{user};
my $user = $conditions->{user}; my $user = $conditions->{user};
@@ -101,8 +100,8 @@ sub getColors($$) {
} }
sub getColorCss ($$) { sub getColorCss ($$) {
my $config = shift; my ($config, $conditions) = @_;
my $conditions = shift;
return unless defined $conditions->{user}; return unless defined $conditions->{user};
my $shift = 20; my $shift = 20;
@@ -132,15 +131,14 @@ sub getColorCss ($$) {
} }
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_user_settings' ); return db::get_columns_hash( $dbh, 'calcms_user_settings' );
} }
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -166,8 +164,7 @@ sub get ($$) {
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless defined $entry->{user}; return unless defined $entry->{user};
@@ -176,8 +173,7 @@ sub insert ($$) {
} }
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless ( defined $entry->{user} ); return unless ( defined $entry->{user} );
@@ -198,8 +194,7 @@ sub update($$) {
} }
sub delete ($$) { sub delete ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return unless ( defined $entry->{user} ); return unless ( defined $entry->{user} );

21
lib/calcms/user_stats.pm
View File

@@ -9,15 +9,13 @@ use Data::Dumper;
our @EXPORT_OK = qw(get_columns get update insert get_stats increase); our @EXPORT_OK = qw(get_columns get update insert get_stats increase);
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_user_stats' ); return db::get_columns_hash( $dbh, 'calcms_user_stats' );
} }
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -65,8 +63,7 @@ sub get ($$) {
} }
sub get_stats($$) { sub get_stats($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -130,8 +127,7 @@ sub get_stats($$) {
} }
sub insert($$) { sub insert($$) {
my $config = shift; my ($config, $stats) = @_;
my $stats = shift;
return undef unless defined $stats->{project_id}; return undef unless defined $stats->{project_id};
return undef unless defined $stats->{studio_id}; return undef unless defined $stats->{studio_id};
@@ -153,8 +149,7 @@ sub insert($$) {
# update project # update project
sub update ($$) { sub update ($$) {
my $config = shift; my ($config, $stats) = @_;
my $stats = shift;
return undef unless defined $stats->{project_id}; return undef unless defined $stats->{project_id};
return undef unless defined $stats->{studio_id}; return undef unless defined $stats->{studio_id};
@@ -187,9 +182,7 @@ sub update ($$) {
} }
sub increase ($$$) { sub increase ($$$) {
my $config = shift; my ($config, $usecase, $options) = @_;
my $usecase = shift;
my $options = shift;
return undef unless defined $usecase; return undef unless defined $usecase;
return undef unless defined $options->{project_id}; return undef unless defined $options->{project_id};
@@ -222,7 +215,7 @@ sub increase ($$$) {
} }
sub get_active_users{ sub get_active_users{
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);

33
lib/calcms/work_dates.pm
View File

@@ -20,8 +20,7 @@ use work_schedule();
our @EXPORT_OK = qw(get_columns get insert update delete get_dates); our @EXPORT_OK = qw(get_columns get insert update delete get_dates);
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_work_dates' ); return db::get_columns_hash( $dbh, 'calcms_work_dates' );
} }
@@ -29,8 +28,7 @@ sub get_columns($) {
# get all work_dates for studio_id and schedule_id within given time range # 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) # calculate start_date, end_date, weeday, day from start and end(datetime)
sub get ($$) { sub get ($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $date_range_include = 0; my $date_range_include = 0;
$date_range_include = 1 $date_range_include = 1
@@ -118,8 +116,7 @@ sub get ($$) {
#update work dates for all schedules of a work and studio_id #update work dates for all schedules of a work and studio_id
sub update($$) { sub update($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -199,8 +196,7 @@ sub update($$) {
} }
sub get_schedule_dates($$) { sub get_schedule_dates($$) {
my $schedule = shift; my ($schedule, $options) = @_;
my $options = shift;
my $is_exclude = $options->{exclude} || 0; my $is_exclude = $options->{exclude} || 0;
my $dates = []; my $dates = [];
@@ -223,12 +219,8 @@ sub get_schedule_dates($$) {
} }
sub get_week_of_month_dates($$$$$$) { sub get_week_of_month_dates($$$$$$) {
my $start = shift; # datetime string my ($start, $end, $duration, $week, $weekday, $frequency) = @_;
my $end = shift; # datetime string # datetime, datetime, minutes, every nth week of month, weekday [1..7], every 1st,2nd,3th time
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 $start eq '';
return undef if $end eq ''; return undef if $end eq '';
@@ -267,8 +259,7 @@ sub get_week_of_month_dates($$$$$$) {
#add duration to a single date #add duration to a single date
sub get_single_date($$) { sub get_single_date($$) {
my $start_datetime = shift; my ($start_datetime, $duration) = @_;
my $duration = shift;
my @start = @{ time::datetime_to_array($start_datetime) }; my @start = @{ time::datetime_to_array($start_datetime) };
return unless @start >= 6; return unless @start >= 6;
@@ -287,11 +278,8 @@ sub get_single_date($$) {
#calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days) #calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days)
sub get_dates($$$$) { sub get_dates($$$$) {
my $start_datetime = shift; my ($start_datetime, $end_date, $duration, $frequency) = @_;
my $end_date = shift; #duration in seconds, frequency in minutes
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) }; my @start = @{ time::datetime_to_array($start_datetime) };
return unless @start >= 6; return unless @start >= 6;
@@ -348,8 +336,7 @@ sub get_dates($$$$) {
#remove all work_dates for studio_id and schedule_id #remove all work_dates for studio_id and schedule_id
sub delete($$) { sub delete($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};

15
lib/calcms/work_schedule.pm
View File

@@ -21,16 +21,14 @@ use series_dates();
our @EXPORT_OK = qw(get_columns get insert update delete); our @EXPORT_OK = qw(get_columns get insert update delete);
sub get_columns($) { sub get_columns($) {
my $config = shift; my ($config) = @_;
my $dbh = db::connect($config); my $dbh = db::connect($config);
return db::get_columns_hash( $dbh, 'calcms_work_schedule' ); return db::get_columns_hash( $dbh, 'calcms_work_schedule' );
} }
#map schedule id to id #map schedule id to id
sub get($$) { sub get($$) {
my $config = shift; my ($config, $condition) = @_;
my $condition = shift;
my $dbh = db::connect($config); my $dbh = db::connect($config);
@@ -82,8 +80,7 @@ sub get($$) {
} }
sub insert ($$) { sub insert ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -94,8 +91,7 @@ sub insert ($$) {
#schedule id to id #schedule id to id
sub update ($$) { sub update ($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};
@@ -122,8 +118,7 @@ sub update ($$) {
#map schedule id to id #map schedule id to id
sub delete($$) { sub delete($$) {
my $config = shift; my ($config, $entry) = @_;
my $entry = shift;
return undef unless defined $entry->{project_id}; return undef unless defined $entry->{project_id};
return undef unless defined $entry->{studio_id}; return undef unless defined $entry->{studio_id};

2
website/agenda/planung/css/default.css
View File

@@ -240,7 +240,7 @@ select#project_id::after {
text-align: left; text-align: left;
vertical-align:middle; vertical-align:middle;
background: #004f9b; background: #004f9b;
min-width: 10rem; min-width: 30ch;
} }
#calcms_nav .dropdown-content a { #calcms_nav .dropdown-content a {

34
website/agenda/planung/css/notify-events.css
View File

@@ -1,36 +1,34 @@
.mailHeader{ table#events{
background:#ccc; transition:all 2s;
} }
.mailSubject{ table#events.done{
}
.mailBody{
white-space:pre;
}
.done{
background:#cfc; background:#cfc;
} }
table#events td:nth-of-type(1){ table#events td:nth-of-type(1){
width:15em; width:15ch;
} }
table#events td:nth-of-type(2){ table#events td:nth-of-type(4){
width:60em; width:12ch;
} }
td.action, input.action{ td.action, input.action{
width:5em; width:5ch;
} }
form input{ form input{
width:50em; width:100%;
} }
form textarea{ img.toggle{
width:50em; background:#1678c2;
height:14em; cursor:grab;
transition:all 0.5s;
} }
img.toggle:hover{
transform: scale(1.2);
box-shadow: 0 5px 11px 0 rgba(0, 0, 0, .18), 0 4px 15px 0 rgba(0, 0, 0, .15);
}

2
website/agenda/planung/image/arrow-down.svg
View File

@@ -1 +1 @@
<svg xmlns="http://www.w3.org/2000/svg" height="18px" viewBox="0 0 24 24" width="18px" fill="#FFFFFF"><path d="M0 0h24v24H0V0z" fill="none"/><path d="M7.41 8.59L12 13.17l4.59-4.58L18 10l-6 6-6-6 1.41-1.41z"/></svg> <svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 96 960 960" width="24" fill="#FFFFFF"><path d="M480 711 240 471l56-56 184 184 184-184 56 56-240 240Z"/></svg>
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 214 B

After

Width:  |  Height:  |  Size: 173 B

1
website/agenda/planung/image/arrow-up.svg Normal file
View File

@@ -0,0 +1 @@
<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 96 960 960" width="24" fill="#FFFFFF"><path d="m296 711-56-56 240-240 240 240-56 56-184-184-184 184Z"/></svg>
Side by Side

After

Width:  |  Height:  |  Size: 173 B

1
website/agenda/planung/image/notify.svg Normal file
View File

@@ -0,0 +1 @@
<svg xmlns="http://www.w3.org/2000/svg" height="24" viewBox="0 96 960 960" width="24" fill="#FFFFFF"><path d="M160 856v-80h80V496q0-83 50-147.5T420 264v-28q0-25 17.5-42.5T480 176q25 0 42.5 17.5T540 236v28q80 20 130 84.5T720 496v280h80v80H160Zm320-300Zm0 420q-33 0-56.5-23.5T400 896h160q0 33-23.5 56.5T480 976ZM320 776h320V496q0-66-47-113t-113-47q-66 0-113 47t-47 113v280Z"/></svg>
Side by Side

After

Width:  |  Height:  |  Size: 381 B

23
website/agenda/planung/js/notify-events.js
View File

@@ -7,12 +7,33 @@ function register_buttons() {
var content = $(data).find("#content"); var content = $(data).find("#content");
$('#result').html(content); $('#result').html(content);
var formId = form.attr('id'); var formId = form.attr('id');
$('#'+formId+" .mailHeader").addClass("done"); $('#' + formId+" table").addClass("done");
}); });
}); });
} }
function hide_details() {
$('table.panel tbody').each(function(){
$(this).children("tr.details").each(function() {
$(this).hide();
})
})
$('table.panel img.toggle').on("click", function() {
if( $(this).attr("src").indexOf("arrow-up") < 0 ){
$(this).attr("src", "image/arrow-up.svg");
} else {
$(this).attr("src", "image/arrow-down.svg");
}
$(this).closest('tbody').children("tr.details").each(function() {
$(this).toggle();
})
})
}
$(document).ready(function() { $(document).ready(function() {
hide_details();
register_buttons(); register_buttons();
}); });

33
website/agenda/planung/notify-events.cgi
View File

@@ -3,10 +3,9 @@
use strict; use strict;
use warnings; use warnings;
no warnings 'redefine'; no warnings 'redefine';
use utf8;
use URI::Escape();
use Data::Dumper; use Data::Dumper;
use MIME::Lite();
use params(); use params();
use config(); use config();
@@ -21,6 +20,7 @@ use markup();
use studios(); use studios();
use series(); use series();
use localization(); use localization();
use mail();
binmode STDOUT, ":utf8"; binmode STDOUT, ":utf8";
@@ -79,7 +79,7 @@ sub show_events {
my $params = $request->{params}->{checked}; my $params = $request->{params}->{checked};
my $permissions = $request->{permissions}; my $permissions = $request->{permissions};
for my $attr ( 'project_id', 'studio_id', 'duration' ) { # 'series_id','event_id' for my $attr ( 'project_id', 'studio_id') { # 'series_id','event_id'
unless ( defined $params->{$attr} ) { unless ( defined $params->{$attr} ) {
uac::print_error( "missing " . $attr . " to show changes" ); uac::print_error( "missing " . $attr . " to show changes" );
return; return;
@@ -92,7 +92,7 @@ sub show_events {
} }
# get events # get events
my $duration = $params->{duration}; my $duration = $params->{duration} // 7;
my $options = { my $options = {
project_id => $params->{project_id}, project_id => $params->{project_id},
studio_id => $params->{studio_id}, studio_id => $params->{studio_id},
@@ -108,6 +108,8 @@ sub show_events {
for my $event (@$events) { for my $event (@$events) {
my $mail = getMail( $config, $request, $event ); my $mail = getMail( $config, $request, $event );
$event->{mail} = $mail; $event->{mail} = $mail;
$event->{start} = substr($event->{start}, 0, 16);
$event->{preproduction} = !$event->{live};
} }
return unless defined $events; return unless defined $events;
@@ -162,20 +164,7 @@ sub sendMail {
$mail->{Cc} = $params->{cc} if defined $params->{cc}; $mail->{Cc} = $params->{cc} if defined $params->{cc};
$mail->{Subject} = $params->{subject} if defined $params->{subject}; $mail->{Subject} = $params->{subject} if defined $params->{subject};
$mail->{Data} = $params->{content} if defined $params->{content}; $mail->{Data} = $params->{content} if defined $params->{content};
mail::send($mail);
my $msg = MIME::Lite->new(
'From' => $mail->{'From'},
'To' => $mail->{'To'},
'Cc' => $mail->{'Cc'},
'Reply-To' => $mail->{'Reply-To'},
'Subject' => $mail->{'Subject'},
'Data' => $mail->{'Data'},
);
print '<pre>';
$msg->print( \*STDOUT );
print '</pre>';
$msg->send;
} }
sub getMail { sub getMail {
@@ -202,21 +191,21 @@ sub getMail {
$event->{noRecipient} = 1; $event->{noRecipient} = 1;
return; return;
} }
my $sender = $config->{location}->{event_sender_email}; my $sender = $config->{locations}->{event_sender_email};
my $mail = { my $mail = {
'From' => $sender, 'From' => $sender,
'To' => join( ', ', @$userMails ), 'To' => join( ', ', @$userMails ),
'Cc' => $sender, 'Cc' => $sender,
'Reply-To' => $sender, 'Reply-To' => $sender,
'Subject' => "$event->{start} - $event->{full_title}", 'Subject' => substr($event->{start},0,16) . " - $event->{full_title}",
'Data' => "Hallo " . join( ' und ', @$userNames ) . ",\n\n" 'Data' => "Hallo " . join( ' und ', @$userNames ) . ",\n\n"
}; };
$mail->{Data} .= "nur zur Erinnerung...\n\n"; $mail->{Data} .= "nur zur Erinnerung...\n\n";
$mail->{Data} .= "am $event->{weekday_name} ist die naechste '$event->{series_name}'-Sendung.\n\n"; $mail->{Data} .= "am $event->{weekday_name} ist die nächste '$event->{series_name}'-Sendung.\n\n";
$mail->{Data} .= $mail->{Data} .=
"$event->{source_base_url}$event->{widget_render_url}/$config->{controllers}->{event}/$event->{event_id}.html\n\n"; "$event->{source_base_url}$event->{widget_render_url}/$config->{controllers}->{event}/$event->{event_id}.html\n\n";
$mail->{Data} .= "Gruss, $request->{user}\n"; $mail->{Data} .= "Gruß, $request->{user}\n";
return $mail; return $mail;
} }

2
website/agenda/planung/pot/de/menu.po
View File

@@ -67,4 +67,6 @@ msgstr "Sendungen anlegen"
msgid "edit-help-texts" msgid "edit-help-texts"
msgstr "Hilfe bearbeiten" msgstr "Hilfe bearbeiten"
msgid "notify-events"
msgstr "Erinnerungen verschicken"

27
website/agenda/planung/pot/de/notify-events.po
View File

@@ -1,3 +1,30 @@
msgid "title"
msgstr "Redaktionen an ihre Sendungen erinnern"
msgid "button_send" msgid "button_send"
msgstr "Senden" msgstr "Senden"
msgid "subject"
msgstr "Betreff"
msgid "to"
msgstr "Empfänger"
msgid "from"
msgstr "Absender"
msgid "cc"
msgstr "Kopie"
msgid "bcc"
msgstr "Blindkopie"
msgid "reply-to"
msgstr "Antwort an"
msgid "body"
msgstr "Inhalt"
msgid "show_details"
msgstr "Zeige Details"

3
website/agenda/planung/pot/en/menu.po
View File

@@ -64,6 +64,9 @@ msgstr "User Stats"
msgid "create-events" msgid "create-events"
msgstr "Create Events" msgstr "Create Events"
msgid "notify-events"
msgstr "Remind Of Editors Broadcasts"
msgid "edit-help-texts" msgid "edit-help-texts"
msgstr "Edit Help" msgstr "Edit Help"

27
website/agenda/planung/pot/en/notify-events.po
View File

@@ -1,3 +1,30 @@
msgid "title"
msgstr "Remind Editors For Their Programme"
msgid "button_send" msgid "button_send"
msgstr "Send" msgstr "Send"
msgid "subject"
msgstr "Subject"
msgid "to"
msgstr "Recipient"
msgid "from"
msgstr "Sender"
msgid "cc"
msgstr "Copy"
msgid "bcc"
msgstr "Blind copy"
msgid "reply-to"
msgstr "Reply To"
msgid "body"
msgstr "Content"
msgid "show_details"
msgstr "Show Details"

4
website/agenda/planung/templates/default.html
View File

@@ -21,6 +21,10 @@
<div><a href="create-events.cgi?project_id=<TMPL_VAR project_id>&studio_id=<TMPL_VAR default_studio_id>"><img src="image/create-events.svg">&nbsp;<TMPL_VAR .loc.create-events></a></div> <div><a href="create-events.cgi?project_id=<TMPL_VAR project_id>&studio_id=<TMPL_VAR default_studio_id>"><img src="image/create-events.svg">&nbsp;<TMPL_VAR .loc.create-events></a></div>
</TMPL_IF> </TMPL_IF>
<TMPL_IF allow.read_user>
<div><a href="notify-events.cgi?project_id=<TMPL_VAR project_id>&studio_id=<TMPL_VAR default_studio_id>"&duration=7><img src="image/notify.svg">&nbsp;<TMPL_VAR .loc.notify-events></a></div>
</TMPL_IF>
<TMPL_IF .allow.read_playout> <TMPL_IF .allow.read_playout>
<div><a href="show-playout.cgi?project_id=<TMPL_VAR project_id>&studio_id=<TMPL_VAR default_studio_id>"><img src="image/play-circle.svg">&nbsp;<TMPL_VAR .loc.playout></a></div> <div><a href="show-playout.cgi?project_id=<TMPL_VAR project_id>&studio_id=<TMPL_VAR default_studio_id>"><img src="image/play-circle.svg">&nbsp;<TMPL_VAR .loc.playout></a></div>
</TMPL_IF> </TMPL_IF>

49
website/agenda/planung/templates/notify-events.html
View File

@@ -23,7 +23,7 @@
</head> </head>
<body> <body>
<div id="result" style="display:none"> </div> <div id="result" style="display:none"> </div>
<h1><TMPL_VAR loc.title></h1>
<div id="forms"> <div id="forms">
<TMPL_LOOP events> <TMPL_LOOP events>
<form id="event_<TMPL_VAR event_id>"> <form id="event_<TMPL_VAR event_id>">
@@ -33,10 +33,15 @@
<input type="hidden" name="event_id" value="<TMPL_VAR event_id>"> <input type="hidden" name="event_id" value="<TMPL_VAR event_id>">
<input type="hidden" name="action" value="send"> <input type="hidden" name="action" value="send">
<table id="events"> <table id="events" id="event_<TMPL_VAR event_id>" class="panel">
<tr id="header_<TMPL_VAR event_id>" class="mailHeader"> <tr id="header_<TMPL_VAR event_id>" class="mailHeader">
<td><b><TMPL_VAR start></b></td> <td><b><TMPL_VAR start></b></td>
<td><b><TMPL_VAR full_title></b> | <TMPL_IF live>live</TMPL_IF> <TMPL_IF preproduction>preproduction</TMPL_IF> <TMPL_IF playout>playout</TMPL_IF></td> <td><b><TMPL_VAR full_title></b><td>
<td>
<TMPL_IF live><img src="image/mic.svg" title="live"></TMPL_IF>
<TMPL_IF preproduction><img src="image/mic_off.svg" title="preproduction"></TMPL_IF>
<TMPL_IF playout><img src="image/play.svg" title="playout"></TMPL_IF>
</td>
<TMPL_IF noRecipient> <TMPL_IF noRecipient>
<td></td> <td></td>
@@ -46,50 +51,48 @@
<td>Warning</td> <td>Warning</td>
<td><div class="error">no recipient configured at series!</div></td> <td><div class="error">no recipient configured at series!</div></td>
</tr> </tr>
<TMPL_ELSE> <TMPL_ELSE>
<td class="action"><button type="submit"><TMPL_VAR .loc.button_send></button></td> <td class="action"><button type="submit"><TMPL_VAR .loc.button_send></button></td>
</tr> </tr>
<TMPL_IF mail.To>
<t>
<td><TMPL_VAR .loc.to></td>
<td colspan="2"><input name="to" value="<TMPL_VAR mail.To>"></td>
<td><img class="toggle" title="<TMPL_VAR .loc.show_details>" src="image/arrow-down.svg"></td>
</tr>
</TMPL_IF>
<TMPL_IF mail.Subject> <TMPL_IF mail.Subject>
<tr> <tr class="subject details">
<td>Subject</td> <td><TMPL_VAR .loc.subject></td>
<td class="mailSubject"><input name="subject" value="<TMPL_VAR mail.Subject>"></td> <td class="mailSubject"><input name="subject" value="<TMPL_VAR mail.Subject>"></td>
</tr> </tr>
</TMPL_IF> </TMPL_IF>
<TMPL_IF mail.To>
<tr>
<td>To</td>
<td><input name="to" value="<TMPL_VAR mail.To>"></td>
</tr>
</TMPL_IF>
<TMPL_IF mail.From> <TMPL_IF mail.From>
<tr> <tr class="details">
<td>From</td> <td><TMPL_VAR .loc.from></td>
<td><TMPL_VAR mail.From></td> <td><TMPL_VAR mail.From></td>
</tr> </tr>
</TMPL_IF> </TMPL_IF>
<TMPL_IF mail.Cc> <TMPL_IF mail.Cc>
<tr> <tr class="details">
<td>Cc</td> <td><TMPL_VAR .loc.cc></td>
<td><input name="cc" value="<TMPL_VAR mail.Cc>"></td> <td><input name="cc" value="<TMPL_VAR mail.Cc>"></td>
</tr> </tr>
</TMPL_IF> </TMPL_IF>
<TMPL_IF mail.Reply-To> <TMPL_IF mail.Reply-To>
<tr> <tr class="details">
<td>Reply-To</td> <td><TMPL_VAR .loc.reply-to></td>
<td><TMPL_VAR mail.Reply-To></td> <td><TMPL_VAR mail.Reply-To></td>
</tr> </tr>
</TMPL_IF> </TMPL_IF>
<TMPL_IF mail.data> <TMPL_IF mail.data>
<tr> <tr class="details">
<td>Content</td> <td><TMPL_VAR .loc.content></td>
<td class="mailBody"><textarea name="content" ><TMPL_VAR mail.data></textarea></td> <td class="mailBody"><textarea name="content" ><TMPL_VAR mail.data></textarea></td>
</tr> </tr>
</TMPL_IF> </TMPL_IF>