copy current state of medienstaatsvertrag.org, to be verified
This commit is contained in:
Milan
2
.gitignore
vendored
Normal file
2
.gitignore
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
*~
|
||||
sync.data
|
||||
116
docs/css/style.css
Normal file
116
docs/css/style.css
Normal file
@@ -0,0 +1,116 @@
|
||||
* {
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
font-size:1em;
|
||||
}
|
||||
|
||||
body {
|
||||
font-family: sans-serif;
|
||||
background:#333;
|
||||
margin: 0;
|
||||
padding:0;
|
||||
}
|
||||
|
||||
#container {
|
||||
margin: 0 auto;
|
||||
max-width:1200px;
|
||||
}
|
||||
|
||||
header, nav{
|
||||
padding:0.5rem;
|
||||
}
|
||||
|
||||
aside, article, footer{
|
||||
padding:2rem;
|
||||
}
|
||||
|
||||
@media screen and (min-width:800px) {
|
||||
body {margin:0px; }
|
||||
|
||||
#content {
|
||||
display:-webkit-flex;
|
||||
display:flex;
|
||||
}
|
||||
|
||||
article {
|
||||
-webkit-flex:3;
|
||||
flex:3;
|
||||
-webkit-order:2;
|
||||
order:2;
|
||||
min-height:400px;
|
||||
}
|
||||
|
||||
aside.left {
|
||||
-webkit-flex:1;
|
||||
flex:1;
|
||||
-webkit-order:1;
|
||||
order:1;
|
||||
}
|
||||
|
||||
aside.right {
|
||||
-webkit-flex:1;
|
||||
flex:1;
|
||||
-webkit-order:3;
|
||||
order:3;
|
||||
}
|
||||
|
||||
ul{
|
||||
display:flex
|
||||
}
|
||||
}
|
||||
|
||||
nav{
|
||||
background:#ddd;
|
||||
}
|
||||
aside{
|
||||
background:#eee;
|
||||
}
|
||||
|
||||
article{
|
||||
background:#ffffff;
|
||||
padding-bottom:3em;
|
||||
line-height:150%;
|
||||
}
|
||||
|
||||
nav, header, footer{
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
header, footer, header a, footer a{
|
||||
color:#ffffff;
|
||||
background:#666;
|
||||
}
|
||||
|
||||
header{
|
||||
font-size:3em;
|
||||
padding:0.3em;
|
||||
}
|
||||
|
||||
h1,h2{
|
||||
font-size:1em;
|
||||
clear:both;
|
||||
}
|
||||
|
||||
h2{
|
||||
padding-top:1em;
|
||||
}
|
||||
|
||||
p{
|
||||
padding-top:1em;
|
||||
}
|
||||
|
||||
a{
|
||||
color:#006;
|
||||
text-decoration:none;
|
||||
}
|
||||
|
||||
li{
|
||||
margin-left:1em;
|
||||
}
|
||||
|
||||
#nav-main li{
|
||||
padding:0.5em;
|
||||
list-style-type:none;
|
||||
}
|
||||
|
||||
|
||||
67
docs/download.html
Normal file
67
docs/download.html
Normal file
@@ -0,0 +1,67 @@
|
||||
<!DOCTYPE html>
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>calcms</title>
|
||||
<meta name="viewport" content="width=device-width; initial-scale=1; maximum-scale=1"> <meta charset="utf-8">
|
||||
<meta http-equiv="Cache-Control" content="no-cache">
|
||||
<link rel="stylesheet" href="/css/style.css">
|
||||
|
||||
<!--calcms start-->
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendeplan Atom" href="/agenda/atom/" />
|
||||
<link rel="alternate" type="application/rss+xml" title="Sendeplan RSS" href="/agenda/rss/" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendekommentare" href="/agenda/feed_kommentare/" />
|
||||
<link rel="stylesheet" type="text/css" media="screen" href="/agenda/css/calcms.css" />
|
||||
<script type="text/javascript" src="/agenda/js/jquery.min.js"></script>
|
||||
<script type="text/javascript" src="/agenda/js/calcms.js"></script>
|
||||
<script type="text/javascript" src="/agenda/js/calcms.cust.js"></script>
|
||||
<!--calcms end-->
|
||||
</head>
|
||||
<body>
|
||||
<div id="container">
|
||||
|
||||
<header id="header">
|
||||
<h1><a href="/">calcms</a></h1>
|
||||
</header>
|
||||
|
||||
<nav id="nav-main">
|
||||
<ul>
|
||||
<li>
|
||||
<a href="/">home</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/programm.html">schedule</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/planung/">editor</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/download.html">download</a>
|
||||
</li>
|
||||
</ul>
|
||||
</nav>
|
||||
|
||||
<div id="content">
|
||||
<article id="article">
|
||||
download sources
|
||||
|
||||
<li><a href="calcms.2017-04-29.tar.gz">calcms.2017-04-29.tar.gz</a></li>
|
||||
<li><a href="calcms.2015-04-18.tar.gz">calcms.2015-04-18.tar.gz</a></li>
|
||||
<li><a href="calcms.2014-12.tar.gz">calcms.2014-12-23.tar.gz</a></li>
|
||||
|
||||
</article>
|
||||
|
||||
<aside class="left">
|
||||
</aside>
|
||||
|
||||
<aside class="right">
|
||||
</aside>
|
||||
</div>
|
||||
|
||||
<footer>
|
||||
calcms 2010 - 2017 by <a href="http://radiopiloten.de">http://radiopiloten.de</a>
|
||||
</footer>
|
||||
</div>
|
||||
</body>
|
||||
|
||||
</html>
|
||||
75
docs/index.html
Normal file
75
docs/index.html
Normal file
@@ -0,0 +1,75 @@
|
||||
<!DOCTYPE html>
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>calcms</title>
|
||||
<meta name="viewport" content="width=device-width; initial-scale=1; maximum-scale=1">
|
||||
<meta charset="utf-8">
|
||||
<meta http-equiv="Cache-Control" content="no-cache">
|
||||
<link rel="stylesheet" href="/css/style.css">
|
||||
|
||||
<!--calcms start-->
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendeplan Atom" href="/agenda/atom/" />
|
||||
<link rel="alternate" type="application/rss+xml" title="Sendeplan RSS" href="/agenda/rss/" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendekommentare" href="/agenda/feed_kommentare/" />
|
||||
<link rel="stylesheet" type="text/css" media="screen" href="/agenda/css/calcms.css" />
|
||||
<script type="text/javascript" src="/agenda/js/jquery.min.js"></script>
|
||||
<script type="text/javascript" src="/agenda/js/calcms.js"></script>
|
||||
<script type="text/javascript" src="/agenda/js/calcms.cust.js"></script>
|
||||
<!--calcms end-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<div id="container">
|
||||
|
||||
<header id="header">
|
||||
<h1><a href="/">calcms</a></h1>
|
||||
</header>
|
||||
|
||||
<nav id="nav-main">
|
||||
<ul>
|
||||
<li>
|
||||
<a href="/">home</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/programm.html">schedule</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/planung/">editor</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/download.html">download</a>
|
||||
</li>
|
||||
</ul>
|
||||
</nav>
|
||||
|
||||
<div id="content">
|
||||
<article>
|
||||
calcms - manage broadcasts at your community radio station.
|
||||
<p>calcms consists of two components:
|
||||
<li> edit the broadcast schedule</li>
|
||||
<li> publish the broadcast schedule </li>
|
||||
|
||||
<p>calcms itself is stand-alone, but can be integrated into both static and dynamic web sites.
|
||||
|
||||
<p>Documentation can be found here:
|
||||
<li><a href="http://dev.radiopiloten.de/dokuwiki/doku.php/calcms:start">http://dev.radiopiloten.de/dokuwiki/doku.php/calcms:start</a></li>
|
||||
|
||||
<p>This page is a example page for integrating calcms into a static web site.
|
||||
<br>The template for the integration which is usually hidden to users can be found here:
|
||||
<li><a href="/programm.html">static template</a></li>
|
||||
</article>
|
||||
|
||||
<aside class="left">
|
||||
</aside>
|
||||
|
||||
<aside class="right">
|
||||
</aside>
|
||||
</div>
|
||||
|
||||
<footer id="footer">
|
||||
calcms 2010 - 2017 by <a href="http://radiopiloten.de">http://radiopiloten.de</a>
|
||||
</footer>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
95
docs/programm.html
Normal file
95
docs/programm.html
Normal file
@@ -0,0 +1,95 @@
|
||||
<!DOCTYPE html>
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>calcms</title>
|
||||
<meta name="viewport" content="width=device-width; initial-scale=1; maximum-scale=1">
|
||||
<meta charset="utf-8">
|
||||
<meta http-equiv="Cache-Control" content="no-cache">
|
||||
<link rel="stylesheet" href="/css/style.css">
|
||||
|
||||
<!--calcms start-->
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendeplan Atom" href="/agenda/atom/" />
|
||||
<link rel="alternate" type="application/rss+xml" title="Sendeplan RSS" href="/agenda/rss/" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendekommentare" href="/agenda/feed_kommentare/" />
|
||||
<link rel="stylesheet" type="text/css" media="screen" href="/agenda/css/calcms.css" />
|
||||
<script type="text/javascript" src="/agenda/js/jquery.min.js"></script>
|
||||
<script type="text/javascript" src="/agenda/js/calcms.js"></script>
|
||||
<script type="text/javascript" src="/agenda/js/calcms.cust.js"></script>
|
||||
<!--calcms end-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<div id="container">
|
||||
|
||||
<header id="header">
|
||||
<h1><a href="/">calcms</a></h1>
|
||||
</header>
|
||||
|
||||
<nav id="nav-main">
|
||||
<ul>
|
||||
<li>
|
||||
<a href="/">home</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/programm.html">schedule</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/planung/">editor</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/download.html">download</a>
|
||||
</li>
|
||||
</ul>
|
||||
</nav>
|
||||
|
||||
<div id="content">
|
||||
<article >
|
||||
<!-- include daily schedule with excerpt -->
|
||||
<div id="calcms_list" class="content">bitte warten</div>
|
||||
</article>
|
||||
|
||||
<aside class="left">
|
||||
<center>
|
||||
<h2>Programm</h2>
|
||||
<div class="content">
|
||||
<!-- include short list of schedules -->
|
||||
<div id="calcms_menu">bitte warten...</div>
|
||||
</div>
|
||||
|
||||
<h2>Kommende Sendung</h2>
|
||||
<div class="content">
|
||||
<!-- show coming shows -->
|
||||
<div id="calcms_playlist">bitte warten…</div>
|
||||
</div>
|
||||
</center>
|
||||
</aside>
|
||||
|
||||
<aside class="right">
|
||||
<center>
|
||||
<h2>Kalender</h2>
|
||||
<div class="content">
|
||||
<!-- show calendar -->
|
||||
<div id="calcms_calendar">bitte warten...</div>
|
||||
</div>
|
||||
|
||||
<h2>Suche</h2>
|
||||
<div class="content">
|
||||
<!-- calcms search start --><div id="calcms_search"><input id="calcms_search_field" name="search" value="" /><input value="suchen" onclick="calcms.selectSearchEventListener();return false;" type="button" /><a id="calcms_search_show_details" href="#" onclick="calcms.showAdvancedSearch('calcms_enhanced_search');return false;">erweitert</a><br />
|
||||
<div id="calcms_enhanced_search" style="display: none;">Archiv <input type="checkbox" name="calcms_archive" id="calcms_archive" /><span id="calcms_categories"></span><span id="calcms_series_names"></span><span id="calcms_programs"></span>
|
||||
</div>
|
||||
</div>
|
||||
<!-- calcms search end -->
|
||||
</div>
|
||||
</center>
|
||||
</aside>
|
||||
</div>
|
||||
|
||||
<footer>
|
||||
calcms 2010 - 2017 by <a href="http://radiopiloten.de">http://radiopiloten.de</a>
|
||||
</footer>
|
||||
|
||||
</div>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
114
example/css/style.css
Normal file
114
example/css/style.css
Normal file
@@ -0,0 +1,114 @@
|
||||
* {
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
font-size:1em;
|
||||
}
|
||||
|
||||
body {
|
||||
text-align: center;
|
||||
font-family: Verdana,Arial,Helvetica,Geneva,sans-serif;
|
||||
background:#333;
|
||||
}
|
||||
|
||||
h1,h2{
|
||||
font-size:0.9em;
|
||||
}
|
||||
|
||||
a{
|
||||
color:#006;
|
||||
text-decoration:none;
|
||||
}
|
||||
|
||||
|
||||
li{
|
||||
padding:0.5em;
|
||||
list-style-type:none;
|
||||
}
|
||||
|
||||
#wrapper {
|
||||
max-width: 1110px;
|
||||
width:100%;
|
||||
min-height:320px;
|
||||
margin: 0 auto;
|
||||
text-align: left;
|
||||
word-spacing: -6px;
|
||||
}
|
||||
|
||||
header, nav, aside, section, footer{
|
||||
word-spacing: 0px;
|
||||
text-align: left;
|
||||
padding:1em;
|
||||
}
|
||||
|
||||
header, footer, header a, footer a{
|
||||
color:#fff;
|
||||
background:#333;
|
||||
}
|
||||
|
||||
header, footer{
|
||||
display: block;
|
||||
}
|
||||
|
||||
nav,aside,section{
|
||||
min-width:7%;
|
||||
min-height:20em;
|
||||
/*
|
||||
display:inline-block;
|
||||
vertical-align:top;
|
||||
*/
|
||||
}
|
||||
|
||||
|
||||
|
||||
nav{
|
||||
float:left;
|
||||
}
|
||||
aside{
|
||||
float:right;
|
||||
}
|
||||
|
||||
nav{
|
||||
margin-right:1em
|
||||
}
|
||||
|
||||
aside{
|
||||
margin-left:1em
|
||||
}
|
||||
|
||||
nav, aside{
|
||||
max-width:20%;
|
||||
min-height:320px;
|
||||
background:#ccc;
|
||||
}
|
||||
|
||||
section{
|
||||
/*width: 600px;*/
|
||||
background:#ffffff;
|
||||
|
||||
/*margin: 200px auto 200px;*/
|
||||
position: relative;
|
||||
z-index:-1;
|
||||
}
|
||||
|
||||
|
||||
header{
|
||||
text-align: center;
|
||||
font-size:3em;
|
||||
padding:0.3em;
|
||||
}
|
||||
|
||||
section{
|
||||
background:#ffffff;
|
||||
}
|
||||
|
||||
footer{
|
||||
text-align: center;
|
||||
clear: both;
|
||||
max-height:1em;
|
||||
margin-right:14px;
|
||||
}
|
||||
|
||||
div.content{
|
||||
padding:1em;
|
||||
}
|
||||
|
||||
82
example/help.html
Normal file
82
example/help.html
Normal file
@@ -0,0 +1,82 @@
|
||||
<!DOCTYPE html>
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>calcms</title>
|
||||
<meta name="viewport" content="width=device-width; initial-scale=1; maximum-scale=1"> <meta charset="utf-8">
|
||||
<meta http-equiv="Cache-Control" content="no-cache">
|
||||
<link rel="stylesheet" href="css/style.css">
|
||||
|
||||
<!--calcms start-->
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendeplan Atom" href="/agenda/atom/" />
|
||||
<link rel="alternate" type="application/rss+xml" title="Sendeplan RSS" href="/agenda/rss/" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendekommentare" href="/agenda/feed_kommentare/" />
|
||||
<link rel="stylesheet" type="text/css" media="screen" href="/agenda_files/css/calcms.css" />
|
||||
<script type="text/javascript" src="/agenda_files/js/jquery.js"></script>
|
||||
<script type="text/javascript" src="/agenda_files/js/calcms.js"></script>
|
||||
<script type="text/javascript" src="/agenda_files/js/calcms.cust.js"></script>
|
||||
<!--calcms end-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<header>
|
||||
<h1><a href="/">calcms</a></h1>
|
||||
</header>
|
||||
|
||||
<div id="wrapper">
|
||||
|
||||
<nav>
|
||||
<ul>
|
||||
<li>
|
||||
<a href="/agenda/programm.hml">programm</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="help.html">help</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/planung/">login</a>
|
||||
</li>
|
||||
</ul>
|
||||
</nav>
|
||||
|
||||
<aside>
|
||||
<!--
|
||||
<h2>Kalender</h2>
|
||||
<div class="content">
|
||||
<div id="calcms_calendar">bitte warten...</div>
|
||||
</div>
|
||||
|
||||
<div class="content">
|
||||
<div id="calcms_search">
|
||||
<form name="calcms_search" onsubmit="selectSearchEventListener();return false;">
|
||||
<input id="calcms_search_field" name="search" value="" size="30" max-length="30" /><input value="suchen" onclick="selectSearchEventListener();return false;" type="button" />
|
||||
</form>
|
||||
<div>
|
||||
<a href="#" onclick="showAdvancedSearch('calcms_enhanced_search');return false;">erweitert</a>
|
||||
<div id="calcms_enhanced_search" style="display: none;">
|
||||
<p>Archiv <input type="checkbox" name="calcms_archive" id="calcms_archive" /><br />
|
||||
<span id="calcms_categories"></span><br />
|
||||
<span id="calcms_series_names"></span><br />
|
||||
<span id="calcms_programs"></span>
|
||||
</p>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
-->
|
||||
</aside>
|
||||
|
||||
<section>
|
||||
<!--
|
||||
<div id="calcms_list" class="content">bitte warten</div>
|
||||
-->
|
||||
|
||||
this is the help page
|
||||
</section>
|
||||
|
||||
<footer>
|
||||
calcms 2010 - 2015 by <a href="http://radiopiloten.de">http://radiopiloten.de</a>
|
||||
</footer>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
85
example/index.html
Normal file
85
example/index.html
Normal file
@@ -0,0 +1,85 @@
|
||||
<!DOCTYPE html>
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>calcms</title>
|
||||
<meta name="viewport" content="width=device-width; initial-scale=1; maximum-scale=1"> <meta charset="utf-8">
|
||||
<meta http-equiv="Cache-Control" content="no-cache">
|
||||
<link rel="stylesheet" href="css/style.css">
|
||||
|
||||
<!--calcms start-->
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendeplan Atom" href="/agenda/atom/" />
|
||||
<link rel="alternate" type="application/rss+xml" title="Sendeplan RSS" href="/agenda/rss/" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendekommentare" href="/agenda/feed_kommentare/" />
|
||||
<link rel="stylesheet" type="text/css" media="screen" href="/agenda_files/css/calcms.css" />
|
||||
<script type="text/javascript" src="/agenda_files/js/jquery.js"></script>
|
||||
<script type="text/javascript" src="/agenda_files/js/calcms.js"></script>
|
||||
<script type="text/javascript" src="/agenda_files/js/calcms.cust.js"></script>
|
||||
<!--calcms end-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<header>
|
||||
<h1><a href="/">calcms</a></h1>
|
||||
</header>
|
||||
|
||||
<div id="wrapper">
|
||||
|
||||
<nav>
|
||||
<ul>
|
||||
<li>
|
||||
<a href="/agenda/programm.hml">programm</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="programm.html">internal programm (hidden to users)</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="help.html">help</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="/agenda/planung/">login</a>
|
||||
</li>
|
||||
</ul>
|
||||
</nav>
|
||||
|
||||
<aside>
|
||||
<!--
|
||||
<h2>Kalender</h2>
|
||||
<div class="content">
|
||||
<div id="calcms_calendar">bitte warten...</div>
|
||||
</div>
|
||||
|
||||
<div class="content">
|
||||
<div id="calcms_search">
|
||||
<form name="calcms_search" onsubmit="selectSearchEventListener();return false;">
|
||||
<input id="calcms_search_field" name="search" value="" size="30" max-length="30" /><input value="suchen" onclick="selectSearchEventListener();return false;" type="button" />
|
||||
</form>
|
||||
<div>
|
||||
<a href="#" onclick="showAdvancedSearch('calcms_enhanced_search');return false;">erweitert</a>
|
||||
<div id="calcms_enhanced_search" style="display: none;">
|
||||
<p>Archiv <input type="checkbox" name="calcms_archive" id="calcms_archive" /><br />
|
||||
<span id="calcms_categories"></span><br />
|
||||
<span id="calcms_series_names"></span><br />
|
||||
<span id="calcms_programs"></span>
|
||||
</p>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
-->
|
||||
</aside>
|
||||
|
||||
<section>
|
||||
<!--
|
||||
<div id="calcms_list" class="content">bitte warten</div>
|
||||
-->
|
||||
|
||||
This is a page with calcms integration
|
||||
</section>
|
||||
|
||||
<footer>
|
||||
calcms 2010 - 2015 by <a href="http://radiopiloten.de">http://radiopiloten.de</a>
|
||||
</footer>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
77
example/programm.html
Normal file
77
example/programm.html
Normal file
@@ -0,0 +1,77 @@
|
||||
<!DOCTYPE html>
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>calcms</title>
|
||||
<meta name="viewport" content="width=device-width; initial-scale=1; maximum-scale=1"> <meta charset="utf-8">
|
||||
<meta http-equiv="Cache-Control" content="no-cache">
|
||||
<link rel="stylesheet" href="css/style.css">
|
||||
|
||||
<!--calcms start-->
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendeplan Atom" href="/agenda/atom/" />
|
||||
<link rel="alternate" type="application/rss+xml" title="Sendeplan RSS" href="/agenda/rss/" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Sendekommentare" href="/agenda/feed_kommentare/" />
|
||||
<link rel="stylesheet" type="text/css" media="screen" href="/agenda_files/css/calcms.css" />
|
||||
<script type="text/javascript" src="/agenda_files/js/jquery.js"></script>
|
||||
<script type="text/javascript" src="/agenda_files/js/calcms.js"></script>
|
||||
<script type="text/javascript" src="/agenda_files/js/calcms.cust.js"></script>
|
||||
<!--calcms end-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<header>
|
||||
<h1><a href="/">calcms</a></h1>
|
||||
</header>
|
||||
|
||||
<div id="wrapper">
|
||||
|
||||
<nav>
|
||||
<h2>Programm</h2>
|
||||
<div class="content">
|
||||
<div id="calcms_menu">bitte warten...</div>
|
||||
</div>
|
||||
|
||||
<h2>Kommende Sendung</h2>
|
||||
<div class="content">
|
||||
<div id="calcms_playlist">bitte warten…</div>
|
||||
</div>
|
||||
</nav>
|
||||
|
||||
<aside>
|
||||
<h2>Kalender</h2>
|
||||
<div class="content">
|
||||
<div id="calcms_calendar">bitte warten...</div>
|
||||
</div>
|
||||
|
||||
<div class="content">
|
||||
<div id="calcms_search">
|
||||
<form name="calcms_search" onsubmit="selectSearchEventListener();return false;">
|
||||
<input id="calcms_search_field" name="search" value="" size="30" max-length="30" /><input value="suchen" onclick="selectSearchEventListener();return false;" type="button" />
|
||||
</form>
|
||||
<div>
|
||||
<a href="#" onclick="showAdvancedSearch('calcms_enhanced_search');return false;">erweitert</a>
|
||||
<div id="calcms_enhanced_search" style="display: none;">
|
||||
<p>Archiv <input type="checkbox" name="calcms_archive" id="calcms_archive" /><br />
|
||||
<span id="calcms_categories"></span><br />
|
||||
<span id="calcms_series_names"></span><br />
|
||||
<span id="calcms_programs"></span>
|
||||
</p>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</aside>
|
||||
|
||||
<section>
|
||||
<div id="calcms_list" class="content">bitte warten</div>
|
||||
Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.
|
||||
</section>
|
||||
|
||||
<footer>
|
||||
calcms 2010 - 2015 by <a href="http://radiopiloten.de">http://radiopiloten.de</a>
|
||||
</footer>
|
||||
|
||||
</div>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
227
install/INSTALL.txt
Normal file
227
install/INSTALL.txt
Normal file
@@ -0,0 +1,227 @@
|
||||
|
||||
==== database setup ====
|
||||
|
||||
=== create database ===
|
||||
|
||||
mysqladmin -u root -p create calcms_test
|
||||
|
||||
=== create users ===
|
||||
|
||||
mysql -u root -p
|
||||
|
||||
if using plesk, use
|
||||
|
||||
mysql -u admin mysql -p`cat /etc/psa/.psa.shadow`
|
||||
|
||||
# calcms_admin
|
||||
|
||||
CREATE USER 'calcms_admin'@'localhost' IDENTIFIED BY 'taes9Cho';
|
||||
GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER ON *.* TO 'calcms_admin'@'localhost' IDENTIFIED BY 'taes9Cho';
|
||||
GRANT ALL PRIVILEGES ON `calcms_test`.* TO 'calcms_admin'@'localhost';
|
||||
|
||||
# calcms_write / for users
|
||||
|
||||
CREATE USER 'calcms_write'@'localhost' IDENTIFIED BY 'Toothok8';
|
||||
GRANT SELECT, INSERT, UPDATE, DELETE ON *.* TO 'calcms_write'@'localhost' IDENTIFIED BY 'Toothok8';
|
||||
GRANT ALL PRIVILEGES ON `calcms_test`.* TO 'calcms_write'@'localhost';
|
||||
|
||||
# calcms_read / for all
|
||||
|
||||
CREATE USER 'calcms_read'@'localhost' IDENTIFIED BY 'Ro2chiya';
|
||||
GRANT SELECT ON *.* TO 'calcms_read'@'localhost' IDENTIFIED BY 'Ro2chiya' ;
|
||||
GRANT ALL PRIVILEGES ON `calcms_test`.* TO 'calcms_read'@'localhost';
|
||||
|
||||
=== deploy time zones ===
|
||||
|
||||
mysql_tzinfo_to_sql /usr/share/zoneinfo | mysql -u root mysql -p
|
||||
|
||||
if using plesk, use
|
||||
|
||||
mysql_tzinfo_to_sql /usr/share/zoneinfo | mysql -u admin mysql -p`cat /etc/psa/.psa.shadow`
|
||||
|
||||
=== create database content ===
|
||||
|
||||
mysql -u calcms_admin -p calcms_test < ./install/create.sql
|
||||
|
||||
==== Apache HTTP Server Setup (at /etc/conf/apache2/ server settings or vhost settings) ====
|
||||
|
||||
=== install mod_perl ===
|
||||
|
||||
install
|
||||
|
||||
libapache2-mod-perl2
|
||||
libapache2-reload-perl
|
||||
libapache2-request-perl
|
||||
|
||||
or via cpan
|
||||
|
||||
Apache2::Reload
|
||||
Apache2::Request
|
||||
|
||||
if mod_perl was installed already make sure it is enabled
|
||||
|
||||
ln -s /etc/apache2/mods-available/perl.load /etc/apache2/mods-enabled/perl.load
|
||||
|
||||
=== enable mod_rewrite ===
|
||||
|
||||
install
|
||||
|
||||
libapache2-rewrite
|
||||
|
||||
ln -s /etc/apache2/mods-available/rewrite.load /etc/apache2/mods-enabled/rewrite.load
|
||||
|
||||
=== Apache Configuration ) ===
|
||||
|
||||
This has to be put into your apache server or virtual host configuration
|
||||
|
||||
### START OF FILE ###
|
||||
|
||||
# Possible values include: debug, info, notice, warn, error, crit, alert, emerg.
|
||||
LogLevel debug
|
||||
|
||||
# init mod_perl (should be done at /etc/apache/mods-enabled/perl.load)
|
||||
# LoadModule perl_module /usr/lib/apache2/modules/mod_perl.so
|
||||
|
||||
# redirect to inject calcms into website
|
||||
LimitInternalRecursion 4
|
||||
|
||||
# enable this at HTTP configuration, but disable at HTTPS configuration (!)
|
||||
Redirect permanent /agenda/planung https://calcms.medienstaatsvertrag.org/agenda/planung
|
||||
|
||||
# alias to inject calcms into website
|
||||
Alias /agenda /home/calcms/website/agenda
|
||||
Alias /agenda_files /home/calcms/website/agenda_files
|
||||
Alias /programm /home/calcms/website/agenda/cache/programm
|
||||
|
||||
<Directory /home/calcms/website/agenda>
|
||||
AllowOverride All
|
||||
Options -Indexes +FollowSymLinks +MultiViews +ExecCGI
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
Require all granted
|
||||
</Directory>
|
||||
|
||||
<Directory /home/calcms/website/agenda/cache/programm>
|
||||
AllowOverride All
|
||||
Options -Indexes +FollowSymLinks +MultiViews +ExecCGI
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
Require all granted
|
||||
</Directory>
|
||||
|
||||
<Directory /home/calcms/website/agenda_files>
|
||||
AllowOverride All
|
||||
Options -Indexes -FollowSymLinks -MultiViews -ExecCGI
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
Require all granted
|
||||
</Directory>
|
||||
|
||||
#mod_perl
|
||||
<IfModule mod_perl.c>
|
||||
PerlSetEnv LC_ALL en_US.UTF-8
|
||||
PerlSetEnv LANGUAGE en_US.UTF-8
|
||||
|
||||
PerlWarn On
|
||||
PerlModule ModPerl::RegistryPrefork
|
||||
|
||||
PerlModule Apache2::Reload
|
||||
PerlInitHandler Apache2::Reload
|
||||
#PerlSetVar ReloadAll Off
|
||||
|
||||
SetEnv TMPDIR /var/tmp/
|
||||
|
||||
# set base library path
|
||||
PerlSetEnv PERL5LIB /home/calcms/lib/calcms/
|
||||
PerlPostConfigRequire /home/calcms/lib/calcms/startup.pl
|
||||
</IfModule>
|
||||
|
||||
#### END_OF_FILE ####
|
||||
|
||||
=== install required perl modules ===
|
||||
|
||||
For debian/ubuntu there are packages for most required modules.
|
||||
If you cannot install packages you can use the CPAN perl package install.
|
||||
For Image::Magick::Square no deb package exists, you need to install it by "cpan Image::Magick::Square"
|
||||
|
||||
apt-get install <deb-package>
|
||||
|
||||
== Install by deb package ==
|
||||
|
||||
libapreq2-3
|
||||
libapache-dbi-perl
|
||||
libauthen-passphrase-blowfish-perl
|
||||
libcalendar-simple-perl
|
||||
libcgi-pm-perl
|
||||
libcgi-session-perl
|
||||
libconfig-general-perl
|
||||
libdatetime-perl
|
||||
libdate-calc-perl
|
||||
libdate-manip-perl
|
||||
libdbi-perl
|
||||
libdbd-mysql-perl
|
||||
libencode-perl
|
||||
libjson-perl
|
||||
libhtml-formattext-withlinks-andtables-perl
|
||||
libhtml-parser-perl
|
||||
libhtml-template-perl
|
||||
libhtml-template-compiled-perl
|
||||
libmime-base64-urlsafe-perl
|
||||
libtext-wikicreole-perl
|
||||
liburi-escape-xs-perl
|
||||
perlmagick
|
||||
|
||||
|
||||
== Install by CPAN perl packages ==
|
||||
|
||||
cpan <perl-package>
|
||||
|
||||
Apache2::Upload
|
||||
Apache::DBI
|
||||
Authen::Passphrase::BlowfishCrypt
|
||||
Calendar::Simple
|
||||
CGI
|
||||
CGI::Carp
|
||||
CGI::Cookie
|
||||
CGI::Session
|
||||
Config::General
|
||||
Data::Dumper
|
||||
DateTime
|
||||
Date::Calc
|
||||
Date::Manip
|
||||
DBD::mysql
|
||||
DBI
|
||||
Encode
|
||||
File::stat
|
||||
HTML::FormatText
|
||||
HTML::Parse
|
||||
HTML::Template
|
||||
HTML::Template::Compiled
|
||||
HTML::Template::Compiled::Plugin::XMLEscape
|
||||
JSON
|
||||
MIME::Base64
|
||||
MIME::Lite
|
||||
POSIX
|
||||
Text::WikiCreole
|
||||
Time::Local
|
||||
Time::localtime
|
||||
URI::Escape
|
||||
Image::Magick
|
||||
Image::Magick::Square
|
||||
|
||||
==== Configure ====
|
||||
|
||||
edit configuration at website/config/config.cgi
|
||||
|
||||
==== inject calcms into any CMS ====
|
||||
|
||||
to frequently update calcms integration create a cronjob to run tools/update_page.sh
|
||||
|
||||
you may have to update the paths inside update_page.sh
|
||||
|
||||
=== connect to Admin interface
|
||||
|
||||
https://localhost/agenda/planung/
|
||||
ccAdmin
|
||||
shug!3Lu
|
||||
|
||||
675
install/LICENSE.txt
Normal file
675
install/LICENSE.txt
Normal file
@@ -0,0 +1,675 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The GNU General Public License is a free, copyleft license for
|
||||
software and other kinds of works.
|
||||
|
||||
The licenses for most software and other practical works are designed
|
||||
to take away your freedom to share and change the works. By contrast,
|
||||
the GNU General Public License is intended to guarantee your freedom to
|
||||
share and change all versions of a program--to make sure it remains free
|
||||
software for all its users. We, the Free Software Foundation, use the
|
||||
GNU General Public License for most of our software; it applies also to
|
||||
any other work released this way by its authors. You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
them if you wish), that you receive source code or can get it if you
|
||||
want it, that you can change the software or use pieces of it in new
|
||||
free programs, and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to prevent others from denying you
|
||||
these rights or asking you to surrender the rights. Therefore, you have
|
||||
certain responsibilities if you distribute copies of the software, or if
|
||||
you modify it: responsibilities to respect the freedom of others.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must pass on to the recipients the same
|
||||
freedoms that you received. You must make sure that they, too, receive
|
||||
or can get the source code. And you must show them these terms so they
|
||||
know their rights.
|
||||
|
||||
Developers that use the GNU GPL protect your rights with two steps:
|
||||
(1) assert copyright on the software, and (2) offer you this License
|
||||
giving you legal permission to copy, distribute and/or modify it.
|
||||
|
||||
For the developers' and authors' protection, the GPL clearly explains
|
||||
that there is no warranty for this free software. For both users' and
|
||||
authors' sake, the GPL requires that modified versions be marked as
|
||||
changed, so that their problems will not be attributed erroneously to
|
||||
authors of previous versions.
|
||||
|
||||
Some devices are designed to deny users access to install or run
|
||||
modified versions of the software inside them, although the manufacturer
|
||||
can do so. This is fundamentally incompatible with the aim of
|
||||
protecting users' freedom to change the software. The systematic
|
||||
pattern of such abuse occurs in the area of products for individuals to
|
||||
use, which is precisely where it is most unacceptable. Therefore, we
|
||||
have designed this version of the GPL to prohibit the practice for those
|
||||
products. If such problems arise substantially in other domains, we
|
||||
stand ready to extend this provision to those domains in future versions
|
||||
of the GPL, as needed to protect the freedom of users.
|
||||
|
||||
Finally, every program is threatened constantly by software patents.
|
||||
States should not allow patents to restrict development and use of
|
||||
software on general-purpose computers, but in those that do, we wish to
|
||||
avoid the special danger that patents applied to a free program could
|
||||
make it effectively proprietary. To prevent this, the GPL assures that
|
||||
patents cannot be used to render the program non-free.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
TERMS AND CONDITIONS
|
||||
|
||||
0. Definitions.
|
||||
|
||||
"This License" refers to version 3 of the GNU General Public License.
|
||||
|
||||
"Copyright" also means copyright-like laws that apply to other kinds of
|
||||
works, such as semiconductor masks.
|
||||
|
||||
"The Program" refers to any copyrightable work licensed under this
|
||||
License. Each licensee is addressed as "you". "Licensees" and
|
||||
"recipients" may be individuals or organizations.
|
||||
|
||||
To "modify" a work means to copy from or adapt all or part of the work
|
||||
in a fashion requiring copyright permission, other than the making of an
|
||||
exact copy. The resulting work is called a "modified version" of the
|
||||
earlier work or a work "based on" the earlier work.
|
||||
|
||||
A "covered work" means either the unmodified Program or a work based
|
||||
on the Program.
|
||||
|
||||
To "propagate" a work means to do anything with it that, without
|
||||
permission, would make you directly or secondarily liable for
|
||||
infringement under applicable copyright law, except executing it on a
|
||||
computer or modifying a private copy. Propagation includes copying,
|
||||
distribution (with or without modification), making available to the
|
||||
public, and in some countries other activities as well.
|
||||
|
||||
To "convey" a work means any kind of propagation that enables other
|
||||
parties to make or receive copies. Mere interaction with a user through
|
||||
a computer network, with no transfer of a copy, is not conveying.
|
||||
|
||||
An interactive user interface displays "Appropriate Legal Notices"
|
||||
to the extent that it includes a convenient and prominently visible
|
||||
feature that (1) displays an appropriate copyright notice, and (2)
|
||||
tells the user that there is no warranty for the work (except to the
|
||||
extent that warranties are provided), that licensees may convey the
|
||||
work under this License, and how to view a copy of this License. If
|
||||
the interface presents a list of user commands or options, such as a
|
||||
menu, a prominent item in the list meets this criterion.
|
||||
|
||||
1. Source Code.
|
||||
|
||||
The "source code" for a work means the preferred form of the work
|
||||
for making modifications to it. "Object code" means any non-source
|
||||
form of a work.
|
||||
|
||||
A "Standard Interface" means an interface that either is an official
|
||||
standard defined by a recognized standards body, or, in the case of
|
||||
interfaces specified for a particular programming language, one that
|
||||
is widely used among developers working in that language.
|
||||
|
||||
The "System Libraries" of an executable work include anything, other
|
||||
than the work as a whole, that (a) is included in the normal form of
|
||||
packaging a Major Component, but which is not part of that Major
|
||||
Component, and (b) serves only to enable use of the work with that
|
||||
Major Component, or to implement a Standard Interface for which an
|
||||
implementation is available to the public in source code form. A
|
||||
"Major Component", in this context, means a major essential component
|
||||
(kernel, window system, and so on) of the specific operating system
|
||||
(if any) on which the executable work runs, or a compiler used to
|
||||
produce the work, or an object code interpreter used to run it.
|
||||
|
||||
The "Corresponding Source" for a work in object code form means all
|
||||
the source code needed to generate, install, and (for an executable
|
||||
work) run the object code and to modify the work, including scripts to
|
||||
control those activities. However, it does not include the work's
|
||||
System Libraries, or general-purpose tools or generally available free
|
||||
programs which are used unmodified in performing those activities but
|
||||
which are not part of the work. For example, Corresponding Source
|
||||
includes interface definition files associated with source files for
|
||||
the work, and the source code for shared libraries and dynamically
|
||||
linked subprograms that the work is specifically designed to require,
|
||||
such as by intimate data communication or control flow between those
|
||||
subprograms and other parts of the work.
|
||||
|
||||
The Corresponding Source need not include anything that users
|
||||
can regenerate automatically from other parts of the Corresponding
|
||||
Source.
|
||||
|
||||
The Corresponding Source for a work in source code form is that
|
||||
same work.
|
||||
|
||||
2. Basic Permissions.
|
||||
|
||||
All rights granted under this License are granted for the term of
|
||||
copyright on the Program, and are irrevocable provided the stated
|
||||
conditions are met. This License explicitly affirms your unlimited
|
||||
permission to run the unmodified Program. The output from running a
|
||||
covered work is covered by this License only if the output, given its
|
||||
content, constitutes a covered work. This License acknowledges your
|
||||
rights of fair use or other equivalent, as provided by copyright law.
|
||||
|
||||
You may make, run and propagate covered works that you do not
|
||||
convey, without conditions so long as your license otherwise remains
|
||||
in force. You may convey covered works to others for the sole purpose
|
||||
of having them make modifications exclusively for you, or provide you
|
||||
with facilities for running those works, provided that you comply with
|
||||
the terms of this License in conveying all material for which you do
|
||||
not control copyright. Those thus making or running the covered works
|
||||
for you must do so exclusively on your behalf, under your direction
|
||||
and control, on terms that prohibit them from making any copies of
|
||||
your copyrighted material outside their relationship with you.
|
||||
|
||||
Conveying under any other circumstances is permitted solely under
|
||||
the conditions stated below. Sublicensing is not allowed; section 10
|
||||
makes it unnecessary.
|
||||
|
||||
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
|
||||
|
||||
No covered work shall be deemed part of an effective technological
|
||||
measure under any applicable law fulfilling obligations under article
|
||||
11 of the WIPO copyright treaty adopted on 20 December 1996, or
|
||||
similar laws prohibiting or restricting circumvention of such
|
||||
measures.
|
||||
|
||||
When you convey a covered work, you waive any legal power to forbid
|
||||
circumvention of technological measures to the extent such circumvention
|
||||
is effected by exercising rights under this License with respect to
|
||||
the covered work, and you disclaim any intention to limit operation or
|
||||
modification of the work as a means of enforcing, against the work's
|
||||
users, your or third parties' legal rights to forbid circumvention of
|
||||
technological measures.
|
||||
|
||||
4. Conveying Verbatim Copies.
|
||||
|
||||
You may convey verbatim copies of the Program's source code as you
|
||||
receive it, in any medium, provided that you conspicuously and
|
||||
appropriately publish on each copy an appropriate copyright notice;
|
||||
keep intact all notices stating that this License and any
|
||||
non-permissive terms added in accord with section 7 apply to the code;
|
||||
keep intact all notices of the absence of any warranty; and give all
|
||||
recipients a copy of this License along with the Program.
|
||||
|
||||
You may charge any price or no price for each copy that you convey,
|
||||
and you may offer support or warranty protection for a fee.
|
||||
|
||||
5. Conveying Modified Source Versions.
|
||||
|
||||
You may convey a work based on the Program, or the modifications to
|
||||
produce it from the Program, in the form of source code under the
|
||||
terms of section 4, provided that you also meet all of these conditions:
|
||||
|
||||
a) The work must carry prominent notices stating that you modified
|
||||
it, and giving a relevant date.
|
||||
|
||||
b) The work must carry prominent notices stating that it is
|
||||
released under this License and any conditions added under section
|
||||
7. This requirement modifies the requirement in section 4 to
|
||||
"keep intact all notices".
|
||||
|
||||
c) You must license the entire work, as a whole, under this
|
||||
License to anyone who comes into possession of a copy. This
|
||||
License will therefore apply, along with any applicable section 7
|
||||
additional terms, to the whole of the work, and all its parts,
|
||||
regardless of how they are packaged. This License gives no
|
||||
permission to license the work in any other way, but it does not
|
||||
invalidate such permission if you have separately received it.
|
||||
|
||||
d) If the work has interactive user interfaces, each must display
|
||||
Appropriate Legal Notices; however, if the Program has interactive
|
||||
interfaces that do not display Appropriate Legal Notices, your
|
||||
work need not make them do so.
|
||||
|
||||
A compilation of a covered work with other separate and independent
|
||||
works, which are not by their nature extensions of the covered work,
|
||||
and which are not combined with it such as to form a larger program,
|
||||
in or on a volume of a storage or distribution medium, is called an
|
||||
"aggregate" if the compilation and its resulting copyright are not
|
||||
used to limit the access or legal rights of the compilation's users
|
||||
beyond what the individual works permit. Inclusion of a covered work
|
||||
in an aggregate does not cause this License to apply to the other
|
||||
parts of the aggregate.
|
||||
|
||||
6. Conveying Non-Source Forms.
|
||||
|
||||
You may convey a covered work in object code form under the terms
|
||||
of sections 4 and 5, provided that you also convey the
|
||||
machine-readable Corresponding Source under the terms of this License,
|
||||
in one of these ways:
|
||||
|
||||
a) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by the
|
||||
Corresponding Source fixed on a durable physical medium
|
||||
customarily used for software interchange.
|
||||
|
||||
b) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by a
|
||||
written offer, valid for at least three years and valid for as
|
||||
long as you offer spare parts or customer support for that product
|
||||
model, to give anyone who possesses the object code either (1) a
|
||||
copy of the Corresponding Source for all the software in the
|
||||
product that is covered by this License, on a durable physical
|
||||
medium customarily used for software interchange, for a price no
|
||||
more than your reasonable cost of physically performing this
|
||||
conveying of source, or (2) access to copy the
|
||||
Corresponding Source from a network server at no charge.
|
||||
|
||||
c) Convey individual copies of the object code with a copy of the
|
||||
written offer to provide the Corresponding Source. This
|
||||
alternative is allowed only occasionally and noncommercially, and
|
||||
only if you received the object code with such an offer, in accord
|
||||
with subsection 6b.
|
||||
|
||||
d) Convey the object code by offering access from a designated
|
||||
place (gratis or for a charge), and offer equivalent access to the
|
||||
Corresponding Source in the same way through the same place at no
|
||||
further charge. You need not require recipients to copy the
|
||||
Corresponding Source along with the object code. If the place to
|
||||
copy the object code is a network server, the Corresponding Source
|
||||
may be on a different server (operated by you or a third party)
|
||||
that supports equivalent copying facilities, provided you maintain
|
||||
clear directions next to the object code saying where to find the
|
||||
Corresponding Source. Regardless of what server hosts the
|
||||
Corresponding Source, you remain obligated to ensure that it is
|
||||
available for as long as needed to satisfy these requirements.
|
||||
|
||||
e) Convey the object code using peer-to-peer transmission, provided
|
||||
you inform other peers where the object code and Corresponding
|
||||
Source of the work are being offered to the general public at no
|
||||
charge under subsection 6d.
|
||||
|
||||
A separable portion of the object code, whose source code is excluded
|
||||
from the Corresponding Source as a System Library, need not be
|
||||
included in conveying the object code work.
|
||||
|
||||
A "User Product" is either (1) a "consumer product", which means any
|
||||
tangible personal property which is normally used for personal, family,
|
||||
or household purposes, or (2) anything designed or sold for incorporation
|
||||
into a dwelling. In determining whether a product is a consumer product,
|
||||
doubtful cases shall be resolved in favor of coverage. For a particular
|
||||
product received by a particular user, "normally used" refers to a
|
||||
typical or common use of that class of product, regardless of the status
|
||||
of the particular user or of the way in which the particular user
|
||||
actually uses, or expects or is expected to use, the product. A product
|
||||
is a consumer product regardless of whether the product has substantial
|
||||
commercial, industrial or non-consumer uses, unless such uses represent
|
||||
the only significant mode of use of the product.
|
||||
|
||||
"Installation Information" for a User Product means any methods,
|
||||
procedures, authorization keys, or other information required to install
|
||||
and execute modified versions of a covered work in that User Product from
|
||||
a modified version of its Corresponding Source. The information must
|
||||
suffice to ensure that the continued functioning of the modified object
|
||||
code is in no case prevented or interfered with solely because
|
||||
modification has been made.
|
||||
|
||||
If you convey an object code work under this section in, or with, or
|
||||
specifically for use in, a User Product, and the conveying occurs as
|
||||
part of a transaction in which the right of possession and use of the
|
||||
User Product is transferred to the recipient in perpetuity or for a
|
||||
fixed term (regardless of how the transaction is characterized), the
|
||||
Corresponding Source conveyed under this section must be accompanied
|
||||
by the Installation Information. But this requirement does not apply
|
||||
if neither you nor any third party retains the ability to install
|
||||
modified object code on the User Product (for example, the work has
|
||||
been installed in ROM).
|
||||
|
||||
The requirement to provide Installation Information does not include a
|
||||
requirement to continue to provide support service, warranty, or updates
|
||||
for a work that has been modified or installed by the recipient, or for
|
||||
the User Product in which it has been modified or installed. Access to a
|
||||
network may be denied when the modification itself materially and
|
||||
adversely affects the operation of the network or violates the rules and
|
||||
protocols for communication across the network.
|
||||
|
||||
Corresponding Source conveyed, and Installation Information provided,
|
||||
in accord with this section must be in a format that is publicly
|
||||
documented (and with an implementation available to the public in
|
||||
source code form), and must require no special password or key for
|
||||
unpacking, reading or copying.
|
||||
|
||||
7. Additional Terms.
|
||||
|
||||
"Additional permissions" are terms that supplement the terms of this
|
||||
License by making exceptions from one or more of its conditions.
|
||||
Additional permissions that are applicable to the entire Program shall
|
||||
be treated as though they were included in this License, to the extent
|
||||
that they are valid under applicable law. If additional permissions
|
||||
apply only to part of the Program, that part may be used separately
|
||||
under those permissions, but the entire Program remains governed by
|
||||
this License without regard to the additional permissions.
|
||||
|
||||
When you convey a copy of a covered work, you may at your option
|
||||
remove any additional permissions from that copy, or from any part of
|
||||
it. (Additional permissions may be written to require their own
|
||||
removal in certain cases when you modify the work.) You may place
|
||||
additional permissions on material, added by you to a covered work,
|
||||
for which you have or can give appropriate copyright permission.
|
||||
|
||||
Notwithstanding any other provision of this License, for material you
|
||||
add to a covered work, you may (if authorized by the copyright holders of
|
||||
that material) supplement the terms of this License with terms:
|
||||
|
||||
a) Disclaiming warranty or limiting liability differently from the
|
||||
terms of sections 15 and 16 of this License; or
|
||||
|
||||
b) Requiring preservation of specified reasonable legal notices or
|
||||
author attributions in that material or in the Appropriate Legal
|
||||
Notices displayed by works containing it; or
|
||||
|
||||
c) Prohibiting misrepresentation of the origin of that material, or
|
||||
requiring that modified versions of such material be marked in
|
||||
reasonable ways as different from the original version; or
|
||||
|
||||
d) Limiting the use for publicity purposes of names of licensors or
|
||||
authors of the material; or
|
||||
|
||||
e) Declining to grant rights under trademark law for use of some
|
||||
trade names, trademarks, or service marks; or
|
||||
|
||||
f) Requiring indemnification of licensors and authors of that
|
||||
material by anyone who conveys the material (or modified versions of
|
||||
it) with contractual assumptions of liability to the recipient, for
|
||||
any liability that these contractual assumptions directly impose on
|
||||
those licensors and authors.
|
||||
|
||||
All other non-permissive additional terms are considered "further
|
||||
restrictions" within the meaning of section 10. If the Program as you
|
||||
received it, or any part of it, contains a notice stating that it is
|
||||
governed by this License along with a term that is a further
|
||||
restriction, you may remove that term. If a license document contains
|
||||
a further restriction but permits relicensing or conveying under this
|
||||
License, you may add to a covered work material governed by the terms
|
||||
of that license document, provided that the further restriction does
|
||||
not survive such relicensing or conveying.
|
||||
|
||||
If you add terms to a covered work in accord with this section, you
|
||||
must place, in the relevant source files, a statement of the
|
||||
additional terms that apply to those files, or a notice indicating
|
||||
where to find the applicable terms.
|
||||
|
||||
Additional terms, permissive or non-permissive, may be stated in the
|
||||
form of a separately written license, or stated as exceptions;
|
||||
the above requirements apply either way.
|
||||
|
||||
8. Termination.
|
||||
|
||||
You may not propagate or modify a covered work except as expressly
|
||||
provided under this License. Any attempt otherwise to propagate or
|
||||
modify it is void, and will automatically terminate your rights under
|
||||
this License (including any patent licenses granted under the third
|
||||
paragraph of section 11).
|
||||
|
||||
However, if you cease all violation of this License, then your
|
||||
license from a particular copyright holder is reinstated (a)
|
||||
provisionally, unless and until the copyright holder explicitly and
|
||||
finally terminates your license, and (b) permanently, if the copyright
|
||||
holder fails to notify you of the violation by some reasonable means
|
||||
prior to 60 days after the cessation.
|
||||
|
||||
Moreover, your license from a particular copyright holder is
|
||||
reinstated permanently if the copyright holder notifies you of the
|
||||
violation by some reasonable means, this is the first time you have
|
||||
received notice of violation of this License (for any work) from that
|
||||
copyright holder, and you cure the violation prior to 30 days after
|
||||
your receipt of the notice.
|
||||
|
||||
Termination of your rights under this section does not terminate the
|
||||
licenses of parties who have received copies or rights from you under
|
||||
this License. If your rights have been terminated and not permanently
|
||||
reinstated, you do not qualify to receive new licenses for the same
|
||||
material under section 10.
|
||||
|
||||
9. Acceptance Not Required for Having Copies.
|
||||
|
||||
You are not required to accept this License in order to receive or
|
||||
run a copy of the Program. Ancillary propagation of a covered work
|
||||
occurring solely as a consequence of using peer-to-peer transmission
|
||||
to receive a copy likewise does not require acceptance. However,
|
||||
nothing other than this License grants you permission to propagate or
|
||||
modify any covered work. These actions infringe copyright if you do
|
||||
not accept this License. Therefore, by modifying or propagating a
|
||||
covered work, you indicate your acceptance of this License to do so.
|
||||
|
||||
10. Automatic Licensing of Downstream Recipients.
|
||||
|
||||
Each time you convey a covered work, the recipient automatically
|
||||
receives a license from the original licensors, to run, modify and
|
||||
propagate that work, subject to this License. You are not responsible
|
||||
for enforcing compliance by third parties with this License.
|
||||
|
||||
An "entity transaction" is a transaction transferring control of an
|
||||
organization, or substantially all assets of one, or subdividing an
|
||||
organization, or merging organizations. If propagation of a covered
|
||||
work results from an entity transaction, each party to that
|
||||
transaction who receives a copy of the work also receives whatever
|
||||
licenses to the work the party's predecessor in interest had or could
|
||||
give under the previous paragraph, plus a right to possession of the
|
||||
Corresponding Source of the work from the predecessor in interest, if
|
||||
the predecessor has it or can get it with reasonable efforts.
|
||||
|
||||
You may not impose any further restrictions on the exercise of the
|
||||
rights granted or affirmed under this License. For example, you may
|
||||
not impose a license fee, royalty, or other charge for exercise of
|
||||
rights granted under this License, and you may not initiate litigation
|
||||
(including a cross-claim or counterclaim in a lawsuit) alleging that
|
||||
any patent claim is infringed by making, using, selling, offering for
|
||||
sale, or importing the Program or any portion of it.
|
||||
|
||||
11. Patents.
|
||||
|
||||
A "contributor" is a copyright holder who authorizes use under this
|
||||
License of the Program or a work on which the Program is based. The
|
||||
work thus licensed is called the contributor's "contributor version".
|
||||
|
||||
A contributor's "essential patent claims" are all patent claims
|
||||
owned or controlled by the contributor, whether already acquired or
|
||||
hereafter acquired, that would be infringed by some manner, permitted
|
||||
by this License, of making, using, or selling its contributor version,
|
||||
but do not include claims that would be infringed only as a
|
||||
consequence of further modification of the contributor version. For
|
||||
purposes of this definition, "control" includes the right to grant
|
||||
patent sublicenses in a manner consistent with the requirements of
|
||||
this License.
|
||||
|
||||
Each contributor grants you a non-exclusive, worldwide, royalty-free
|
||||
patent license under the contributor's essential patent claims, to
|
||||
make, use, sell, offer for sale, import and otherwise run, modify and
|
||||
propagate the contents of its contributor version.
|
||||
|
||||
In the following three paragraphs, a "patent license" is any express
|
||||
agreement or commitment, however denominated, not to enforce a patent
|
||||
(such as an express permission to practice a patent or covenant not to
|
||||
sue for patent infringement). To "grant" such a patent license to a
|
||||
party means to make such an agreement or commitment not to enforce a
|
||||
patent against the party.
|
||||
|
||||
If you convey a covered work, knowingly relying on a patent license,
|
||||
and the Corresponding Source of the work is not available for anyone
|
||||
to copy, free of charge and under the terms of this License, through a
|
||||
publicly available network server or other readily accessible means,
|
||||
then you must either (1) cause the Corresponding Source to be so
|
||||
available, or (2) arrange to deprive yourself of the benefit of the
|
||||
patent license for this particular work, or (3) arrange, in a manner
|
||||
consistent with the requirements of this License, to extend the patent
|
||||
license to downstream recipients. "Knowingly relying" means you have
|
||||
actual knowledge that, but for the patent license, your conveying the
|
||||
covered work in a country, or your recipient's use of the covered work
|
||||
in a country, would infringe one or more identifiable patents in that
|
||||
country that you have reason to believe are valid.
|
||||
|
||||
If, pursuant to or in connection with a single transaction or
|
||||
arrangement, you convey, or propagate by procuring conveyance of, a
|
||||
covered work, and grant a patent license to some of the parties
|
||||
receiving the covered work authorizing them to use, propagate, modify
|
||||
or convey a specific copy of the covered work, then the patent license
|
||||
you grant is automatically extended to all recipients of the covered
|
||||
work and works based on it.
|
||||
|
||||
A patent license is "discriminatory" if it does not include within
|
||||
the scope of its coverage, prohibits the exercise of, or is
|
||||
conditioned on the non-exercise of one or more of the rights that are
|
||||
specifically granted under this License. You may not convey a covered
|
||||
work if you are a party to an arrangement with a third party that is
|
||||
in the business of distributing software, under which you make payment
|
||||
to the third party based on the extent of your activity of conveying
|
||||
the work, and under which the third party grants, to any of the
|
||||
parties who would receive the covered work from you, a discriminatory
|
||||
patent license (a) in connection with copies of the covered work
|
||||
conveyed by you (or copies made from those copies), or (b) primarily
|
||||
for and in connection with specific products or compilations that
|
||||
contain the covered work, unless you entered into that arrangement,
|
||||
or that patent license was granted, prior to 28 March 2007.
|
||||
|
||||
Nothing in this License shall be construed as excluding or limiting
|
||||
any implied license or other defenses to infringement that may
|
||||
otherwise be available to you under applicable patent law.
|
||||
|
||||
12. No Surrender of Others' Freedom.
|
||||
|
||||
If conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot convey a
|
||||
covered work so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you may
|
||||
not convey it at all. For example, if you agree to terms that obligate you
|
||||
to collect a royalty for further conveying from those to whom you convey
|
||||
the Program, the only way you could satisfy both those terms and this
|
||||
License would be to refrain entirely from conveying the Program.
|
||||
|
||||
13. Use with the GNU Affero General Public License.
|
||||
|
||||
Notwithstanding any other provision of this License, you have
|
||||
permission to link or combine any covered work with a work licensed
|
||||
under version 3 of the GNU Affero General Public License into a single
|
||||
combined work, and to convey the resulting work. The terms of this
|
||||
License will continue to apply to the part which is the covered work,
|
||||
but the special requirements of the GNU Affero General Public License,
|
||||
section 13, concerning interaction through a network will apply to the
|
||||
combination as such.
|
||||
|
||||
14. Revised Versions of this License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions of
|
||||
the GNU General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Program specifies that a certain numbered version of the GNU General
|
||||
Public License "or any later version" applies to it, you have the
|
||||
option of following the terms and conditions either of that numbered
|
||||
version or of any later version published by the Free Software
|
||||
Foundation. If the Program does not specify a version number of the
|
||||
GNU General Public License, you may choose any version ever published
|
||||
by the Free Software Foundation.
|
||||
|
||||
If the Program specifies that a proxy can decide which future
|
||||
versions of the GNU General Public License can be used, that proxy's
|
||||
public statement of acceptance of a version permanently authorizes you
|
||||
to choose that version for the Program.
|
||||
|
||||
Later license versions may give you additional or different
|
||||
permissions. However, no additional obligations are imposed on any
|
||||
author or copyright holder as a result of your choosing to follow a
|
||||
later version.
|
||||
|
||||
15. Disclaimer of Warranty.
|
||||
|
||||
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
|
||||
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
|
||||
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
|
||||
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
|
||||
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
|
||||
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
|
||||
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
|
||||
|
||||
16. Limitation of Liability.
|
||||
|
||||
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
|
||||
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
|
||||
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
|
||||
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
|
||||
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
|
||||
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
|
||||
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
|
||||
SUCH DAMAGES.
|
||||
|
||||
17. Interpretation of Sections 15 and 16.
|
||||
|
||||
If the disclaimer of warranty and limitation of liability provided
|
||||
above cannot be given local legal effect according to their terms,
|
||||
reviewing courts shall apply local law that most closely approximates
|
||||
an absolute waiver of all civil liability in connection with the
|
||||
Program, unless a warranty or assumption of liability accompanies a
|
||||
copy of the Program in return for a fee.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
state the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program does terminal interaction, make it output a short
|
||||
notice like this when it starts in an interactive mode:
|
||||
|
||||
<program> Copyright (C) <year> <name of author>
|
||||
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, your program's commands
|
||||
might be different; for a GUI interface, you would use an "about box".
|
||||
|
||||
You should also get your employer (if you work as a programmer) or school,
|
||||
if any, to sign a "copyright disclaimer" for the program, if necessary.
|
||||
For more information on this, and how to apply and follow the GNU GPL, see
|
||||
<http://www.gnu.org/licenses/>.
|
||||
|
||||
The GNU General Public License does not permit incorporating your program
|
||||
into proprietary programs. If your program is a subroutine library, you
|
||||
may consider it more useful to permit linking proprietary applications with
|
||||
the library. If this is what you want to do, use the GNU Lesser General
|
||||
Public License instead of this License. But first, please read
|
||||
<http://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
|
||||
3
install/backup.sh
Normal file
3
install/backup.sh
Normal file
@@ -0,0 +1,3 @@
|
||||
#/bin/sh
|
||||
DATE=`date +%Y-%m-%d_%H-%M-%S | tr -d "\n"`
|
||||
mysqldump -u calcms_admin -p'taes9Cho' calcms_test > backup-$DATE.sql
|
||||
1168
install/create.sql
Normal file
1168
install/create.sql
Normal file
File diff suppressed because it is too large
Load Diff
45
lib/calcms/UTF8DBI.pm
Normal file
45
lib/calcms/UTF8DBI.pm
Normal file
@@ -0,0 +1,45 @@
|
||||
# UTF8DBI.pm re-implementation by Pavel Kudinov http://search.cpan.org/~kudinov/
|
||||
# originally from: http://dysphoria.net/code/perl-utf8/
|
||||
# And patched again by Andrew Forrest, Jan 2007
|
||||
|
||||
use DBI 1.21;
|
||||
use utf8;
|
||||
use Encode;
|
||||
|
||||
package UTF8DBI; use base DBI;
|
||||
sub _utf8_ {
|
||||
if (ref $_ eq 'ARRAY') { _utf8_() foreach @$_ }
|
||||
elsif (ref $_ eq 'HASH' ) { _utf8_() foreach values %$_ }
|
||||
else {
|
||||
Encode::_utf8_on($_);
|
||||
if (Encode::is_utf8($_) && ! Encode::is_utf8($_, 1)) {
|
||||
#$_ = '⁂malformed-UTF8‼' #die "Malformed utf8 string in database"
|
||||
#print data_string_desc($_)."\n"
|
||||
#data_string_desc(STRING);
|
||||
#Encode::decode_utf8($_);
|
||||
#;
|
||||
#Encode::_utf8_off($_);
|
||||
#Encode::decode_utf8($_);
|
||||
#Encode::encode_utf8($_);
|
||||
}
|
||||
};
|
||||
$_;
|
||||
};
|
||||
|
||||
|
||||
package UTF8DBI::db; use base DBI::db;
|
||||
|
||||
sub selectrow_arrayref { return UTF8DBI::_utf8_ for shift->SUPER::selectrow_arrayref(@_) };
|
||||
sub selectrow_hashref { return UTF8DBI::_utf8_ for shift->SUPER::selectrow_hashref (@_) };
|
||||
sub selectall_arrayref { return UTF8DBI::_utf8_ for shift->SUPER::selectall_arrayref(@_) };
|
||||
sub selectall_hashref { return UTF8DBI::_utf8_ for shift->SUPER::selectall_hashref (@_) };
|
||||
sub selectcol_arrayref { return UTF8DBI::_utf8_ for shift->SUPER::selectcol_arrayref(@_) };
|
||||
|
||||
sub selectrow_array { @{shift->selectrow_arrayref(@_)} };
|
||||
|
||||
|
||||
package UTF8DBI::st; use base DBI::st;
|
||||
|
||||
sub fetch { return UTF8DBI::_utf8_ for shift->SUPER::fetch (@_) };
|
||||
|
||||
1;
|
||||
294
lib/calcms/aggregator.pm
Normal file
294
lib/calcms/aggregator.pm
Normal file
@@ -0,0 +1,294 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use events;
|
||||
use comments;
|
||||
use calendar;
|
||||
use project;
|
||||
|
||||
package aggregator;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_cache configure_cache put_cache get_list check_params);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
#my $cgi=undef;
|
||||
|
||||
sub get_list{
|
||||
my $config = shift;
|
||||
my $request=shift;
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
#customize prefiltered request parameters
|
||||
$request->{params}->{original}->{date}=$request->{params}->{checked}->{date};
|
||||
if ($params->{event_id}ne''){
|
||||
$request->{params}->{original}->{template}='event_details.html';
|
||||
}else{
|
||||
$request->{params}->{original}->{template}='event_list.html';
|
||||
}
|
||||
$request->{params}->{checked} = events::check_params($config, $request->{params}->{original});
|
||||
log::write($config, 'params',$request->{params}->{checked}) if ($debug);
|
||||
|
||||
my $content='';
|
||||
my $results=events::get($config, $request);
|
||||
events::render($content, $config, $request, $results);
|
||||
# calendar::get_cached_or_render($content,$request);
|
||||
|
||||
|
||||
#set url to embed as last loaded url in javascript
|
||||
my $date=$params->{date}||'';
|
||||
$date='heute' if ($params->{date}eq'today');
|
||||
$date=$results->[0]->{day} if ($params->{event_id}ne'');
|
||||
my $url='';
|
||||
#$config->{controllers}->{events}.'/'.$date.'/';
|
||||
if ($params->{from_date}ne'' && $params->{till_date}ne''){
|
||||
$url=$config->{controllers}->{events}.'/'.$params->{from_date}.'/'.$params->{till_date} ;
|
||||
}else{
|
||||
$url=$config->{controllers}->{events}.'/'.$params->{from_date}.'/'.$params->{till_date} ;
|
||||
}
|
||||
|
||||
#count most projects
|
||||
my $used_projects={};
|
||||
for my $result (@$results){
|
||||
my $project=$result->{project_title}||'';
|
||||
$used_projects->{$project}++;
|
||||
}
|
||||
my @used_projects=reverse sort {$used_projects->{$a} <=> $used_projects->{$b}} (keys %$used_projects);
|
||||
my $most_used_project=$used_projects[0];
|
||||
#use Data::Dumper;print STDERR Dumper(\@used_projects);
|
||||
|
||||
return {
|
||||
day => $results->[0]->{day},
|
||||
start_datetime => $results->[0]->{start_datetime},
|
||||
event_id => $results->[0]->{event_id},
|
||||
program => $results->[0]->{program},
|
||||
project_title => $most_used_project,
|
||||
series_name => $results->[0]->{series_name},
|
||||
title => $results->[0]->{title},
|
||||
content => $content,
|
||||
results => $results,
|
||||
url => $url,
|
||||
};
|
||||
}
|
||||
|
||||
sub get_menu{
|
||||
my $config = shift;
|
||||
my $request=shift;
|
||||
my $date=shift;
|
||||
my $results=shift;
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
|
||||
#load details only on demand
|
||||
if ($params->{event_id}ne''){
|
||||
$request->{params}->{original}->{template}='event_menu.html';
|
||||
$request->{params}->{original}->{event_id}=undef;
|
||||
$request->{params}->{original}->{date}=$date;
|
||||
$request->{params}->{checked} =events::check_params($config, $request->{params}->{original});
|
||||
$results=events::get($config, $request);
|
||||
}else{
|
||||
$request->{params}->{checked}->{template}=template::check('event_menu.html');
|
||||
}
|
||||
|
||||
#events menu
|
||||
my $output='';
|
||||
events::render($output, $config, $request, $results);
|
||||
|
||||
return {
|
||||
content => $output
|
||||
};
|
||||
}
|
||||
|
||||
sub get_calendar{
|
||||
my $config = shift;
|
||||
my $request=shift;
|
||||
my $date=shift;
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
$request->{params}->{original}->{template} = 'calendar.html';
|
||||
$request->{params}->{original}->{date} = $date if (defined $date);
|
||||
$request->{params}->{checked} = calendar::check_params($config, $request->{params}->{original});
|
||||
$params = $request->{params}->{checked};
|
||||
log::write($config, 'params',$params) if ($debug);
|
||||
|
||||
#set query string for caching
|
||||
my $options=[];
|
||||
push (@$options,'date='.$params->{date}) if ($params->{date} ne'');
|
||||
push (@$options,'from_date='.$params->{from_date}) if ($params->{from_date} ne'');
|
||||
push (@$options,'till_date='.$params->{till_date}) if ($params->{till_date} ne'');
|
||||
$ENV{QUERY_STRING}=''.join("&",@$options);
|
||||
|
||||
my $content='';
|
||||
calendar::get_cached_or_render($content, $config, $request);
|
||||
|
||||
return {
|
||||
content => $content
|
||||
};
|
||||
}
|
||||
|
||||
sub get_newest_comments{
|
||||
my $config = shift;
|
||||
my $request=shift;
|
||||
|
||||
my $params={
|
||||
template =>'comments_newest.html',
|
||||
limit => 10,
|
||||
type =>'list',
|
||||
show_max => 3
|
||||
};
|
||||
$request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => $params,
|
||||
checked => comments::check_params($config, $params),
|
||||
},
|
||||
config => $config,
|
||||
connection => $request->{connection}
|
||||
};
|
||||
my $content='';
|
||||
comments::get_cached_or_render($content, $config, $request);
|
||||
return {
|
||||
content => $content
|
||||
};
|
||||
}
|
||||
|
||||
sub get_cache{
|
||||
my $config = shift;
|
||||
my $request = shift;
|
||||
|
||||
my $params =$request->{params}->{checked};
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
if ($config->{cache}->{use_cache} == 1){
|
||||
configure_cache($config);
|
||||
log::write($config, 'cache_files',cache::get_map()) if ($debug);
|
||||
my $cache=cache::load($config, $params);
|
||||
log::write($config, 'cache_files',$cache->{action}) if ($debug);
|
||||
return $cache;
|
||||
}
|
||||
return{};
|
||||
}
|
||||
|
||||
sub configure_cache{
|
||||
my $config = shift;
|
||||
|
||||
cache::init();
|
||||
my $controllers=$config->{controllers};
|
||||
|
||||
my $date_pattern=$cache::date_pattern;
|
||||
# cache::add_map('' ,'programm/index.html');
|
||||
cache::add_map('date=today' ,'programm/'.$controllers->{events}.'/today.html');
|
||||
cache::add_map('date='.$date_pattern ,'programm/'.$controllers->{events}.'/$1-$2-$3.html');
|
||||
cache::add_map('from_date='.$date_pattern.'&till_date='.$date_pattern ,'programm/'.$controllers->{events}.'/$1-$2-$3_$4-$5-$6.html');
|
||||
cache::add_map('event_id=(\d+)' ,'programm/'.$controllers->{event}.'/$1.html');
|
||||
}
|
||||
|
||||
|
||||
sub put_cache{
|
||||
my $config = shift;
|
||||
my $request = shift;
|
||||
my $cache = shift;
|
||||
|
||||
#write to cache
|
||||
if ($config->{cache}->{use_cache} == 1){
|
||||
cache::save($cache);
|
||||
}
|
||||
}
|
||||
|
||||
sub check_params{
|
||||
my $config = shift;
|
||||
my $params = shift;
|
||||
|
||||
#get start and stop from projects
|
||||
my $range= project::get_date_range($config);
|
||||
my $start_date = $range->{start_date};
|
||||
my $end_date = $range->{end_date};
|
||||
|
||||
# my $project_name=$config->{project}||'';
|
||||
# log::error($config, 'no default project configured') if($project_name eq '');
|
||||
# log::error($config, "no configuration found for project '$project_name'") unless(exists($config->{projects}->{$project_name}));
|
||||
# my $project=$config->{projects}->{$project_name}||'';
|
||||
# log::erorr($config, 'no configuration found for project') if($project eq'');
|
||||
# if ((defined $params->{project}) && ($params->{project}=~/(\w+)/)){
|
||||
# $project=$config->{projects}->{$1} if exists($config->{projects}->{$1});
|
||||
# }
|
||||
|
||||
#filter for date
|
||||
my $date=time::check_date($params->{date});
|
||||
#print STDERR $date."\n";
|
||||
if ($date eq ''){
|
||||
$date=time::time_to_date(time()) ;
|
||||
}
|
||||
#
|
||||
if ($date eq 'today'){
|
||||
$date=time::get_event_date($config);
|
||||
}
|
||||
|
||||
# $date =$config->{date}->{start_date} if ($date lt $config->{date}->{start_date});
|
||||
# $date =$config->{date}->{end_date} if ($date gt $config->{date}->{end_date});
|
||||
$date =$start_date if $date lt $start_date;
|
||||
$date =$end_date if $date gt $end_date;
|
||||
|
||||
#filter for date
|
||||
# my $date=time::check_date($params->{date});
|
||||
my $time=time::check_time($params->{time});
|
||||
if ((defined $params->{today}) && ($params->{today}eq'1')){
|
||||
$date =time::time_to_date(time());
|
||||
$params->{date}=$date;
|
||||
};
|
||||
|
||||
my $from_date=time::check_date($params->{from_date});
|
||||
my $till_date=time::check_date($params->{till_date});
|
||||
|
||||
my $previous_series=$params->{previous_series} || '';
|
||||
if(($previous_series)&&($previous_series=~/(\d+)/)){
|
||||
$params->{event_id}=events::get_previous_event_of_series(undef, $config, $1);
|
||||
}
|
||||
|
||||
my $next_series=$params->{next_series} || '';
|
||||
if(($next_series)&&($next_series=~/(\d+)/)){
|
||||
$params->{event_id}=events::get_next_event_of_series(undef, $config, $1);
|
||||
}
|
||||
|
||||
my $event_id=$params->{event_id}||'';
|
||||
unless ($event_id eq''){
|
||||
if ($event_id=~/(\d+)/){
|
||||
$event_id=$1;
|
||||
}else{
|
||||
log::error($config, "invalid event_id");
|
||||
}
|
||||
}
|
||||
|
||||
my $debug=$params->{debug}||'';
|
||||
if ($debug=~/([a-z\_\,]+)/){
|
||||
$debug=$1;
|
||||
}
|
||||
|
||||
#set query string for caching
|
||||
if ((!exists $ENV{QUERY_STRING}) || ($ENV{QUERY_STRING}eq'')){
|
||||
my $options=[];
|
||||
push (@$options,'date='.$date) if $date ne'';
|
||||
push (@$options,'from_date='.$from_date) if $from_date ne'';
|
||||
push (@$options,'till_date='.$till_date) if $till_date ne'';
|
||||
push (@$options,'event_id='.$event_id) if $event_id ne'';
|
||||
$ENV{QUERY_STRING}=''.join("&",@$options);
|
||||
}
|
||||
|
||||
return {
|
||||
date => $date,
|
||||
time => $time,
|
||||
from_date => $from_date,
|
||||
till_date => $till_date,
|
||||
event_id => $event_id,
|
||||
# project => $project,
|
||||
debug => $debug,
|
||||
};
|
||||
;
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
180
lib/calcms/audio_recordings.pm
Normal file
180
lib/calcms/audio_recordings.pm
Normal file
@@ -0,0 +1,180 @@
|
||||
#!/bin/perl
|
||||
|
||||
package audio_recordings;
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use Data::Dumper;
|
||||
use db;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
# columns:
|
||||
# id, project_id, studio_id, event_id
|
||||
# created_by, created_at
|
||||
# path, md5
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_audio_recordings');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
# get playout entries
|
||||
sub get{
|
||||
my $config = shift;
|
||||
my $condition = shift;
|
||||
|
||||
return undef unless defined $condition->{project_id};
|
||||
return undef unless defined $condition->{studio_id};
|
||||
|
||||
my $date_range_include=0;
|
||||
$date_range_include=1 if (defined $condition->{date_range_include}) && ($condition->{date_range_include}==1);
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $conditions=[];
|
||||
my $bind_values=[];
|
||||
|
||||
if ((defined $condition->{id}) && ($condition->{id} ne '')){
|
||||
push @$conditions, 'id=?';
|
||||
push @$bind_values, $condition->{id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @$conditions, 'project_id=?';
|
||||
push @$bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @$conditions, 'studio_id=?';
|
||||
push @$bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{event_id}) && ($condition->{event_id} ne '')){
|
||||
push @$conditions, 'event_id=?';
|
||||
push @$bind_values, $condition->{event_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{path}) && ($condition->{path} ne '')){
|
||||
push @$conditions, 'path=?';
|
||||
push @$bind_values, $condition->{path};
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $whereClause='';
|
||||
$whereClause=" where ".join(" and ",@$conditions) if (scalar @$conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select id
|
||||
,project_id
|
||||
,studio_id
|
||||
,event_id
|
||||
,path
|
||||
,md5
|
||||
,size
|
||||
,created_by
|
||||
,created_at
|
||||
from calcms_audio_recordings
|
||||
$whereClause
|
||||
order by created_at desc
|
||||
};
|
||||
|
||||
print STDERR Dumper($query).Dumper($bind_values);
|
||||
my $entries=db::get($dbh, $query, $bind_values);
|
||||
return $entries;
|
||||
}
|
||||
|
||||
|
||||
# update playout entry if differs to old values
|
||||
sub update{
|
||||
my $config = shift;
|
||||
my $dbh = shift;
|
||||
my $entry = shift;
|
||||
|
||||
print STDERR "update:".Dumper($entry);
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
|
||||
my $bind_values=[
|
||||
$entry->{path}, $entry->{md5}, $entry->{size}, $entry->{created_by}, $entry->{created_at},
|
||||
$entry->{project_id}, $entry->{studio_id}, $entry->{event_id}
|
||||
];
|
||||
|
||||
my $query=qq{
|
||||
update calcms_audio_recordings
|
||||
set path=?, md5=?, size=?, created_by=?, created_at=?
|
||||
where project_id=? and studio_id=? and event_id=?
|
||||
};
|
||||
print STDERR Dumper($query).Dumper($bind_values);
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
# insert playout entry
|
||||
sub insert{
|
||||
my $config = shift;
|
||||
my $dbh = shift;
|
||||
my $entry = shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{event_id};
|
||||
return undef unless defined $entry->{path};
|
||||
|
||||
print STDERR "insert into audio_recordings:".Dumper($entry);
|
||||
return db::insert($dbh, 'calcms_audio_recordings', {
|
||||
project_id => $entry->{project_id},
|
||||
studio_id => $entry->{studio_id},
|
||||
event_id => $entry->{event_id},
|
||||
path => $entry->{path},
|
||||
size => $entry->{size},
|
||||
md5 => $entry->{md5},
|
||||
created_by => $entry->{created_by},
|
||||
});
|
||||
|
||||
}
|
||||
|
||||
# delete playout entry
|
||||
sub delete{
|
||||
my $config = shift;
|
||||
my $dbh = shift;
|
||||
my $entry = shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{event_id};
|
||||
return undef unless defined $entry->{path};
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_audio_recordings
|
||||
where project_id=? and studio_id=? and event_id=? and path=?
|
||||
};
|
||||
my $bind_values = [ $entry->{project_id}, $entry->{studio_id}, $entry->{event_id}, $entry->{path} ];
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg = shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
354
lib/calcms/auth.pm
Normal file
354
lib/calcms/auth.pm
Normal file
@@ -0,0 +1,354 @@
|
||||
#!/bin/perl
|
||||
|
||||
use CGI;
|
||||
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
|
||||
use CGI::Session qw(-ip-match);
|
||||
use CGI::Cookie;
|
||||
#$CGI::Session::IP_MATCH=1;
|
||||
|
||||
package auth;
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use Data::Dumper;
|
||||
use Authen::Passphrase::BlowfishCrypt;
|
||||
use time;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_user login logout crypt_password);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
|
||||
my $defaultExpiration=60;
|
||||
my $tmp_dir='/var/tmp/';
|
||||
my $debug=0;
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_user{
|
||||
my $cgi=shift;
|
||||
my $config=shift;
|
||||
|
||||
my %parms=$cgi->Vars();
|
||||
my $parms=\%parms;
|
||||
|
||||
debug("get_user")if ($debug);
|
||||
|
||||
# login or logout on action
|
||||
if (defined $parms->{action}){
|
||||
if ($parms->{action} eq 'login'){
|
||||
my $user=login($cgi, $config, $parms->{user}, $parms->{password});
|
||||
$cgi->delete('user','password','uri','action');
|
||||
return $user;
|
||||
}elsif($parms->{action} eq 'logout'){
|
||||
logout($cgi);
|
||||
$cgi->delete('user','password','uri','action');
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
# read session id from cookie
|
||||
my $session_id=read_cookie($cgi);
|
||||
|
||||
# login if no cookie found
|
||||
return show_login_form($parms->{user}, 'Please login') unless defined $session_id;
|
||||
|
||||
# read session
|
||||
my $session=read_session($session_id);
|
||||
|
||||
# login if user not found
|
||||
return show_login_form($parms->{user}, 'unknown User') unless defined $session;
|
||||
|
||||
$parms->{user} = $session->{user};
|
||||
$parms->{expires} = $session->{expires};
|
||||
debug($parms->{expires});
|
||||
return $session->{user}, $session->{expires};
|
||||
}
|
||||
|
||||
sub crypt_password{
|
||||
my $password=shift;
|
||||
|
||||
my $ppr = Authen::Passphrase::BlowfishCrypt->new(
|
||||
cost => 8,
|
||||
salt_random => 1,
|
||||
passphrase => $password
|
||||
);
|
||||
return{
|
||||
salt => $ppr->salt_base64,
|
||||
crypt => $ppr->as_crypt
|
||||
};
|
||||
}
|
||||
|
||||
sub login{
|
||||
my $cgi=shift;
|
||||
my $config=shift;
|
||||
my $user=shift;
|
||||
my $password=shift;
|
||||
debug("login")if ($debug);
|
||||
|
||||
#print STDERR "login $user $password\n";
|
||||
my $result = authenticate($config, $user, $password);
|
||||
#print STDERR Dumper($result);
|
||||
|
||||
return show_login_form($user,'Could not authenticate you') unless defined $result;
|
||||
return unless defined $result->{login}eq '1';
|
||||
|
||||
my $timeout=$result->{timeout} || $defaultExpiration;
|
||||
$timeout='+'.$timeout.'m';
|
||||
|
||||
my $session_id=create_session($user, $password, $timeout);
|
||||
return $user if(create_cookie($cgi, $session_id, $timeout));
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub logout{
|
||||
my $cgi=shift;
|
||||
my $session_id=read_cookie($cgi);
|
||||
debug("logout")if ($debug);
|
||||
unless(delete_session($session_id)){
|
||||
return show_login_form('Cant delete session', 'logged out');
|
||||
};
|
||||
unless(delete_cookie($cgi)){
|
||||
return show_login_form('Cant remove cookie', 'logged out');
|
||||
}
|
||||
my $uri=$ENV{HTTP_REFERER}||'';
|
||||
$uri=~s/action=logout//g;
|
||||
print $cgi->redirect($uri);
|
||||
# return show_login_form('', 'logged out');
|
||||
}
|
||||
|
||||
#read and write data from browser, http://perldoc.perl.org/CGI/Cookie.html
|
||||
sub create_cookie{
|
||||
my $cgi=shift;
|
||||
my $session_id=shift;
|
||||
my $timeout=shift;
|
||||
#debug("create_cookie")if ($debug);
|
||||
|
||||
my $cookie = CGI::Cookie->new(
|
||||
-name => 'sessionID',
|
||||
-value => $session_id,
|
||||
-expires => $timeout,
|
||||
# -domain => '.capricorn.com',
|
||||
# -path => '/agenda/admin/',
|
||||
-secure => 1
|
||||
);
|
||||
print "Set-Cookie: ",$cookie->as_string,"\n";
|
||||
print STDERR "#Set-Cookie: ",$cookie->as_string,"\n";
|
||||
# print $cgi->header( -cookie => $cookie );
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub read_cookie{
|
||||
my $cgi=shift;
|
||||
|
||||
debug("read_cookie")if ($debug);
|
||||
my %cookie = CGI::Cookie->fetch;
|
||||
debug("cookies: ".Dumper(\%cookie))if ($debug);
|
||||
my $cookie=$cookie{'sessionID'};
|
||||
debug("cookie: ".$cookie)if ($debug);
|
||||
return undef unless (defined $cookie);
|
||||
my $session_id= $cookie->value || undef;
|
||||
debug("sid: ".$session_id)if ($debug);
|
||||
return $session_id;
|
||||
#return $cgi->cookie('sessionID') || undef;
|
||||
};
|
||||
|
||||
sub delete_cookie{
|
||||
my $cgi=shift;
|
||||
|
||||
debug("delete_cookie")if ($debug);
|
||||
my $cookie = $cgi->cookie(
|
||||
-name => 'sessionID',
|
||||
-value => '',
|
||||
-expires => '+1s'
|
||||
);
|
||||
print $cgi->header( -cookie => $cookie );
|
||||
return 1;
|
||||
}
|
||||
|
||||
#read and write server-side session data
|
||||
sub create_session{
|
||||
my $user=shift;
|
||||
my $password=shift;
|
||||
my $expiration=shift;
|
||||
|
||||
debug("create_session")if ($debug);
|
||||
my $session = new CGI::Session(undef, undef, {Directory=>$tmp_dir});
|
||||
$session->expire($expiration);
|
||||
$session->param("user", $user);
|
||||
$session->param("pid", $$);
|
||||
# $session->param("password", $password);
|
||||
return $session->id();
|
||||
}
|
||||
|
||||
sub read_session{
|
||||
my $session_id=shift;
|
||||
|
||||
debug("read_session")if $debug;
|
||||
return undef unless(defined $session_id);
|
||||
|
||||
debug("read_session2")if $debug;
|
||||
my $session = new CGI::Session(undef, $session_id, {Directory=>$tmp_dir});
|
||||
return undef unless defined $session;
|
||||
|
||||
debug("read_session3")if $debug;
|
||||
my $user = $session->param("user") || undef;
|
||||
return undef unless defined $user;
|
||||
my $expires = time::time_to_datetime($session->param("_SESSION_ATIME")+$session->param("_SESSION_ETIME"));
|
||||
return {
|
||||
user => $user,
|
||||
expires => $expires
|
||||
}
|
||||
}
|
||||
|
||||
sub delete_session{
|
||||
my $session_id=shift;
|
||||
|
||||
debug("delete_session")if ($debug);
|
||||
return undef unless(defined $session_id);
|
||||
my $session = new CGI::Session(undef, $session_id, {Directory=>$tmp_dir});
|
||||
$session->delete();
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
#check user authentication
|
||||
sub authenticate{
|
||||
my $config=shift;
|
||||
my $user=shift;
|
||||
my $password=shift;
|
||||
|
||||
$config->{access}->{write}=0;
|
||||
my $dbh = db::connect($config);
|
||||
my $query = qq{
|
||||
select *
|
||||
from calcms_users
|
||||
where name=?
|
||||
};
|
||||
my $bind_values = [$user];
|
||||
#print STDERR "query:".Dumper($query).Dumper($bind_values);
|
||||
|
||||
my $users = db::get($dbh,$query,$bind_values);
|
||||
#print STDERR "result:".Dumper($users);
|
||||
|
||||
if (scalar(@$users) != 1){
|
||||
print STDERR "auth: did not find user '$user'\n";
|
||||
return undef;
|
||||
}
|
||||
#print STDERR Dumper($users);
|
||||
|
||||
my $salt=$users->[0]->{salt};
|
||||
my $ppr = Authen::Passphrase::BlowfishCrypt->from_crypt(
|
||||
$users->[0]->{pass},
|
||||
$users->[0]->{salt}
|
||||
);
|
||||
|
||||
return undef unless $ppr->match($password);
|
||||
if($users->[0]->{disabled} == 1){
|
||||
print STDERR "user '$user' is disabled\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $timeout = $users->[0]->{session_timeout} || 120;
|
||||
$timeout =10 if $timeout < 10;
|
||||
$timeout =12*60 if $timeout > 12*60;
|
||||
|
||||
return {
|
||||
timeout => $timeout,
|
||||
login => 1
|
||||
}
|
||||
}
|
||||
|
||||
sub show_login_form{
|
||||
my $user=shift||'';
|
||||
my $uri=$ENV{HTTP_REFERER}||'';
|
||||
my $message=shift||'';
|
||||
debug("show_login_form")if ($debug);
|
||||
print qq{Content-type:text/html
|
||||
|
||||
<!DOCTYPE HTML>
|
||||
<html>
|
||||
<head>
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
<style type="text/css">
|
||||
html,body{
|
||||
height: 100%;
|
||||
font-family:helvetica,arial,sans-serif;
|
||||
}
|
||||
|
||||
body{
|
||||
display: table;
|
||||
margin: 0 auto;
|
||||
}
|
||||
|
||||
input, .row, .field{
|
||||
padding:0.5em;
|
||||
}
|
||||
|
||||
.container{
|
||||
height: 100%;
|
||||
display: table-cell;
|
||||
vertical-align: middle;
|
||||
}
|
||||
|
||||
#login_form{
|
||||
background:#ddd;
|
||||
box-shadow: 1em 1em 1em #888;
|
||||
margin:1em;
|
||||
padding:1em;
|
||||
text-align:center;
|
||||
}
|
||||
|
||||
#login_form .field{
|
||||
width:8em;
|
||||
float:left;
|
||||
}
|
||||
|
||||
#login_form .message{
|
||||
background:#ccc;
|
||||
text-align:left;
|
||||
font-weight:bold;
|
||||
padding:1em;
|
||||
margin:-1em;
|
||||
margin-bottom:0;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
|
||||
<div class="container">
|
||||
<div id="login_form">
|
||||
<div class="message">$message</div><br/>
|
||||
<form method="post">
|
||||
<div class="row">
|
||||
<div class="field">user</div>
|
||||
<input name="user" value="$user"><br/>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="field">password</div>
|
||||
<input type="password" name="password"><br/>
|
||||
</div>
|
||||
<div class="row">
|
||||
<input type="submit" name="action" value="login">
|
||||
<input type="submit" name="action" value="logout">
|
||||
</div>
|
||||
<input type="hidden" name="uri" value="$uri">
|
||||
</form>
|
||||
</div>
|
||||
</container>
|
||||
</body>
|
||||
</html>
|
||||
};
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub debug{
|
||||
my $message=shift;
|
||||
print STDERR "$message\n" if $debug>0;
|
||||
}
|
||||
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
179
lib/calcms/cache.pm
Normal file
179
lib/calcms/cache.pm
Normal file
@@ -0,0 +1,179 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
#use Data::Dumper;
|
||||
|
||||
use config;
|
||||
use time;
|
||||
use log;
|
||||
use markup;
|
||||
|
||||
package cache;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(init add_map get_map get_map_keys load save get_filename escape_regexp escape_regexp_line);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
my $cache_map ={};
|
||||
my $cache_map_keys =[];
|
||||
my $header_printed =0;
|
||||
|
||||
our $date_pattern ='(\d{4})\-(\d{2})\-(\d{2})';
|
||||
our $datetime_pattern ='(\d{4})\-(\d{2})\-(\d{2})[T\+](\d{2})\:(\d{2})(\:\d{2})?';
|
||||
|
||||
sub init{
|
||||
$cache_map ={};
|
||||
$cache_map_keys =[];
|
||||
$header_printed =0;
|
||||
}
|
||||
|
||||
sub add_map{
|
||||
my $key =$_[0];
|
||||
my $value =$_[1];
|
||||
|
||||
$key='^'.$key.'$';
|
||||
push @$cache_map_keys,$key;
|
||||
$cache_map->{$key}=$value;
|
||||
}
|
||||
|
||||
sub get_map{
|
||||
return $cache_map;
|
||||
}
|
||||
|
||||
sub get_map_keys{
|
||||
return $cache_map_keys;
|
||||
}
|
||||
|
||||
#get cache from params
|
||||
sub load{
|
||||
my $params=shift;
|
||||
|
||||
my $filename=get_filename($params);
|
||||
|
||||
my $result={
|
||||
filename=>$filename
|
||||
};
|
||||
|
||||
if (defined $filename){
|
||||
my @file_info=stat($filename);
|
||||
my $modified=$file_info[9]||'';
|
||||
if ($modified ne ''){
|
||||
#file exists
|
||||
my @now =localtime(time());
|
||||
my @modified =localtime($modified);
|
||||
if ($now[2]==$modified[2]){
|
||||
#file is elder than a hour
|
||||
my $content=log::load_file($filename);
|
||||
if (defined $content){
|
||||
$result->{content} =$content;
|
||||
$result->{action} ='read';
|
||||
return $result;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$result->{action}='save';
|
||||
return $result;
|
||||
}
|
||||
|
||||
#get filename from params
|
||||
sub get_filename{
|
||||
my $config = shift;
|
||||
my $params = shift;
|
||||
|
||||
# my $url=$ENV{REQUEST_URI};
|
||||
my $url=$ENV{QUERY_STRING}||'';
|
||||
if ($url ne''){
|
||||
$url=~s/(^|\&)update\=\d//gi;
|
||||
$url=~s/(^|\&)debug\=.*//gi;
|
||||
$url=~s/\?\&/\?/g;
|
||||
$url=~s/\&{2,99}/\&/g;
|
||||
$url=~s/\&$//g;
|
||||
$url=~s/^\/\//\//g;
|
||||
}
|
||||
foreach my $pattern (@$cache_map_keys){
|
||||
|
||||
my $filename=$url;
|
||||
log::write($config, 'cache_trace',"look at \"$filename\" for $pattern") if ($config->{system}->{debug});
|
||||
if ($filename =~/$pattern/){
|
||||
my $m1=$1;
|
||||
my $m2=$2;
|
||||
my $m3=$3;
|
||||
my $m4=$4;
|
||||
my $m5=$5;
|
||||
my $m6=$6;
|
||||
my $m7=$7;
|
||||
my $m8=$8;
|
||||
# my $m9=$9;
|
||||
|
||||
my $result=$cache_map->{$pattern};
|
||||
|
||||
$filename=~s/$pattern/$result/;
|
||||
$filename=~s/\$1/$m1/ if (defined $m1);
|
||||
$filename=~s/\$2/$m2/ if (defined $m2);
|
||||
$filename=~s/\$3/$m3/ if (defined $m3);
|
||||
$filename=~s/\$4/$m4/ if (defined $m4);
|
||||
$filename=~s/\$5/$m5/ if (defined $m5);
|
||||
$filename=~s/\$6/$m6/ if (defined $m6);
|
||||
$filename=~s/\$7/$m7/ if (defined $m7);
|
||||
$filename=~s/\$8/$m8/ if (defined $m8);
|
||||
# $filename=~s/\$9/$m9/ if (defined $m9);
|
||||
$filename=$config->{cache}->{cache_dir}.$filename;
|
||||
return $filename;
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
#deprecated: set file from params
|
||||
sub set{
|
||||
my $params=shift;
|
||||
my $content=shift;
|
||||
|
||||
my $filename=get_filename($params);
|
||||
my $cache={
|
||||
filename => $filename,
|
||||
content => $content
|
||||
};
|
||||
# print $filename.":file\n";
|
||||
|
||||
if (defined $filename){
|
||||
cache::save($cache);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub save{
|
||||
my $cache=shift;
|
||||
|
||||
return if ($cache->{action}ne'save');
|
||||
return if ((!defined $cache->{filename}) || ($cache->{filename}eq''));
|
||||
|
||||
log::save_file($cache->{filename},$cache->{content});
|
||||
chmod 0664, $cache->{filename};
|
||||
}
|
||||
|
||||
|
||||
sub escape_regexp{
|
||||
my $reg_exp=shift;
|
||||
$reg_exp=~s/([\^\$\\(\)\[\]\{\}\|\/\*\+\.\-\&\:])/\\$1/gi;
|
||||
return $reg_exp;
|
||||
}
|
||||
|
||||
sub escape_regexp_line{
|
||||
my $reg_exp=shift;
|
||||
$reg_exp=~s/([\^\$\\(\)\[\]\{\}\|\/\*\+\.\-\&\:])/\\$1/gi;
|
||||
return '^'.$reg_exp.'$';
|
||||
}
|
||||
|
||||
sub configure{
|
||||
my $file_name=shift;
|
||||
|
||||
cache::init();
|
||||
cache::add_map('',$file_name);
|
||||
}
|
||||
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
516
lib/calcms/calendar.pm
Normal file
516
lib/calcms/calendar.pm
Normal file
@@ -0,0 +1,516 @@
|
||||
#use Calendar::Simple qw(date_span);
|
||||
use Date::Calc;
|
||||
|
||||
use config;
|
||||
use template;
|
||||
use markup;
|
||||
use cache;
|
||||
use log;
|
||||
use time;
|
||||
use project;
|
||||
use events;
|
||||
|
||||
package calendar;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(init get_cached_or_render get render get_calendar_weeks configure_cache);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
#my $debug='';
|
||||
|
||||
sub init{
|
||||
}
|
||||
|
||||
sub get_cached_or_render{
|
||||
# my $output = $_[0]
|
||||
my $config = $_[1];
|
||||
my $request = $_[2];
|
||||
|
||||
my $parms =$request->{params}->{checked};
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
my $cache={};
|
||||
if ($config->{cache}->{use_cache} == 1){
|
||||
calendar::configure_cache($config);
|
||||
$cache=cache::load($config, $parms);
|
||||
log::write($config, 'cache',$cache->{action}) if ($debug);
|
||||
if (defined $cache->{content}){
|
||||
$_[0]=$cache->{content};
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
my $calendar=calendar::get($config, $request);
|
||||
log::write($config, 'calendar',$calendar) if ($debug);
|
||||
#print STDERR Dumper($calendar);
|
||||
|
||||
calendar::render($_[0], $config, $request, $calendar);
|
||||
|
||||
#write to cache
|
||||
if ($config->{cache}->{use_cache} == 1){
|
||||
#todo:put out reference only
|
||||
$cache->{content}=$_[0];
|
||||
log::write($config, 'cache_files',$cache) if ($debug);
|
||||
cache::save($cache);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub get{
|
||||
my $config = shift;
|
||||
my $request = shift;
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
my $language = $config->{date}->{language} || 'en';
|
||||
|
||||
my $date = $params->{date}||'';
|
||||
my $template = $params->{template}||'';
|
||||
my $from_time = $params->{from_time}||'';
|
||||
my $till_time = $params->{till_time}||'';
|
||||
|
||||
my @today=localtime(time());
|
||||
my $today=sprintf('%04d-%02d-%02d', 1900+$today[5], $today[4]+1, $today[3]);
|
||||
|
||||
my $weekday_names = $time::names->{$language}->{weekdays};
|
||||
my $weekday_short_names = $time::names->{$language}->{weekdays_abbr};
|
||||
my $week_label={};
|
||||
my $c=0;
|
||||
for my $weekday (@$weekday_short_names){
|
||||
$week_label->{$weekday}=$weekday_names->[$c]||'';
|
||||
$c++;
|
||||
}
|
||||
|
||||
$template=~s/\'//gi;
|
||||
$from_time=~s/\'//gi;
|
||||
$till_time=~s/\'//gi;
|
||||
|
||||
#put "clear all" filter into final results
|
||||
my $day_result={};
|
||||
my $clear_filter=$day_result;
|
||||
|
||||
#put "week day" filter into final results
|
||||
my $days=[];
|
||||
$c=0;
|
||||
for my $weekday (@$weekday_short_names){
|
||||
my $day_result={
|
||||
label => $week_label->{$weekday},
|
||||
weekday => $c+1,
|
||||
weekday_parameter => 'weekday='.$c,
|
||||
weekday_short_name => $weekday_short_names->[$c] ||'',
|
||||
weekday_name => $weekday_names->[$c] ||'',
|
||||
description => qq{alle $week_label->{$weekday}-Termine anzeigen},
|
||||
};
|
||||
push @$days,$day_result;
|
||||
$c++;
|
||||
}
|
||||
|
||||
#weeks and days array
|
||||
my $weekAndDayResults=[];
|
||||
|
||||
#weekday array
|
||||
my $weekdayResults=$days;
|
||||
|
||||
#week array
|
||||
my $weekResults=[];
|
||||
|
||||
#info hash by timedate
|
||||
my $dateInfo={};
|
||||
|
||||
#generate content for each day in a week in a month in a year
|
||||
#get today
|
||||
my $start_date='';
|
||||
my $end_date='';
|
||||
if ($date=~/(\d{4})\-(\d{2})/){
|
||||
my $year=$1;
|
||||
my $month=$2;
|
||||
$start_date = "$year-$month-01";
|
||||
$end_date = "$year-$month-".Date::Calc::Days_in_Month($year,$month);
|
||||
}else{
|
||||
$start_date = $params->{start_date};
|
||||
$end_date = $params->{end_date};
|
||||
}
|
||||
|
||||
my $previous_month=$start_date;
|
||||
if ($previous_month=~/(\d{4})\-(\d{2})/){
|
||||
my $year =$1;
|
||||
my $month=$2-1;
|
||||
$month='0'.$month if (length($month)<2);
|
||||
if ($month lt '01'){
|
||||
$year-=1;
|
||||
$month='12';
|
||||
}
|
||||
$previous_month="$year-$month-01";
|
||||
$previous_month=$params->{start_date} if ($previous_month lt $params->{start_date});
|
||||
}
|
||||
|
||||
my $next_month=$end_date;
|
||||
if ($next_month=~/(\d{4})\-(\d{2})/){
|
||||
my $year=$1;
|
||||
my $month=$2+1;
|
||||
$month='0'.$month if (length($month)<2);
|
||||
if ($month gt '12'){
|
||||
$year+=1;
|
||||
$month='01';
|
||||
}
|
||||
$next_month="$year-$month-01";
|
||||
$next_month=$params->{end_date} if ($next_month gt $params->{end_date});
|
||||
}
|
||||
|
||||
my $start_year=undef;
|
||||
my $start_month=undef;
|
||||
if ($start_date=~/(\d{4})\-(\d{2})/){
|
||||
$start_year=$1;
|
||||
$start_month=$2;
|
||||
}
|
||||
my $start_month_name=$time::names->{$language}->{months_abbr}->[$start_month-1];
|
||||
|
||||
if($params->{month_only}eq'1'){
|
||||
return {
|
||||
next_month => $next_month,
|
||||
previous_month => $previous_month,
|
||||
start_year => $start_year,
|
||||
start_month => $start_month,
|
||||
start_month_name => $start_month_name
|
||||
};
|
||||
}
|
||||
|
||||
my $years=calendar::get_calendar_weeks($config, $start_date, $end_date);
|
||||
|
||||
my $dbh=db::connect($config, $request);
|
||||
|
||||
my $used_days=events::get_by_date_range($dbh, $config, $start_date, $end_date);
|
||||
my $used_day={};
|
||||
for my $day(@$used_days){
|
||||
$used_day->{$day->{start_date}}=1;
|
||||
}
|
||||
|
||||
for my $year (sort {$a <=> $b} keys %$years){
|
||||
my $months=$years->{$year};
|
||||
|
||||
for my $month (sort {$a <=> $b} keys %$months){
|
||||
my $weeks=$months->{$month};
|
||||
|
||||
my $weekCounter=1;
|
||||
for my $week (@$weeks){
|
||||
my $dayResults=[];
|
||||
|
||||
my $week_end =undef;
|
||||
my $week_start=undef;
|
||||
|
||||
my $week_of_year=undef;
|
||||
my $woy_year = undef;
|
||||
|
||||
for my $date (@$week){
|
||||
my ($year, $month, $day)=split(/\-/,$date);
|
||||
my $weekday=0;
|
||||
my $day_result=undef;
|
||||
|
||||
($week_of_year,$woy_year) = Date::Calc::Week_of_Year($year,$month,$day) unless defined $week_of_year;
|
||||
|
||||
$day_result={
|
||||
date => $date,
|
||||
date_parameter => 'date='.$date,
|
||||
day => $day,
|
||||
year => $year,
|
||||
month => $month,
|
||||
};
|
||||
$day_result->{time} =$from_time if defined $from_time;
|
||||
|
||||
$day_result->{class}.= ' calcms_today' if $date eq $today;
|
||||
$day_result->{class}.= ' selected' if defined $used_day->{$date};
|
||||
$day_result->{class}.= " week_$weekCounter";
|
||||
$day_result->{class}.= " other_month" if ($weekCounter<2) && ($day gt "15");
|
||||
$day_result->{class}.= " other_month" if ($weekCounter>3) && ($day lt "15");
|
||||
$day_result->{class}=~s/^\s+//g;
|
||||
|
||||
$week_start =$day unless defined $week_start;
|
||||
$week_end =$day;
|
||||
|
||||
log::write($config, 'day_results',$day_result)if ($debug);
|
||||
|
||||
$day_result->{weekday_name}=$weekday_names->[$weekday];
|
||||
$day_result->{weekday_short_name}=$weekday_short_names->[$weekday];
|
||||
$day_result->{weekday}=$weekday+1;
|
||||
|
||||
$dateInfo->{$day_result->{date}}=$day_result->{weekday} if defined $day_result->{date};
|
||||
|
||||
push @$dayResults, $day_result;
|
||||
$weekday++;
|
||||
|
||||
}#end for days
|
||||
|
||||
#week filter
|
||||
my $start_date=$week->[0];
|
||||
my $end_date =$week->[-1];
|
||||
|
||||
my $week_result={
|
||||
from_date => $start_date,
|
||||
till_date => $end_date,
|
||||
week_start => $week_start,
|
||||
week_end => $week_end,
|
||||
week_month => sprintf("%2d",$month),
|
||||
week_year => $year,
|
||||
week_of_year => $week_of_year,
|
||||
};
|
||||
|
||||
$week_result->{class}.= ' selected' if (
|
||||
((defined $params->{from_date}) && ($start_date eq $params->{from_date}))
|
||||
|| ((defined $params->{till_date}) && ($end_date eq $params->{till_date}))
|
||||
);
|
||||
$week_result->{class}.= " week_$weekCounter";
|
||||
$week_result->{class}=~s/^\s+//g;
|
||||
|
||||
push @$weekResults, $week_result;
|
||||
|
||||
push @$weekAndDayResults,{
|
||||
days=>$dayResults,
|
||||
week=>[$week_result]
|
||||
};
|
||||
$weekCounter++;
|
||||
|
||||
}#end week
|
||||
|
||||
}#end month
|
||||
|
||||
}#end year
|
||||
|
||||
for my $weekday (@$weekdayResults){
|
||||
$weekday->{start_date} = $start_date;
|
||||
$weekday->{end_date} = $end_date;
|
||||
}
|
||||
|
||||
return {
|
||||
week_and_days => $weekAndDayResults,
|
||||
weekdays => $weekdayResults,
|
||||
weeks => $weekResults,
|
||||
days => $dateInfo,
|
||||
next_month => $next_month,
|
||||
previous_month => $previous_month,
|
||||
start_date => $start_date,
|
||||
end_date => $end_date,
|
||||
start_month_name => $start_month_name,
|
||||
start_month => $start_month,
|
||||
start_year => $start_year,
|
||||
base_url => $config->{locations}->{base_url},
|
||||
cache_base_url => $config->{cache}->{base_url},
|
||||
controllers => $config->{controllers},
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
sub render{
|
||||
# my $out = $_[0];
|
||||
my $config = $_[1];
|
||||
my $request = $_[2];
|
||||
my $calendar = $_[3];
|
||||
|
||||
my $parms =$request->{params}->{checked};
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
my $template_parameters=$calendar;
|
||||
$template_parameters->{debug} = $config->{system}->{debug};
|
||||
$template_parameters->{base_url} = $config->{locations}->{base_url};
|
||||
$template_parameters->{cache_base_url} = $config->{cache}->{base_url};
|
||||
$template_parameters->{server_cache} = $config->{cache}->{server_cache} if ($config->{cache}->{server_cache});
|
||||
$template_parameters->{use_client_cache} = $config->{cache}->{use_client_cache} if ($config->{cache}->{use_client_cache});
|
||||
|
||||
template::process($_[0], $parms->{template}, $template_parameters);
|
||||
}
|
||||
|
||||
sub get_calendar_weeks{
|
||||
my $config = shift;
|
||||
my $start = shift;
|
||||
my $end = shift;
|
||||
|
||||
my $debug = $config->{system}->{debug};
|
||||
|
||||
$start = time::date_to_array($start);
|
||||
$end = time::date_to_array($end);
|
||||
|
||||
my $start_year = int($start->[0]);
|
||||
my $end_year = int($end->[0]);
|
||||
|
||||
my $start_month = int($start->[1]);
|
||||
my $end_month = int($end->[1]);
|
||||
|
||||
my $years={};
|
||||
for my $year ($start_year..$end_year){
|
||||
my $months={};
|
||||
for my $month ($start_month..$end_month){
|
||||
#get week arrays of days of the month
|
||||
my $weeks=getWeeksOfMonth($year, $month);
|
||||
$months->{$month}=$weeks;
|
||||
}
|
||||
$years->{$year}=$months;
|
||||
}
|
||||
log::write($config, 'years',$years)if ($debug);
|
||||
return $years;
|
||||
}
|
||||
|
||||
sub getWeeksOfMonth{
|
||||
my $thisYear = shift;
|
||||
my $thisMonth = shift;
|
||||
my $thisDay = 1;
|
||||
|
||||
# get weekday of 1st of month
|
||||
my $thisMonthWeekday = Date::Calc::Day_of_Week($thisYear,$thisMonth,1);
|
||||
|
||||
# get next month date
|
||||
my($nextYear, $nextMonth, $nextDay)=Date::Calc::Add_Delta_YM($thisYear,$thisMonth,$thisDay, 0,1);
|
||||
# get weekday of 1st of next month
|
||||
my $nextMonthWeekday = Date::Calc::Day_of_Week($nextYear, $nextMonth, $nextDay);
|
||||
my($lastYear, $lastMonth, $lastDayOfMonth)=Date::Calc::Add_Delta_Days($nextYear,$nextMonth,$nextDay, -1);
|
||||
|
||||
# get date of 1st of row
|
||||
my( $week,$year) = Date::Calc::Week_of_Year($thisYear,$thisMonth,$thisDay);
|
||||
($year,my $month, my $day) = Date::Calc::Monday_of_Week($week,$year);
|
||||
|
||||
my @weeks=();
|
||||
my $weekday=1;
|
||||
|
||||
{
|
||||
# first week
|
||||
my @days=();
|
||||
for $weekday(0 .. $thisMonthWeekday-2){
|
||||
push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
|
||||
$day++;
|
||||
}
|
||||
# set current month
|
||||
$month = $thisMonth;
|
||||
$year = $thisYear;
|
||||
$day = 1;
|
||||
for $weekday($thisMonthWeekday..7){
|
||||
push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
|
||||
$day++;
|
||||
}
|
||||
# next week
|
||||
push @weeks, \@days;
|
||||
}
|
||||
|
||||
# weeks until end of month
|
||||
while(scalar(@weeks)<6){
|
||||
my @days=();
|
||||
$weekday=1;
|
||||
while($weekday<=7){
|
||||
push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
|
||||
$day++;
|
||||
$weekday++;
|
||||
last if $day>$lastDayOfMonth;
|
||||
}
|
||||
|
||||
if ($day>$lastDayOfMonth){
|
||||
# set next month
|
||||
$month=$nextMonth;
|
||||
$year=$nextYear;
|
||||
$day=1;
|
||||
|
||||
if ($nextMonthWeekday!=1){
|
||||
# finish end week
|
||||
if($weekday<=7){
|
||||
while( $weekday<=7){
|
||||
push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
|
||||
$day++;
|
||||
$weekday++;
|
||||
}
|
||||
}
|
||||
}
|
||||
push @weeks, \@days;
|
||||
last;
|
||||
};
|
||||
push @weeks, \@days if $weeks[-1]->[-1] ne $days[-1];
|
||||
}
|
||||
|
||||
#coming weeks
|
||||
while(scalar(@weeks)<6){
|
||||
my @days=();
|
||||
for $weekday(1..7){
|
||||
push @days, sprintf("%04d-%02d-%02d",$year,$month,$day);
|
||||
$day++;
|
||||
}
|
||||
push @weeks, \@days;
|
||||
}
|
||||
return \@weeks;
|
||||
}
|
||||
|
||||
sub configure_cache{
|
||||
my $config = shift;
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
cache::init();
|
||||
|
||||
my $date_pattern = $cache::date_pattern;
|
||||
my $controllers = $config->{controllers};
|
||||
|
||||
cache::add_map('' , $controllers->{calendar}.'/cal.html');
|
||||
cache::add_map('date='.$date_pattern , $controllers->{calendar}.'/$1-$2.html');
|
||||
cache::add_map('from_date='.$date_pattern.'&till_date='.$date_pattern , $controllers->{calendar}.'/$1-$2_$5-$6.html');
|
||||
|
||||
log::write($config, 'cache_files',cache::get_map()) if ($debug);
|
||||
}
|
||||
|
||||
sub check_params{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
|
||||
#get start and stop from projects
|
||||
my $range= project::get_date_range($config);
|
||||
my $start_date = $range->{start_date};
|
||||
my $end_date = $range->{end_date};
|
||||
|
||||
#switch off limiting end date by project
|
||||
my $open_end=0;
|
||||
if((defined $params->{'open_end'})&&($params->{'open_end'}=~/(\d+)/)){
|
||||
$open_end = $1;
|
||||
$end_date = time::add_days_to_datetime(time::time_to_datetime(), 365);
|
||||
}
|
||||
|
||||
my $month_only=$params->{month_only}||'';
|
||||
|
||||
#filter for date
|
||||
my $date=time::check_date($params->{date});
|
||||
|
||||
$date =$start_date if ($date lt $start_date);
|
||||
$date =$end_date if ($date gt $end_date);
|
||||
log::error($config, "no valid year-month format given!") if ($date eq"-1");
|
||||
|
||||
my $time=time::check_time($params->{time});
|
||||
log::error($config, "no valid time format given!") if ($time eq"-1");
|
||||
|
||||
my $from_date=time::check_date($params->{from_date})||'';
|
||||
log::error($config, "no valid date format given!") if (defined $from_date && $from_date eq"-1");
|
||||
$from_date =$start_date if ($from_date lt $start_date);
|
||||
$from_date =$end_date if ($from_date gt $end_date);
|
||||
|
||||
my $till_date=time::check_date($params->{till_date}||'');
|
||||
log::error($config, "no valid date format given!") if (defined $till_date && $till_date eq"-1");
|
||||
$till_date =$start_date if ($till_date lt $start_date);
|
||||
$till_date =$end_date if ($till_date gt $end_date);
|
||||
|
||||
my $template=template::check($params->{template},'calendar.html');
|
||||
|
||||
my $debug=$params->{debug};
|
||||
if ((defined $debug) && ($debug=~/([a-z\_\,]+)/)){
|
||||
$debug=$1;
|
||||
}
|
||||
|
||||
return {
|
||||
template => $template,
|
||||
date => $date,
|
||||
from_date => $from_date,
|
||||
till_date => $till_date,
|
||||
debug => $debug,
|
||||
month_only => $month_only,
|
||||
open_end => $open_end,
|
||||
start_date => $start_date,
|
||||
end_date => $end_date
|
||||
}
|
||||
}
|
||||
#do not delete last line!
|
||||
1;
|
||||
|
||||
712
lib/calcms/comments.pm
Normal file
712
lib/calcms/comments.pm
Normal file
@@ -0,0 +1,712 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use config;
|
||||
use template;
|
||||
use time;
|
||||
|
||||
package comments;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
#our @EXPORT = qw(all);
|
||||
our @EXPORT_OK = qw(init get_cached_or_render get modify_results render configure_cache get_query get_by_event get_level get_events check insert set_lock_status set_news_status lock update_comment_count sort);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub init{
|
||||
}
|
||||
|
||||
sub get_cached_or_render{
|
||||
# my $response=$_[0];
|
||||
my $config = $_[1];
|
||||
my $request = $_[2];
|
||||
my $mark_locked = $_[3];
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
#print STDERR Dumper($params);
|
||||
$config->{app_name}=$config->{controllers}->{comments};
|
||||
|
||||
my $comment=$request->{params}->{checked};
|
||||
|
||||
my $filename='';
|
||||
my $cache={};
|
||||
|
||||
my $results=comments::get($config, $request);
|
||||
|
||||
if((defined $mark_locked) && ($mark_locked eq 'mark_locked')){
|
||||
for my $result(@$results){
|
||||
if($result->{lock_status}ne'show'){
|
||||
$result->{author}='Zensur';
|
||||
$result->{content}='Dieser Eintrag wurde gelöscht.';
|
||||
}
|
||||
}
|
||||
}elsif((defined $mark_locked) && ($mark_locked eq 'filter_locked')){
|
||||
my @results2=();
|
||||
for my $result(@$results){
|
||||
push @results2, $result if($result->{lock_status}eq'show');
|
||||
}
|
||||
$results=\@results2;
|
||||
}
|
||||
|
||||
comments::modify_results($results, $config, $request);
|
||||
|
||||
#print STDERR Dumper($results);
|
||||
$results=comments::sort($config, $results) if ($comment->{type}eq'tree');
|
||||
|
||||
#print STDERR Dumper($results);
|
||||
# if ($comment->{sort_order}eq'desc'){
|
||||
# my @results= reverse(@$results);
|
||||
# $results=\@results;
|
||||
# }
|
||||
|
||||
if (
|
||||
($params->{show_max} ne'')
|
||||
&& ($params->{limit} ne'')
|
||||
&& ($params->{show_max}<$params->{limit})
|
||||
){
|
||||
my @results2=();
|
||||
my $c=0;
|
||||
for my $result(@$results){
|
||||
push @results2,$result;
|
||||
$c++;
|
||||
last if ($c>=$params->{show_max});
|
||||
}
|
||||
$results=\@results2;
|
||||
}
|
||||
|
||||
comments::render($_[0], $config, $request, $results);
|
||||
|
||||
}
|
||||
|
||||
sub get{
|
||||
my $config = shift;
|
||||
my $request= shift;
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
|
||||
my $dbh=db::connect($config, $request);
|
||||
|
||||
(my $query, my $bind_values)=comments::get_query($dbh, $config, $request);
|
||||
#print STDERR Dumper($$query);
|
||||
#print STDERR Dumper($bind_values);
|
||||
my $results=db::get($dbh, $$query, $bind_values);
|
||||
#print STDERR Dumper($results);
|
||||
return $results;
|
||||
}
|
||||
|
||||
sub get_query{
|
||||
my $dbh = shift;
|
||||
my $config = shift;
|
||||
my $request=shift;
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
|
||||
my $event_id = undef;
|
||||
my $event_start = undef;
|
||||
my $from = 'calcms_comments c';
|
||||
my $where = '';
|
||||
my $limit = '';
|
||||
my @conditions=();
|
||||
my $bind_values=[];
|
||||
|
||||
#exclude comments from config filter/exclude_locations
|
||||
if (
|
||||
(defined $config->{filter})
|
||||
&& (defined $config->{filter}->{exclude_locations})
|
||||
){
|
||||
my @exclude_locations=split(/[,\s]+/,$config->{filter}->{exclude_locations});
|
||||
my $exclude_locations=join(', ',map {'?'} @exclude_locations);
|
||||
|
||||
$from.=',calcms_events e';
|
||||
push @conditions,'e.id=c.event_id';
|
||||
push @conditions,'e.location not in ('.$exclude_locations.')';
|
||||
for my $location (@exclude_locations){
|
||||
push @$bind_values, $location;
|
||||
}
|
||||
}
|
||||
|
||||
if (
|
||||
(defined $params->{event_id} && $params->{event_id}ne'') &&
|
||||
(defined $params->{event_start} && $params->{event_start}ne'')
|
||||
){
|
||||
#$where =qq{ and (event_id=? or event_start=?) };
|
||||
push @conditions, q{ (event_id=? or event_start=?) };
|
||||
push @$bind_values, $params->{event_id};
|
||||
push @$bind_values, $params->{event_start};
|
||||
}
|
||||
|
||||
my $sort_order=$params->{sort_order};
|
||||
|
||||
if ($params->{limit} ne''){
|
||||
$limit ='limit ?';
|
||||
push @$bind_values,$params->{limit};
|
||||
}
|
||||
|
||||
if (@conditions>0){
|
||||
$where= 'where '.join(' and ',@conditions);
|
||||
}
|
||||
|
||||
my $dbcols=['id', 'event_start', 'event_id', 'content', 'ip', 'author', 'email',
|
||||
'lock_status', 'created_at', 'title', 'parent_id', 'level', 'news_status', 'project'];
|
||||
my $cols=join(', ',map { 'c.'.$_ } @$dbcols);
|
||||
my $query=qq{
|
||||
select $cols
|
||||
from $from
|
||||
$where
|
||||
order by created_at $sort_order
|
||||
$limit
|
||||
};
|
||||
# where lock_status='show'
|
||||
# use Data::Dumper;print STDERR Dumper($query);
|
||||
|
||||
return (\$query, $bind_values);
|
||||
}
|
||||
|
||||
sub modify_results{
|
||||
my $results = $_[0];
|
||||
my $config = $_[1];
|
||||
my $request = $_[2];
|
||||
|
||||
my $params=$request->{params}->{checked};
|
||||
|
||||
my $time_diff='';
|
||||
if ($params->{template}=~/\.xml/){
|
||||
$time_diff=time::utc_offset($config->{date}->{time_zone});
|
||||
$time_diff=~s/(\d\d)(\d\d)/$1\:$2/g;
|
||||
}
|
||||
|
||||
my $language = $config->{date}->{language} || 'en';
|
||||
|
||||
for my $result (@$results){
|
||||
$result->{allow}->{new_comments} = 1 if ($params->{allow}->{new_comments});
|
||||
$result->{start_date_name} = time::date_format($result->{created_at}, $language);
|
||||
$result->{start_time_name} = time::time_format($result->{created_at});
|
||||
my $comment_limit=100;
|
||||
if (length($result->{content})>$comment_limit){
|
||||
$result->{short_content} = substr($result->{content},0,$comment_limit).'...' ;
|
||||
}else{
|
||||
$result->{short_content} = $result->{content};
|
||||
}
|
||||
$result->{base_url} = $config->{locations}->{base_url};
|
||||
$result->{cache_base_url} = $config->{cache}->{base_url};
|
||||
|
||||
if($params->{template}=~/\.xml/){
|
||||
# $result->{content} =~s/(\[\[.*?\]\])//gi;
|
||||
# $result->{content} =markup::plain_to_xml($result->{content});
|
||||
# $result->{content} =$result->{html_content};
|
||||
|
||||
$result->{content} = markup::html_to_plain($result->{html_content});
|
||||
$result->{short_content}= markup::html_to_plain($result->{short_content});
|
||||
$result->{excerpt} = "lass dich ueberraschen" if ((defined $result->{excerpt}) && ($result->{excerpt}eq''));
|
||||
$result->{excerpt} = markup::html_to_plain($result->{excerpt});
|
||||
$result->{title} = markup::html_to_plain($result->{title});
|
||||
$result->{series_name} = markup::html_to_plain($result->{series_name});
|
||||
$result->{program} = markup::html_to_plain($result->{program});
|
||||
|
||||
if (defined $result->{created_at}){
|
||||
$result->{created_at}=~s/ /T/gi;
|
||||
$result->{created_at}.=$time_diff;
|
||||
}
|
||||
|
||||
if (defined $result->{modified_at}){
|
||||
$result->{modified_at}=~s/ /T/gi;
|
||||
$result->{modified_at}.=$time_diff;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $results;
|
||||
}
|
||||
|
||||
|
||||
sub render{
|
||||
# my $response =$_[0];
|
||||
my $config = $_[1];
|
||||
my $request = $_[2];
|
||||
my $results = $_[3];
|
||||
|
||||
my $params =$request->{params}->{checked};
|
||||
|
||||
my %template_parameters=%$params;
|
||||
my $template_parameters=\%template_parameters;
|
||||
|
||||
$template_parameters->{comments} = $results;
|
||||
$template_parameters->{comment_count} =(@$results)+0;
|
||||
$template_parameters->{one_result} =1 if($template_parameters->{comment_count}==1);
|
||||
$template_parameters->{allow}->{new_comments} =1 if ($params->{allow}->{new_comments});
|
||||
|
||||
$template_parameters->{event_id} = $params->{event_id};
|
||||
$template_parameters->{event_start} = $params->{event_start};
|
||||
|
||||
$template_parameters->{server_cache} = $config->{cache}->{server_cache} if ($config->{cache}->{server_cache});
|
||||
$template_parameters->{use_client_cache}= $config->{cache}->{use_client_cache} if ($config->{cache}->{use_client_cache});
|
||||
$template_parameters->{controllers} = $config->{controllers};
|
||||
template::process($_[0],$params->{template},$template_parameters);
|
||||
}
|
||||
|
||||
#check if comment exists already
|
||||
sub check{
|
||||
my $dbh = shift;
|
||||
my $config = shift;
|
||||
my $comment = shift;
|
||||
|
||||
my $query=qq{
|
||||
select id
|
||||
from calcms_comments
|
||||
where (
|
||||
event_start=?
|
||||
or event_id=?
|
||||
)
|
||||
and parent_id=?
|
||||
and author=?
|
||||
and ip=?
|
||||
and content=?
|
||||
};
|
||||
my $bind_values=[
|
||||
$comment->{event_start},
|
||||
$comment->{event_id},
|
||||
$comment->{parent_id},
|
||||
$comment->{author},
|
||||
$comment->{ip},
|
||||
$comment->{content}
|
||||
];
|
||||
|
||||
my $comments=db::get($dbh,$query,$bind_values);
|
||||
|
||||
my @comments=@$comments;
|
||||
return 0 if (@comments>0);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#used for insert
|
||||
sub get_level{
|
||||
my $dbh = shift;
|
||||
my $config = shift;
|
||||
my $comment = shift;
|
||||
|
||||
my $parent_id=$comment->{parent_id};
|
||||
return 0 unless defined $parent_id;
|
||||
if($parent_id=~/(\d+)/){
|
||||
$parent_id=$1;
|
||||
}
|
||||
return 0 unless $parent_id=~/^\d+$/;
|
||||
return 0 if $parent_id==0;
|
||||
|
||||
#get level from parent node
|
||||
my $query=qq{
|
||||
select level
|
||||
from calcms_comments
|
||||
where (
|
||||
event_start=?
|
||||
or event_id=?
|
||||
)
|
||||
and id=?
|
||||
limit 1
|
||||
};
|
||||
my $bind_values=[
|
||||
$comment->{event_start},
|
||||
$comment->{event_id},
|
||||
$parent_id
|
||||
];
|
||||
|
||||
my $comments=db::get($dbh,$query,$bind_values);
|
||||
|
||||
my @comments=@$comments;
|
||||
if (@comments>0){
|
||||
return $comments->[0]->{level}+1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub get_by_event{
|
||||
my $dbh = shift;
|
||||
my $config = shift;
|
||||
my $request =$_[0];
|
||||
|
||||
my $params = $request->{params}->{checked}->{comment};
|
||||
|
||||
my $event_id = undef;
|
||||
my $search = undef;
|
||||
my $where = '';
|
||||
my $limit = '';
|
||||
my $bind_values=[];
|
||||
|
||||
if ($params->{event_id}ne''){
|
||||
$where =qq{ event_id=? };
|
||||
$bind_values=[$params->{event_id}];
|
||||
}
|
||||
|
||||
if ((defined $params->{search}) && ($params->{search}ne'')){
|
||||
$search ='%'.$params->{search}.'%';
|
||||
$where =qq{ (content like ?) or (email like ?) or (author like ?) or (ip like ?)};
|
||||
$bind_values=[
|
||||
$search,
|
||||
$search,
|
||||
$search,
|
||||
$search
|
||||
];
|
||||
}
|
||||
|
||||
my $sort_order=$params->{sort_order} || 'desc';
|
||||
|
||||
if ((defined $params->{limit}) && ($params->{limit} ne'')){
|
||||
$limit ='limit ?';
|
||||
push @$bind_values,$params->{limit};
|
||||
}
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_comments
|
||||
where $where
|
||||
order by created_at $sort_order
|
||||
$limit
|
||||
};
|
||||
|
||||
#print STDERR $query."\n";
|
||||
my $comments=db::get($dbh, $query, $bind_values);
|
||||
|
||||
return $comments;
|
||||
}
|
||||
|
||||
sub get_by_time{
|
||||
my $dbh = shift;
|
||||
my $config = shift;
|
||||
my $comment = shift;
|
||||
|
||||
my $where='';
|
||||
my $bind_values=[];
|
||||
if ($comment->{age} ne ''){
|
||||
$where=qq{
|
||||
where event_id in (
|
||||
select distinct event_id
|
||||
from calcms_comments
|
||||
where (
|
||||
unix_timestamp(now()) - ? < unix_timestamp(created_at)
|
||||
)
|
||||
)
|
||||
};
|
||||
$bind_values=[
|
||||
$comment->{age}*3600,
|
||||
];
|
||||
}elsif (($comment->{from} ne '') && ($comment->{till} ne '')){
|
||||
$where=qq{
|
||||
where event_id in (
|
||||
select distinct event_id
|
||||
from calcms_comments
|
||||
where created_at >= ?
|
||||
and created_at <= ?
|
||||
)
|
||||
};
|
||||
$bind_values=[
|
||||
$comment->{from},
|
||||
$comment->{till}
|
||||
];
|
||||
}
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_comments
|
||||
$where
|
||||
order by event_id, id
|
||||
};
|
||||
my $comments=db::get($dbh, $query, $bind_values);
|
||||
return $comments;
|
||||
}
|
||||
|
||||
sub get_events{
|
||||
my $dbh=shift;
|
||||
my $config = shift;
|
||||
my $request=shift;
|
||||
my $comments=shift;
|
||||
|
||||
my $params=$request->{params}->{checked}->{comment};
|
||||
|
||||
#get event_ids from comments
|
||||
my $event_ids={};
|
||||
for my $comment (@$comments){
|
||||
my $event_id=$comment->{event_id};
|
||||
$event_ids->{$event_id}=1;
|
||||
}
|
||||
|
||||
#get events from comment's event ids
|
||||
return [] if ((keys %{$event_ids})==0);
|
||||
|
||||
#my $quoted_event_ids=join "," ,(map {$dbh->quote($_)}(keys %{$event_ids}));
|
||||
my @bind_values=keys %{$event_ids};
|
||||
my $event_id_values=join "," ,(map {'?'}(keys %{$event_ids}));
|
||||
|
||||
my $query=qq{
|
||||
select id, start, program, series_name, title, excerpt
|
||||
from calcms_events
|
||||
where id in ($event_id_values)
|
||||
};
|
||||
|
||||
my $events=db::get($dbh, $query, \@bind_values);
|
||||
|
||||
#build lookup table for events by id
|
||||
my $events_by_id={};
|
||||
for my $event (@$events){
|
||||
$events_by_id->{$event->{id}}=$event;
|
||||
$event->{max_comment_id}=0;
|
||||
}
|
||||
|
||||
#add unassigned events
|
||||
# for my $event_id (keys %{$event_ids}){
|
||||
# if ($events_by_id->{$event_id}eq''){
|
||||
# my $event={
|
||||
# title => "not assigned",
|
||||
# max_comment_id => 0
|
||||
#
|
||||
# };
|
||||
# push @$events,$event;
|
||||
# $events_by_id->{$event_id}=$event;
|
||||
# }
|
||||
# }
|
||||
|
||||
for my $comment (@$comments){
|
||||
my $event_id=$comment->{event_id};
|
||||
my $event=$events_by_id->{$event_id};
|
||||
next unless (defined $event);
|
||||
$event->{comment_count}++;
|
||||
push @{$event->{comments}},$comment;# if ($params->{event_id}ne'');
|
||||
$event->{max_comment_id}=$comment->{id} if ($comment->{id} > $event->{max_comment_id});
|
||||
for my $name (keys %{$config->{controllers}}){
|
||||
$comment->{"controller_".$name}=$config->{controllers}->{$name}||'';
|
||||
# $event->{"controller_$name"}=$config->{controllers}->{$name};
|
||||
}
|
||||
}
|
||||
my @sorted_events=reverse sort {$a->{max_comment_id} <=> $b->{max_comment_id}} @$events;
|
||||
return \@sorted_events;
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $dbh = shift;
|
||||
my $config = shift;
|
||||
my $comment = shift;
|
||||
|
||||
$comment->{level}=comments::get_level($dbh, $config, $comment);
|
||||
|
||||
my $entry={
|
||||
event_start => $comment->{event_start},
|
||||
event_id => $comment->{event_id},
|
||||
parent_id => $comment->{parent_id},
|
||||
level => $comment->{level},
|
||||
title => $comment->{title},
|
||||
content => $comment->{content},
|
||||
author => $comment->{author},
|
||||
email => $comment->{email},
|
||||
ip => $comment->{ip}
|
||||
};
|
||||
|
||||
my $comment_id=db::insert($dbh, 'calcms_comments', $entry);
|
||||
return $comment_id;
|
||||
}
|
||||
|
||||
sub set_lock_status{
|
||||
my $dbh=shift;
|
||||
my $config = shift;
|
||||
my $comment=shift;
|
||||
|
||||
my $id = $comment->{id};
|
||||
my $lock_status = $comment->{set_lock_status};
|
||||
my $query=qq{
|
||||
update calcms_comments
|
||||
set lock_status = ?
|
||||
where id = ?
|
||||
};
|
||||
my $bind_values=[
|
||||
$lock_status,
|
||||
$id
|
||||
];
|
||||
db::put($dbh,$query,$bind_values);
|
||||
|
||||
$query=qq{
|
||||
select event_id
|
||||
from calcms_comments
|
||||
where id=?
|
||||
};
|
||||
$bind_values=[$id];
|
||||
my $comments=db::get($dbh,$query,$bind_values);
|
||||
if (@$comments>0){
|
||||
$comment->{event_id}=$comments->[0]->{event_id};
|
||||
update_comment_count($dbh,$comment);
|
||||
}
|
||||
}
|
||||
|
||||
sub set_news_status{
|
||||
my $dbh=shift;
|
||||
my $config = shift;
|
||||
my $comment=shift;
|
||||
|
||||
my $id = $comment->{id};
|
||||
my $news_status = $comment->{set_news_status};
|
||||
my $query=qq{
|
||||
update calcms_comments
|
||||
set news_status= ?
|
||||
where id = ?
|
||||
};
|
||||
my $bind_values=[$news_status,$id];
|
||||
db::put($dbh,$query,$bind_values);
|
||||
}
|
||||
|
||||
sub update_comment_count{
|
||||
my $dbh=shift;
|
||||
my $config = shift;
|
||||
my $comment=shift;
|
||||
|
||||
my $query=qq{
|
||||
select count(id) count
|
||||
from calcms_comments
|
||||
where lock_status='show'
|
||||
and event_id=?
|
||||
};
|
||||
my $bind_values=[$comment->{event_id}];
|
||||
my $comments=db::get($dbh,$query,$bind_values);
|
||||
|
||||
my $count=0;
|
||||
$count=$comments->[0]->{count} if (@$comments>0);
|
||||
$query=qq{
|
||||
update calcms_events
|
||||
set comment_count=?
|
||||
where id=?
|
||||
};
|
||||
$bind_values=[
|
||||
$count,
|
||||
$comment->{event_id}
|
||||
];
|
||||
db::put($dbh,$query,$bind_values);
|
||||
}
|
||||
|
||||
#precondition: results are presorted by creation date (by sql)
|
||||
sub sort{
|
||||
my $config = shift;
|
||||
my $results=shift;
|
||||
|
||||
#define parent nodes
|
||||
my $nodes={};
|
||||
for my $node (@$results){
|
||||
$nodes->{$node->{id}}=$node;
|
||||
}
|
||||
my @root_nodes=();
|
||||
for my $node (@$results){
|
||||
#fill childs into parent nodes
|
||||
push @{$nodes->{$node->{parent_id}}->{childs}},$node;
|
||||
#define root nodes
|
||||
push @root_nodes,$node if ($node->{level}==0);
|
||||
}
|
||||
#print STDERR Dumper(\@root_nodes);
|
||||
|
||||
#sort root nodes from newest to oldest
|
||||
my $sorted_nodes=[];
|
||||
for my $node (@root_nodes){
|
||||
#for my $node (reverse @root_nodes){
|
||||
sort_childs($node,$nodes,$sorted_nodes);
|
||||
}
|
||||
return $sorted_nodes;
|
||||
}
|
||||
|
||||
sub sort_childs{
|
||||
my $node=shift;
|
||||
my $nodes=shift;
|
||||
my $sorted_nodes=shift;
|
||||
|
||||
#push node into list of sorted nodes
|
||||
push @{$sorted_nodes},$node;
|
||||
|
||||
#return if node is leaf
|
||||
return $sorted_nodes unless (defined $node->{childs});
|
||||
|
||||
#process child nodes
|
||||
for my $child (@{$node->{childs}}){
|
||||
$sorted_nodes=sort_childs($child,$nodes,$sorted_nodes);
|
||||
}
|
||||
return $sorted_nodes;
|
||||
}
|
||||
|
||||
sub configure_cache{
|
||||
my $config = shift;
|
||||
|
||||
cache::init();
|
||||
|
||||
my $date_pattern = $cache::date_pattern;
|
||||
my $datetime_pattern = $cache::datetime_pattern;
|
||||
my $controllers = $config->{controllers};
|
||||
|
||||
cache::add_map('template=comments_newest&limit=3&type=list' ,$controllers->{comments}.'/neueste.html');
|
||||
cache::add_map('template=comments_atom.xml&limit=20' ,$controllers->{comments}.'/feed.xml');
|
||||
cache::add_map('template=comments.html&event_id=(\d+)&event_start='.$datetime_pattern ,$controllers->{comments}.'/$1_$2-$3-$4_$5-$6.html');
|
||||
}
|
||||
|
||||
sub check_params{
|
||||
my $config = shift;
|
||||
my $params = shift;
|
||||
|
||||
my $comment={};
|
||||
|
||||
$comment->{event_start}='';
|
||||
if ( (defined $params->{event_start}) && ($params->{event_start}=~/(\d\d\d\d\-\d\d\-\d\d[T ]\d\d\:\d\d)(\:\d\d)?/) ){
|
||||
$comment->{event_start}=$1;
|
||||
}
|
||||
|
||||
$comment->{sort_order}='desc';
|
||||
$comment->{limit}='';
|
||||
if ( (defined $params->{limit}) && ($params->{limit}=~/(\d+)/) ){
|
||||
$comment->{limit}=$1;
|
||||
}
|
||||
|
||||
$comment->{show_max}='';
|
||||
if ( (defined $params->{show_max}) && ($params->{show_max}=~/(\d+)/) ){
|
||||
$comment->{show_max}=$1;
|
||||
}
|
||||
|
||||
if ( (defined $params->{sort_order}) && ($params->{sort_order}eq'asc') ){
|
||||
$comment->{sort_order}='asc';
|
||||
}
|
||||
|
||||
$comment->{event_id}='';
|
||||
if ( (defined $params->{event_id}) && ($params->{event_id}=~/(\d+)/) ){
|
||||
$comment->{event_id}=$1;
|
||||
}
|
||||
|
||||
if ( (defined $params->{parent_id}) && ($params->{parent_id}=~/(\d+)/) ){
|
||||
$comment->{parent_id}=$1;
|
||||
}
|
||||
|
||||
if ((defined $params->{type}) && ($params->{type} eq 'list')){
|
||||
$comment->{type}='list';
|
||||
}else{
|
||||
$comment->{type}='tree';
|
||||
}
|
||||
|
||||
my $debug=$params->{debug}||'';
|
||||
if ($debug=~/([a-z\_\,]+)/){
|
||||
$comment->{debug}=$1;
|
||||
}
|
||||
|
||||
log::error($config, 'missing parameter a') if ( (defined $params->{limit}) && ($comment->{limit} eq'') );
|
||||
log::error($config, 'missing parameter b') if ( (defined $params->{event_id}) && ($comment->{event_id} eq'') );
|
||||
log::error($config, 'missing parameter c') if ( (defined $params->{event_start}) && ($comment->{event_start} eq'') );
|
||||
|
||||
my $delta_days=1;
|
||||
if ($comment->{event_start}ne''){
|
||||
my $today = time::datetime_to_array(time::time_to_datetime());
|
||||
my $date = time::datetime_to_array($comment->{event_start});
|
||||
$delta_days = time::days_between($today,$date);
|
||||
}
|
||||
if(
|
||||
($delta_days > $config->{permissions}->{no_new_comments_before} )
|
||||
|| ($delta_days < -1*$config->{permissions}->{no_new_comments_after} )
|
||||
){
|
||||
$comment->{allow}->{new_comments}=0;
|
||||
}else{
|
||||
$comment->{allow}->{new_comments}=1;
|
||||
}
|
||||
|
||||
$comment->{template}=template::check($params->{template},'comments.html');
|
||||
|
||||
return $comment;
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
33
lib/calcms/config.pm
Normal file
33
lib/calcms/config.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package config;
|
||||
|
||||
require Exporter;
|
||||
my @ISA = qw(Exporter);
|
||||
my @EXPORT_OK = qw(get $config);
|
||||
my %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
use Config::General;
|
||||
|
||||
our $modified_at=-999;
|
||||
our $config= undef;
|
||||
|
||||
sub get{
|
||||
my $filename=shift;
|
||||
|
||||
#return config if known
|
||||
#my $age=(-M $filename);
|
||||
#return $config::config if ((defined $config::config) && ($age <= $config::modified_at));
|
||||
|
||||
#reload config if changed
|
||||
my $configuration = new Config::General(
|
||||
-ConfigFile=>$filename,
|
||||
-UTF8=>1
|
||||
);
|
||||
$config::config=$configuration->{DefaultConfig}->{config};
|
||||
$config::modified_at=$age;
|
||||
#print STDERR "reload $filename\n";
|
||||
|
||||
return $config::config;
|
||||
}
|
||||
|
||||
#do not delete last line
|
||||
1;
|
||||
261
lib/calcms/creole_wiki.pm
Normal file
261
lib/calcms/creole_wiki.pm
Normal file
@@ -0,0 +1,261 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use markup;
|
||||
|
||||
package creole_wiki;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(extractEventFromWikiText removeMeta eventToWikiText extractMeta removeMeta metaToWiki);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
#convert creole wiki text to event
|
||||
sub extractEventFromWikiText{
|
||||
my $params=shift;
|
||||
my $event=shift;
|
||||
$event={} unless (defined $event);
|
||||
|
||||
my $title =$params->{title}||'';
|
||||
my $content =$params->{content}||'';
|
||||
my $local_media_url =$params->{local_media_url}||'';
|
||||
|
||||
#split content into excerpt, content and comments
|
||||
$content=~s/\s*\,\s*/, /g;
|
||||
my @lines=split(/\s*\-{10,99}\s*/,$content);
|
||||
my $lines=\@lines;
|
||||
for my $line (@$lines){
|
||||
$line=~s/^\s+|\s+$//g;
|
||||
}
|
||||
if (@lines==1){
|
||||
$event->{content}=shift @lines;
|
||||
}elsif(@lines==2){
|
||||
$event->{excerpt}=shift @lines;
|
||||
$event->{content}=shift @lines;
|
||||
}else{
|
||||
$event->{excerpt}=shift @lines;
|
||||
$event->{content}=shift @lines;
|
||||
$event->{comments}=join("--------------------\n",@lines);
|
||||
}
|
||||
if (defined $event->{excerpt}){
|
||||
$event->{excerpt}=markup::html_to_plain($event->{excerpt});
|
||||
}
|
||||
#extract program from title
|
||||
$event->{program}='';
|
||||
|
||||
if ($title=~/^(.*?)\:/){
|
||||
my $program=$1;
|
||||
unless ($program=~/\s\-\s/){
|
||||
$event->{program}=$program;
|
||||
$event->{program}=~s/^\s+|\s+$//g;
|
||||
$event->{program}=~s/\s+/ /g;
|
||||
$title=~s/^.*?\:\s+//gi;
|
||||
}
|
||||
}
|
||||
|
||||
#extract series_name from title
|
||||
$event->{series_name}='';
|
||||
if ($title=~/^(.*?)\s+\-\s+/){
|
||||
$event->{series_name}=$1;
|
||||
$event->{series_name}=~s/^\s+|\s+$//g;
|
||||
$event->{series_name}=~s/\s+/ /g;
|
||||
$title=~s/^(.*?)\s+\-\s+//gi;
|
||||
}
|
||||
|
||||
#extract categories from title
|
||||
my @categories=();
|
||||
while ($title=~/\((.*?),(.*?)\)/){
|
||||
my $category=$1;
|
||||
$category =~s/\s+/ /g;
|
||||
$category =~s/^\s+|\s+$//g;
|
||||
$category =~s/\&/\+/g;
|
||||
push @categories,$category if (defined $category && $category=~/\S/);
|
||||
|
||||
$category='';
|
||||
$category=$2 if (defined $2);
|
||||
$category =~s/\s+/ /g;
|
||||
$category =~s/^\s+|\s+$//g;
|
||||
$category =~s/\&/\+/g;
|
||||
push @categories,$category if (defined $category && $category=~/\S/);
|
||||
$title=~s/\((.*?),(.*?)\)/\($2\)/;
|
||||
}
|
||||
if ($title=~/\((.*?)\)/){
|
||||
my $category=$1;
|
||||
$category =~s/\s+/ /g;
|
||||
$category =~s/^\s+|\s+$//g;
|
||||
$category =~s/\&/\+/g;
|
||||
|
||||
# print $category."\n";
|
||||
push @categories,$category if (defined $category && $category=~/\S/);
|
||||
$title=~s/\((.*?)\)//;
|
||||
}
|
||||
$event->{categories} = \@categories if (@categories>0);
|
||||
$event->{title} = $title;
|
||||
$event->{title} =~s/^\s+|\s+$//g;
|
||||
|
||||
if (defined $event->{content}){
|
||||
#extract podcast_url from content link 'podcast'
|
||||
my $podcast_url='';
|
||||
if ($event->{content}=~/\[\[\s*([^\|\]]+)\s*\|\s*podcast\s*\]\]/i){
|
||||
$podcast_url=$1;
|
||||
# $podcast_url=~s/\|.*//g;
|
||||
# print "found podcast:".$podcast_url."\n";
|
||||
}
|
||||
$event->{podcast_url} = $podcast_url;
|
||||
|
||||
#extract media_url from content link 'download'
|
||||
my $media_url='';
|
||||
if ($event->{content}=~/\[\[\s*([^\|\]]+)\s*\|\s*(direct\s+)?download\s*\]\]/i){
|
||||
$media_url=$1;
|
||||
# $podcast_url=~s/\|.*//g;
|
||||
# print "found media:".$media_url."\n";
|
||||
}
|
||||
$event->{media_url} = $media_url;
|
||||
|
||||
#replace "thumbs/xxx" link by link to local media URI
|
||||
$event->{content}=~s/\{\{\s*thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}/\[\[$local_media_url\/images\/$1\|\{\{$local_media_url\/thumbs\/$1\|$2\}\}\]\]/g;
|
||||
|
||||
#extract image from content
|
||||
if ($event->{content}=~/\{\{(.*?)(\||\}\})/){
|
||||
$event->{image}=$1;
|
||||
}
|
||||
}
|
||||
|
||||
#meta
|
||||
if (defined $event->{comments}){
|
||||
my $meta=extractMeta($event->{comments});
|
||||
$event->{meta} = $meta if (@$meta>0);
|
||||
}
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub eventToWikiText{
|
||||
my $event=shift;
|
||||
my $local_media_url =$event->{local_media_url}||'';
|
||||
|
||||
$event->{program} =~s/^\s+|\s+$//g;
|
||||
$event->{series_name} =~s/^\s+|\s+$//g;
|
||||
$event->{title} =~s/^\s+|\s+$//g;
|
||||
$event->{excerpt} =~s/^\s+|\s+$//g;
|
||||
$event->{content} =~s/^\s+|\s+$//g;
|
||||
$event->{comments} =~s/^\s+|\s+$//g;
|
||||
|
||||
my $title='';
|
||||
if($event->{program} ne''){
|
||||
$title=$event->{program};
|
||||
$title.=': ' if (($event->{series_name} ne'') || ($event->{title} ne''));
|
||||
}
|
||||
if($event->{series_name} ne''){
|
||||
$title.=$event->{series_name};
|
||||
$title.=' - ' if ($event->{title} ne'');
|
||||
}
|
||||
$title.=$event->{title};
|
||||
if ($event->{categories}){
|
||||
$title.=' ('.join(",", @{$event->{categories}} ).')' if (@{$event->{categories}}>0);
|
||||
}
|
||||
|
||||
my $meta=extractMeta($event->{comments}, $event->{meta});
|
||||
#use Data::Dumper;print "extracted meta".Dumper($meta);
|
||||
|
||||
$event->{comments}=removeMeta($event->{comments});
|
||||
$event->{wiki_comments}=$event->{comments}."\n\n".metaToWiki($meta);
|
||||
#use Data::Dumper;print "event content".Dumper($event->{content});
|
||||
|
||||
#rich content editors:
|
||||
#$event->{wiki_content}=markup::html_to_creole($event->{content});
|
||||
|
||||
#markup editors
|
||||
$event->{wiki_content}=$event->{content};
|
||||
|
||||
|
||||
# [[http://localhost/agenda_files/media/images/Vl8X7YmaWrmm9RMN_OMywA.jpg|{{http://localhost/agenda_files/media/thumbs/Vl8X7YmaWrmm9RMN_OMywA.jpg|}}]]
|
||||
#replace "thumbs/xxx" link by link to local media URI
|
||||
# while ($event->{wiki_content}=~/\[\[.*?\/+media\/+images\/+(.*?)\s*\|.*?\{\{.*?\/+media\/+thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}\]\]/){
|
||||
$event->{wiki_content}=~s/\[\[.*?\/+media\/+images\/+(.*?)\s*\|.*?\{\{.*?\/+media\/+thumbs\/+(.*?)\s*\|\s*(.*?)\s*\}\}\]\]/\{\{thumbs\/$1\|$3\}\}/g;
|
||||
# }
|
||||
|
||||
my $wiki_content=join("\n".("-"x20)."\n",($event->{excerpt}, $event->{wiki_content}) );
|
||||
$wiki_content.="\n".("-"x20)."\n".$event->{wiki_comments} if ($event->{wiki_comments}=~/\S/);
|
||||
|
||||
return {
|
||||
title => $title,
|
||||
content => $event->{content},
|
||||
wiki_content => $wiki_content
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
#extrace meta tags from comment text
|
||||
sub extractMeta{
|
||||
my $comments =shift;
|
||||
my $meta =shift;
|
||||
|
||||
$meta=[] unless (defined $meta);
|
||||
|
||||
#push meta tags into meta list
|
||||
if (defined $comments){
|
||||
#build index for meta already defined
|
||||
my $meta_keys={};
|
||||
for my $pair (@$meta){
|
||||
$meta_keys->{$pair->{name}.'='.$pair->{value}}=1;
|
||||
}
|
||||
|
||||
while ($comments=~/\~\~META\:(.+?)\=(.+?)\~\~/g){
|
||||
my $name=$1;
|
||||
my $value=$2;
|
||||
|
||||
#fix meta values
|
||||
$name=lc($name);
|
||||
$name=~s/^\s+|\s+$//g;
|
||||
$value=~s/^\s+|\s+$//g;
|
||||
|
||||
#insert into list, if not defined yet
|
||||
unless( ($name eq'') || ($value eq'') || (exists $meta_keys->{$name.'='.$value}) ){
|
||||
push @$meta,{
|
||||
name=>$name,
|
||||
value=>$value,
|
||||
};
|
||||
$meta_keys->{$name.'='.$value}=1;
|
||||
}
|
||||
};
|
||||
}
|
||||
# use Data::Dumper;print Dumper($meta);
|
||||
return $meta;
|
||||
}
|
||||
|
||||
#remove meta tags from comment text
|
||||
sub removeMeta{
|
||||
my $comments=shift||'';
|
||||
|
||||
my $result='';
|
||||
for my $line (split(/\n/,$comments)){
|
||||
$result.=$line unless ($line=~/\~\~META\:(.+?)\=(.+?)\~\~/g);
|
||||
}
|
||||
#use Data::Dumper;print "removed metsas:".Dumper($result);
|
||||
$result=~s/^\s+//g;
|
||||
$result=~s/\s+$//g;
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
#add meta tags to comment text
|
||||
sub metaToWiki{
|
||||
my $meta =shift;
|
||||
|
||||
my $result='';
|
||||
for my $pair (@$meta){
|
||||
# use Data::Dumper;print Dumper($pair);
|
||||
$result.='~~META:'.$pair->{name}.'='.$pair->{value}.'~~'."\n";
|
||||
}
|
||||
return $result;
|
||||
#use Data::Dumper;print Dumper($meta);
|
||||
|
||||
}
|
||||
|
||||
|
||||
#test:
|
||||
#perl -e 'use creole_wiki;$a=creole_wiki::extractEventFromWikiText("teaser\n----------------------\nbody[[asd|download]][[bsd|hallo]][[csd|podcast]]{{a|b}}[[dsd|wer]]\n----------------------\ncomments",{title=>" a : b - c ( d e - f , g h i - j, k - m - l) "});use Data::Dumper;print Dumper($a)';
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
278
lib/calcms/db.pm
Normal file
278
lib/calcms/db.pm
Normal file
@@ -0,0 +1,278 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
#use DBI;
|
||||
#use Apache::DBI;
|
||||
use DBD::mysql;
|
||||
|
||||
package db;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
connect disconnect
|
||||
get insert put
|
||||
next_id get_max_id
|
||||
shift_date_by_hours shift_datetime_by_minutes
|
||||
get_columns get_columns_hash
|
||||
$write
|
||||
$read
|
||||
);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
#debug settings
|
||||
our $debug_read=0;
|
||||
our $debug_write=0;
|
||||
|
||||
#database control
|
||||
our $read=1;
|
||||
our $write=1;
|
||||
|
||||
# connect to database
|
||||
sub connect{
|
||||
my $options=shift;
|
||||
my $request=shift;
|
||||
|
||||
return $request->{connection} if ((defined $request) && (defined $request->{connection}));
|
||||
|
||||
my $access_options=$options->{access};
|
||||
|
||||
my $hostname =$access_options->{hostname};
|
||||
my $port =$access_options->{port};
|
||||
my $database =$access_options->{database};
|
||||
my $username =$access_options->{username};
|
||||
my $password =$access_options->{password};
|
||||
|
||||
if ((defined $access_options->{write}) && ($access_options->{write}eq'1')){
|
||||
$username =$access_options->{username_write};
|
||||
$password =$access_options->{password_write};
|
||||
}
|
||||
|
||||
my $dbh=undef;
|
||||
my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
|
||||
# if ($db::utf8dbi eq '1'){
|
||||
# use UTF8DBI;
|
||||
# $dbh = UTF8DBI->connect( $dsn,$username,$password) || die "Database connection not made: $DBI::errstr"; # \nfor $dsn, $username
|
||||
# }else{
|
||||
# use DBI;
|
||||
$dbh = DBI->connect( $dsn,$username,$password,{mysql_enable_utf8 => 1}) || die "could not connect to database: $DBI::errstr"; # \nfor $dsn, $username
|
||||
# }
|
||||
#print STDERR "db connect $username\n" if ($debug_read==1);
|
||||
#print STDERR "db connect $username\n";
|
||||
$dbh->{RaiseError} = 1;
|
||||
|
||||
$dbh->{'mysql_enable_utf8'} = 1;
|
||||
put($dbh,"set character set utf8");
|
||||
put($dbh,"set names utf8");
|
||||
put($dbh,"set time_zone='".$options->{date}->{time_zone}."'");
|
||||
|
||||
$request->{connection}=$dbh;
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
sub disconnect{
|
||||
my $request=shift;
|
||||
my $dbh=$request->{connection};
|
||||
$dbh->disconnect;
|
||||
delete $request->{connection};
|
||||
}
|
||||
|
||||
# get all database entries of an sql query (as list of hashs)
|
||||
sub get{
|
||||
my $dbh=shift;
|
||||
my $sql=shift;
|
||||
my $bind_values=shift;
|
||||
|
||||
if ($debug_read==1){
|
||||
print STDERR $sql."\n";
|
||||
print STDERR Dumper($bind_values)."\n" if defined $bind_values;
|
||||
}
|
||||
|
||||
my $sth = $dbh->prepare( $sql );
|
||||
if ((defined $bind_values)&&(ref($bind_values)eq'ARRAY')){
|
||||
# print STDERR Dumper($bind_values)."\n";
|
||||
my $result = $sth->execute(@$bind_values);
|
||||
unless ($result){
|
||||
print STDERR $sql."\n";
|
||||
die "db: $DBI::errstr $sql" if ($read==1);
|
||||
}
|
||||
}else{
|
||||
$sth->execute() || die "db: $DBI::errstr $sql" if ($read==1);
|
||||
}
|
||||
|
||||
my @results=();
|
||||
while ( my $row=$sth->fetchrow_hashref){
|
||||
my $result={};
|
||||
foreach my $key (keys %$row){
|
||||
$result->{$key}=$row->{$key};
|
||||
}
|
||||
push @results, $result;
|
||||
}
|
||||
|
||||
if ($debug_read==1){
|
||||
print STDERR Dumper($results[0])."\n" if (@results==1);
|
||||
print STDERR @results."\n" if (@results!=1);
|
||||
}
|
||||
|
||||
$sth->finish;
|
||||
return \@results;
|
||||
}
|
||||
|
||||
# get list of table columns
|
||||
sub get_columns{
|
||||
my $dbh=shift;
|
||||
my $table=shift;
|
||||
|
||||
my $columns=db::get($dbh, 'select column_name from information_schema.columns where table_name=?',[$table]);
|
||||
my @result=map {$_->{column_name}} (@$columns);
|
||||
return \@result;
|
||||
}
|
||||
|
||||
# get hash with table columns as keys
|
||||
sub get_columns_hash{
|
||||
my $dbh=shift;
|
||||
my $table=shift;
|
||||
|
||||
my $columns=db::get_columns($dbh, $table);
|
||||
my $result={};
|
||||
for my $column (@$columns){
|
||||
$result->{$column}=1;
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
|
||||
# insert an entry into database (select from where)
|
||||
sub insert_old{
|
||||
my $dbh=shift;
|
||||
my $tablename=shift;
|
||||
my $entry=shift;
|
||||
my $do_not_quote=shift;
|
||||
|
||||
my $keys =join(",", map {$_} (keys %$entry));
|
||||
my $values =undef;
|
||||
if (defined $do_not_quote && $do_not_quote ne ''){
|
||||
$values =join("\n,", map {$entry->{$_}} (keys %$entry));
|
||||
}else{
|
||||
$values =join("\n,", map {$dbh->quote($entry->{$_})} (keys %$entry));
|
||||
}
|
||||
my $sql ="insert into $tablename \n ($keys) \n values ($values);\n";
|
||||
print STDERR $sql."\n" if ($debug_write==1);
|
||||
put($dbh,$sql);
|
||||
|
||||
}
|
||||
|
||||
#returns last inserted id
|
||||
sub insert{
|
||||
my $dbh=shift;
|
||||
my $tablename=shift;
|
||||
my $entry=shift;
|
||||
# my $do_not_quote=shift;
|
||||
|
||||
my $keys =join(",", map {$_} (keys %$entry));
|
||||
my $values =join(",", map {'?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
|
||||
my $sql ="insert into $tablename \n ($keys) \n values ($values);\n";
|
||||
|
||||
if ($debug_write==1){
|
||||
print STDERR $sql."\n";
|
||||
print STDERR Dumper(\@bind_values)."\n" if (@bind_values);
|
||||
}
|
||||
|
||||
put($dbh, $sql, \@bind_values);
|
||||
my $result=get($dbh, 'SELECT LAST_INSERT_ID() id;');
|
||||
return $result->[0]->{id} if $result->[0]->{id}>0;
|
||||
return undef;
|
||||
}
|
||||
|
||||
# execute a modifying database command (update,insert,...)
|
||||
sub put{
|
||||
my $dbh=shift;
|
||||
my $sql=shift;
|
||||
my $bind_values=shift;
|
||||
|
||||
if ($debug_write==1){
|
||||
print STDERR $sql."\n";
|
||||
print STDERR Dumper($bind_values)."\n" if defined $bind_values;
|
||||
}
|
||||
|
||||
my $sth = $dbh->prepare( $sql );
|
||||
if ($write==1){
|
||||
if ((defined $bind_values)&&(ref($bind_values)eq'ARRAY')){
|
||||
$sth->execute(@$bind_values);
|
||||
}else{
|
||||
$sth->execute();
|
||||
}
|
||||
};
|
||||
$sth->finish;
|
||||
print STDERR "1\n" if ($debug_write==1);
|
||||
|
||||
my $result=get($dbh, 'SELECT ROW_COUNT() changes;');
|
||||
return $result->[0]->{changes} if $result->[0]->{changes}>0;
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub quote{
|
||||
my $dbh=shift;
|
||||
my $sql=shift;
|
||||
|
||||
$sql=~s/\_/\\\_/g;
|
||||
return $dbh->quote($sql);
|
||||
}
|
||||
|
||||
#subtract hours, deprecated(!)
|
||||
sub shift_date_by_hours{
|
||||
my $dbh=shift;
|
||||
my $date=shift;
|
||||
my $offset=shift;
|
||||
|
||||
my $query='select date(? - INTERVAL ? HOUR) date';
|
||||
my $bind_values=[$date,$offset];
|
||||
my $results=db::get($dbh, $query, $bind_values);
|
||||
return $results->[0]->{date};
|
||||
}
|
||||
|
||||
#add minutes, deprecated(!)
|
||||
sub shift_datetime_by_minutes{
|
||||
my $dbh=shift;
|
||||
my $datetime=shift;
|
||||
my $offset=shift;
|
||||
|
||||
my $query="select ? + INTERVAL ? MINUTE date";
|
||||
my $bind_values=[$datetime,$offset];
|
||||
my $results=db::get($dbh, $query, $bind_values);
|
||||
return $results->[0]->{date};
|
||||
}
|
||||
|
||||
# get next free id of a database table
|
||||
sub next_id{
|
||||
my $dbh=shift;
|
||||
my $table=shift;
|
||||
|
||||
my $query=qq{
|
||||
select max(id) id
|
||||
from $table
|
||||
where 1
|
||||
};
|
||||
my $results=get($dbh,$query);
|
||||
return $results->[0]->{id}+1;
|
||||
}
|
||||
|
||||
# get max id from table
|
||||
sub get_max_id{
|
||||
my $dbh=shift;
|
||||
my $table=shift;
|
||||
|
||||
my $query=qq{
|
||||
select max(id) id
|
||||
from $table
|
||||
where 1
|
||||
};
|
||||
my $results=get($dbh,$query);
|
||||
return $results->[0]->{id};
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
134
lib/calcms/eventOps.pm
Normal file
134
lib/calcms/eventOps.pm
Normal file
@@ -0,0 +1,134 @@
|
||||
package eventOps;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use series;
|
||||
use series_dates;
|
||||
use time;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
setAttributesFromSeriesTemplate
|
||||
setAttributesFromSchedule
|
||||
setAttributesFromOtherEvent
|
||||
setAttributesForCurrentTime
|
||||
getRecurrenceBaseId
|
||||
);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
# functions: to be separated
|
||||
sub setAttributesFromSeriesTemplate{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
my $event=shift;
|
||||
|
||||
#get attributes from series
|
||||
my $series=series::get(
|
||||
$config,{
|
||||
project_id => $params->{project_id},
|
||||
studio_id => $params->{studio_id},
|
||||
series_id => $params->{series_id},
|
||||
}
|
||||
);
|
||||
if(@$series!=1){
|
||||
uac::print_error("series not found");
|
||||
return undef;
|
||||
}
|
||||
|
||||
#copy fields from series template
|
||||
my $serie=$series->[0];
|
||||
for my $attr(
|
||||
'program','series_name','title',
|
||||
'excerpt', 'topic', 'content', 'html_content',
|
||||
'project','category','location','image', 'live',
|
||||
'archive_url', 'podcast_url'
|
||||
){
|
||||
$event->{$attr}=$serie->{$attr};
|
||||
}
|
||||
return $serie;
|
||||
}
|
||||
|
||||
sub setAttributesFromSchedule{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
my $event=shift;
|
||||
|
||||
#set attributes from schedule
|
||||
my $schedules=series_dates::get(
|
||||
$config, {
|
||||
project_id => $params->{project_id},
|
||||
studio_id => $params->{studio_id},
|
||||
series_id => $params->{series_id},
|
||||
start_at => $params->{start_date}
|
||||
}
|
||||
);
|
||||
|
||||
if(@$schedules!=1){
|
||||
uac::print_error("schedule not found");
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $schedule=$schedules->[0];
|
||||
for my $attr(
|
||||
'start','end',
|
||||
'day', 'weekday',
|
||||
'start_date', 'end_date'
|
||||
){
|
||||
$event->{$attr}=$schedule->{$attr};
|
||||
}
|
||||
|
||||
my $timezone=$config->{date}->{time_zone};
|
||||
$event->{duration} = time::get_duration($event->{start}, $event->{end}, $timezone);
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub setAttributesFromOtherEvent{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
my $event=shift;
|
||||
|
||||
my $event2=series::get_event($config, {
|
||||
allow_any => 1,
|
||||
#project_id => $params->{project_id},
|
||||
#studio_id => $params->{studio_id},
|
||||
#series_id => $params->{series_id},
|
||||
event_id => $params->{source_event_id}
|
||||
});
|
||||
if (defined $event2){
|
||||
for my $attr ('title', 'user_title', 'excerpt', 'user_excerpt', 'content', 'html_content', 'topics', 'image', 'live', 'no_event_sync', 'podcast_url', 'archive_url'){
|
||||
$event->{$attr}=$event2->{$attr};
|
||||
}
|
||||
$event->{rerun}=1;
|
||||
$event->{recurrence}=getRecurrenceBaseId($event2);
|
||||
}
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub setAttributesForCurrentTime{
|
||||
my $serie=shift;
|
||||
my $event=shift;
|
||||
|
||||
#on new event not from schedule use current time
|
||||
if($event->{start}eq''){
|
||||
$event->{start}=time::time_to_datetime();
|
||||
if ($event->{start}=~/(\d\d\d\d\-\d\d\-\d\d \d\d)/){
|
||||
$event->{start}=$1.':00';
|
||||
}
|
||||
}
|
||||
$event->{duration}=$serie->{duration}||60;
|
||||
$event->{end} =time::add_minutes_to_datetime($event->{start}, $event->{duration});
|
||||
$event->{end}=~s/(\d\d:\d\d)\:\d\d/$1/;
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
# get recurrence base id
|
||||
sub getRecurrenceBaseId{
|
||||
my $event = shift;
|
||||
return $event->{recurrence} if (defined $event->{recurrence}) && ($event->{recurrence} ne '') && ($event->{recurrence} ne '0');
|
||||
return $event->{event_id};
|
||||
}
|
||||
|
||||
176
lib/calcms/event_history.pm
Normal file
176
lib/calcms/event_history.pm
Normal file
@@ -0,0 +1,176 @@
|
||||
#!/bin/perl
|
||||
|
||||
package event_history;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get get_by_id insert insert_by_event_id delete);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_event_history');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
return undef unless defined $condition->{studio_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
|
||||
push @conditions, 'series_id=?';
|
||||
push @bind_values, $condition->{series_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{event_id}) && ($condition->{event_id} ne '')){
|
||||
push @conditions, 'event_id=?';
|
||||
push @bind_values, $condition->{event_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{change_id}) && ($condition->{change_id} ne '')){
|
||||
push @conditions, 'id=?';
|
||||
push @bind_values, $condition->{change_id};
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_event_history
|
||||
$conditions
|
||||
order by modified_at desc
|
||||
$limit
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
|
||||
my $changes=db::get($dbh, $query, \@bind_values);
|
||||
#print STDERR Dumper($changes);
|
||||
|
||||
for my $change (@$changes){
|
||||
$change->{change_id}=$change->{id};
|
||||
delete $change->{id};
|
||||
}
|
||||
return $changes;
|
||||
}
|
||||
|
||||
sub get_by_id{
|
||||
my $config=shift;
|
||||
my $id=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_event_history
|
||||
where event_id=?
|
||||
};
|
||||
|
||||
my $studios=db::get($dbh,$query,[$id]);
|
||||
return undef if (@$studios!=1);
|
||||
return $studios->[0];
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
$entry->{event_id}=$entry->{id} if((defined $entry->{id})&&(!(defined $entry->{event_id})));
|
||||
delete $entry->{id};
|
||||
|
||||
#TODO:filter for existing attributes
|
||||
my $columns=get_columns($config);
|
||||
my $event={};
|
||||
for my $column (keys %$columns){
|
||||
$event->{$column}=$entry->{$column} if defined $entry->{$column};
|
||||
}
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $id=db::insert($dbh, 'calcms_event_history', $event);
|
||||
return $id;
|
||||
}
|
||||
|
||||
# insert event
|
||||
sub insert_by_event_id{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
return undef unless defined $options->{project_id};
|
||||
return undef unless defined $options->{studio_id};
|
||||
return undef unless defined $options->{series_id};
|
||||
return undef unless defined $options->{event_id};
|
||||
return undef unless defined $options->{user};
|
||||
|
||||
my $sql=q{
|
||||
select * from calcms_events
|
||||
where id=?
|
||||
};
|
||||
my $bind_values=[$options->{event_id}];
|
||||
my $dbh=db::connect($config);
|
||||
my $results=db::get($dbh, $sql, $bind_values);
|
||||
if(@$results!=1){
|
||||
print STDERR "cannot find event with event_id=$options->{event_id}";
|
||||
return 0;
|
||||
}
|
||||
|
||||
# add to history
|
||||
my $event=$results->[0];
|
||||
$event->{project_id} = $options->{project_id};
|
||||
$event->{studio_id} = $options->{studio_id};
|
||||
$event->{series_id} = $options->{series_id};
|
||||
$event->{event_id} = $options->{event_id};
|
||||
$event->{user} = $options->{user};
|
||||
$event->{deleted} = 1;
|
||||
event_history::insert($config, $event);
|
||||
}
|
||||
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
db::put($dbh, 'delete from calcms_event_history where event_id=?', [$entry->{id}]);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
1775
lib/calcms/events.pm
Normal file
1775
lib/calcms/events.pm
Normal file
File diff suppressed because it is too large
Load Diff
297
lib/calcms/images.pm
Normal file
297
lib/calcms/images.pm
Normal file
@@ -0,0 +1,297 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use config;
|
||||
use template;
|
||||
|
||||
package images;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
#our @EXPORT = qw(all);
|
||||
our @EXPORT_OK = qw(get insert update insert_or_update delete delete_files);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
#column 'created_at' will be set at insert
|
||||
#column 'modified_at' will be set by default (do not update)
|
||||
my $sql_columns =['filename', 'name', 'description', 'created_by', 'modified_by', 'modified_at', 'studio_id', 'project_id'];
|
||||
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
my @cond=();
|
||||
my $bind_values=[];
|
||||
if ((defined $options->{project_id}) && ($options->{project_id}ne'')){
|
||||
push @cond, 'project_id = ?';
|
||||
push @$bind_values, $options->{project_id};
|
||||
}
|
||||
if ((defined $options->{studio_id}) && ($options->{studio_id}ne'')){
|
||||
push @cond, 'studio_id = ?';
|
||||
push @$bind_values, $options->{studio_id};
|
||||
}
|
||||
if ((defined $options->{filename}) && ($options->{filename}ne'')){
|
||||
push @cond, 'filename = ?';
|
||||
push @$bind_values,$options->{filename};
|
||||
}
|
||||
if ((defined $options->{from}) && ($options->{from}ne'')){
|
||||
push @cond, 'date(created_at) >= ?';
|
||||
push @$bind_values,$options->{from};
|
||||
}
|
||||
if ((defined $options->{till}) && ($options->{till}ne'')){
|
||||
push @cond, 'date(created_at) <= ?';
|
||||
push @$bind_values,$options->{till};
|
||||
}
|
||||
if ((defined $options->{created_by}) && ($options->{created_by}ne'')){
|
||||
push @cond, 'created_by = ?';
|
||||
push @$bind_values,$options->{created_by};
|
||||
}
|
||||
if ((defined $options->{modified_by}) && ($options->{modified_by}ne'')){
|
||||
push @cond, 'modified_by = ?';
|
||||
push @$bind_values,$options->{modified_by};
|
||||
}
|
||||
if ((defined $options->{search}) && ($options->{search}ne'')){
|
||||
push @cond, '(filename like ?'
|
||||
.' or name like ?'
|
||||
.' or description like ?'
|
||||
.' or created_by like ?'
|
||||
.')';
|
||||
my $search='%'.$options->{search}.'%';
|
||||
push @$bind_values,$search;
|
||||
push @$bind_values,$search;
|
||||
push @$bind_values,$search;
|
||||
push @$bind_values,$search;
|
||||
# push @$bind_values,$search;
|
||||
}
|
||||
|
||||
my $where='';
|
||||
if (@cond>0){
|
||||
$where = 'where '.join (' and ', @cond);
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ( (defined $options->{limit}) && ($options->{limit}=~/(\d+)/) ){
|
||||
$limit=' limit '.$1;
|
||||
}
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_images
|
||||
$where
|
||||
order by created_at desc
|
||||
$limit
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper($bind_values);
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $results=db::get($dbh, $query, $bind_values);
|
||||
|
||||
#print STDERR @$results."\n";
|
||||
return $results;
|
||||
}
|
||||
|
||||
sub insert_or_update{
|
||||
my $dbh=shift;
|
||||
my $image=shift;
|
||||
|
||||
$image->{name}='new' if ($image->{name}eq'');
|
||||
my $entry=get_by_filename($dbh, $image->{filename});
|
||||
if (defined $entry){
|
||||
update($dbh, $image);
|
||||
}else{
|
||||
insert($dbh, $image);
|
||||
}
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $dbh=shift;
|
||||
my $image=shift;
|
||||
|
||||
my @sql_columns=@$sql_columns;
|
||||
|
||||
#set created at timestamp
|
||||
push @sql_columns,'created_at';
|
||||
$image->{created_at}=time::time_to_datetime();
|
||||
|
||||
unless (defined $image->{created_by}){
|
||||
print STDERR "missing created_by at image::insert\n";
|
||||
return undef;
|
||||
}
|
||||
unless (defined $image->{studio_id}){
|
||||
print STDERR "missing studio_id at image::insert\n";
|
||||
return undef;
|
||||
}
|
||||
unless (defined $image->{project_id}){
|
||||
print STDERR "missing project_id at image::insert\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $query=q{
|
||||
insert into calcms_images(
|
||||
}.join(',',@sql_columns).qq{
|
||||
)
|
||||
values( }.join(', ', (map {'?'} @sql_columns)).q{ )
|
||||
};
|
||||
my @bind_values=map { $image->{$_} } @sql_columns;
|
||||
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
return db::put($dbh, $query, \@bind_values);
|
||||
}
|
||||
|
||||
|
||||
sub update{
|
||||
my $dbh=shift;
|
||||
my $image=shift;
|
||||
|
||||
unless (defined $image->{studio_id}){
|
||||
print STDERR "missing studio_id at images::update\n";
|
||||
return undef;
|
||||
}
|
||||
unless (defined $image->{project_id}){
|
||||
print STDERR "missing project_id at image::update\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
$image->{modified_at}=time::time_to_datetime();
|
||||
|
||||
my @set=();
|
||||
my $bind_values=[];
|
||||
for my $column (@$sql_columns){
|
||||
if (defined $image->{$column}){
|
||||
push @set, $column.' = ?';
|
||||
push @$bind_values,$image->{$column};
|
||||
}
|
||||
}
|
||||
|
||||
#conditions
|
||||
my $conditions=['filename=?'];
|
||||
push @$bind_values,$image->{filename};
|
||||
|
||||
push @$conditions, 'project_id=?';
|
||||
push @$bind_values, $image->{project_id}||0;
|
||||
|
||||
push @$conditions, 'studio_id=?';
|
||||
push @$bind_values, $image->{studio_id}||0;
|
||||
|
||||
return if (@set==0);
|
||||
|
||||
my $set=join (",",@set);
|
||||
$conditions=join(' and ', @$conditions);
|
||||
my $query=qq{
|
||||
update calcms_images
|
||||
set $set
|
||||
where $conditions
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper($bind_values);
|
||||
return db::put($dbh,$query,$bind_values);
|
||||
}
|
||||
|
||||
sub delete{
|
||||
my $dbh=shift;
|
||||
my $image=shift;
|
||||
|
||||
unless (defined $image->{project_id}){
|
||||
print STDERR "missing project_id at images::delete\n";
|
||||
return undef;
|
||||
}
|
||||
unless (defined $image->{project_id}){
|
||||
print STDERR "missing project_id at images::delete\n";
|
||||
return undef;
|
||||
}
|
||||
unless (defined $image->{filename}){
|
||||
print STDERR "missing filename at images::delete\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $project_id = $image->{project_id};
|
||||
my $studio_id = $image->{studio_id};
|
||||
my $filename = $image->{filename};
|
||||
|
||||
my $conditions = ['filename=?'];
|
||||
my $bind_values = [$filename];
|
||||
|
||||
push @$conditions, 'project_id=?';
|
||||
push @$bind_values, $studio_id;
|
||||
|
||||
push @$conditions, 'studio_id=?';
|
||||
push @$bind_values, $project_id;
|
||||
|
||||
$conditions=join(' and ', @$conditions);
|
||||
my $query=qq{
|
||||
delete from calcms_images
|
||||
where $conditions
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper($bind_values);
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
# deactivated
|
||||
sub delete_files{
|
||||
my $config = $_[0];
|
||||
my $local_media_dir = $_[1];
|
||||
my $filename = $_[2];
|
||||
my $action_result = $_[3];
|
||||
my $errors = $_[4];
|
||||
|
||||
return undef;
|
||||
|
||||
print log::error($config, 'missing permissions on writing into local media dir')unless(-w $local_media_dir);
|
||||
|
||||
if ($filename=~/[^a-zA-Z0-9\.\_\-]/){
|
||||
log::error($config, "invalid filename: '$filename'");
|
||||
return;
|
||||
}
|
||||
if ($filename=~/\.\./ || $filename=~/^\// || $filename=~/\//){
|
||||
log::error($config, "invalid filename: '$filename'");
|
||||
return;
|
||||
}
|
||||
|
||||
log::error($config, 'missing permissions on writing into local_media_dir/images/')unless(-w $local_media_dir.'images/');
|
||||
log::error($config, 'missing permissions on writing into local_media_dir/thumbs/')unless(-w $local_media_dir.'thumbs/');
|
||||
log::error($config, 'missing permissions on writing into local_media_dir/icons/') unless(-w $local_media_dir.'icons/');
|
||||
|
||||
my $path=$local_media_dir.'/upload/'.$filename;
|
||||
#delete_file($path,"Upload $filename",$action_result,$errors);
|
||||
|
||||
$path=$local_media_dir.'/images/'.$filename;
|
||||
delete_file($path,"Image $filename",$action_result,$errors);
|
||||
|
||||
$path=$local_media_dir.'/thumbs/'.$filename;
|
||||
delete_file($path,"Thumb $filename",$action_result,$errors);
|
||||
|
||||
$path=$local_media_dir.'/icons/'.$filename;
|
||||
delete_file($path,"Icon $filename",$action_result,$errors);
|
||||
}
|
||||
|
||||
# deactivated
|
||||
sub delete_file{
|
||||
my $path = $_[0];
|
||||
my $type = $_[1];
|
||||
my $action_result = $_[2];
|
||||
my $errors = $_[3];
|
||||
|
||||
return undef;
|
||||
|
||||
unless (-e $path){
|
||||
$errors.= qq{Error: File does not exist!<br>};
|
||||
return;
|
||||
}
|
||||
|
||||
unless (-w $path){
|
||||
$errors.= qq{Error: Cannot write $type<br>};
|
||||
return;
|
||||
}
|
||||
|
||||
unlink($path);
|
||||
if ($?==0){
|
||||
$action_result.= qq{$type deleted<br>};
|
||||
}else{
|
||||
$errors.= qq{Error on deleting $type<br>};
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
110
lib/calcms/localization.pm
Normal file
110
lib/calcms/localization.pm
Normal file
@@ -0,0 +1,110 @@
|
||||
package localization;
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use uac;
|
||||
use user_settings;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get getJavascript);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
# get localisation
|
||||
# file : po file
|
||||
# language : get for selected language
|
||||
# user : get from user settings
|
||||
# loc : add to existing localization, optional
|
||||
sub get{
|
||||
my $config =shift;
|
||||
my $options=shift;
|
||||
|
||||
#print STDERR Dumper($options);
|
||||
|
||||
#get pot file
|
||||
unless (defined $options->{file}){
|
||||
print STDERR "missing po file\n";
|
||||
return $options->{loc}||{};
|
||||
}
|
||||
|
||||
my $language=undef;
|
||||
#get language from options
|
||||
$language=$options->{language} if (defined $options->{language});
|
||||
|
||||
#get language from user
|
||||
if ( (!(defined $language)) && (defined $options->{user})){
|
||||
my $user_settings=user_settings::get($config, {user=>$options->{user}});
|
||||
$language=$user_settings->{language};
|
||||
}
|
||||
$language='en' unless defined $language;
|
||||
$language='en' unless $language eq 'de';
|
||||
|
||||
my $loc={};
|
||||
$loc=$options->{loc} if defined $options->{loc};
|
||||
|
||||
my $files=$options->{file};
|
||||
$files=~s/[^a-zA-Z\,\_\-]//g;
|
||||
#get all comma separated po files
|
||||
for my $file (split/\,/,$files){
|
||||
#read default language
|
||||
#my $po_file=$config->{locations}->{admin_pot_dir}.'/en/'.$file.'.po';
|
||||
#$loc=read_po_file($po_file, $loc);
|
||||
|
||||
#read selected language
|
||||
#if($language ne 'en'){
|
||||
my $po_file=$config->{locations}->{admin_pot_dir}.'/'.$language.'/'.$file.'.po';
|
||||
$loc=read_po_file($po_file, $loc);
|
||||
#}
|
||||
}
|
||||
return $loc;
|
||||
}
|
||||
|
||||
sub read_po_file{
|
||||
my $po_file=shift;
|
||||
my $loc =shift;
|
||||
|
||||
unless (-e $po_file){
|
||||
print STDERR "po file $po_file does not exist\n";
|
||||
return $loc;
|
||||
}
|
||||
unless (-r $po_file){
|
||||
print STDERR "cannot read po file $po_file\n";
|
||||
return $loc;
|
||||
}
|
||||
|
||||
my $key='';
|
||||
open my $file, '<:encoding(UTF-8)', $po_file;
|
||||
while (<$file>){
|
||||
my $line=$_;
|
||||
#print STDERR $line;
|
||||
if ($line=~/^msgid\s*\"(.*)\"\s*$/){
|
||||
$key=$1;
|
||||
$key=~s/\'//g;
|
||||
$key=~s/\"//g;
|
||||
}
|
||||
if ($line=~/^msgstr\s*\"(.*)\"\s*$/){
|
||||
my $val=$1;
|
||||
$val=~s/\'//g;
|
||||
$val=~s/\"//g;
|
||||
$loc->{$key}=$val;
|
||||
}
|
||||
}
|
||||
return $loc;
|
||||
}
|
||||
|
||||
sub getJavascript{
|
||||
my $loc=shift;
|
||||
|
||||
my $out='<script>';
|
||||
$out.="var loc={};\n";
|
||||
for my $key (sort keys %$loc){
|
||||
$out.=qq{loc['$key']='$loc->{$key}';}."\n";
|
||||
}
|
||||
$out.="</script>\n";
|
||||
return $out;
|
||||
}
|
||||
|
||||
1;
|
||||
166
lib/calcms/log.pm
Normal file
166
lib/calcms/log.pm
Normal file
@@ -0,0 +1,166 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use template;
|
||||
use config;
|
||||
|
||||
package log;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
#our @EXPORT = qw(all);
|
||||
our @EXPORT_OK = qw(init write read error mem);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
#our $debug=0;
|
||||
our $debug_params='';
|
||||
our $header="Content-type:text/html\n\n";
|
||||
|
||||
our $gtop = undef;
|
||||
our $proc = undef;
|
||||
|
||||
sub init{
|
||||
my $request =$_[0];
|
||||
$log::debug_params =$request->{params}->{checked}->{debug}||'';
|
||||
$log::header =$request->{header}if (defined $request->{header});
|
||||
|
||||
#if ($config->{system}->{debug_memory}>0){
|
||||
#use GTop();
|
||||
#$log::gtop=GTop->new;
|
||||
#$log::proc=$gtop->proc_mem($$);
|
||||
#}
|
||||
}
|
||||
|
||||
sub write{
|
||||
my $config = shift;
|
||||
my $key = shift;
|
||||
my $data = shift;
|
||||
my $dump = shift;
|
||||
|
||||
return unless(defined $config::config->{system}->{debug});
|
||||
return unless(($config::config->{system}->{debug}>0) &&($log::debug_params=~/$key/));
|
||||
|
||||
my $line=Dumper($data);
|
||||
$line=~s/^\$VAR1 = \{\n/<code>/g;
|
||||
$line=~s/\};\n$/<\/code>/g;
|
||||
$line=~s/\n/\\n/g;
|
||||
my $msg=localtime()." [$key] ".$ENV{REQUEST_URI}."\\n".$line;
|
||||
$msg.=Dumper($dump) if (defined $dump);
|
||||
$msg.="\n";
|
||||
|
||||
log::print($config, $msg);
|
||||
}
|
||||
|
||||
sub print{
|
||||
my $config = $_[0];
|
||||
my $message= $_[1];
|
||||
|
||||
unless (defined $config){
|
||||
print STDERR "missing config at log::error\n";
|
||||
return;
|
||||
}
|
||||
|
||||
my $filename=$config->{system}->{log_debug_file}||'';
|
||||
if ($filename eq ''){
|
||||
print STDERR "calcms config parameter 'system/log_debug_file' not set!\n";
|
||||
return;
|
||||
};
|
||||
|
||||
open my $FILE, ">>:utf8", $filename or warn("cant write log file '$filename'");
|
||||
print $FILE $message;
|
||||
close $FILE;
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $config = $_[0];
|
||||
my $message="Error: $_[1]\n";
|
||||
|
||||
unless (defined $config){
|
||||
print STDERR "missing config at log::error\n";
|
||||
}
|
||||
|
||||
print STDERR $message."\n";
|
||||
if($config::config->{system}->{debug}){
|
||||
log::write($config, '', $message);# if ($config::config->{system}->{debug}>1);
|
||||
|
||||
my $out='';
|
||||
#do not call template::check to avoid deep recursion!
|
||||
template::process('print','templates/default.html', {
|
||||
static_files_url => $config::config->{locations}->{static_files_url},
|
||||
error=>$message
|
||||
});
|
||||
}
|
||||
# TODO: remove exit
|
||||
die();
|
||||
#exit;
|
||||
}
|
||||
|
||||
sub mem{
|
||||
my $config = $_[0];
|
||||
return unless $config::config->{system}->{debug_memory};
|
||||
my $size=$log::gtop->proc_mem($$)->size();
|
||||
my $format_size=$size;
|
||||
$format_size=~s/(\d)(\d\d\d)$/$1\.$2/g;
|
||||
$format_size=~s/(\d)(\d\d\d)(\d\d\d)$/$1\.$2\.$3/g;
|
||||
my $line=localtime(time())."\t".$$."\t".$format_size."\t".$_[0];
|
||||
$line.="\t\t".($size-$_[1]) if(defined $_[1]);
|
||||
log::error($config, "log_memory_file is not defined!") if (!defined $config::config->{system}->{log_debug_memory_file});
|
||||
log::append_file($config::config->{system}->{log_debug_memory_file} , $line);
|
||||
}
|
||||
|
||||
sub load_file{
|
||||
my $filename=$_[0];
|
||||
# my $content=$_[1];
|
||||
|
||||
# binmode STDOUT, ":utf8";
|
||||
my $content='';
|
||||
if (-e $filename){
|
||||
my $FILE=undef;
|
||||
open $FILE, "<:utf8", $filename || warn "cant read file '$filename'";
|
||||
$content=join "",(<$FILE>);
|
||||
close $FILE;
|
||||
return $content;
|
||||
}
|
||||
}
|
||||
|
||||
sub save_file{
|
||||
my $filename=$_[0];
|
||||
my $content=$_[1];
|
||||
|
||||
#check if directory is writeable
|
||||
if ($filename=~/^(.+?)\/[^\/]+$/){
|
||||
my $dir=$1;
|
||||
unless (-w $dir){
|
||||
print STDERR `pwd;id -a;`;
|
||||
print STDERR "log::save_file : cannot write to directory ($dir)\n";
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
open my $FILE, ">:utf8", $filename || warn("cant write file '$filename'");
|
||||
if (defined $FILE){
|
||||
print $FILE $content."\n";
|
||||
close $FILE;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub append_file{
|
||||
my $filename =$_[0];
|
||||
my $content =$_[1];
|
||||
|
||||
unless ( (defined $filename) && ($filename ne'') && (-e $filename) ){
|
||||
print STDERR "cannot append, file '$filename' does not exist\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if (defined $content){
|
||||
open my $FILE, ">>:utf8", $filename or warn("cant write file '$filename'");
|
||||
print $FILE $content."\n";
|
||||
close $FILE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
485
lib/calcms/markup.pm
Normal file
485
lib/calcms/markup.pm
Normal file
@@ -0,0 +1,485 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use Text::WikiCreole;
|
||||
|
||||
use HTML::Parse;
|
||||
use HTML::FormatText;
|
||||
|
||||
use log;
|
||||
|
||||
package markup;
|
||||
|
||||
use Encode;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
#our @EXPORT = qw(all);
|
||||
our @EXPORT_OK = qw(fix_line_ends html_to_creole creole_to_html creole_to_plain plain_to_ical ical_to_plain ical_to_xml html_to_plain fix_utf8 uri_encode compress base26);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub fix_line_ends{
|
||||
my $s=shift;
|
||||
$s=~s/\r?\n|\r/\n/g;
|
||||
return $s;
|
||||
}
|
||||
|
||||
# convert 1..26 to a..z, 27 to aa, inspired by ConvertAA
|
||||
sub base26{
|
||||
my $num = shift ;
|
||||
return '' if $num <= 0;
|
||||
|
||||
my $s = "";
|
||||
while($num){
|
||||
$s= chr (--$num % 26 + ord "a").$s;
|
||||
$num = int $num/26;
|
||||
}
|
||||
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub html_to_creole{
|
||||
my $s=shift;
|
||||
|
||||
#remove elements
|
||||
# $s=~s/[\r\f\n]+/\n/gi;
|
||||
# $s=~s/<\/p.*?>//gi;
|
||||
# $s=~s/<\/br.*?>//gi;
|
||||
$s=~s/\<\!\-\-[\s\S]*?\-\-\>//gi;
|
||||
$s=~s/<script.*?>.*?<\/script.*?>//gi;
|
||||
# $s=~s/<\/?span.*?>//gi;
|
||||
# $s=~s/<\/?font.*?>//gi;
|
||||
# $s=~s/<\/?meta.*?>//gi;
|
||||
# $s=~s/<\/?title.*?>//gi;
|
||||
# $s=~s/<\/?style.*?>//gi;
|
||||
# $s=~s/<\/?col.*?>//gi;
|
||||
# $s=~s/<\/?thead.*?>//gi;
|
||||
# $s=~s/<\/?tbody.*?>//gi;
|
||||
$s=~s/<\/?form.*?>//gi;
|
||||
$s=~s/<\/?select.*?>//gi;
|
||||
$s=~s/<\/?option.*?//gi;
|
||||
$s=~s/<\/?input.*?>//gi;
|
||||
# $s=~s/<\/?button.*?>//gi;
|
||||
# $s=~s/<\/?textarea.*?>//gi;
|
||||
$s=~s/<\/?script.*?>//gi;
|
||||
|
||||
#table elements
|
||||
# $s=~s/\s*<\/?td.*?>//gi;
|
||||
# $s=~s/\s*<\/?th.*?>//gi;
|
||||
|
||||
#remove line breaks
|
||||
$s=~s/[\r\n]+/ /gi;
|
||||
|
||||
#formats
|
||||
$s=~s/<img.*?src="(.*?)".*?>/{{$1\|}}/gi;
|
||||
$s=~s/<img.*?title="(.*?)".*?>/{{$2\|$1}}/gi;
|
||||
$s=~s/<img.*?src="(.*?)"[^>]*?title="(.*?)".*?>/{{$1\|$2}}/gi;
|
||||
$s=~s/<img.*?title="(.*?)"[^>]*?src="(.*?)".*?>/{{$2\|$1}}/gi;
|
||||
$s=~s/<\/?img.*?>//gi;
|
||||
#replace line breaks from images
|
||||
$s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
|
||||
$s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
|
||||
$s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
|
||||
|
||||
$s=~s/<i.*?>(.*?)<\/i>/\/\/$1\/\//gi;
|
||||
$s=~s/<\/?i.*?>//gi;
|
||||
$s=~s/<b.*?>(.*?)<\/b>/\*\*$1\*\*/gi;
|
||||
# $s=~s/<\/?b.*?>//gi;
|
||||
|
||||
$s=~s/<strong.*?>(.*?)<\/strong>/\*\*$1\*\*/gi;
|
||||
$s=~s/<em.*?>(.*?)<\/em>/\/\/$1\/\//gi;
|
||||
$s=~s/<blockquote.*?>((\W+|\w+)*?)<\/blockquote>/{{{$1}}}/gi;
|
||||
# $s=~s/<a\s+.*?href="(.*?)".*?>((\W+|\w+)*?)<\/a>/\[\[$1\|$2\]\]$3/gi;
|
||||
$s=~s/<a\s+.*?href="(.*?)".*?>(.*?)(\s*)<\/a>/\[\[$1\|$2\]\]$3/gi;
|
||||
$s=~s/<a.*?>//gi;
|
||||
#replace line breaks from links
|
||||
$s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
|
||||
$s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
|
||||
$s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
|
||||
|
||||
# print STDERR Dumper($s) if ($s=~/</);
|
||||
|
||||
$s=~s/[\s]+/ /gi;
|
||||
# $s=~s/\n[ \t\r\n]+\n/\n\n/gi;
|
||||
# $s=~s/\n[ ]+/\n /gi;
|
||||
# $s=~s/\n+/\n/gi;
|
||||
# $s=~s/\n+/\\\n/gi;
|
||||
|
||||
#line elements, increase head line level to avoid breaking single = chars
|
||||
$s=~s/\s*<h1.*?>/== /gi;
|
||||
$s=~s/\s*<h2.*?>/=== /gi;
|
||||
$s=~s/\s*<h3.*?>/==== /gi;
|
||||
$s=~s/\s*<h\d.*?>/===== /gi;
|
||||
# $s=~s/\s*<\/h\d.*?>/\n/gi;
|
||||
|
||||
# $s=~s/<br.*?>/\\\\<br>/gi;
|
||||
# $s=~s/\s*<div.*?>//gi;
|
||||
# $s=~s/\s*<\/div>/\n/gi;
|
||||
|
||||
# $s=~s/<table.*?>/\n/gi;
|
||||
# $s=~s/<\/table>/\n/gi;
|
||||
# $s=~s/\s*<tr.*?>//gi;
|
||||
# $s=~s/\s*<\/tr>//gi;
|
||||
|
||||
# $s=~s/\s*<ol.*?>/\n/gi;
|
||||
# $s=~s/\s*<\/ol>/\n/gi;
|
||||
# $s=~s/\s*<ul.*?>/\n/gi;
|
||||
# $s=~s/\s*<\/ul>/\n/gi;
|
||||
# $s=~s/\s*<li.*?>/\n\* /gi;
|
||||
# $s=~s/\s*<\/li>//gi;
|
||||
|
||||
# $s=~s/\s*<p.*?>\s*/\n\n/gi;
|
||||
# $s=~s/\s*<br.*?>\s*/\n /gi;
|
||||
|
||||
my $tree=HTML::Parse::parse_html('<body>'.$s.'</body>');
|
||||
my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 2000);
|
||||
$s= $formatter->format($tree);
|
||||
#use Data::Dumper; print "asd:<textarea cols=100 rows=5>".Dumper($s);print "</textarea>";
|
||||
$s=~s/\</\</g;
|
||||
|
||||
#fix line endings
|
||||
$s=~s/\n[ \t]+/\n/gi;
|
||||
#$s=~s/\n[\t\r ]+\n/\n\n/g;
|
||||
$s=~s/\n{3,99}/\n\n/g;
|
||||
$s=~s/\n*\*[\s]+/\n\* /g;
|
||||
#$s=~s/(\n\*.*?\n)([^\*])/$1\n\n$2/g;
|
||||
|
||||
#enter line break before headlines
|
||||
$s=~s/(={2,99})/\n$1/g;
|
||||
#reduce head line level
|
||||
$s=~s/=(=+)/$1/g;
|
||||
|
||||
$s=~s/^\s+//gi;
|
||||
$s=~s/\s+$//gi;
|
||||
$s=~s/\n{3,99}/\n\n/g;
|
||||
# $s=~s/\n\n+/ \\\\\n/g;
|
||||
$s=~s/\n/\\\\\n/g;
|
||||
$s=~s/\\\\\n\=/\n\=/g;
|
||||
|
||||
#$s=~s/\n\n/ \\\\\n/g;
|
||||
# $s=~s/(\\\\\n){3,99}/\\\\\n\\\\\n/g;
|
||||
#$s=~s/\\\\[ \t]+/\\\\\n/g;
|
||||
|
||||
# $s=~s/<\/a>//gi;
|
||||
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub creole_to_html{
|
||||
my $s=$_[0]||'';
|
||||
|
||||
#$s=~s/\n\#\n/\n/g;
|
||||
#fix_line_ends($s);
|
||||
$s=~s/<a\s+.*?href="(.*?)".*?>(.*?)(\s*)<\/a>/\[\[$1\|$2\]\]$3/gi;
|
||||
$s=~s/<a.*?>//gi;
|
||||
|
||||
$s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
|
||||
$s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
|
||||
$s=~s/(\[\[[^\]\n]*?)\n([^\]]*?\]\])/$1$2/g;
|
||||
$s=~s/^\s+//g;
|
||||
$s=~s/\s+$//g;
|
||||
|
||||
$s=Text::WikiCreole::creole_parse($s)||'';
|
||||
# $s=~s/<p>/\n/gi;
|
||||
# $s=~s/\{\{\{((\W+|\w+)+?)\}\}\}/<blockquote>$1<\/blockquote>/g;
|
||||
# $s=~s/\{\{(.+?)\|(.*?)\}\}/<img src="$1" title="$2" \/>/g;
|
||||
# $s=~s/\[\[(.+?)\|(.*?)\]\]/<a href="$1">$2<\/a>/g;
|
||||
# $s=~s/([^\:])\/\/(.*?[^\:])\/\//$1<em>$2<\/em> /g;
|
||||
# $s=~s/\n=== (.*?)\n/<h3>$1<\/h3>\n/g;
|
||||
# $s=~s/\n== (.*?)\n/<h2>$1<\/h2>\n/g;
|
||||
#replace line breaks from images
|
||||
$s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
|
||||
$s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
|
||||
$s=~s/(\{\{[^\}\n]*?)\n([^\}\n]*?\}\})/$1$2/g;
|
||||
#replace line breaks from links
|
||||
# $s=~s/\n= (.*?)\n/<h1>$1<\/h1>\n/g;
|
||||
# $s=~s/\*\*(.*?)\*\*/<strong>$1<\/strong> /g;
|
||||
# $s=~s/^== (.*?)\n/<h2>$1<\/h2>\n/g;
|
||||
# $s=~s/\n\* (.*?)([\r\n]+)/<li>$1<\/li>\n/g;
|
||||
# $s=~s/\n\- (.*?)\n/<lo>$1<\/lo>\n/g;
|
||||
# $s=~s/\n\n/<p>/gi;
|
||||
# $s=~s/\n+/<br \/>/gi;
|
||||
# $s=~s/\</\</g;
|
||||
|
||||
#remove whitespaces and break lines at start or end of elements
|
||||
for my $elem ('p','li'){
|
||||
$s=~s|<$elem>\s*<br/><br/>|<$elem>|g;
|
||||
$s=~s|<br/><br/>\s*</$elem>|</$elem>|g;
|
||||
}
|
||||
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub creole_to_plain{
|
||||
my $s=shift;
|
||||
|
||||
$s=~s/\<p\>/\n/gi;
|
||||
$s=~s/\{\{\{((\W+|\w+)+?)\}\}\}/<blockquote>$1<\/blockquote>/g;
|
||||
$s=~s/\{\{(.+?)\|(.*?)\}\}//g;
|
||||
$s=~s/\[\[(.+?)\|(.*?)\]\]/$2/g;
|
||||
$s=~s/\/\/([^\/\/]*?)\/\//<em>$1<\/em> /g;
|
||||
$s=~s/\n=== (.*?)\n/\n<h3>$1<\/h3>\n/g;
|
||||
$s=~s/\n== (.*?)\n/\n<h2>$1<\/h2>\n/g;
|
||||
$s=~s/\*\*(.*?)\*\*/<strong>$1<\/strong> /g;
|
||||
$s=~s/^== (.*?)\n/<h2>$1<\/h2>\n/g;
|
||||
$s=~s/\n\* (.*?)\n/\n<li>$1<\/li>\n/g;
|
||||
$s=~s/\n\* (.*?)\n/\n<li>$1<\/li>\n/g;
|
||||
$s=~s/\n\- (.*?)\n/\n<lo>$1<\/lo>\n/g;
|
||||
$s=~s/\n\- (.*?)\n/\n<lo>$1<\/lo>\n/g;
|
||||
$s=~s/\n\n/\n<p>/gi;
|
||||
$s=~s/\n/\n<br\/>/gi;
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub html_to_plain{
|
||||
my $s=shift;
|
||||
return '' unless (defined $s);
|
||||
my $tree=HTML::Parse::parse_html('<body>'.$s.'</body>');
|
||||
my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 2000);
|
||||
$s= $formatter->format($tree);
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub ical_to_plain{
|
||||
return '' unless defined ($_[0]);
|
||||
$_[0]=~s/\\n/\n/gi;
|
||||
$_[0]=~s/ /\t/gi;
|
||||
$_[0]=~s/\\\./\./gi;
|
||||
$_[0]=~s/\\\,/\,/gi;
|
||||
$_[0]=~s/\\\\/\\/gi;
|
||||
return $_[0];
|
||||
}
|
||||
|
||||
sub plain_to_ical{
|
||||
return '' unless defined ($_[0]);
|
||||
#remove images + links
|
||||
$_[0]=~s/\[\[.+?\|(.+?)\]\]/$1/g;
|
||||
$_[0]=~s/\{\{.+?\}\}//g;
|
||||
$_[0]=~s/^\s+//g;
|
||||
$_[0]=~s/\\/\\\\/gi;
|
||||
$_[0]=~s/\,/\\\,/gi;
|
||||
# $_[0]=~s/\./\\\./gi;
|
||||
$_[0]=~s/[\r\n]/\\n/gi;
|
||||
$_[0]=~s/\t/ /gi;
|
||||
return $_[0];
|
||||
}
|
||||
|
||||
sub plain_to_xml{
|
||||
return '' unless defined ($_[0]);
|
||||
$_[0]=~s/\n\={1,6} (.*?)\s+/\n\[\[$1\]\]\n/gi;
|
||||
#remove images + links
|
||||
$_[0]=~s/\[\[.+?\|(.+?)\]\]/$1/g;
|
||||
$_[0]=~s/\{\{.+?\}\}//g;
|
||||
return encode_xml_element($_[0]);
|
||||
|
||||
# $_[0]=~s/\ä/ä/gi;
|
||||
# $_[0]=~s/\ö/ö/gi;
|
||||
# $_[0]=~s/\ü/ü/gi;
|
||||
# $_[0]=~s/\Ä/Ä/gi;
|
||||
# $_[0]=~s/\Ö/Ö/gi;
|
||||
# $_[0]=~s/\Ü/Ü/gi;
|
||||
# $_[0]=~s/\ß/ß/gi;
|
||||
# $_[0]=~s/\&/\&/gi;
|
||||
# $_[0]=~s/\</\</gi;
|
||||
# $_[0]=~s/\>/\>/gi;
|
||||
# $_[0]=~s/\"/\"/gi;
|
||||
|
||||
## $_[0]=~s/\n/<br\/>/gi;
|
||||
## $_[0]=~s/\&amp;/\&/gi;
|
||||
## $_[0]=~s/\&amp;/+/gi;
|
||||
## $_[0]=~s/\&/+/gi;
|
||||
## $_[0]=~s/\&/+/gi;
|
||||
# return $_[0];
|
||||
}
|
||||
|
||||
sub fix_utf8{
|
||||
$_[0] = decode( 'cp1252', $_[0] );
|
||||
return $_[0];
|
||||
}
|
||||
|
||||
sub uri_encode{
|
||||
$_[0] =~s/([^a-zA-Z0-9_\.\-])/sprintf("%%%02lx",ord($1))/esg;
|
||||
return $_[0];
|
||||
}
|
||||
|
||||
sub compress{
|
||||
my $header='';
|
||||
|
||||
if($_[0]=~/(Content\-type\:[^\n]+[\n]+)/){
|
||||
$header=$1;
|
||||
}else{
|
||||
#return;
|
||||
}
|
||||
|
||||
my $start=index($_[0],$header);
|
||||
return if ($start<0);
|
||||
|
||||
my $header_length=length($header);
|
||||
$header =substr($_[0],0,$start+$header_length);
|
||||
# print $header."\n";
|
||||
|
||||
my $content=substr($_[0],$start+$header_length);
|
||||
|
||||
# #remove multiple line breaks
|
||||
$content=~s/[\r\n]+[\s]*[\r\n]+/\n/g;
|
||||
|
||||
#remove leading whitespaces
|
||||
$content=~s/[\r\n]+[\s]+/\n/g;
|
||||
|
||||
#remove tailing whitespaces
|
||||
$content=~s/[\t ]*[\r\n]+/\n/g;
|
||||
|
||||
#remove whitespaces inside tags
|
||||
$content=~s/([\n]\<[^\n]+)[\r\n]+/$1 /g;
|
||||
$content=~s/\"\s+\>/\"\>/g;
|
||||
|
||||
#get closing tags closer
|
||||
$content=~s/[\r\n]+(\<[\/\!])/$1/g;
|
||||
$content=~s/(\>)[\r\n]+([^\<])/$1$2/g;
|
||||
|
||||
#remove leading whitespaces
|
||||
#$content=~s/[\r\n]+([\d\S])/$1/g;
|
||||
|
||||
#remove empty lines
|
||||
$content=~s/[\n\r]+/\n/g;
|
||||
|
||||
#remove whitespaces between tags
|
||||
$content=~s/\>[\t ]+\<(^\/T)/\>\<$1/g;
|
||||
|
||||
#multiple whitespaces
|
||||
$content=~s/[\t ]+/ /g;
|
||||
|
||||
#restore content-type line break
|
||||
$_[0]=$header.$content;
|
||||
#$_[0]=~s/HTTP_CONTENT_TYPE/\n\n/;
|
||||
# return $_[0];
|
||||
}
|
||||
|
||||
#from XML::RSS.pm
|
||||
my %entity = (
|
||||
nbsp => " ",
|
||||
iexcl => "¡",
|
||||
cent => "¢",
|
||||
pound => "£",
|
||||
curren => "¤",
|
||||
yen => "¥",
|
||||
brvbar => "¦",
|
||||
sect => "§",
|
||||
uml => "¨",
|
||||
copy => "©",
|
||||
ordf => "ª",
|
||||
laquo => "«",
|
||||
not => "¬",
|
||||
shy => "­",
|
||||
reg => "®",
|
||||
macr => "¯",
|
||||
deg => "°",
|
||||
plusmn => "±",
|
||||
sup2 => "²",
|
||||
sup3 => "³",
|
||||
acute => "´",
|
||||
micro => "µ",
|
||||
para => "¶",
|
||||
middot => "·",
|
||||
cedil => "¸",
|
||||
sup1 => "¹",
|
||||
ordm => "º",
|
||||
raquo => "»",
|
||||
frac14 => "¼",
|
||||
frac12 => "½",
|
||||
frac34 => "¾",
|
||||
iquest => "¿",
|
||||
Agrave => "À",
|
||||
Aacute => "Á",
|
||||
Acirc => "Â",
|
||||
Atilde => "Ã",
|
||||
Auml => "Ä",
|
||||
Aring => "Å",
|
||||
AElig => "Æ",
|
||||
Ccedil => "Ç",
|
||||
Egrave => "È",
|
||||
Eacute => "É",
|
||||
Ecirc => "Ê",
|
||||
Euml => "Ë",
|
||||
Igrave => "Ì",
|
||||
Iacute => "Í",
|
||||
Icirc => "Î",
|
||||
Iuml => "Ï",
|
||||
ETH => "Ð",
|
||||
Ntilde => "Ñ",
|
||||
Ograve => "Ò",
|
||||
Oacute => "Ó",
|
||||
Ocirc => "Ô",
|
||||
Otilde => "Õ",
|
||||
Ouml => "Ö",
|
||||
times => "×",
|
||||
Oslash => "Ø",
|
||||
Ugrave => "Ù",
|
||||
Uacute => "Ú",
|
||||
Ucirc => "Û",
|
||||
Uuml => "Ü",
|
||||
Yacute => "Ý",
|
||||
THORN => "Þ",
|
||||
szlig => "ß",
|
||||
agrave => "à",
|
||||
aacute => "á",
|
||||
acirc => "â",
|
||||
atilde => "ã",
|
||||
auml => "ä",
|
||||
aring => "å",
|
||||
aelig => "æ",
|
||||
ccedil => "ç",
|
||||
egrave => "è",
|
||||
eacute => "é",
|
||||
ecirc => "ê",
|
||||
euml => "ë",
|
||||
igrave => "ì",
|
||||
iacute => "í",
|
||||
icirc => "î",
|
||||
iuml => "ï",
|
||||
eth => "ð",
|
||||
ntilde => "ñ",
|
||||
ograve => "ò",
|
||||
oacute => "ó",
|
||||
ocirc => "ô",
|
||||
otilde => "õ",
|
||||
ouml => "ö",
|
||||
divide => "÷",
|
||||
oslash => "ø",
|
||||
ugrave => "ù",
|
||||
uacute => "ú",
|
||||
ucirc => "û",
|
||||
uuml => "ü",
|
||||
yacute => "ý",
|
||||
thorn => "þ",
|
||||
yuml => "ÿ",
|
||||
);
|
||||
|
||||
my $entities = join('|', keys %entity);
|
||||
|
||||
sub encode_xml_element {
|
||||
my $text = shift;
|
||||
|
||||
my $encoded_text = '';
|
||||
|
||||
while ( $text =~ s/(.*?)(\<\!\[CDATA\[.*?\]\]\>)//s ) {
|
||||
$encoded_text .= encode_xml_element_text($1) . $2;
|
||||
}
|
||||
$encoded_text .= encode_xml_element_text($text);
|
||||
|
||||
return $encoded_text;
|
||||
}
|
||||
|
||||
sub encode_xml_element_text {
|
||||
my $text = shift;
|
||||
|
||||
$text =~ s/&(?!(#[0-9]+|#x[0-9a-fA-F]+|\w+);)/&/g;
|
||||
$text =~ s/&($entities);/$entity{$1}/g;
|
||||
$text =~ s/\</\<\;/g;
|
||||
$text =~ s/\>/\>\;/g;
|
||||
|
||||
return $text;
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
83
lib/calcms/params.pm
Normal file
83
lib/calcms/params.pm
Normal file
@@ -0,0 +1,83 @@
|
||||
package params;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use CGI;
|
||||
use Apache2::Request;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get isJson);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
my $isJson=0;
|
||||
|
||||
sub isJson{
|
||||
return $isJson;
|
||||
}
|
||||
|
||||
sub get{
|
||||
#get the Apache2::RequestRec
|
||||
my $r=shift;
|
||||
|
||||
my $tmp_dir ='/var/tmp/';
|
||||
my $upload_limit=1000*1024;
|
||||
|
||||
my $cgi = undef;
|
||||
my $status = undef;
|
||||
my $params = {};
|
||||
|
||||
$isJson=0;
|
||||
|
||||
if (defined $r){
|
||||
#print STDERR "Apache2::Request\n";
|
||||
#get Apache2::Request
|
||||
my $req = Apache2::Request->new($r, POST_MAX => $upload_limit, TEMP_DIR => $tmp_dir);
|
||||
|
||||
for my $key ($req->param){
|
||||
$params->{scalar($key)}=scalar($req->param($key));
|
||||
}
|
||||
|
||||
#copy params to hash
|
||||
#my $body=$req->body();
|
||||
#if (defined $body){
|
||||
# for my $key (keys %$body){
|
||||
# $params->{scalar($key)}=scalar($req->param($key));
|
||||
# }
|
||||
#}
|
||||
$status = $req->parse; #parse
|
||||
}else{
|
||||
#print STDERR "CGI\n";
|
||||
$CGI::POST_MAX = $upload_limit;
|
||||
$CGI::TMPDIRECTORY=$tmp_dir;
|
||||
$cgi=new CGI();
|
||||
$status=$cgi->cgi_error()||$status;
|
||||
my %params=$cgi->Vars();
|
||||
$params=\%params;
|
||||
}
|
||||
$cgi=new CGI() unless(defined $cgi);
|
||||
|
||||
$isJson=1 if (defined $params->{json}) && ($params->{json}eq'1');
|
||||
|
||||
if(defined $status){
|
||||
$status='' if ($status eq 'Success');
|
||||
$status='' if ($status eq 'Missing input data');
|
||||
print $cgi->header.$status."\n" if($status ne'');
|
||||
}
|
||||
#print STDERR Dumper($params);
|
||||
#print $cgi->header.Dumper($params).$status;
|
||||
|
||||
return ($cgi, $params, $status);
|
||||
}
|
||||
|
||||
sub debug{
|
||||
my $message=shift;
|
||||
#print "$msg<br/>\n" if ($debug>0);
|
||||
#print "$message<br>\n";
|
||||
#log::print($message."\n") if ($debug);
|
||||
}
|
||||
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
367
lib/calcms/playout.pm
Normal file
367
lib/calcms/playout.pm
Normal file
@@ -0,0 +1,367 @@
|
||||
#!/bin/perl
|
||||
|
||||
package playout;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use db;
|
||||
use time;
|
||||
use series_events;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get sync);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_playout');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
# get playout entries
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
return undef unless defined $condition->{studio_id};
|
||||
|
||||
my $date_range_include=0;
|
||||
$date_range_include=1 if $condition->{date_range_include}==1;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
|
||||
push @conditions, 'start=?';
|
||||
push @bind_values, $condition->{start_at};
|
||||
}
|
||||
|
||||
if ((defined $condition->{from}) && ($condition->{from} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'end_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}else{
|
||||
push @conditions, 'start_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{till}) && ($condition->{till} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'start_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}else{
|
||||
push @conditions, 'end_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select date(start) start_date
|
||||
,date(end) end_date
|
||||
,dayname(start) weekday
|
||||
,start_date day
|
||||
,start
|
||||
,end
|
||||
,studio_id
|
||||
,project_id
|
||||
,duration
|
||||
,file
|
||||
,errors
|
||||
,channels
|
||||
,format
|
||||
,format_version
|
||||
,format_profile
|
||||
,format_settings
|
||||
,stream_size
|
||||
,bitrate
|
||||
,bitrate_mode
|
||||
,sampling_rate
|
||||
,writing_library
|
||||
,rms_left
|
||||
,rms_right
|
||||
,rms_image
|
||||
from calcms_playout
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
return $entries;
|
||||
}
|
||||
|
||||
# update playout entries for a given date span
|
||||
# insert, update and delete entries
|
||||
sub sync{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
#print STDERR Dumper($config);
|
||||
#print STDERR Dumper($options);
|
||||
return undef unless defined $options->{project_id} ;
|
||||
return undef unless defined $options->{studio_id} ;
|
||||
return undef unless defined $options->{from} ;
|
||||
return undef unless defined $options->{till} ;
|
||||
return undef unless defined $options->{events} ;
|
||||
|
||||
my $project_id = $options->{project_id};
|
||||
my $studio_id = $options->{studio_id};
|
||||
my $updates = $options->{events};
|
||||
#print STDERR "sync\n";
|
||||
#print STDERR Dumper($updates);
|
||||
|
||||
# get new entries by date
|
||||
my $update_by_date={};
|
||||
for my $entry (@$updates){
|
||||
$update_by_date->{$entry->{start}}=$entry;
|
||||
}
|
||||
|
||||
# get database entries
|
||||
my $bind_values=[
|
||||
$options->{project_id}, $options->{studio_id}, $options->{from}, $options->{till}
|
||||
];
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_playout
|
||||
where project_id=?
|
||||
and studio_id=?
|
||||
and start >=?
|
||||
and end <= ?
|
||||
order by start
|
||||
};
|
||||
print STDERR "from:$options->{from} till:$options->{till}\n";
|
||||
my $dbh=db::connect($config);
|
||||
my $entries=db::get($dbh, $query, $bind_values);
|
||||
#print STDERR "entries:".Dumper($entries);
|
||||
|
||||
# get database entries by date
|
||||
my $entries_by_date={};
|
||||
for my $entry (@$entries){
|
||||
# store entry by date
|
||||
my $start=$entry->{start};
|
||||
$entries_by_date->{$start}=$entry;
|
||||
|
||||
# remove outdated entries
|
||||
unless (defined $update_by_date->{$start}){
|
||||
print STDERR "delete:".Dumper($entry);
|
||||
playout::delete($config, $dbh, $entry);
|
||||
my $result=series_events::set_playout_status($config, {
|
||||
project_id => $project_id,
|
||||
studio_id => $studio_id,
|
||||
start => $entry->{start},
|
||||
playout => 0,
|
||||
});
|
||||
print STDERR "delete playout_status result=".$result."\n";
|
||||
next;
|
||||
}
|
||||
# update existing entries
|
||||
if (defined $update_by_date->{$start}){
|
||||
next if has_changed($entry, $update_by_date->{$start})==0;
|
||||
print STDERR "update:".Dumper($entry);
|
||||
playout::update($config, $dbh, $entry, $update_by_date->{$start});
|
||||
my $result=series_events::set_playout_status($config, {
|
||||
project_id => $project_id,
|
||||
studio_id => $studio_id,
|
||||
start => $entry->{start},
|
||||
playout => 1,
|
||||
});
|
||||
print STDERR "update playout_status result=".$result."\n";
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
# insert new entries
|
||||
for my $entry (@$updates){
|
||||
my $start=$entry->{start};
|
||||
unless (defined $entries_by_date->{$start}){
|
||||
$entry->{project_id} = $project_id;
|
||||
$entry->{studio_id} = $studio_id;
|
||||
print STDERR "insert:".Dumper($entry);
|
||||
playout::insert($config, $dbh, $entry);
|
||||
my $result=series_events::set_playout_status($config, {
|
||||
project_id => $project_id,
|
||||
studio_id => $studio_id,
|
||||
start => $entry->{start},
|
||||
playout => 1,
|
||||
});
|
||||
print STDERR "insert playout_status result=".$result."\n";
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub has_changed{
|
||||
my $oldEntry=shift;
|
||||
my $newEntry=shift;
|
||||
|
||||
my $update=0;
|
||||
for my $key ('duration', 'errors', 'file', 'channels', 'format', 'format_version', 'format_profile', 'format_settings', 'stream_size', 'bitrate', 'bitrate_mode', 'sampling_rate', 'writing_library'){
|
||||
return 1 if ($oldEntry->{$key}||'') ne ($newEntry->{$key}||'');
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# update playout entry if differs to old values
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $dbh=shift;
|
||||
my $oldEntry=shift;
|
||||
my $newEntry=shift;
|
||||
|
||||
return if has_changed($oldEntry, $newEntry)==0;
|
||||
|
||||
for my $key ('duration', 'errors', 'file', 'channels', 'format', 'format_version', 'format_profile', 'format_settings', 'stream_size', 'bitrate', 'bitrate_mode', 'sampling_rate', 'writing_library', 'rms_left', 'rms_right', 'rms_image', 'replay_gain'){
|
||||
if (($oldEntry->{$key}||'') ne ($newEntry->{$key}||'')){
|
||||
$oldEntry->{$key}=$newEntry->{$key};
|
||||
}
|
||||
}
|
||||
|
||||
my $entry=$oldEntry;
|
||||
print STDERR "update:".Dumper($entry);
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
$entry->{end} = playout::getEnd($entry->{start}, $entry->{duration});
|
||||
$entry->{start_date} = time::add_hours_to_datetime($entry->{start}, -$day_start);
|
||||
$entry->{end_date} = time::add_hours_to_datetime($entry->{end}, -$day_start);
|
||||
|
||||
my $bind_values=[
|
||||
$entry->{end}, $entry->{duration}, $entry->{file}, $entry->{errors},
|
||||
$entry->{start_date}, $entry->{end_date},
|
||||
$entry->{channels}, $entry->{'format'}, $entry->{format_version}, $entry->{format_profile}, $entry->{format_settings}, $entry->{stream_size},
|
||||
$entry->{bitrate}, $entry->{bitrate_mode}, $entry->{sampling_rate}, $entry->{writing_library},
|
||||
$entry->{rms_left}, $entry->{rms_right}, $entry->{rms_image},
|
||||
$entry->{replay_gain},
|
||||
$entry->{project_id}, $entry->{studio_id}, $entry->{start}
|
||||
];
|
||||
my $query=qq{
|
||||
update calcms_playout
|
||||
set end=?, duration=?, file=?, errors=?,
|
||||
start_date=?, end_date=?,
|
||||
channels=?, format=?, format_version=?, format_profile=?, format_settings=?, stream_size=?,
|
||||
bitrate=?, bitrate_mode=?, sampling_rate=?, writing_library=?,
|
||||
rms_left=?, rms_right=?, rms_image=?,
|
||||
replay_gain=?
|
||||
where project_id=? and studio_id=? and start=?
|
||||
};
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
# insert playout entry
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $dbh=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{start};
|
||||
return undef unless defined $entry->{duration};
|
||||
return undef unless defined $entry->{file};
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
$entry->{end} = playout::getEnd($entry->{start}, $entry->{duration});
|
||||
$entry->{start_date} = time::add_hours_to_datetime($entry->{start}, -$day_start);
|
||||
$entry->{end_date} = time::add_hours_to_datetime($entry->{end}, -$day_start);
|
||||
|
||||
return db::insert($dbh, 'calcms_playout', {
|
||||
project_id => $entry->{project_id},
|
||||
studio_id => $entry->{studio_id},
|
||||
start => $entry->{start},
|
||||
end => $entry->{end},
|
||||
start_date => $entry->{start_date},
|
||||
end_date => $entry->{end_date},
|
||||
duration => $entry->{duration},
|
||||
rms_left => $entry->{rms_left},
|
||||
rms_right => $entry->{rms_right},
|
||||
rms_image => $entry->{rms_image},
|
||||
replay_gain => $entry->{replay_gain},
|
||||
file => $entry->{file},
|
||||
errors => $entry->{errors},
|
||||
channels => $entry->{channels},
|
||||
"format" => $entry->{"format"},
|
||||
format_version => $entry->{format_version},
|
||||
format_profile => $entry->{format_profile},
|
||||
format_settings => $entry->{format_settings},
|
||||
stream_size => $entry->{stream_size},
|
||||
bitrate => $entry->{bitrate},
|
||||
bitrate_mode => $entry->{bitrate_mode},
|
||||
sampling_rate => $entry->{sampling_rate},
|
||||
writing_library => $entry->{writing_library}
|
||||
});
|
||||
|
||||
}
|
||||
|
||||
# delete playout entry
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $dbh=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{start};
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_playout
|
||||
where project_id=? and studio_id=? and start=?
|
||||
};
|
||||
my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{start}];
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
sub getEnd{
|
||||
my $start=shift;
|
||||
my $duration=shift;
|
||||
# calculate end from start + duration
|
||||
my @start = @{time::datetime_to_array($start)};
|
||||
next unless @start>=6;
|
||||
#print STDERR Dumper(\@start);
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$start[0], $start[1], $start[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, 0, int($duration) # delta days, hours, minutes, seconds
|
||||
);
|
||||
#print STDERR Dumper(\@end_datetime);
|
||||
return time::array_to_datetime(\@end_datetime);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
478
lib/calcms/project.pm
Normal file
478
lib/calcms/project.pm
Normal file
@@ -0,0 +1,478 @@
|
||||
#!/bin/perl
|
||||
|
||||
package project;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use config;
|
||||
use log;
|
||||
use template;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
check get_columns get insert delete get_date_range
|
||||
get_studios assign_studio unassign_studio is_studio_assigned get_studio_assignments
|
||||
get_series_ids assign_series unassign_series is_series_assigned get_series_assignments
|
||||
get_with_dates get_sorted
|
||||
);
|
||||
#TODO: globally replace get_studios by get_studio_assignments
|
||||
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
# get project columns
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_projects');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
# get projects
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{name}) && ($condition->{name} ne '')){
|
||||
push @conditions, 'name=?';
|
||||
push @bind_values, $condition->{name};
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_projects
|
||||
$conditions
|
||||
order by start_date
|
||||
$limit
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
|
||||
my $projects=db::get($dbh, $query, \@bind_values);
|
||||
return $projects;
|
||||
}
|
||||
|
||||
sub get_date_range{
|
||||
my $config=shift;
|
||||
my $query=qq{
|
||||
select min(start_date) start_date, max(end_date) end_date
|
||||
from calcms_projects
|
||||
};
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $projects=db::get($dbh, $query);
|
||||
return $projects->[0];
|
||||
}
|
||||
|
||||
# insert project
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
my $columns=get_columns($config);
|
||||
my $project={};
|
||||
for my $column (keys %$columns){
|
||||
$project->{$column}=$entry->{$column} if defined $entry->{$column};
|
||||
}
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $id=db::insert($dbh, 'calcms_projects', $project);
|
||||
return $id;
|
||||
}
|
||||
|
||||
# delete project
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
db::put($dbh, 'delete from calcms_projects where project_id=?', [$entry->{project_id}]);
|
||||
}
|
||||
|
||||
# update project
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $project=shift;
|
||||
|
||||
my $columns=project::get_columns($config);
|
||||
my $entry={};
|
||||
for my $column (keys %$columns){
|
||||
$entry->{$column}=$project->{$column} if defined $project->{$column};
|
||||
}
|
||||
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
push @bind_values,$entry->{project_id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_projects
|
||||
set $values
|
||||
where project_id=?
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
my $dbh=db::connect($config);
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
}
|
||||
|
||||
|
||||
# get studios of a project
|
||||
sub get_studios{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
return undef unless defined $options->{project_id};
|
||||
my $project_id=$options->{project_id};
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_project_studios
|
||||
where project_id=?
|
||||
};
|
||||
my $dbh=db::connect($config);
|
||||
my $project_studios=db::get($dbh,$query,[$project_id]);
|
||||
|
||||
return $project_studios;
|
||||
}
|
||||
|
||||
sub get_studio_assignments{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $options->{project_id}) && ($options->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $options->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $options->{studio_id}) && ($options->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $options->{studio_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_project_studios
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $results=db::get($dbh, $query, \@bind_values);
|
||||
|
||||
return $results;
|
||||
}
|
||||
|
||||
# is studio assigned to project
|
||||
sub is_studio_assigned{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return 0 unless defined $entry->{project_id};
|
||||
return 0 unless defined $entry->{studio_id};
|
||||
|
||||
my $project_id=$entry->{project_id};
|
||||
my $studio_id= $entry->{studio_id};
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_project_studios
|
||||
where project_id=? and studio_id=?
|
||||
};
|
||||
my $bind_values=[$project_id, $studio_id];
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $project_studios=db::get($dbh, $query, $bind_values);
|
||||
return 1 if @$project_studios==1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
# assign studio to project
|
||||
sub assign_studio{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
my $project_id=$entry->{project_id};
|
||||
my $studio_id= $entry->{studio_id};
|
||||
|
||||
if (is_studio_assigned($entry)){
|
||||
print STDERR "studio $entry->{studio_id} already assigned to project $entry->{project_id}\n";
|
||||
return 1;
|
||||
}
|
||||
my $dbh=db::connect($config);
|
||||
my $id=db::insert($dbh, 'calcms_project_studios', $entry);
|
||||
return $id;
|
||||
}
|
||||
|
||||
# unassign studio from project
|
||||
sub unassign_studio{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
my $project_id=$entry->{project_id};
|
||||
my $studio_id= $entry->{studio_id};
|
||||
|
||||
my $sql='delete from calcms_project_studios where project_id=? and studio_id=?';
|
||||
my $bind_values=[$project_id, $studio_id];
|
||||
my $dbh=db::connect($config);
|
||||
return db::put($dbh, $sql, $bind_values);
|
||||
}
|
||||
|
||||
# get series by project and studio
|
||||
sub get_series{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
return undef unless defined $options->{project_id};
|
||||
return undef unless defined $options->{studio_id};
|
||||
my $project_id=$options->{project_id};
|
||||
my $studio_id= $options->{studio_id};
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_project_series
|
||||
where project_id=? and studio_id=?
|
||||
};
|
||||
my $bind_values=[$project_id, $studio_id];
|
||||
my $dbh=db::connect($config);
|
||||
my $project_series=db::get($dbh, $query, $bind_values);
|
||||
|
||||
return $project_series;
|
||||
}
|
||||
|
||||
sub get_series_assignments{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $options->{project_id}) && ($options->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $options->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $options->{studio_id}) && ($options->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $options->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $options->{series_id}) && ($options->{series_id} ne '')){
|
||||
push @conditions, 'series_id=?';
|
||||
push @bind_values, $options->{series_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_project_series
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $results=db::get($dbh, $query, \@bind_values);
|
||||
|
||||
return $results;
|
||||
}
|
||||
|
||||
# is series assigned to project and studio
|
||||
sub is_series_assigned{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return 0 unless defined $entry->{project_id};
|
||||
return 0 unless defined $entry->{studio_id};
|
||||
return 0 unless defined $entry->{series_id};
|
||||
|
||||
my $project_id=$entry->{project_id};
|
||||
my $studio_id= $entry->{studio_id};
|
||||
my $series_id= $entry->{series_id};
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_project_series
|
||||
where project_id=? and studio_id=? and series_id=?
|
||||
};
|
||||
my $bind_values=[$project_id, $studio_id, $series_id];
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $project_series=db::get($dbh,$query, $bind_values);
|
||||
return 1 if @$project_series==1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
# assign series to project and studio
|
||||
sub assign_series{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{series_id};
|
||||
|
||||
my $project_id=$entry->{project_id};
|
||||
my $studio_id= $entry->{studio_id};
|
||||
my $series_id= $entry->{series_id};
|
||||
|
||||
if (is_series_assigned($entry)){
|
||||
print STDERR "series $series_id already assigned to project $project_id and studio $studio_id\n";
|
||||
return return undef;
|
||||
}
|
||||
my $dbh=db::connect($config);
|
||||
my $id=db::insert($dbh, 'calcms_project_series', $entry);
|
||||
print STDERR "assigned series $series_id to project $project_id and studio $studio_id\n";
|
||||
return $id;
|
||||
}
|
||||
|
||||
# unassign series from project
|
||||
# TODO: remove series _single_ if no event is assigned to
|
||||
sub unassign_series{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{series_id};
|
||||
|
||||
my $project_id=$entry->{project_id};
|
||||
my $studio_id= $entry->{studio_id};
|
||||
my $series_id= $entry->{series_id};
|
||||
|
||||
my $sql='delete from calcms_project_series where project_id=? and studio_id=? and series_id=?';
|
||||
my $bind_values=[$project_id, $studio_id, $series_id];
|
||||
my $dbh=db::connect($config);
|
||||
return db::put($dbh, $sql, $bind_values);
|
||||
}
|
||||
|
||||
sub get_with_dates{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
my $language = $config->{date}->{language} || 'en';
|
||||
my $projects=project::get($config, {});
|
||||
|
||||
foreach my $project (reverse sort { $a->{end_date} cmp $b->{end_date} } (@$projects) ){
|
||||
$project->{months} = get_months($config, $project, $language);
|
||||
$project->{user} = $ENV{REMOTE_USER};
|
||||
$project->{current} = 1 if ($project->{name} eq $config::config->{project});
|
||||
}
|
||||
|
||||
return $projects;
|
||||
}
|
||||
|
||||
#TODO: add config
|
||||
sub get_sorted{
|
||||
my $config=shift;
|
||||
my $projects=project::get($config, {});
|
||||
my @projects=reverse sort { $a->{end_date} cmp $b->{end_date} } (@$projects);
|
||||
|
||||
unshift @projects,{
|
||||
name => 'all',
|
||||
title => 'alle',
|
||||
priority => '0',
|
||||
start_date => $projects[-1]->{start_date},
|
||||
end_date => $projects[0]->{end_date},
|
||||
};
|
||||
return \@projects;
|
||||
}
|
||||
|
||||
# internal
|
||||
sub get_months{
|
||||
my $config=shift;
|
||||
my $project = shift;
|
||||
my $language = shift || $config->{date}->{language} || 'en';
|
||||
|
||||
my $start = $project->{start_date};
|
||||
my $end = $project->{end_date};
|
||||
|
||||
(my $start_year,my $start_month,my $start_day)=split(/\-/,$start);
|
||||
my $last_day = Date::Calc::Days_in_Month($start_year,$start_month);
|
||||
$start_day = 1 if ($start_day<1);
|
||||
$start_day = $last_day if ($start_day gt $last_day);
|
||||
|
||||
(my $end_year,my $end_month,my $end_day)=split(/\-/,$end);
|
||||
$last_day = Date::Calc::Days_in_Month($end_year,$end_month);
|
||||
$end_day = 1 if ($end_day<1);
|
||||
$end_day = $last_day if ($end_day gt $last_day);
|
||||
|
||||
my @months=();
|
||||
for my $year($start_year..$end_year){
|
||||
my $m1=1;
|
||||
my $m2=12;
|
||||
$m1=$start_month if $year eq $start_year;
|
||||
$m2=$end_month if $year eq $end_year;
|
||||
|
||||
for my $month($m1..$m2){
|
||||
my $d1=1;
|
||||
my $d2=Date::Calc::Days_in_Month($year,$month);
|
||||
$d1=$start_day if $month eq $start_month;
|
||||
$d2=$end_day if $month eq $end_month;
|
||||
push @months,{
|
||||
start => time::array_to_date($year,$month,$d1),
|
||||
end => time::array_to_date($year,$month,$d2),
|
||||
year => $year,
|
||||
month => $month,
|
||||
month_name => $time::names->{$language}->{months_abbr}->[$month-1],
|
||||
title => $project->{title},
|
||||
user => $ENV{REMOTE_USER}
|
||||
};
|
||||
}
|
||||
}
|
||||
@months=reverse @months;
|
||||
return \@months;
|
||||
}
|
||||
|
||||
# check project_id
|
||||
sub check{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
return "missing project_id at checking project" unless defined $options->{project_id};
|
||||
return "Please select a project" if($options->{project_id}eq'-1');
|
||||
return "Please select a project" if($options->{project_id}eq'');
|
||||
my $projects=project::get($config, { project_id=>$options->{project_id} } );
|
||||
return "Sorry. unknown project" unless defined $projects;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
8
lib/calcms/projects.pm
Normal file
8
lib/calcms/projects.pm
Normal file
@@ -0,0 +1,8 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
package projects;
|
||||
|
||||
print STDERR "projects.pm is not used anymore!\n";
|
||||
#do not delete last line!
|
||||
1;
|
||||
146
lib/calcms/roles.pm
Normal file
146
lib/calcms/roles.pm
Normal file
@@ -0,0 +1,146 @@
|
||||
package roles;
|
||||
use Apache2::Reload;
|
||||
require Exporter;
|
||||
my @ISA = qw(Exporter);
|
||||
my @EXPORT_OK = qw($roles get_user get_user_permissions get_template_parameters);
|
||||
my %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
our $roles={
|
||||
'admin' => {
|
||||
access_events => 1,
|
||||
access_images => 1,
|
||||
access_comments => 1,
|
||||
access_sync => 1,
|
||||
access_system => 1,
|
||||
read_event_all => 1,
|
||||
create_event => 1,
|
||||
delete_event => 1,
|
||||
update_comment => 1,
|
||||
create_image => 1,
|
||||
read_image_own => 1,
|
||||
read_image_all => 1,
|
||||
update_image_own => 1,
|
||||
update_image_all => 1,
|
||||
delete_image_own => 1,
|
||||
delete_image_all => 1,
|
||||
sync_own => 1,
|
||||
sync_all => 1,
|
||||
sync_select_range => 1,
|
||||
upload_playlist => 1,
|
||||
},
|
||||
'dev' => {
|
||||
access_events => 1,
|
||||
access_images => 1,
|
||||
access_comments => 1,
|
||||
access_sync => 1,
|
||||
access_system => 0,
|
||||
read_event_all => 1,
|
||||
create_event => 1,
|
||||
delete_event => 1,
|
||||
update_comment => 1,
|
||||
create_image => 1,
|
||||
read_image_own => 1,
|
||||
read_image_all => 1,
|
||||
update_image_own => 1,
|
||||
update_image_all => 1,
|
||||
delete_image_own => 1,
|
||||
delete_image_all => 1,
|
||||
sync_own => 0,
|
||||
sync_all => 1,
|
||||
sync_select_range => 1,
|
||||
upload_playlist => 1,
|
||||
},
|
||||
'editor' => {
|
||||
access_events => 1,
|
||||
access_images => 1,
|
||||
access_comments => 1,
|
||||
access_sync => 1,
|
||||
access_system => 0,
|
||||
read_event_all => 0,
|
||||
create_event => 1,
|
||||
delete_event => 0,
|
||||
update_comment => 0,
|
||||
create_image => 1,
|
||||
read_image_own => 1,
|
||||
read_image_all => 1,
|
||||
update_image_own => 1,
|
||||
update_image_all => 0,
|
||||
delete_image_own => 1,
|
||||
delete_image_all => 0,
|
||||
sync_own => 1,
|
||||
sync_all => 0,
|
||||
sync_select_range => 0,
|
||||
upload_playlist => 1,
|
||||
},
|
||||
'nobody' => {
|
||||
access_events => 0,
|
||||
access_images => 0,
|
||||
access_comments => 0,
|
||||
access_sync => 0,
|
||||
access_system => 0,
|
||||
read_event_all => 0,
|
||||
create_event => 0,
|
||||
delete_event => 0,
|
||||
update_comment => 0,
|
||||
create_image => 0,
|
||||
read_image_own => 0,
|
||||
read_image_all => 0,
|
||||
update_image_own => 0,
|
||||
update_image_all => 0,
|
||||
delete_image_own => 0,
|
||||
delete_image_all => 0,
|
||||
sync_own => 0,
|
||||
sync_all => 0,
|
||||
sync_select_range => 0,
|
||||
upload_playlist => 0,
|
||||
}
|
||||
};
|
||||
|
||||
sub get_user{
|
||||
my $user= $ENV{REMOTE_USER};
|
||||
my $users=$config::config->{users};
|
||||
return $user if (defined $users->{$user});
|
||||
return 'nobody';
|
||||
}
|
||||
|
||||
sub get_user_permissions{
|
||||
my $user= $ENV{REMOTE_USER}||'';
|
||||
return $roles::roles->{nobody} unless ($user=~/\S/);
|
||||
my $users=$config::config->{users};
|
||||
if (defined $users->{$user}){
|
||||
my $role=$users->{$user};
|
||||
if (defined $roles::roles->{$role}){
|
||||
return $roles::roles->{$role};
|
||||
}
|
||||
}
|
||||
return $roles::roles->{nobody};
|
||||
}
|
||||
|
||||
sub get_user_jobs{
|
||||
my $user= $ENV{REMOTE_USER}||'';
|
||||
return [] unless($user =~/\S/);
|
||||
my $result=[];
|
||||
my $jobs=$config::config->{jobs}->{job};
|
||||
|
||||
for my $job (@$jobs){
|
||||
for my $job_user (split /\,/,$job->{users}){
|
||||
push @$result,$job if ($user eq $job_user);
|
||||
}
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub get_jobs{
|
||||
return $config::config->{jobs}->{job};
|
||||
}
|
||||
|
||||
sub get_template_parameters{
|
||||
my $user_permissions=shift;
|
||||
$user_permissions=roles::get_user_permissions() unless(defined $user_permissions);
|
||||
my @user_permissions=();
|
||||
for my $usecase (keys %$user_permissions){
|
||||
push @user_permissions, $usecase if ($user_permissions->{$usecase}eq'1');
|
||||
}
|
||||
return \@user_permissions;
|
||||
}
|
||||
|
||||
1208
lib/calcms/series.pm
Normal file
1208
lib/calcms/series.pm
Normal file
File diff suppressed because it is too large
Load Diff
555
lib/calcms/series_dates.pm
Normal file
555
lib/calcms/series_dates.pm
Normal file
@@ -0,0 +1,555 @@
|
||||
package series_dates;
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use time;
|
||||
use db;
|
||||
use log;
|
||||
use studio_timeslot_dates;
|
||||
use series_schedule;
|
||||
|
||||
# schedule dates for series_schedule
|
||||
# table: calcms_series_dates
|
||||
# columns: id, studio_id, series_id, start(datetime), end(datetime)
|
||||
# TODO: delete column schedule_id
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get insert update delete get_dates get_series);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_series_dates');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
# get all series_dates for studio_id and series_id within given time range
|
||||
# calculate start_date, end_date, weeday, day from start and end(datetime)
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
|
||||
push @conditions, 'series_id=?';
|
||||
push @bind_values, $condition->{series_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
|
||||
push @conditions, 'start=?';
|
||||
push @bind_values, $condition->{start_at};
|
||||
}
|
||||
|
||||
if ((defined $condition->{from}) && ($condition->{from} ne '')){
|
||||
push @conditions, 'start_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}
|
||||
|
||||
if ((defined $condition->{till}) && ($condition->{till} ne '')){
|
||||
push @conditions, 'end_date<?';
|
||||
push @bind_values, $condition->{till};
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
|
||||
push @conditions, 'exclude=?';
|
||||
push @bind_values, $condition->{exclude};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select date(start) start_date
|
||||
,date(end) end_date
|
||||
,dayname(start) weekday
|
||||
,start_date day
|
||||
,start
|
||||
,end
|
||||
,id schedule_id
|
||||
,series_id
|
||||
,studio_id
|
||||
,project_id
|
||||
,exclude
|
||||
|
||||
from calcms_series_dates
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
#print STDERR $query."\n";
|
||||
#print STDERR Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
for my $entry (@$entries){
|
||||
$entry->{weekday}=substr($entry->{weekday},0,2);
|
||||
}
|
||||
|
||||
return $entries;
|
||||
}
|
||||
|
||||
#check if event is scheduled (on permission check)
|
||||
sub is_event_scheduled{
|
||||
my $request=shift;
|
||||
my $options=shift;
|
||||
|
||||
return 0 unless defined $options->{project_id};
|
||||
return 0 unless defined $options->{studio_id};
|
||||
return 0 unless defined $options->{series_id};
|
||||
return 0 unless defined $options->{start_at};
|
||||
|
||||
my $config = $request->{config};
|
||||
my $schedules=series_dates::get(
|
||||
$config, {
|
||||
project_id => $options->{project_id},
|
||||
studio_id => $options->{studio_id},
|
||||
series_id => $options->{series_id},
|
||||
start_at => $options->{start_at}
|
||||
}
|
||||
);
|
||||
return 0 if(@$schedules!=1);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
#get all series for given studio_id, time range and search
|
||||
sub get_series{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $date_range_include=0;
|
||||
$date_range_include=1 if $condition->{date_range_include}==1;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
push @conditions, 'd.series_id=s.id';
|
||||
# push @conditions, 'd.studio_id=s.studio_id';
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'd.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'd.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
|
||||
push @conditions, 'd.series_id=?';
|
||||
push @bind_values, $condition->{series_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
|
||||
push @conditions, 'd.start=?';
|
||||
push @bind_values, $condition->{start_at};
|
||||
}
|
||||
|
||||
if ((defined $condition->{from}) && ($condition->{from} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'd.end_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}else{
|
||||
push @conditions, 'd.start_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{till}) && ($condition->{till} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'd.start_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}else{
|
||||
push @conditions, 'd.end_date<?';
|
||||
push @bind_values, $condition->{till};
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'd.id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
|
||||
push @conditions, 'd.exclude=?';
|
||||
push @bind_values, $condition->{exclude};
|
||||
}
|
||||
|
||||
my $search_cond='';
|
||||
if ((defined $condition->{search}) && ($condition->{search} ne'')){
|
||||
my $search=lc $condition->{search};
|
||||
$search=~s/[^a-z0-9\_\.\-\:\!öäüßÖÄÜ \&]/%/;
|
||||
$search=~s/\%+/\%/;
|
||||
$search=~s/^[\%\s]+//;
|
||||
$search=~s/[\%\s]+$//;
|
||||
if ($search ne ''){
|
||||
$search='%'.$search.'%';
|
||||
my @attr=('s.title', 's.series_name', 's.excerpt', 's.category', 's.content');
|
||||
push @conditions, "(".join(" or ", map {'lower('.$_.') like ?'} @attr ).")";
|
||||
for my $attr (@attr){
|
||||
push @bind_values,$search;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select date(d.start) start_date
|
||||
,date(d.end) end_date
|
||||
,dayname(d.start) weekday
|
||||
,d.start_date day
|
||||
,d.start
|
||||
,d.end
|
||||
,d.id schedule_id
|
||||
,d.series_id
|
||||
,d.series_schedule_id
|
||||
,d.exclude
|
||||
,d.studio_id
|
||||
,d.project_id
|
||||
,s.series_name
|
||||
,s.title
|
||||
,s.has_single_events
|
||||
from calcms_series_dates d, calcms_series s
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
|
||||
for my $entry (@$entries){
|
||||
$entry->{weekday} = substr($entry->{weekday},0,2);
|
||||
}
|
||||
|
||||
# add series schedule
|
||||
$entries=series_dates::addSeriesScheduleAttributes($config, $entries);
|
||||
|
||||
return $entries;
|
||||
}
|
||||
|
||||
sub addSeriesScheduleAttributes{
|
||||
my $config=shift;
|
||||
my $entries=shift;
|
||||
|
||||
my $scheduleIds={};
|
||||
# get series schedule ids used at entries
|
||||
for my $entry (@$entries){
|
||||
$scheduleIds->{$entry->{series_schedule_id}}=1;
|
||||
}
|
||||
my @scheduleIds=keys %$scheduleIds;
|
||||
return $entries if scalar(@scheduleIds)==0;
|
||||
|
||||
# get schedules with schedule ids
|
||||
my $schedules=series_schedule::get($config, {
|
||||
schedule_ids => \@scheduleIds
|
||||
});
|
||||
|
||||
# get schedules by id
|
||||
my $scheduleById={};
|
||||
for my $schedule (@$schedules){
|
||||
$scheduleById->{$schedule->{schedule_id}}=$schedule;
|
||||
}
|
||||
|
||||
for my $entry (@$entries){
|
||||
$entry->{frequency} = $scheduleById->{$entry->{series_schedule_id}}->{frequency};
|
||||
$entry->{period_type} = $scheduleById->{$entry->{series_schedule_id}}->{period_type};
|
||||
}
|
||||
|
||||
return $entries;
|
||||
}
|
||||
|
||||
|
||||
#update series dates for all schedules of a series and studio_id
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id} ;
|
||||
return undef unless defined $entry->{studio_id} ;
|
||||
return undef unless defined $entry->{series_id} ;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
#delete all dates for series (by studio and series id)
|
||||
series_dates::delete($config, $entry);
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
|
||||
#get all schedules for series ordered by exclude, date
|
||||
my $schedules=series_schedule::get($config, {
|
||||
project_id => $entry->{project_id},
|
||||
studio_id => $entry->{studio_id},
|
||||
series_id => $entry->{series_id},
|
||||
});
|
||||
|
||||
#add scheduled series dates and remove exluded dates
|
||||
my $series_dates={};
|
||||
|
||||
#TODO:set schedules exclude to 0 if not 1
|
||||
#insert all normal dates (not excludes)
|
||||
for my $schedule (@$schedules){
|
||||
my $dates=get_schedule_dates($schedule, {exclude => 0});
|
||||
for my $date (@$dates){
|
||||
$date->{exclude}=0;
|
||||
$series_dates->{$date->{start}}=$date;
|
||||
#print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
|
||||
}
|
||||
}
|
||||
|
||||
#insert / overwrite all exlude dates
|
||||
for my $schedule (@$schedules){
|
||||
my $dates=get_schedule_dates($schedule, {exclude => 1});
|
||||
for my $date (@$dates){
|
||||
$date->{exclude}=1;
|
||||
$series_dates->{$date->{start}}=$date;
|
||||
#print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
|
||||
}
|
||||
}
|
||||
|
||||
#print STDERR Dumper($series_dates->{'2014-02-05 19:00:00'});
|
||||
|
||||
my $request={
|
||||
config => $config
|
||||
};
|
||||
|
||||
my $i=0;
|
||||
my $j=0;
|
||||
for my $date (keys %$series_dates){
|
||||
my $series_date=$series_dates->{$date};
|
||||
#insert date
|
||||
my $entry={
|
||||
project_id => $entry->{project_id},
|
||||
studio_id => $entry->{studio_id},
|
||||
series_id => $entry->{series_id},
|
||||
series_schedule_id => $series_date->{series_schedule_id},
|
||||
start => $series_date->{start},
|
||||
end => $series_date->{end},
|
||||
exclude => $series_date->{exclude},
|
||||
};
|
||||
if(studio_timeslot_dates::can_studio_edit_events($config, $entry)==1){ # by studio_id, start, end
|
||||
$entry->{start_date}= time::add_hours_to_datetime($entry->{start}, -$day_start);
|
||||
$entry->{end_date}= time::add_hours_to_datetime($entry->{end}, -$day_start);
|
||||
db::insert($dbh, 'calcms_series_dates', $entry);
|
||||
#print STDERR "$entry->{start_date}\n";
|
||||
$i++;
|
||||
}else{
|
||||
$j++;
|
||||
#print STDERR Dumper($entry);
|
||||
}
|
||||
}
|
||||
#print STDERR "$i series_dates updates\n";
|
||||
return $j." dates out of studio times, ".$i;
|
||||
}
|
||||
|
||||
sub get_schedule_dates{
|
||||
my $schedule=shift;
|
||||
my $options=shift;
|
||||
|
||||
my $is_exclude=$options->{exclude}||0;
|
||||
my $dates=[];
|
||||
return $dates if (($is_exclude eq'1') && ($schedule->{exclude}ne'1'));
|
||||
return $dates if (($is_exclude eq'0') && ($schedule->{exclude}eq'1'));
|
||||
|
||||
if ($schedule->{period_type}eq'single'){
|
||||
$dates=get_single_date($schedule->{start}, $schedule->{duration}) ;
|
||||
}elsif($schedule->{period_type}eq'days'){
|
||||
$dates=get_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{frequency}) ;
|
||||
}elsif($schedule->{period_type}eq'week_of_month'){
|
||||
$dates=get_week_of_month_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{week_of_month}, $schedule->{weekday}, $schedule->{month}, $schedule->{nextDay});
|
||||
}else{
|
||||
print STDERR "unknown schedule period_type\n";
|
||||
}
|
||||
|
||||
# set series schedule id
|
||||
for my $date (@$dates){
|
||||
$date->{series_schedule_id}=$schedule->{schedule_id};
|
||||
}
|
||||
return $dates;
|
||||
}
|
||||
|
||||
|
||||
sub get_week_of_month_dates{
|
||||
my $start =shift; # datetime string
|
||||
my $end =shift; # datetime string
|
||||
my $duration =shift; # in minutes
|
||||
my $week =shift; # every nth week of month
|
||||
my $weekday =shift; # weekday [1..7]
|
||||
my $frequency =shift; # every 1st,2nd,3th time
|
||||
my $nextDay =shift; # add 24 hours to start, (for night hours at last weekday of month)
|
||||
|
||||
return undef if $start eq'';
|
||||
return undef if $end eq'';
|
||||
return undef if $duration eq'';
|
||||
return undef if $week eq'';
|
||||
return undef if $weekday eq'';
|
||||
return undef if $frequency eq'';
|
||||
return undef if $frequency==0;
|
||||
|
||||
my $start_dates=time::get_nth_weekday_in_month($start, $end, $week, $weekday-1);
|
||||
|
||||
if ((defined $nextDay) && ($nextDay>0)){
|
||||
for (my $i=0;$i<@$start_dates;$i++){
|
||||
$start_dates->[$i]=time::add_hours_to_datetime($start_dates->[$i],24);
|
||||
}
|
||||
}
|
||||
|
||||
my $results=[];
|
||||
|
||||
my $c=-1;
|
||||
for my $start_datetime (@$start_dates){
|
||||
$c++;
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
next unless @start>=6;
|
||||
next if (($c % $frequency)!=0);
|
||||
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$start[0], $start[1], $start[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, $duration, 0 # delta days, hours, minutes, seconds
|
||||
);
|
||||
my $end_datetime=time::array_to_datetime(\@end_datetime);
|
||||
|
||||
push @$results, {
|
||||
start => $start_datetime,
|
||||
end => $end_datetime
|
||||
};
|
||||
}
|
||||
return $results;
|
||||
}
|
||||
|
||||
#add duration to a single date
|
||||
sub get_single_date{
|
||||
my $start_datetime = shift;
|
||||
my $duration = shift;
|
||||
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
return unless @start>=6;
|
||||
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$start[0], $start[1], $start[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, $duration, 0 # delta days, hours, minutes, seconds
|
||||
);
|
||||
my $date={
|
||||
start => $start_datetime,
|
||||
end => time::array_to_datetime(\@end_datetime)
|
||||
};
|
||||
return [$date];
|
||||
}
|
||||
|
||||
#calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days)
|
||||
sub get_dates{
|
||||
my $start_datetime = shift;
|
||||
my $end_date = shift;
|
||||
my $duration = shift; # in minutes
|
||||
my $frequency = shift; # in days
|
||||
#print "start_datetime:$start_datetime end_date:$end_date duration:$duration frequency:$frequency\n";
|
||||
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
return unless @start>=6;
|
||||
my @start_date = ($start[0], $start[1], $start[2]);
|
||||
my $start_time = sprintf('%02d:%02d:%02d', $start[3], $start[4], $start[5]);
|
||||
|
||||
#print STDERR "$start_datetime,$end_date,$duration,$frequency\n";
|
||||
|
||||
#return on single date
|
||||
my $date={};
|
||||
$date->{start}= sprintf("%04d-%02d-%02d",@start_date).' '.$start_time;
|
||||
return undef if $duration eq '';
|
||||
|
||||
return undef if (($frequency eq '')||($end_date eq''));
|
||||
|
||||
#continue on recurring date
|
||||
my @end = @{time::datetime_to_array($end_date)};
|
||||
return unless @end>=3;
|
||||
my @end_date = ($end[0], $end[1], $end[2]);
|
||||
|
||||
my $today=time::time_to_date();
|
||||
my ($year, $month, $day)=split(/\-/,$today);
|
||||
|
||||
my $dates=[];
|
||||
return $dates if ($end_date lt $today);
|
||||
return $dates if ($frequency<1);
|
||||
|
||||
my $j = Date::Calc::Delta_Days(@start_date, @end_date);
|
||||
my $c=0;
|
||||
for (my $i = 0; $i <= $j; $i+=$frequency ){
|
||||
my @date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
|
||||
my $date={};
|
||||
$date->{start}=sprintf("%04d-%02d-%02d",@date).' '.$start_time;
|
||||
|
||||
#if($date->{start} gt $today){
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$date[0], $date[1], $date[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, $duration, 0 # delta days, hours, minutes, seconds
|
||||
);
|
||||
$date->{end}=time::array_to_datetime(\@end_datetime);
|
||||
push @$dates,$date;
|
||||
#}
|
||||
last if ($c>200);
|
||||
$c++;
|
||||
}
|
||||
return $dates;
|
||||
}
|
||||
|
||||
#remove all series_dates for studio_id and series_id
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless defined $entry->{project_id};
|
||||
return unless defined $entry->{studio_id};
|
||||
return unless defined $entry->{series_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_series_dates
|
||||
where project_id=? and studio_id=? and series_id=?
|
||||
};
|
||||
my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
467
lib/calcms/series_events.pm
Normal file
467
lib/calcms/series_events.pm
Normal file
@@ -0,0 +1,467 @@
|
||||
package series_events;
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use markup;
|
||||
|
||||
use db;
|
||||
use log;
|
||||
use time;
|
||||
use uac;
|
||||
use events;
|
||||
use series;
|
||||
use series_dates;
|
||||
use studios;
|
||||
use studio_timeslot_dates;
|
||||
use event_history;
|
||||
|
||||
# check permissions, insert and update events related to series
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
check_permission
|
||||
save_content
|
||||
save_event_time
|
||||
insert_event
|
||||
delete_event
|
||||
set_playout_status
|
||||
);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
# update main fields of the event by id
|
||||
# do not check for project,studio,series
|
||||
# all changed columns are returned for history handling
|
||||
sub save_content{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
return undef unless(defined $entry->{id});
|
||||
|
||||
for my $attr (keys %$entry){
|
||||
$entry->{$attr}=~s/^\s+//g;
|
||||
$entry->{$attr}=~s/\s+$//g;
|
||||
}
|
||||
|
||||
#print STDERR Dumper(\$entry->{content});
|
||||
for my $attr ('content', 'topic'){
|
||||
if (defined $entry->{$attr}){
|
||||
$entry->{'html_'.$attr}=markup::creole_to_html($entry->{$attr});
|
||||
#$entry->{'html_'.$attr}=~s/([^\>])\n+([^\<])/$1<br\/><br\/>$2/g;
|
||||
#$entry->{'html_'.$attr}=~s/^\s*(<p>)?//g;
|
||||
#$entry->{'html_'.$attr}=~s/(<\/p>)?\s*$//g;
|
||||
}
|
||||
}
|
||||
|
||||
#print STDERR Dumper(\$entry->{html_content});
|
||||
#print STDERR "ok2\n";
|
||||
#return;
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
#return;
|
||||
#update only existing atributes
|
||||
|
||||
#TODO: double check series_name (needed for reassignment but not for editing...)
|
||||
my @keys=();
|
||||
for my $key ('series_name', 'title', 'excerpt', 'content', 'html_content',
|
||||
'user_title', 'user_excerpt', 'topic', 'html_topic',
|
||||
'episode', 'image', 'podcast_url', 'archive_url',
|
||||
'live', 'published', 'playout', 'archived', 'rerun', 'disable_event_sync',
|
||||
'modified_by'
|
||||
){
|
||||
push @keys, $key if defined $entry->{$key};
|
||||
}
|
||||
$entry->{episode}=undef if((defined $entry->{episode}) && ($entry->{episode}eq'0'));
|
||||
|
||||
my $values =join(",", map {$_.'=?'} (@keys));
|
||||
my @bind_values =map {$entry->{$_}} (@keys);
|
||||
|
||||
push @bind_values,$entry->{id};
|
||||
my $query=qq{
|
||||
update calcms_events
|
||||
set $values
|
||||
where id=?
|
||||
};
|
||||
|
||||
#print STDERR $query.Dumper(\@bind_values);
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
return $entry;
|
||||
}
|
||||
|
||||
# save event time by id
|
||||
# do not check project, studio, series
|
||||
# for history handling all changed columns are returned
|
||||
sub save_event_time{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless(defined $entry->{id});
|
||||
return undef unless(defined $entry->{duration});
|
||||
return undef unless(defined $entry->{start_date});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $event={
|
||||
id => $entry->{id},
|
||||
start => $entry->{start_date},
|
||||
end => time::add_minutes_to_datetime($entry->{start_date}, $entry->{duration})
|
||||
};
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
my $event_hour=int((split(/[\-\:\sT]/,$event->{start}))[3]);
|
||||
|
||||
my @update_columns=();
|
||||
my $bind_values=[];
|
||||
push @update_columns,'start=?';
|
||||
push @$bind_values,$event->{start};
|
||||
|
||||
push @update_columns, 'end=?';
|
||||
push @$bind_values, $event->{end};
|
||||
|
||||
# add start date
|
||||
my $start_date= time::add_hours_to_datetime($event->{start}, -$day_start);
|
||||
push @update_columns, 'start_date=?';
|
||||
push @$bind_values, $start_date;
|
||||
$event->{start_date} =$start_date;
|
||||
|
||||
# add end date
|
||||
my $end_date= time::add_hours_to_datetime($event->{end}, -$day_start);
|
||||
push @update_columns, 'end_date=?';
|
||||
push @$bind_values, $end_date;
|
||||
$event->{end_date} = $end_date;
|
||||
|
||||
my $update_columns=join(",\n", @update_columns);
|
||||
my $update_sql=qq{
|
||||
update calcms_events
|
||||
set $update_columns
|
||||
where id=?
|
||||
};
|
||||
push @$bind_values, $event->{id};
|
||||
#print STDERR $update_sql."\n".Dumper($bind_values)."\n";
|
||||
db::put($dbh, $update_sql, $bind_values);
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub set_playout_status{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{start};
|
||||
return undef unless defined $entry->{playout};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
# check if event is assigned to project and studio
|
||||
my $sql=qq{
|
||||
select se.event_id event_id
|
||||
from calcms_series_events se, calcms_events e
|
||||
where
|
||||
se.event_id=e.id
|
||||
and e.start=?
|
||||
and se.project_id=?
|
||||
and se.studio_id=?
|
||||
};
|
||||
my $bind_values=[$entry->{start}, $entry->{project_id}, $entry->{studio_id}];
|
||||
#print STDERR Dumper($sql).Dumper($bind_values);
|
||||
my $events=db::get($dbh, $sql, $bind_values);
|
||||
#print STDERR Dumper($events);
|
||||
return undef if scalar(@$events)!=1;
|
||||
my $event_id=$events->[0]->{event_id};
|
||||
$sql=qq{
|
||||
update calcms_events
|
||||
set playout=?
|
||||
where id=?
|
||||
and start=?
|
||||
};
|
||||
$bind_values=[$entry->{playout}, $event_id, $entry->{start}];
|
||||
#print STDERR $sql."\n".Dumper($bind_values)."\n";
|
||||
my $result=db::put($dbh, $sql, $bind_values);
|
||||
return $result;
|
||||
}
|
||||
|
||||
# is event assigned to project, studio and series?
|
||||
sub is_event_assigned{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return 0 unless defined $entry->{project_id};
|
||||
return 0 unless defined $entry->{studio_id};
|
||||
return 0 unless defined $entry->{series_id};
|
||||
return 0 unless defined $entry->{event_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $sql=q{
|
||||
select * from calcms_series_events
|
||||
where project_id=? and studio_id=? and series_id=? and event_id=?
|
||||
};
|
||||
my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{event_id}];
|
||||
my $results=db::get($dbh, $sql, $bind_values);
|
||||
|
||||
return 1 if @$results>=1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub delete_event{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{series_id};
|
||||
return undef unless defined $entry->{event_id};
|
||||
return undef unless defined $entry->{user};
|
||||
|
||||
#is event assigned to project, studio and series?
|
||||
unless(is_event_assigned($config, $entry)==1){
|
||||
print STDERR "cannot delete event with project_id=$entry->{project_id}, studio_id=$entry->{studio_id}, series_id=$entry->{series_id}, event_id=$entry->{event_id}";
|
||||
return 0;
|
||||
}
|
||||
|
||||
event_history::insert_by_event_id($config, $entry);
|
||||
|
||||
#delete the association
|
||||
series::unassign_event($config, $entry);
|
||||
|
||||
# delete the event
|
||||
my $dbh=db::connect($config);
|
||||
my $sql=q{
|
||||
delete from calcms_events
|
||||
where id=?
|
||||
};
|
||||
my $bind_values=[$entry->{event_id}];
|
||||
db::put($dbh, $sql, $bind_values);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
#check permissions
|
||||
# options: conditions (studio_id, series_id,...)
|
||||
# key permission: permissions to be checked (one of)
|
||||
# key check_for: user, studio, series, events, schedule
|
||||
# return error text or 1 if okay
|
||||
sub check_permission{
|
||||
my $request=shift;
|
||||
my $options=shift;
|
||||
|
||||
return "missing permission at check" unless defined $options->{permission};
|
||||
return "missing check_for at check" unless defined $options->{check_for};
|
||||
return "missing user at check" unless defined $request->{user};
|
||||
return "missing project_id at check" unless defined $options->{project_id};
|
||||
return "missing studio_id at check" unless defined $options->{studio_id};
|
||||
return "missing series_id at check" unless defined $options->{series_id};
|
||||
|
||||
my $permissions = $request->{permissions};
|
||||
my $config = $request->{config};
|
||||
|
||||
my $studio_check=studios::check($config, $options);
|
||||
return $studio_check if($studio_check ne '1');
|
||||
print STDERR "check studio ok\n";
|
||||
|
||||
my $project_check=project::check($config, $options);
|
||||
return $project_check if($project_check ne '1');
|
||||
print STDERR "check project ok\n";
|
||||
|
||||
#check if permissions are set (like create_event)
|
||||
my $found=0;
|
||||
for my $permission (split /\,/,$options->{permission}){
|
||||
$found=1 if ((defined $permissions->{$permission})&&($permissions->{$permission})eq'1');
|
||||
}
|
||||
return 'missing permission to '.$options->{permission} if $found==0;
|
||||
delete $options->{permission};
|
||||
|
||||
#convert check list to hash
|
||||
my $check={};
|
||||
for my $permission (@{$options->{check_for}}){
|
||||
$check->{$permission}=1;
|
||||
}
|
||||
delete $options->{check_for};
|
||||
|
||||
# is project assigned to studio
|
||||
return "studio is not assigned to project" unless project::is_studio_assigned($config, $options)==1;
|
||||
|
||||
#get studio names
|
||||
my $studios=studios::get($config, {
|
||||
project_id => $options->{project_id},
|
||||
studio_id => $options->{studio_id}
|
||||
});
|
||||
return "unknown studio" unless defined $studios;
|
||||
return "unknown studio" unless (@$studios==1);
|
||||
my $studio=$studios->[0];
|
||||
my $studio_name=$studio->{name}||'';
|
||||
|
||||
#get series names
|
||||
my $series=series::get($config, {
|
||||
project_id => $options->{project_id},
|
||||
studio_id => $options->{studio_id},
|
||||
series_id => $options->{series_id}
|
||||
});
|
||||
my $series_name=$series->[0]->{series_name}||'';
|
||||
$series_name.=' - '.$series->[0]->{title} if $series->[0]->{series_name} ne '';
|
||||
|
||||
#check all items from checklist
|
||||
if((defined $check->{user})&&(uac::is_user_assigned_to_studio($request, $options)==0)){
|
||||
return "User '$request->{user}' is not assigned to studio $studio_name ($options->{studio_id})";
|
||||
}
|
||||
|
||||
if((defined $check->{studio})&&(project::is_series_assigned($config, $options)==0)){
|
||||
return "Series '$series_name' ($options->{series_id}) is not assigned to studio '$studio_name' ($options->{studio_id})";
|
||||
}
|
||||
|
||||
# check series and can user update events
|
||||
if((defined $check->{series})&&(series::can_user_update_events($request, $options)==0)){
|
||||
return "unknown series" unless defined $series;
|
||||
return "User $request->{user} cannot update events for series '$series_name' ($options->{series_id})";
|
||||
}
|
||||
|
||||
# check series and can user create events
|
||||
if((defined $check->{create_events})&&(series::can_user_create_events($request, $options)==0)){
|
||||
return "unknown series" unless defined $series;
|
||||
return "User $request->{user} cannot create events for series '$series_name' ($options->{series_id})";
|
||||
}
|
||||
|
||||
if((defined $check->{studio_timeslots})&&(studio_timeslot_dates::can_studio_edit_events($config, $options)==0)){
|
||||
return "requested time is not assigned to studio '$studio_name' ($options->{studio_id})";
|
||||
}
|
||||
|
||||
#check if event is assigned to user,project,studio,series,location
|
||||
if(defined $check->{events}){
|
||||
return "missing event_id" unless defined $options->{event_id};
|
||||
my $result=series::is_event_assigned_to_user($request, $options);
|
||||
return $result if $result ne '1';
|
||||
}
|
||||
|
||||
# prevent editing events that are over for more than 14 days
|
||||
if(defined $check->{event_age}){
|
||||
if (series::is_event_older_than_days($config, {
|
||||
project_id => $options->{project_id},
|
||||
studio_id => $options->{studio_id},
|
||||
series_id => $options->{series_id},
|
||||
event_id => $options->{event_id},
|
||||
max_age => 14
|
||||
})==1){
|
||||
return "show is over for more than 2 weeks" unless(
|
||||
(defined $permissions->{update_event_after_week})
|
||||
&& ($permissions->{update_event_after_week} eq '1')
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
#check if schedule event exists for given date
|
||||
if(defined $check->{schedule}){
|
||||
return "unknown series" unless defined $series;
|
||||
return "missing start_at at check_permission" unless defined $options->{start_date};
|
||||
#TODO: check "is_event_scheduled" if start_at could be moved to start_date
|
||||
$options->{start_at}=$options->{start_date};
|
||||
return "No event scheduled for series '$series_name' ($options->{series_id})" if(series_dates::is_event_scheduled($request, $options)==0);
|
||||
}
|
||||
|
||||
return '1';
|
||||
}
|
||||
|
||||
#not handled, yet:
|
||||
# responsible, status, rating, podcast_url, media_url, visible, time_of_day, recurrence, reference, created_at
|
||||
# category, time_of_day,
|
||||
|
||||
#insert event
|
||||
sub insert_event{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
my $project_id = $options->{project_id};
|
||||
my $studio = $options->{studio};
|
||||
my $serie = $options->{serie};
|
||||
my $params = $options->{event};
|
||||
my $user = $options->{user};
|
||||
|
||||
return 0 unless defined $studio;
|
||||
return 0 unless defined $serie;
|
||||
return 0 unless defined $params;
|
||||
return 0 unless defined $user;
|
||||
return 0 unless defined $studio->{location};
|
||||
|
||||
my $projects=project::get($config, {project_id=>$project_id});
|
||||
if(@$projects==0){
|
||||
print STDERR "project not found at insert event\n";
|
||||
return 0;
|
||||
}
|
||||
my $projectName=$projects->[0]->{name};
|
||||
my $event={
|
||||
project => $projectName,
|
||||
location => $studio->{location}, # location from studio
|
||||
};
|
||||
#print '<pre>';
|
||||
$event=series_events::add_event_dates($config, $event, $params);
|
||||
|
||||
#get event content from series
|
||||
for my $attr ('program', 'series_name', 'title', 'excerpt', 'content', 'topic', 'image', 'episode', 'podcast_url', 'archive_url'){
|
||||
$event->{$attr}=$serie->{$attr} if defined $serie->{$attr};
|
||||
}
|
||||
|
||||
#overwrite series values from parameters
|
||||
for my $attr ('program', 'series_name', 'title', 'user_title', 'excerpt', 'user_except', 'content', 'topic', 'image', 'episode', 'podcast_url', 'archive_url'){
|
||||
$event->{$attr}=$params->{$attr} if defined $params->{$attr};
|
||||
}
|
||||
$event->{'html_content'} = markup::creole_to_html($event->{'content'}) if defined $event->{'content'};
|
||||
$event->{'html_topic'} = markup::creole_to_html($event->{'topic'}) if defined $event->{'topic'};
|
||||
|
||||
#add event status
|
||||
for my $attr ('live', 'published', 'playout', 'archived', 'rerun', 'disable_event_sync'){
|
||||
$event->{$attr}=$params->{$attr}||0;
|
||||
}
|
||||
|
||||
if($serie->{has_single_events}eq'1'){
|
||||
delete $event->{series_name};
|
||||
delete $event->{episode};
|
||||
}
|
||||
|
||||
$event->{modified_at} = time::time_to_datetime(time());
|
||||
$event->{created_at} = time::time_to_datetime(time());
|
||||
$event->{modified_by} = $user;
|
||||
|
||||
#print STDERR Dumper($event);
|
||||
my $dbh=db::connect($config);
|
||||
my $event_id= db::insert($dbh, 'calcms_events', $event);
|
||||
|
||||
#add to history
|
||||
$event->{project_id}= $project_id;
|
||||
$event->{studio_id} = $studio->{id};
|
||||
$event->{series_id} = $serie->{series_id};
|
||||
$event->{event_id} = $event_id;
|
||||
event_history::insert($config, $event);
|
||||
return $event_id;
|
||||
}
|
||||
|
||||
|
||||
#set start, end, start-date, end_date to an event
|
||||
sub add_event_dates{
|
||||
my $config =shift;
|
||||
my $event =shift;
|
||||
my $params =shift;
|
||||
|
||||
#start and end datetime
|
||||
$event->{start} = $params->{start_date};
|
||||
$event->{end} = time::add_minutes_to_datetime($params->{start_date}, $params->{duration});
|
||||
|
||||
#set program days
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
$event->{start_date} = time::date_cond(time::add_hours_to_datetime($event->{start}, -$day_start));
|
||||
$event->{end_date} = time::date_cond(time::add_hours_to_datetime($event->{end}, -$day_start));
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
183
lib/calcms/series_schedule.pm
Normal file
183
lib/calcms/series_schedule.pm
Normal file
@@ -0,0 +1,183 @@
|
||||
package series_schedule;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use series_dates;
|
||||
|
||||
# table: calcms_series_schedule
|
||||
# columns: id, studio_id, series_id,
|
||||
# start (datetime),
|
||||
# duration (minutes),
|
||||
# frequency (days),
|
||||
# end (date),
|
||||
# weekday (1..7)
|
||||
# week_of_month (1..5)
|
||||
# month
|
||||
# nextDay (add 24 hours to start)
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get insert update delete);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_series_schedule');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
#map schedule id to id
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
|
||||
push @conditions, 'series_id=?';
|
||||
push @bind_values, $condition->{series_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_ids}) && (ref($condition->{schedule_ids}) eq 'ARRAY')){
|
||||
my @scheduleIds = @{$condition->{schedule_ids}};
|
||||
push @conditions, 'id in ('.(join(',', (map {'?'} @scheduleIds) )).')';
|
||||
for my $id (@scheduleIds){
|
||||
push @bind_values, $id;
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{start}) && ($condition->{start} ne '')){
|
||||
push @conditions, 'start=?';
|
||||
push @bind_values, $condition->{start};
|
||||
}
|
||||
|
||||
if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
|
||||
push @conditions, 'exclude=?';
|
||||
push @bind_values, $condition->{exclude};
|
||||
}
|
||||
|
||||
if ((defined $condition->{period_type}) && ($condition->{period_type} ne '')){
|
||||
push @conditions, 'period_type=?';
|
||||
push @bind_values, $condition->{period_type};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_series_schedule
|
||||
$conditions
|
||||
order by exclude, start
|
||||
};
|
||||
#print STDERR $query."\n".Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
for my $entry (@$entries){
|
||||
$entry->{schedule_id}=$entry->{id};
|
||||
delete $entry->{id};
|
||||
}
|
||||
#print STDERR Dumper($entries);
|
||||
return $entries;
|
||||
}
|
||||
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{series_id};
|
||||
return undef unless defined $entry->{start};
|
||||
my $dbh=db::connect($config);
|
||||
return db::insert($dbh, 'calcms_series_schedule', $entry);
|
||||
}
|
||||
|
||||
#schedule id to id
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{series_id};
|
||||
return undef unless defined $entry->{schedule_id};
|
||||
return undef unless defined $entry->{start};
|
||||
$entry->{nextDay}=0 unless defined $entry->{nextDay};
|
||||
|
||||
$entry->{id}=$entry->{schedule_id};
|
||||
delete $entry->{schedule_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
|
||||
push @bind_values,$entry->{project_id};
|
||||
push @bind_values,$entry->{studio_id};
|
||||
push @bind_values,$entry->{id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_series_schedule
|
||||
set $values
|
||||
where project_id=? and studio_id=? and id=?
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
print "done\n";
|
||||
}
|
||||
|
||||
#map schedule id to id
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{series_id};
|
||||
return undef unless defined $entry->{schedule_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_series_schedule
|
||||
where project_id=? and studio_id=? and series_id=? and id=?
|
||||
};
|
||||
my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{series_id}, $entry->{schedule_id}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
32
lib/calcms/startup.pl
Normal file
32
lib/calcms/startup.pl
Normal file
@@ -0,0 +1,32 @@
|
||||
use lib qw(/home/calcms/lib/calcms/);
|
||||
|
||||
return 1;
|
||||
#use B::TerseSize
|
||||
|
||||
#load mod_perl modules
|
||||
#use Apache2;
|
||||
#use ModPerl::RegistryPrefork;
|
||||
#use Apache::compat;
|
||||
|
||||
#on upload CGI open of tmpfile: Permission denied
|
||||
#use CGI;
|
||||
|
||||
#load common used modules
|
||||
#use Data::Dumper;
|
||||
#use DBI;
|
||||
use Apache::DBI;
|
||||
#$Apache::DBI::DEBUG = 2;
|
||||
|
||||
use Time::Local;
|
||||
use Date::Calc;
|
||||
use Calendar::Simple qw(date_span);
|
||||
|
||||
use config;
|
||||
use log;
|
||||
use time;
|
||||
use db;
|
||||
use cache;
|
||||
use template;
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
434
lib/calcms/studio_timeslot_dates.pm
Normal file
434
lib/calcms/studio_timeslot_dates.pm
Normal file
@@ -0,0 +1,434 @@
|
||||
package studio_timeslot_dates;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use time;
|
||||
|
||||
# schedule dates for calcms_studio_schedule
|
||||
# table: calcms_studio_timeslot_dates
|
||||
# columns: id, studio_id, start(datetime), end(datetime)
|
||||
# TODO: delete column schedule_id
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get insert update delete get_dates);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_studio_timeslot_dates');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
# get all studio_timeslot_dates for studio_id within given time range
|
||||
# calculate start_date, end_date, weeday, day from start and end(datetime)
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $date_range_include=0;
|
||||
$date_range_include=1 if $condition->{date_range_include}==1;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'schedule_id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
# from and till range from an event should beween start and end of the studio's permission
|
||||
if ((defined $condition->{start}) && ($condition->{start} ne '')){
|
||||
push @conditions, 'start<=?';
|
||||
push @bind_values, $condition->{start};
|
||||
}
|
||||
|
||||
if ((defined $condition->{end}) && ($condition->{end} ne '')){
|
||||
push @conditions, 'end>=?';
|
||||
push @bind_values, $condition->{end};
|
||||
}
|
||||
|
||||
# check only a given date date range (without time)
|
||||
if ((defined $condition->{from}) && ($condition->{from} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'end_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}else{
|
||||
push @conditions, 'start_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{till}) && ($condition->{till} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'start_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}else{
|
||||
push @conditions, 'end_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select date(start) start_date
|
||||
,date(end) end_date
|
||||
,dayname(start) start_weekday
|
||||
,dayname(end) end_weekday
|
||||
,start_date day
|
||||
,start
|
||||
,end
|
||||
,schedule_id
|
||||
,studio_id
|
||||
|
||||
from calcms_studio_timeslot_dates
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
#print STDERR $query."\n";
|
||||
#print STDERR Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
for my $entry (@$entries){
|
||||
$entry->{start_weekday}=substr($entry->{start_weekday},0,2);
|
||||
$entry->{end_weekday}=substr($entry->{end_weekday},0,2);
|
||||
}
|
||||
#print STDERR Dumper($entries);
|
||||
return $entries;
|
||||
}
|
||||
|
||||
|
||||
|
||||
#get all studio_timeslot_schedules for studio_id and update studio_timeslot_dates
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless(defined $entry->{schedule_id});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
#delete all dates for schedule id
|
||||
studio_timeslot_dates::delete($config, $entry);
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
|
||||
#get the schedule with schedule id ordered by date
|
||||
my $schedules=studio_timeslot_schedule::get($config, {
|
||||
schedule_id => $entry->{schedule_id}
|
||||
});
|
||||
#add scheduled dates
|
||||
my $i=0;
|
||||
my $dates={};
|
||||
for my $schedule (@$schedules){
|
||||
#calculate dates from start to end_date
|
||||
my $dateList=get_dates($schedule->{start}, $schedule->{end}, $schedule->{end_date}, $schedule->{frequency});
|
||||
#print STDERR Dumper($dateList);
|
||||
for my $date (@$dateList){
|
||||
#set studio i from
|
||||
$date->{project_id} = $schedule->{project_id};
|
||||
$date->{studio_id} = $schedule->{studio_id};
|
||||
$date->{schedule_id} = $schedule->{schedule_id};
|
||||
$dates->{$date->{start}.$date->{studio_id}}=$date;
|
||||
}
|
||||
}
|
||||
|
||||
for my $date (keys %$dates){
|
||||
my $timeslot_date=$dates->{$date};
|
||||
#insert date
|
||||
my $entry={
|
||||
project_id => $timeslot_date->{project_id},
|
||||
studio_id => $timeslot_date->{studio_id},
|
||||
schedule_id => $timeslot_date->{schedule_id},
|
||||
start => $timeslot_date->{start},
|
||||
end => $timeslot_date->{end},
|
||||
};
|
||||
$entry->{start_date}= time::add_hours_to_datetime($entry->{start}, -$day_start);
|
||||
$entry->{end_date}= time::add_hours_to_datetime($entry->{end}, -$day_start);
|
||||
db::insert($dbh, 'calcms_studio_timeslot_dates', $entry);
|
||||
#print STDERR "$entry->{start_date}\n";
|
||||
$i++;
|
||||
}
|
||||
#print STDERR "$i studio_timeslot_dates updates\n";
|
||||
return $i;
|
||||
}
|
||||
|
||||
# calculate all start/end datetimes between start_date and stop_date with a frequency(days)
|
||||
# returns list of hashs with start and end
|
||||
sub get_dates{
|
||||
my $start_datetime = shift; # start
|
||||
my $end_datetime = shift; # start
|
||||
my $stop_date = shift; # limit recurring events
|
||||
my $frequency = shift; # in days
|
||||
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
return unless @start>=6;
|
||||
my @start_date = ($start[0], $start[1], $start[2]);
|
||||
my $start_date = sprintf("%04d-%02d-%02d",@start_date);
|
||||
my $start_time = sprintf('%02d:%02d:%02d', $start[3], $start[4], $start[5]);
|
||||
|
||||
my @end = @{time::datetime_to_array($end_datetime)};
|
||||
return unless @end>=6;
|
||||
my @end_date = ($end[0], $end[1], $end[2]);
|
||||
my $end_date = sprintf("%04d-%02d-%02d",@end_date);
|
||||
my $end_time = sprintf('%02d:%02d:%02d', $end[3], $end[4], $end[5]);
|
||||
|
||||
my @stop = @{time::date_to_array($stop_date)};
|
||||
return unless @end>=3;
|
||||
my @stop_date = ($stop[0], $stop[1], $stop[2]);
|
||||
$stop_date = sprintf("%04d-%02d-%02d",@stop_date);
|
||||
|
||||
my $date={};
|
||||
$date->{start}= $start_date.' '.$start_time;
|
||||
$date->{end} = $end_date.' '.$end_time;
|
||||
|
||||
my $dates=[];
|
||||
return $dates if ($date->{end} le $date->{start});
|
||||
|
||||
return $dates if ($stop_date lt $end_date);
|
||||
|
||||
my $j = Date::Calc::Delta_Days(@start_date, @stop_date);
|
||||
return $dates if $j<0;
|
||||
|
||||
# split full time events into single days
|
||||
if($frequency<1){
|
||||
#start day
|
||||
my @next_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], 1);
|
||||
my $next_date = sprintf("%04d-%02d-%02d",@next_date);
|
||||
push @$dates,{
|
||||
start => $start_date.' '.$start_time,
|
||||
end => $next_date .' 00:00:00',
|
||||
};
|
||||
my $c=0;
|
||||
for (my $i = 1; $i < $j; $i++){
|
||||
my @start_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
|
||||
my $start_date = sprintf("%04d-%02d-%02d",@start_date);
|
||||
my @next_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i+1);
|
||||
my $next_date = sprintf("%04d-%02d-%02d",@next_date);
|
||||
push @$dates,{
|
||||
start => $start_date.' 00:00:00',
|
||||
end => $next_date.' 00:00:00',
|
||||
};
|
||||
last if ($c>1000);
|
||||
$c++;
|
||||
}
|
||||
#end day
|
||||
push @$dates,{
|
||||
start => $end_date.' 00:00:00',
|
||||
end => $end_date.' '.$end_time,
|
||||
} if($end_time ne '00:00:00');
|
||||
return $dates;
|
||||
}
|
||||
|
||||
# multiple time events
|
||||
my $c=0;
|
||||
for (my $i = 0; $i <= $j; $i+=$frequency ){
|
||||
#add frequency to start and end date
|
||||
my @start_date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
|
||||
my @end_date = Date::Calc::Add_Delta_Days($end[0], $end[1], $end[2], $i);
|
||||
#print STDERR Dumper(\@start_date);
|
||||
#print STDERR Dumper(\@end_date);
|
||||
my $start_date=sprintf("%04d-%02d-%02d",@start_date);
|
||||
my $end_date =sprintf("%04d-%02d-%02d",@end_date);
|
||||
push @$dates,{
|
||||
start => $start_date.' '.$start_time,
|
||||
end => $end_date.' '.$end_time,
|
||||
};
|
||||
last if ($c>1000);
|
||||
$c++;
|
||||
}
|
||||
return $dates;
|
||||
}
|
||||
|
||||
#remove all studio_timeslot_dates for studio_id and schedule_id
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
#print STDERR "delete:".Dumper($entry);
|
||||
return unless(defined $entry->{project_id});
|
||||
return unless(defined $entry->{studio_id});
|
||||
return unless(defined $entry->{schedule_id});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_studio_timeslot_dates
|
||||
where schedule_id=?
|
||||
};
|
||||
my $bind_values=[$entry->{schedule_id}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
# time based filter to check if studio is assigned to an studio at a given time range
|
||||
# return 1 if there is a schedule date starting before start and ending after end
|
||||
sub can_studio_edit_events{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
#print Dumper($condition);
|
||||
|
||||
#return 0 unless defined $condition->{project_id};
|
||||
return 0 unless defined $condition->{studio_id};
|
||||
return 0 unless defined $condition->{start};
|
||||
return 0 unless defined $condition->{end};
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{start}) && ($condition->{start} ne '')){
|
||||
push @conditions, 'start<=?';
|
||||
push @bind_values, $condition->{start};
|
||||
}
|
||||
|
||||
if ((defined $condition->{end}) && ($condition->{end} ne '')){
|
||||
push @conditions, 'end>=?';
|
||||
push @bind_values, $condition->{end};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $query=qq{
|
||||
select count(*) permission
|
||||
from calcms_studio_timeslot_dates
|
||||
$conditions
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
#print STDERR Dumper($entries);
|
||||
return 0 if scalar(@$entries) == 0;
|
||||
return 1 if $entries->[0]->{permission}>0;
|
||||
|
||||
if ($entries->[0]->{permission}==0){
|
||||
my $timeslot=getMergedDays($config, $condition);
|
||||
return 0 unless defined $timeslot;
|
||||
if (
|
||||
($condition->{start} ge $timeslot->{start})
|
||||
&& ($condition->{end} le $timeslot->{end})
|
||||
){
|
||||
#print STDERR "($condition->{start} ge $timeslot->{start}) ".($condition->{start} ge $timeslot->{start});
|
||||
#print STDERR "($condition->{end} le $timeslot->{end}) ".($condition->{end} le $timeslot->{end});
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# merge two subsequent days if first day ends at same time as next day starts
|
||||
# returns hashref with start and end of merged slot
|
||||
# returns undef if not slot could be found
|
||||
sub getMergedDays{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
#print Dumper($condition);
|
||||
|
||||
#return 0 unless defined $condition->{project_id};
|
||||
return 0 unless defined $condition->{studio_id};
|
||||
return 0 unless defined $condition->{start};
|
||||
return 0 unless defined $condition->{end};
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
# set start to next day at 00:00
|
||||
my $start=undef;
|
||||
if ($condition->{start}=~/(\d\d\d\d\-\d\d\-\d\d)/){
|
||||
$start=$1.' 00:00';
|
||||
$start=time::add_days_to_datetime($start, 1);
|
||||
push @bind_values, $start;
|
||||
}
|
||||
|
||||
# set end to end days at 00:00
|
||||
my $end=undef;
|
||||
if ($condition->{end}=~/(\d\d\d\d\-\d\d\-\d\d)/){
|
||||
$end=$1.' 00:00';
|
||||
push @bind_values, $end;
|
||||
}
|
||||
return undef unless defined $start;
|
||||
return undef unless defined $end;
|
||||
|
||||
push @conditions, '(start=? or end=?)';
|
||||
|
||||
my $conditions='';
|
||||
$conditions='where '.join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
# get all days starting on first day or ending at next day
|
||||
my $dbh=db::connect($config);
|
||||
my $query=qq{
|
||||
select start, end
|
||||
from calcms_studio_timeslot_dates
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
# print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
# print STDERR Dumper($entries);
|
||||
|
||||
if (scalar(@$entries)==2){
|
||||
if ($entries->[0]->{end} eq $entries->[1]->{start}){
|
||||
$entries={
|
||||
start => $entries->[0]->{start},
|
||||
end => $entries->[1]->{end}
|
||||
};
|
||||
# print STDERR "found".Dumper($entries)."\n";
|
||||
return $entries;
|
||||
}
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
144
lib/calcms/studio_timeslot_schedule.pm
Normal file
144
lib/calcms/studio_timeslot_schedule.pm
Normal file
@@ -0,0 +1,144 @@
|
||||
package studio_timeslot_schedule;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use studio_timeslot_dates;
|
||||
|
||||
# table: calcms_studio_timeslot_schedule
|
||||
# columns: id, project_id, studio_id, start(datetime), end(datetime), end_date(date),
|
||||
# frequency(days), duration(minutes), create_events(days), publish_events(days)
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get insert update delete);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_studio_timeslot_schedule');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
#map schedule id to id
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_studio_timeslot_schedule
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
#print $query."\n";
|
||||
#print Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
for my $entry (@$entries){
|
||||
$entry->{schedule_id}=$entry->{id};
|
||||
delete $entry->{id};
|
||||
}
|
||||
return $entries;
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless(defined $entry->{project_id});
|
||||
return unless(defined $entry->{studio_id});
|
||||
return unless(defined $entry->{start});
|
||||
return unless(defined $entry->{end});
|
||||
return unless(defined $entry->{frequency});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
return db::insert($dbh, 'calcms_studio_timeslot_schedule', $entry);
|
||||
}
|
||||
|
||||
#schedule id to id
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless(defined $entry->{project_id});
|
||||
return unless(defined $entry->{studio_id});
|
||||
return unless(defined $entry->{schedule_id});
|
||||
return unless(defined $entry->{start});
|
||||
return unless(defined $entry->{end});
|
||||
return unless(defined $entry->{frequency});
|
||||
|
||||
$entry->{id}=$entry->{schedule_id};
|
||||
delete $entry->{schedule_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
push @bind_values,$entry->{id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_studio_timeslot_schedule
|
||||
set $values
|
||||
where id=?
|
||||
};
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
#print "done\n";
|
||||
|
||||
$entry->{schedule_id}=$entry->{id};
|
||||
delete $entry->{id};
|
||||
|
||||
}
|
||||
|
||||
#map schedule id to id
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless(defined $entry->{schedule_id});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_studio_timeslot_schedule
|
||||
where id=?
|
||||
};
|
||||
my $bind_values=[$entry->{schedule_id}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
158
lib/calcms/studios.pm
Normal file
158
lib/calcms/studios.pm
Normal file
@@ -0,0 +1,158 @@
|
||||
#!/bin/perl
|
||||
|
||||
use CGI;
|
||||
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
|
||||
use CGI::Session qw(-ip-match);
|
||||
use CGI::Cookie;
|
||||
#$CGI::Session::IP_MATCH=1;
|
||||
|
||||
package studios;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get get_by_id insert update delete check check_studio);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_studios');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift||{};
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 's.id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{name}) && ($condition->{name} ne '')){
|
||||
push @conditions, 's.name=?';
|
||||
push @bind_values, $condition->{name};
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $query='';
|
||||
unless ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
$query=qq{
|
||||
select *
|
||||
from calcms_studios s
|
||||
$conditions
|
||||
$limit
|
||||
};
|
||||
}else{
|
||||
push @conditions, 's.id=ps.studio_id';
|
||||
|
||||
push @conditions, 'ps.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
my $conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
$query=qq{
|
||||
select *
|
||||
from calcms_studios s, calcms_project_studios ps
|
||||
$conditions
|
||||
$limit
|
||||
};
|
||||
}
|
||||
my $dbh=db::connect($config);
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
my $studios=db::get($dbh, $query,\@bind_values);
|
||||
return $studios;
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
$entry->{created_at} = time::time_to_datetime(time());
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $id=db::insert($dbh, 'calcms_studios', $entry);
|
||||
return $id;
|
||||
}
|
||||
|
||||
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $studio=shift;
|
||||
|
||||
$studio->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $columns=get_columns($config);
|
||||
my $entry={};
|
||||
for my $column (keys %$columns){
|
||||
$entry->{$column}=$studio->{$column} if defined $studio->{$column};
|
||||
}
|
||||
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
push @bind_values,$entry->{id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_studios
|
||||
set $values
|
||||
where id=?
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
}
|
||||
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $studio=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
db::put($dbh, 'delete from calcms_studios where id=?', [$studio->{id}]);
|
||||
}
|
||||
|
||||
#TODO rename to check
|
||||
sub check_studio{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
return check($config, $options);
|
||||
}
|
||||
|
||||
sub check{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
return "missing studio_id" unless defined $options->{studio_id};
|
||||
return "Please select a studio" if($options->{studio_id}eq'-1');
|
||||
return "Please select a studio" if($options->{studio_id}eq'');
|
||||
my $studios=studios::get($config, {studio_id => $options->{studio_id}});
|
||||
return "Sorry. unknown studio" unless defined $studios;
|
||||
return "Sorry. unknown studio" unless @$studios==1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
|
||||
24
lib/calcms/tags.pm
Normal file
24
lib/calcms/tags.pm
Normal file
@@ -0,0 +1,24 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
package tags;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_tags);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub get_tags{
|
||||
my $dbh=shift;
|
||||
my $query=qq{
|
||||
select name, count(name) sum from calcms_tags
|
||||
group by name
|
||||
order by sum desc
|
||||
};
|
||||
my $tags=db::get($dbh,$query);
|
||||
return $tags;
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
227
lib/calcms/template.pm
Normal file
227
lib/calcms/template.pm
Normal file
@@ -0,0 +1,227 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
package template;
|
||||
use Data::Dumper;
|
||||
use HTML::Template::Compiled;
|
||||
use HTML::Template::Compiled::Plugin::XMLEscape;
|
||||
use JSON;
|
||||
use Cwd;
|
||||
|
||||
use config;
|
||||
use params;
|
||||
use project;
|
||||
use log;
|
||||
use roles;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
#our @EXPORT = qw(all);
|
||||
our @EXPORT_OK = qw(check process exit_on_missing_permission clear_cache);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub process{
|
||||
# my $output=$_[0];
|
||||
my $filename=$_[1];
|
||||
my $params=$_[2];
|
||||
|
||||
my $config=$config::config;
|
||||
for my $key (keys %{$config::config->{locations}}){
|
||||
$params->{$key} =$config::config->{locations}->{$key} if ($key=~/\_url$/);
|
||||
}
|
||||
|
||||
# add current project
|
||||
unless (defined $params->{project_title}){
|
||||
my $projects = project::get_with_dates($config, { name => $config->{project} });
|
||||
if (@$projects==1){
|
||||
my $project= $projects->[0];
|
||||
foreach my $key (keys %$project){
|
||||
$params->{'project_'.$key}=$project->{$key};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$params->{user}=$ENV{REMOTE_USER} unless defined $params->{user};
|
||||
|
||||
my $user_permissions=roles::get_user_permissions();
|
||||
for my $permission (keys %$user_permissions){
|
||||
$params->{$permission}=$user_permissions->{$permission} if ($user_permissions->{$permission} eq '1');
|
||||
}
|
||||
|
||||
$params->{jobs}=roles::get_user_jobs();
|
||||
|
||||
log::write($config, 'template',$params) if ($config::config->{system}->{debug}>0);
|
||||
# my $html_template = HTML::Template->new(
|
||||
# filename => $filename,
|
||||
# die_on_bad_params =>0,
|
||||
## cache =>1,
|
||||
## cache_debug => 1
|
||||
# );
|
||||
|
||||
|
||||
if (($filename =~/json\-p/) || (params::isJson)){
|
||||
my $header="Content-type:application/json; charset=utf-8\n\n";
|
||||
my $json=to_json($params, {pretty => 1});
|
||||
# $json=$header.$params->{json_callback}.'['.$json.']';
|
||||
$json=$header.$params->{json_callback}.$json;
|
||||
if((defined $_[0]) && ($_[0]eq'print')){
|
||||
print $json."\n";
|
||||
}else{
|
||||
$_[0]= $json."\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
#print STDERR $filename."\n";
|
||||
log::error($config, "cannot find template $filename ") unless -e $filename;
|
||||
log::error($config, "cannot read template $filename ") unless -r $filename;
|
||||
|
||||
my $default_escape='0';
|
||||
$default_escape='JS' if ($filename=~/\.js$/);
|
||||
$default_escape='JS' if ($filename=~/\.json$/);
|
||||
$default_escape='HTML_ALL' if ($filename=~/\.html$/);
|
||||
|
||||
my $html_template=undef;
|
||||
|
||||
unless ($filename=~/\.xml$/){
|
||||
$html_template = HTML::Template::Compiled->new(
|
||||
filename => $filename,
|
||||
die_on_bad_params => 0,
|
||||
case_sensitive => 0,
|
||||
loop_context_vars => 0,
|
||||
global_vars => 0,
|
||||
tagstyle => '-asp -comment',
|
||||
default_escape => $default_escape,
|
||||
cache => 0,
|
||||
utf8 => 1,
|
||||
);
|
||||
}else{
|
||||
$html_template = HTML::Template::Compiled->new(
|
||||
filename => $filename,
|
||||
die_on_bad_params => 0,
|
||||
case_sensitive => 1,
|
||||
loop_context_vars => 0,
|
||||
global_vars => 0,
|
||||
tagstyle => '-asp -comment',
|
||||
default_escape => 'XML',
|
||||
plugin => [qw(HTML::Template::Compiled::Plugin::XMLEscape)],
|
||||
utf8 => 1
|
||||
);
|
||||
}
|
||||
|
||||
#$params=
|
||||
setRelativeUrls($params,0) unless (defined $params->{extern}) && ($params->{extern} eq '1');
|
||||
|
||||
# HTML::Template::Compiled->preload($cache_dir);
|
||||
$html_template->param($params);
|
||||
if((defined $_[0]) && ($_[0]eq'print')){
|
||||
print $html_template->output;
|
||||
}else{
|
||||
$_[0]=$html_template->output;
|
||||
}
|
||||
}
|
||||
|
||||
# set relative urls in nested params structure
|
||||
sub setRelativeUrls{
|
||||
my $params=shift;
|
||||
my $depth=shift || 0;
|
||||
|
||||
#print STDERR "setRelativeUrls depth:$depth ".ref($params)."\n";
|
||||
|
||||
return unless defined $params;
|
||||
|
||||
if ($depth>10){
|
||||
print STDERR "prevent deep recursion in template::setRelativeUrls()\n";
|
||||
return ;
|
||||
}
|
||||
|
||||
# set recursive for hash
|
||||
if (ref($params) eq 'HASH'){
|
||||
for my $key (keys %$params){
|
||||
#next unless ($key eq 'icon') || ($key eq 'thumb');
|
||||
my $val=$params->{$key};
|
||||
next unless defined $val;
|
||||
if (ref($val) eq ''){
|
||||
# make link relative
|
||||
$params->{$key} =~s/^https?\:(\/\/[^\/]+)/$1/;
|
||||
}elsif ( (ref($val) eq 'HASH') || (ref($val) eq 'ARRAY') ){
|
||||
setRelativeUrls($params->{$key}, $depth+1);
|
||||
}
|
||||
}
|
||||
return $params;
|
||||
}
|
||||
|
||||
# set recursive for arrays
|
||||
if (ref($params) eq 'ARRAY'){
|
||||
for my $i (0..@$params){
|
||||
my $val=$params->[$i];
|
||||
next unless defined $val;
|
||||
if ( (ref($val) eq 'HASH') || (ref($val) eq 'ARRAY') ){
|
||||
setRelativeUrls($params->[$i], $depth+1);
|
||||
}
|
||||
}
|
||||
return $params;
|
||||
}
|
||||
|
||||
return $params;
|
||||
}
|
||||
|
||||
#requires read config
|
||||
sub check{
|
||||
my $template=shift||'';
|
||||
my $default=shift;
|
||||
|
||||
if($template =~/json\-p/){
|
||||
$template=~s/[^a-zA-Z0-9\-\_\.]//g;
|
||||
$template=~s/\.{2,99}/\./g;
|
||||
return $template;
|
||||
}
|
||||
|
||||
my $config=$config::config;
|
||||
if ($template eq''){
|
||||
$template=$default;
|
||||
}else{
|
||||
$template=~s/^\.\///gi;
|
||||
#template does use ';' in filename
|
||||
log::error($config, 'invalid template!') if ($template=~/;/);
|
||||
#template does use '..' in filename
|
||||
log::error($config, 'invalid template!') if ($template=~/\.\./);
|
||||
}
|
||||
#print STDERR $config::config->{cache}->{compress}."<.compres default:$template\n";
|
||||
$template=(split(/\//,$template))[-1];
|
||||
my $cwd=getcwd();
|
||||
|
||||
$template.='.html' unless ($template=~/\./);
|
||||
if (($config::config->{cache}->{compress}eq'1') && (-e $cwd.'/templates/compressed/'.$template)){
|
||||
$template=$cwd.'/templates/compressed/'.$template;
|
||||
}elsif (-e $cwd.'/templates/'.$template){
|
||||
$template=$cwd.'/templates/'.$template;
|
||||
}else{
|
||||
log::error($config, "template not found: '$cwd/$template'");
|
||||
|
||||
}
|
||||
|
||||
log::error($config, "missing permission to read template '$template'") unless (-r $template);
|
||||
return $template;
|
||||
}
|
||||
|
||||
#deprecated (for old admin only)
|
||||
sub exit_on_missing_permission{
|
||||
my $permission=shift;
|
||||
my $user_permissions=roles::get_user_permissions();
|
||||
if ($user_permissions->{$permission} ne '1'){
|
||||
print STDERR "missing permission to $permission\n";
|
||||
template::process('print', template::check('default.html'), {error => 'sorry, missing permission!'});
|
||||
die();
|
||||
#exit;
|
||||
}
|
||||
}
|
||||
|
||||
sub clear_cache{
|
||||
HTML::Template::Compiled->clear_cache();
|
||||
# return;
|
||||
# my $html_template = HTML::Template::Compiled->new();
|
||||
# $html_template->clear_cache();
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
586
lib/calcms/time.pm
Normal file
586
lib/calcms/time.pm
Normal file
@@ -0,0 +1,586 @@
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Time::Local;
|
||||
use DateTime;
|
||||
use Date::Calc;
|
||||
use Date::Manip;
|
||||
use POSIX qw(strftime);
|
||||
use config;
|
||||
|
||||
package time;
|
||||
use Data::Dumper;
|
||||
use utf8;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
format_datetime format_time
|
||||
date_format time_format
|
||||
datetime_to_time time_to_datetime time_to_date
|
||||
datetime_to_date
|
||||
add_days_to_datetime add_hours_to_datetime add_minutes_to_datetime
|
||||
add_days_to_date
|
||||
datetime_to_array date_to_array array_to_date array_to_datetime array_to_time array_to_time_hm
|
||||
date_cond time_cond check_date check_time check_datetime check_year_month
|
||||
datetime_to_rfc822 get_datetime datetime_to_utc datetime_to_utc_datetime
|
||||
get_duration get_duration_seconds
|
||||
get_durations get_names get_all_names get_weekdays weekday_index
|
||||
$names
|
||||
);
|
||||
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
our $names={
|
||||
'de' =>{
|
||||
months =>['Januar','Februar','März','April','Mai','Juni','Juli','August','September','Oktober','November','Dezember'],
|
||||
months_abbr =>['Jan','Feb','Mär','Apr','Mai','Jun','Jul','Aug','Sep','Okt','Nov','Dez'],
|
||||
weekdays =>['Montag','Dienstag','Mittwoch','Donnerstag','Freitag','Samstag','Sonntag'],
|
||||
weekdays_abbr =>['Mo','Di','Mi','Do','Fr','Sa','So'],
|
||||
},
|
||||
'en' =>{
|
||||
months =>['January','February','March','April','May','June','Jule','August','September','October','November','December'],
|
||||
months_abbr =>['Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'],
|
||||
weekdays =>['Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday'],
|
||||
weekdays_abbr =>['Mo','Tu','We','Th','Fr','Sa','Su'],
|
||||
},
|
||||
};
|
||||
|
||||
our $durations=[
|
||||
0, 5,10,15,20,30,40,45,50,60,70,75,80,90,100,105,110,115,120,135,150,165,180,195,210,225,240,300,360,420,480,540,600,660,720,1440
|
||||
];
|
||||
|
||||
sub get_names{
|
||||
my $language=shift||'en';
|
||||
return $time::names->{$language};
|
||||
}
|
||||
|
||||
sub get_all_names{
|
||||
return $time::names;
|
||||
}
|
||||
|
||||
sub get_durations{
|
||||
return $time::durations;
|
||||
}
|
||||
|
||||
#TODO: build from datenames
|
||||
our $weekday_index={
|
||||
'0' => 0,
|
||||
'1' => 1,
|
||||
'2' => 2,
|
||||
'3' => 3,
|
||||
'4' => 4,
|
||||
'5' => 5,
|
||||
'6' => 6,
|
||||
'Mo'=> 0,
|
||||
'Tu'=> 1,
|
||||
'Di'=> 1,
|
||||
'We'=> 2,
|
||||
'Mi'=> 2,
|
||||
'Th'=> 3,
|
||||
'Do'=> 3,
|
||||
'Fr'=> 4,
|
||||
'Sa'=> 5,
|
||||
'Su'=> 6,
|
||||
'So'=> 6
|
||||
};
|
||||
|
||||
sub get_weekdays{
|
||||
return{
|
||||
0 => 0,
|
||||
1 => 1,
|
||||
2 => 2,
|
||||
3 => 3,
|
||||
4 => 4,
|
||||
5 => 5,
|
||||
6 => 6,
|
||||
'Mo'=>0,
|
||||
'Tu'=>1,
|
||||
'Di'=>1,
|
||||
'We'=>2,
|
||||
'Mi'=>2,
|
||||
'Th'=>3,
|
||||
'Do'=>3,
|
||||
'Fr'=>4,
|
||||
'Sa'=>5,
|
||||
'Su'=>6,
|
||||
'So'=>6
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
#deprecated, for wordpress sync
|
||||
sub format_datetime{
|
||||
my $datetime=shift;
|
||||
return $datetime if ($datetime eq '');
|
||||
return add_hours_to_datetime($datetime,0);
|
||||
};
|
||||
|
||||
#deprecated
|
||||
sub format_time{
|
||||
my $t=$_[0];
|
||||
|
||||
my $year =$t->[5]+1900;
|
||||
my $month =$t->[4]+1;
|
||||
$month ='0'.$month if(length($month)==1);
|
||||
|
||||
my $day =$t->[3];
|
||||
$day ='0'.$day if(length($day)==1);
|
||||
|
||||
|
||||
my $hour =$t->[2];
|
||||
$hour ='0'.$hour if(length($hour)==1);
|
||||
|
||||
my $minute =$t->[1];
|
||||
$minute ='0'.$minute if(length($minute)==1);
|
||||
|
||||
return [$day,$month,$year,$hour,$minute];
|
||||
};
|
||||
|
||||
|
||||
# convert datetime to unix time
|
||||
sub datetime_to_time{
|
||||
my $datetime=$_[0];
|
||||
# print $datetime."\n";
|
||||
if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)[T\s](\d+)\:(\d+)(\:(\d+))?/){
|
||||
my $year=$1;
|
||||
my $month=$2-1;
|
||||
my $day=$3;
|
||||
my $hour=$4;
|
||||
my $minute=$5;
|
||||
my $second=$8||0;
|
||||
return Time::Local::timelocal($second,$minute,$hour,$day,$month,$year);
|
||||
|
||||
}else{
|
||||
print STDERR "datetime_to_time: no valid date time found! ($datetime )\n";
|
||||
return -1;
|
||||
}
|
||||
};
|
||||
|
||||
#get rfc822 datetime string from datetime string
|
||||
sub datetime_to_rfc822{
|
||||
my $datetime=$_[0];
|
||||
my $time=datetime_to_time($datetime);
|
||||
return POSIX::strftime("%a, %d %b %Y %H:%M:%S %z", localtime($time));
|
||||
}
|
||||
|
||||
#get seconds from epoch
|
||||
sub datetime_to_utc{
|
||||
my $datetime=shift;
|
||||
my $time_zone=shift;
|
||||
$datetime=get_datetime($datetime, $time_zone);
|
||||
return $datetime->epoch();
|
||||
}
|
||||
|
||||
# get full utc datetime including timezone offset
|
||||
sub datetime_to_utc_datetime{
|
||||
my $datetime=shift;
|
||||
my $time_zone=shift;
|
||||
$datetime=get_datetime($datetime, $time_zone);
|
||||
return $datetime->format_cldr("yyyy-MM-ddTHH:mm:ssZZZZZ");
|
||||
}
|
||||
|
||||
|
||||
|
||||
#add hours to datetime string
|
||||
sub add_hours_to_datetime{
|
||||
my $datetime=shift;
|
||||
my $hours=shift;
|
||||
return time_to_datetime(datetime_to_time($datetime)+(3600*$hours));
|
||||
};
|
||||
|
||||
#add minutes to datetime string
|
||||
sub add_minutes_to_datetime{
|
||||
my $datetime=shift;
|
||||
my $minutes=shift;
|
||||
return time_to_datetime(datetime_to_time($datetime)+(60*$minutes));
|
||||
};
|
||||
|
||||
#add days to datetime string
|
||||
sub add_days_to_datetime{
|
||||
my $datetime=shift;
|
||||
my $days=shift;
|
||||
my $time=datetime_to_array($datetime);
|
||||
#print STDERR Dumper($time);
|
||||
($time->[0], $time->[1], $time->[2]) =Date::Calc::Add_Delta_Days($time->[0]+0, $time->[1]+0, $time->[2]+0, $days);
|
||||
return array_to_datetime($time);
|
||||
}
|
||||
|
||||
sub add_days_to_date{
|
||||
my $datetime=shift;
|
||||
my $days=shift;
|
||||
my $date=date_to_array($datetime);
|
||||
($date->[0], $date->[1], $date->[2]) =Date::Calc::Add_Delta_Days($date->[0]+0, $date->[1]+0, $date->[2]+0, $days);
|
||||
return array_to_date($date);
|
||||
}
|
||||
|
||||
# convert unix time to datetime format
|
||||
sub time_to_datetime{
|
||||
my $time=shift;
|
||||
$time=time() unless((defined $time) && ($time ne''));
|
||||
my @t=localtime($time);
|
||||
return sprintf('%04d-%02d-%02d %02d:%02d:%02d', $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);
|
||||
};
|
||||
|
||||
# convert unix time to date format
|
||||
sub time_to_date{
|
||||
my $time=shift;
|
||||
$time=time() unless((defined $time) && ($time ne''));
|
||||
my @t=localtime($time);
|
||||
return sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]);
|
||||
};
|
||||
|
||||
# convert datetime to a array of date/time values
|
||||
sub datetime_to_array{
|
||||
my $datetime=$_[0]||'';
|
||||
if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)([T\s]+(\d+)\:(\d+)(\:(\d+))?)?/){
|
||||
my $year=$1;
|
||||
my $month=$2;
|
||||
my $day=$3;
|
||||
my $hour=$5||'00';
|
||||
my $minute=$6||'00';
|
||||
my $second=$8||'00';
|
||||
return [$year,$month,$day,$hour,$minute,$second];
|
||||
}
|
||||
return undef;
|
||||
};
|
||||
|
||||
# convert datetime to date
|
||||
sub datetime_to_date{
|
||||
my $datetime=$_[0]||'';
|
||||
if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)/){
|
||||
my $year=$1;
|
||||
my $month=$2;
|
||||
my $day=$3;
|
||||
return sprintf("%04d-%02d-%02d",$year,$month,$day);
|
||||
}
|
||||
return undef;
|
||||
};
|
||||
|
||||
#convert datetime array or single value to datetime string
|
||||
sub array_to_datetime{
|
||||
my $date =shift;
|
||||
if(ref($date)eq'ARRAY'){
|
||||
return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $date->[0], $date->[1], $date->[2], $date->[3], $date->[4], $date->[5]);
|
||||
}
|
||||
my $month =shift;
|
||||
my $day =shift;
|
||||
my $hour =shift||'0';
|
||||
my $minute =shift||'0';
|
||||
my $second =shift||'0';
|
||||
return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $date, $month, $day, $hour, $minute, $second);
|
||||
}
|
||||
|
||||
#convert date array or single values to date string
|
||||
sub array_to_date{
|
||||
my $date =shift;
|
||||
if(ref($date)eq'ARRAY'){
|
||||
return sprintf("%04d-%02d-%02d", $date->[0], $date->[1], $date->[2]);
|
||||
}
|
||||
my $month=shift;
|
||||
my $day =shift;
|
||||
return sprintf("%04d-%02d-%02d", $date, $month, $day);
|
||||
}
|
||||
|
||||
sub array_to_time{
|
||||
my $date =shift;
|
||||
if(ref($date)eq'ARRAY'){
|
||||
return sprintf("%02d:%02d:%02d", $date->[3], $date->[4], $date->[5]);
|
||||
}
|
||||
my $minute = shift||0;
|
||||
my $second = shift||0;
|
||||
return sprintf("%02d:%02d:%02d", $date, $minute, $second);
|
||||
}
|
||||
|
||||
sub array_to_time_hm{
|
||||
my $date =shift;
|
||||
if(ref($date)eq'ARRAY'){
|
||||
return sprintf("%02d:%02d", $date->[3], $date->[4]);
|
||||
}
|
||||
my $minute = shift||0;
|
||||
return sprintf("%02d:%02d", $date, $minute);
|
||||
}
|
||||
|
||||
|
||||
# get number of days between two days
|
||||
sub days_between{
|
||||
my $today=$_[0];
|
||||
my $date=$_[1];
|
||||
my $delta_days=eval{Date::Calc::Delta_Days(
|
||||
$today->[0],$today->[1],$today->[2],
|
||||
$date->[0], $date->[1], $date->[2]
|
||||
)};
|
||||
return $delta_days;
|
||||
}
|
||||
|
||||
sub dayOfYear{
|
||||
my $datetime=$_[0];
|
||||
if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)/){
|
||||
my $year = $1;
|
||||
my $month = $2;
|
||||
my $day = $3;
|
||||
return Date::Calc::Day_of_Year($year,$month,$day);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# get duration in minutes
|
||||
sub get_duration{
|
||||
my $start = shift;
|
||||
my $end = shift;
|
||||
my $timezone= shift;
|
||||
$start=time::get_datetime($start, $timezone);
|
||||
$end =time::get_datetime($end, $timezone);
|
||||
my $duration=$end->epoch()-$start->epoch();
|
||||
return $duration/60;
|
||||
}
|
||||
|
||||
# get duration in seconds
|
||||
sub get_duration_seconds{
|
||||
my $start = shift;
|
||||
my $end = shift;
|
||||
my $timezone= shift||'UTC';
|
||||
$start=time::get_datetime($start, $timezone);
|
||||
$end =time::get_datetime($end, $timezone);
|
||||
my $duration=$end->epoch()-$start->epoch();
|
||||
return $duration;
|
||||
}
|
||||
|
||||
# convert date string to a array of date values
|
||||
sub date_to_array{
|
||||
my $datetime=$_[0];
|
||||
if ($datetime=~/(\d\d\d\d)\-(\d+)\-(\d+)/){
|
||||
my $year = $1;
|
||||
my $month = $2;
|
||||
my $day = $3;
|
||||
return [$year,$month,$day];
|
||||
}
|
||||
return undef;
|
||||
};
|
||||
|
||||
# parse date string and return date string
|
||||
# pass 'today', return '' on parse error
|
||||
sub date_cond{
|
||||
my $date=shift;
|
||||
|
||||
return '' if ($date eq'');
|
||||
if ($date=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)/){
|
||||
my $year = $1;
|
||||
my $month = $2;
|
||||
my $day = $3;
|
||||
return sprintf("%04d-%02d-%02d", $year, $month, $day);
|
||||
}
|
||||
return 'today' if ($date eq 'today');
|
||||
return '';
|
||||
};
|
||||
|
||||
#parse time and return time string hh:mm:ss
|
||||
#return hh:00 if time is 'now'
|
||||
sub time_cond{
|
||||
my $time = shift;
|
||||
|
||||
return '' if ($time eq'');
|
||||
if ($time=~/(\d\d?)\:(\d\d?)(\:(\d\d))?/){
|
||||
my $hour=$1;
|
||||
my $minute=$2;
|
||||
my $second=$4||'00';
|
||||
return sprintf("%02d:%02d:%02d", $hour, $minute, $second);
|
||||
}
|
||||
if ($time eq 'now'){
|
||||
my $date=datetime_to_array(time_to_datetime(time()));
|
||||
my $hour=$date->[3]-2;
|
||||
$hour=0 if ($hour<0);
|
||||
$time=sprintf("%02d:00",$hour);
|
||||
return $time;
|
||||
}
|
||||
return '';
|
||||
};
|
||||
|
||||
#parse date and time string and return yyyy-mm-ddThh:mm:ss
|
||||
sub datetime_cond{
|
||||
my $datetime = shift;
|
||||
|
||||
return '' if ($datetime eq'');
|
||||
(my $date,my $time)=split /[ T]/,$datetime;
|
||||
$date=time::date_cond($date);
|
||||
return '' if ($date eq'');
|
||||
$time=time::time_cond($time);
|
||||
return '' if ($time eq'');
|
||||
|
||||
return $date.'T'.$time;
|
||||
}
|
||||
|
||||
sub check_date{
|
||||
my $date=shift;
|
||||
|
||||
return "" if((!defined $date) || ($date eq ''));
|
||||
if($date=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)/){
|
||||
return $1.'-'.$2.'-'.$3;
|
||||
}elsif($date=~/(\d\d?)\.(\d\d?)\.(\d\d\d\d)/){
|
||||
return $3.'-'.$2.'-'.$1;
|
||||
}
|
||||
return $date if ($date eq'today' || $date eq'tomorrow' || $date eq'yesterday');
|
||||
return -1;
|
||||
#error("no valid date format given!");
|
||||
};
|
||||
|
||||
sub check_time{
|
||||
my $time=shift;
|
||||
return "" if((!defined $time) || ($time eq ''));
|
||||
return $time if(($time eq 'now') || ($time eq 'future'));
|
||||
if($time=~/(\d\d?)\:(\d\d?)/){
|
||||
return $1.':'.$2
|
||||
}
|
||||
return -1;
|
||||
};
|
||||
|
||||
sub check_datetime{
|
||||
my $date=shift;
|
||||
|
||||
return "" if((!defined $date) || ($date eq ''));
|
||||
if($date=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)[T ](\d\d?)\:(\d\d?)/){
|
||||
return sprintf("%04d-%02d-%02dT%02d:%02d",$1,$2,$3,$4,$5);
|
||||
}
|
||||
return -1;
|
||||
};
|
||||
|
||||
sub check_year_month{
|
||||
my $date=shift;
|
||||
return -1 unless(defined $date);
|
||||
return $date if($date eq '');
|
||||
if($date=~/(\d\d\d\d)\-(\d\d?)/){
|
||||
return $1.'-'.$2.'-'.$3;
|
||||
}
|
||||
return -1;
|
||||
};
|
||||
|
||||
#TODO: remove config dependency
|
||||
sub date_time_format{
|
||||
my $datetime=shift;
|
||||
my $language=shift || $config::config->{date}->{language} || 'en';
|
||||
if (defined $datetime && $datetime=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)[\sT](\d\d?\:\d\d?)/){
|
||||
my $time=$4;
|
||||
my $day=$3;
|
||||
my $month=$2;
|
||||
my $year=$1;
|
||||
|
||||
$month=$time::names->{$language}->{months_abbr}->[$month-1]||'';
|
||||
return "$day. $month $year $time";
|
||||
}
|
||||
return $datetime;
|
||||
}
|
||||
|
||||
#format datetime to date string
|
||||
#TODO: remove config dependency
|
||||
sub date_format{
|
||||
my $datetime=shift;
|
||||
my $language=shift || $config::config->{date}->{language} || 'en';
|
||||
|
||||
if (defined $datetime && $datetime=~/(\d\d\d\d)\-(\d\d?)\-(\d\d?)/){
|
||||
my $day=$3;
|
||||
my $month=$2;
|
||||
my $year=$1;
|
||||
$month=$time::names->{$language}->{months_abbr}->[$month-1]||'';
|
||||
return "$day. $month $year";
|
||||
}
|
||||
return $datetime;
|
||||
};
|
||||
|
||||
#format datetime to time string
|
||||
sub time_format{
|
||||
my $datetime=shift;
|
||||
if (defined $datetime && $datetime=~/(\d\d?\:\d\d?)/){
|
||||
return $1;
|
||||
}
|
||||
return $datetime;
|
||||
};
|
||||
|
||||
#get offset from given time_zone
|
||||
sub utc_offset{
|
||||
my $time_zone=shift;
|
||||
|
||||
$a=DateTime->now();
|
||||
$a->set_time_zone($time_zone);
|
||||
return $a->strftime("%z");
|
||||
}
|
||||
|
||||
#get weekday from (yyyy,mm,dd)
|
||||
sub weekday{
|
||||
my ($year,$month,$day)=@_;
|
||||
my $time = Time::Local::timelocal(0,0,0,$day,$month-1,$year);
|
||||
return (localtime($time))[6];
|
||||
}
|
||||
|
||||
#get current date, related to starting day_starting_hour
|
||||
#TODO: remove config dependency
|
||||
sub get_event_date{
|
||||
my $config=shift;
|
||||
$config=$config::config unless defined $config;
|
||||
|
||||
my $datetime=time::time_to_datetime(time());
|
||||
my $hour=(time::datetime_to_array($datetime))->[3];
|
||||
#today: between 0:00 and starting_hour show last day
|
||||
if ($hour < $config->{date}->{day_starting_hour}){
|
||||
my $date=time::datetime_to_array(time::add_hours_to_datetime($datetime,-24));
|
||||
return $date->[0].'-'.$date->[1].'-'.$date->[2];
|
||||
}else{
|
||||
#today: between starting_hour and end of day show current day
|
||||
my $date=time::datetime_to_array(time::time_to_datetime(time()));
|
||||
return $date->[0]."-".$date->[1]."-".$date->[2];
|
||||
}
|
||||
}
|
||||
|
||||
#get datetime object from datetime string
|
||||
sub get_datetime{
|
||||
my $datetime=shift;
|
||||
my $timezone=shift;
|
||||
|
||||
return unless defined $datetime;
|
||||
return if $datetime eq '';
|
||||
my @l = @{time::datetime_to_array($datetime)};
|
||||
return undef if scalar(@l)==0;
|
||||
|
||||
# catch invalid datees
|
||||
$datetime=undef;
|
||||
eval{
|
||||
$datetime=DateTime->new(
|
||||
year =>$l[0],
|
||||
month =>$l[1],
|
||||
day =>$l[2],
|
||||
hour =>$l[3],
|
||||
minute =>$l[4],
|
||||
second =>$l[5],
|
||||
time_zone=> $timezone
|
||||
);
|
||||
};
|
||||
return undef unless defined $datetime;
|
||||
$datetime->set_locale('de_DE');
|
||||
return $datetime;
|
||||
}
|
||||
|
||||
#get list of nth weekday in month from start to end
|
||||
sub get_nth_weekday_in_month{
|
||||
my $start=shift; # datetime string
|
||||
my $end=shift; # datetime string
|
||||
my $nth=shift; # every nth week of month
|
||||
my $weekday=shift; # weekday [0..6,'Mo'-'Su','Mo'-'Fr']
|
||||
|
||||
my $weekdays=time::get_weekdays();
|
||||
$weekday=$weekdays->{$weekday+1};
|
||||
|
||||
my $dates=[];
|
||||
if ($start=~/(\d\d\d\d)-(\d\d)-(\d\d)[ T](\d\d)\:(\d\d)/){
|
||||
my $hour=int($4);
|
||||
my $min=int($5);
|
||||
my $sec=0;
|
||||
my @date = Date::Manip::ParseRecur("0:1*$nth:$weekday:$hour:$min:$sec", "", $start, $end);
|
||||
for my $date (@date){
|
||||
if ($date=~/(\d\d\d\d)(\d\d)(\d\d)(\d\d)\:(\d\d)\:(\d\d)/){
|
||||
push @$dates,"$1-$2-$3 $4:$5:$6";
|
||||
}
|
||||
}
|
||||
}
|
||||
return $dates;
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
818
lib/calcms/uac.pm
Normal file
818
lib/calcms/uac.pm
Normal file
@@ -0,0 +1,818 @@
|
||||
#!/bin/perl
|
||||
|
||||
use CGI;
|
||||
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
|
||||
use CGI::Session qw(-ip-match);
|
||||
use CGI::Cookie;
|
||||
#$CGI::Session::IP_MATCH=1;
|
||||
|
||||
package uac;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use auth;
|
||||
use db;
|
||||
use template;
|
||||
use project;
|
||||
use studios;
|
||||
#use series;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
get_user get_users update_user insert_user delete_user
|
||||
get_roles insert_role update_role get_role_columns
|
||||
get_studios_by_user get_users_by_studio
|
||||
get_projects_by_user
|
||||
get_user_role get_studio_roles
|
||||
assign_user_role remove_user_role
|
||||
get_user_permissions get_user_presets
|
||||
prepare_request set_template_permissions
|
||||
permission_denied
|
||||
);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
# get user by name
|
||||
sub get_user{
|
||||
my $config=shift;
|
||||
my $user=shift;
|
||||
|
||||
my $query=qq{
|
||||
select id, name, full_name, email, disabled, modified_at, created_at
|
||||
from calcms_users
|
||||
where name=?
|
||||
};
|
||||
my $bind_values=[$user];
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $users=db::get($dbh, $query,$bind_values);
|
||||
if (@$users!=1){
|
||||
print STDERR "cannot find user '$user'\n";
|
||||
return undef;
|
||||
}
|
||||
return $users->[0];
|
||||
}
|
||||
|
||||
# get all users
|
||||
sub get_users{
|
||||
my $config=shift;
|
||||
|
||||
my $query=qq{
|
||||
select id, name, full_name, email, disabled, modified_at, created_at
|
||||
from calcms_users
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $users=db::get($dbh, $query);
|
||||
return $users;
|
||||
}
|
||||
|
||||
#TODO: get_users_by_project
|
||||
|
||||
# get all users of a given studio id
|
||||
# used at series (previously named get_studio_users)
|
||||
sub get_users_by_studio{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
return unless (defined $condition->{studio_id});
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'ur.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'ur.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" and ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select distinct(u.id), u.name, u.full_name
|
||||
from calcms_user_roles ur, calcms_users u
|
||||
where ur.user_id=u.id
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $users=db::get($dbh, $query, \@bind_values);
|
||||
return $users;
|
||||
}
|
||||
|
||||
# get projects a user is assigned by name
|
||||
sub get_projects_by_user{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'ur.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'ur.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{user}) && ($condition->{user} ne '')){
|
||||
push @conditions, 'u.name=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" and ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select distinct p.*, ur.project_id project_id
|
||||
from calcms_user_roles ur, calcms_users u, calcms_projects p
|
||||
where ur.user_id=u.id and p.project_id=ur.project_id
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $users=db::get($dbh, $query, \@bind_values);
|
||||
return $users;
|
||||
}
|
||||
|
||||
# get all studios a user is assigned to by role
|
||||
# used at series (previously named get_user_studios)
|
||||
sub get_studios_by_user{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'ur.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'ur.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{user}) && ($condition->{user} ne '')){
|
||||
push @conditions, 'u.name=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" and ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select distinct s.*, ur.project_id project_id
|
||||
from calcms_user_roles ur, calcms_users u, calcms_studios s
|
||||
where ur.user_id=u.id and s.id=ur.studio_id
|
||||
$conditions
|
||||
};
|
||||
my $dbh=db::connect($config);
|
||||
my $users=db::get($dbh, $query, \@bind_values);
|
||||
return $users;
|
||||
}
|
||||
|
||||
sub insert_user{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
$entry->{created_at} = time::time_to_datetime(time());
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
db::insert($dbh, 'calcms_users', $entry);
|
||||
}
|
||||
|
||||
sub update_user{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
push @bind_values,$entry->{id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_users
|
||||
set $values
|
||||
where id=?
|
||||
};
|
||||
|
||||
my $dbh =db::connect($config);
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
}
|
||||
|
||||
sub delete_user{
|
||||
my $config=shift;
|
||||
my $id=shift;
|
||||
return unless (defined $id && ($id=~/^\d+$/));
|
||||
|
||||
my $query=qq{
|
||||
delete from calcms_users
|
||||
where id=?
|
||||
};
|
||||
my $dbh =db::connect($config);
|
||||
db::put($dbh, $query, [$id]);
|
||||
}
|
||||
|
||||
|
||||
# get all roles used by all users of a studio
|
||||
# available conditions: project_id, studio_id
|
||||
sub get_studio_roles{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
return [] if ($condition->{studio_id} eq '');
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'ur.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'ur.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" and ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select r.*, ur.studio_id, ur.project_id
|
||||
from calcms_roles r, calcms_user_roles ur
|
||||
where r.id=ur.role_id
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $roles=db::get($dbh, $query, \@bind_values);
|
||||
return $roles;
|
||||
}
|
||||
|
||||
# get role columns (for external use only)
|
||||
sub get_role_columns{
|
||||
my $config=shift;
|
||||
my $dbh=db::connect($config);
|
||||
my $columns=db::get_columns_hash($dbh, 'calcms_roles');
|
||||
return $columns
|
||||
}
|
||||
|
||||
# get roles
|
||||
# filter: studio_id project_id
|
||||
sub get_roles{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $columns=db::get_columns_hash($dbh, 'calcms_roles');
|
||||
|
||||
for my $column (keys %$columns){
|
||||
if (defined $condition->{$column}){
|
||||
push @conditions, $column.'=?';
|
||||
push @bind_values, $condition->{$column};
|
||||
}
|
||||
}
|
||||
my $conditions='';
|
||||
$conditions=' where '.join(' and ',@conditions) if(@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select r.*
|
||||
from calcms_roles r
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $roles=db::get($dbh, $query, \@bind_values);
|
||||
|
||||
return $roles;
|
||||
}
|
||||
|
||||
#insert role to database, set created_at and modified_at
|
||||
sub insert_role{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
$entry->{created_at} = time::time_to_datetime(time());
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $columns=db::get_columns_hash($dbh, 'calcms_roles');
|
||||
;
|
||||
my $role={};
|
||||
for my $column (keys %$columns){
|
||||
$role->{$column}=$entry->{$column} if defined $entry->{$column};
|
||||
}
|
||||
db::insert($dbh, 'calcms_roles', $role);
|
||||
}
|
||||
|
||||
#update role, set modified_at
|
||||
sub update_role{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $dbh =db::connect($config);
|
||||
my $columns=db::get_columns_hash($dbh, 'calcms_roles');
|
||||
my $values =join(",", map {$_.'=?'} (keys %$columns));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$columns);
|
||||
push @bind_values,$entry->{id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_roles
|
||||
set $values
|
||||
where id=?
|
||||
};
|
||||
# print $query."<br>\n".Dumper(\@bind_values)."<br>\ņ";
|
||||
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
}
|
||||
|
||||
# delete role from database
|
||||
sub delete_role{
|
||||
my $config=shift;
|
||||
my $id=shift;
|
||||
|
||||
return unless (defined $id && ($id=~/^\d+$/));
|
||||
|
||||
my $query=qq{
|
||||
delete from calcms_roles
|
||||
where id=?
|
||||
};
|
||||
my $dbh =db::connect($config);
|
||||
db::put($dbh, $query, [$id]);
|
||||
}
|
||||
|
||||
# get all roles for given conditions: project_id, studio_id, user_id, name
|
||||
# includes global admin user role
|
||||
sub get_user_roles{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if (defined $condition->{user}){
|
||||
push @conditions, 'u.name=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
if (defined $condition->{user_id}){
|
||||
push @conditions, 'ur.user_id=?';
|
||||
push @bind_values, $condition->{user_id};
|
||||
}
|
||||
if (defined $condition->{studio_id}){
|
||||
push @conditions, 'ur.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
if (defined $condition->{project_id}){
|
||||
push @conditions, 'ur.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions= " and ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select distinct r.*
|
||||
from calcms_users u, calcms_user_roles ur, calcms_roles r
|
||||
where ur.user_id=u.id and ur.role_id=r.id
|
||||
$conditions
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $user_roles=db::get($dbh, $query, \@bind_values);
|
||||
|
||||
#return roles, if the contain an admin role
|
||||
for my $role(@$user_roles){
|
||||
return $user_roles if $role->{role}eq'Admin';
|
||||
}
|
||||
|
||||
#get all admin roles
|
||||
delete $condition->{studio_id} if defined $condition->{studio_id};
|
||||
delete $condition->{project_id} if defined $condition->{project_id};
|
||||
my $admin_roles=get_admin_user_roles($config, $condition);
|
||||
|
||||
#add admin roles to user roles
|
||||
my @user_roles=(@$admin_roles, @$user_roles);
|
||||
$user_roles=\@user_roles;
|
||||
|
||||
return $user_roles;
|
||||
}
|
||||
|
||||
#return admin user roles for given conditions: project_id, studio_id, user, user_id
|
||||
sub get_admin_user_roles{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{user}) && ($condition->{user} ne '')){
|
||||
push @conditions, 'u.name=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
if ((defined $condition->{user_id}) && ($condition->{user_id} ne '')){
|
||||
push @conditions, 'ur.user_id=?';
|
||||
push @bind_values, $condition->{user_id};
|
||||
}
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'ur.studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'ur.project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" and ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select distinct r.*, ur.studio_id, ur.project_id
|
||||
from calcms_users u, calcms_user_roles ur, calcms_roles r
|
||||
where ur.user_id=u.id and ur.role_id=r.id and r.role='Admin'
|
||||
$conditions
|
||||
limit 1
|
||||
};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $user_roles=db::get($dbh, $query, \@bind_values);
|
||||
return $user_roles;
|
||||
}
|
||||
|
||||
# read permissions for given conditions and add to user_permissions
|
||||
# return user_permissions
|
||||
# studio_id, user_id, name
|
||||
sub get_user_permissions{
|
||||
my $config=shift;
|
||||
my $conditions=shift;
|
||||
my $user_permissions=shift;
|
||||
|
||||
my $user_roles = get_user_roles($config, $conditions);
|
||||
my $admin_roles = get_admin_user_roles($config, $conditions);
|
||||
my @user_roles=(@$admin_roles,@$user_roles);
|
||||
|
||||
#set default permissions
|
||||
$user_permissions={} unless(defined $user_permissions);
|
||||
$user_permissions->{is_admin}=1 if(scalar @$admin_roles>0);
|
||||
|
||||
my $max_level=0;
|
||||
# aggregate max permissions
|
||||
# should be limited by project and studio
|
||||
for my $user_role (@user_roles){
|
||||
if ($user_role->{level}>$max_level){
|
||||
$user_permissions->{level} = $user_role->{level};
|
||||
$user_permissions->{id} = $user_role->{id};
|
||||
$user_permissions->{role} = $user_role->{role};
|
||||
$user_permissions->{studio_id} = $user_role->{studio_id};
|
||||
$user_permissions->{project_id}= $user_role->{project_id};
|
||||
$max_level = $user_role->{level};
|
||||
}
|
||||
for my $permission (keys %$user_role){
|
||||
if (($permission ne 'level') && ($permission ne 'id') && ($permission ne 'role') && ($permission ne 'studio_id') && ($permission ne 'project_id')){
|
||||
$user_permissions->{$permission}=1 if ((defined $user_role->{$permission}) && ($user_role->{$permission} ne '0'));
|
||||
}
|
||||
}
|
||||
}
|
||||
return $user_permissions;
|
||||
}
|
||||
|
||||
#get user id by user name
|
||||
sub get_user_id{
|
||||
my $config=shift;
|
||||
my $user=shift;
|
||||
|
||||
return undef unless (defined $user);
|
||||
|
||||
my $query=qq{
|
||||
select id
|
||||
from calcms_users
|
||||
where binary name=?
|
||||
};
|
||||
my $dbh=db::connect($config);
|
||||
my $users=db::get($dbh, $query, [$user]);
|
||||
return undef if (@$users==0);
|
||||
return $users->[0]->{id};
|
||||
}
|
||||
|
||||
#get role id by role name
|
||||
sub get_role_id{
|
||||
my $config=shift;
|
||||
my $role=shift;
|
||||
|
||||
return undef unless (defined $role);
|
||||
|
||||
my $query=qq{
|
||||
select id
|
||||
from calcms_roles
|
||||
where role=?
|
||||
};
|
||||
my $dbh=db::connect($config);
|
||||
my $roles=db::get($dbh, $query, [$role]);
|
||||
return undef if (@$roles==0);
|
||||
return $roles->[0]->{id};
|
||||
}
|
||||
|
||||
# assign a role to an user (for a studio)
|
||||
sub assign_user_role{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
#print STDERR Dumper($options);
|
||||
return undef unless defined $options->{project_id};
|
||||
return undef unless defined $options->{studio_id};
|
||||
return undef unless defined $options->{user_id};
|
||||
return undef unless defined $options->{role_id};
|
||||
|
||||
#return if already exists
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_user_roles
|
||||
where project_id=? and studio_id=? and user_id=? and role_id=?
|
||||
};
|
||||
my $dbh=db::connect($config);
|
||||
my $user_roles=db::get($dbh, $query, [$options->{project_id}, $options->{studio_id}, $options->{user_id}, $options->{role_id}]);
|
||||
return undef if (@$user_roles>0);
|
||||
|
||||
#insert entry
|
||||
my $entry={
|
||||
project_id => $options->{project_id},
|
||||
studio_id => $options->{studio_id},
|
||||
user_id => $options->{user_id},
|
||||
role_id => $options->{role_id},
|
||||
created_at => time::time_to_datetime(time())
|
||||
};
|
||||
|
||||
return db::insert($dbh, 'calcms_user_roles', $entry);
|
||||
}
|
||||
|
||||
# unassign a user from a role of (for a studio)
|
||||
sub remove_user_role{
|
||||
my $config=shift;
|
||||
my $options=shift;
|
||||
|
||||
return undef unless defined $options->{project_id};
|
||||
return undef unless defined $options->{studio_id};
|
||||
return undef unless defined $options->{user_id};
|
||||
return undef unless defined $options->{role_id};
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_user_roles
|
||||
where project_id=? and studio_id=? and user_id=? and role_id=?
|
||||
};
|
||||
my $bind_values=[ $options->{project_id}, $options->{studio_id}, $options->{user_id}, $options->{role_id} ];
|
||||
#print STDERR Dumper($query).Dumper($bind_values);
|
||||
my $dbh=db::connect($config);
|
||||
my $result=db::put($dbh, $query, $bind_values);
|
||||
# successfully return even if no entry exists
|
||||
return 1;
|
||||
}
|
||||
|
||||
#checks
|
||||
sub is_user_assigned_to_studio{
|
||||
my $request=shift;
|
||||
my $options=shift;
|
||||
|
||||
my $config = $request->{config};
|
||||
|
||||
return 0 unless defined $request->{user};
|
||||
return 0 unless defined $options->{studio_id};
|
||||
return 0 unless defined $options->{project_id};
|
||||
|
||||
my $options2={
|
||||
user => $request->{user},
|
||||
studio_id => $options->{studio_id},
|
||||
project_id => $options->{project_id}
|
||||
};
|
||||
|
||||
my $user_studios=uac::get_studios_by_user($config, $options2);
|
||||
return 1 if(@$user_studios==1);
|
||||
return 0;
|
||||
}
|
||||
|
||||
# print errors at get_user_presets and check for project id and studio id
|
||||
# call after header is printed
|
||||
sub check{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
my $user_presets=shift;
|
||||
|
||||
if (defined $user_presets->{error}){
|
||||
uac::print_error($user_presets->{error});
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $project_check=project::check($config, { project_id => $params->{project_id} } );
|
||||
if($project_check ne '1'){
|
||||
uac::print_error($project_check);
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $studio_check=studios::check($config, { studio_id => $params->{studio_id} } );
|
||||
if($studio_check ne '1'){
|
||||
uac::print_error($studio_check);
|
||||
return undef;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
# get user, projects and studios user is assigned to for selected values from params
|
||||
# set permissions for selected project and studio
|
||||
# return request
|
||||
sub get_user_presets{
|
||||
my $config = shift;
|
||||
my $options = shift;
|
||||
|
||||
my $user = $options->{user}||'';
|
||||
my $error = undef;
|
||||
return {error=>"no user selected"} if ($user eq'');
|
||||
|
||||
my $project_id = $options->{project_id}||'';
|
||||
my $studio_id = $options->{studio_id}||'';
|
||||
$config->{access}->{write}=0;
|
||||
|
||||
#get
|
||||
my $admin_roles = get_admin_user_roles($config, {user=>$user});
|
||||
|
||||
#get all projects by user
|
||||
my $projects = uac::get_projects_by_user($config, {user=>$user});
|
||||
return {error=>"no project is assigned to user"} if(@$projects==0);
|
||||
|
||||
$projects=project::get($config) if(@$admin_roles>0);
|
||||
my @projects=reverse sort {$a->{end_date} cmp $b->{end_date}} (@$projects);
|
||||
$projects=\@projects;
|
||||
|
||||
if ($project_id ne'' && $project_id ne'-1'){
|
||||
my $projectFound=0;
|
||||
for my $project(@$projects){
|
||||
if ($project->{project_id} eq $project_id){
|
||||
$projectFound=1;
|
||||
last;
|
||||
};
|
||||
}
|
||||
return {error=>"project is not assigned to user"} if($projectFound==0);
|
||||
}else{
|
||||
$project_id=$projects->[0]->{project_id};
|
||||
}
|
||||
#print STDERR "project:$project_id\n";
|
||||
|
||||
#check if studios are assigned to project
|
||||
my $studios = project::get_studios($config, {project_id => $project_id});
|
||||
$error="no studio is assigned to project" if (@$studios==0);
|
||||
|
||||
if(@$admin_roles==0){
|
||||
#get all studios by user
|
||||
$studios=uac::get_studios_by_user($config, {user=>$user, project_id=>$project_id});
|
||||
$error="no studio is assigned to user" if (@$studios==0);
|
||||
if (($studio_id ne '')&&($studio_id ne '-1')){
|
||||
my $studioFound=0;
|
||||
for my $studio(@$studios){
|
||||
if ($studio->{id} eq $studio_id){
|
||||
$studioFound=1;
|
||||
last;
|
||||
};
|
||||
}
|
||||
$error="studio is not assigned to user" if($studioFound==0);
|
||||
}else{
|
||||
$studio_id =$studios->[0]->{id};
|
||||
}
|
||||
}else{
|
||||
#for admin get studios by project
|
||||
$studios = studios::get($config, {project_id => $project_id});
|
||||
if (($studio_id ne '')&&($studio_id ne '-1')){
|
||||
my $studioFound=0;
|
||||
for my $studio(@$studios){
|
||||
if ($studio->{id} eq $studio_id){
|
||||
$studioFound=1;
|
||||
last;
|
||||
};
|
||||
}
|
||||
$error="studio is not assigned to project" if($studioFound==0);
|
||||
}else{
|
||||
$studio_id =$studios->[0]->{id};
|
||||
}
|
||||
}
|
||||
|
||||
my $permissions=uac::get_user_permissions($config, {user=>$user, project_id=>$project_id, studio_id=>$studio_id});
|
||||
|
||||
#only admin is allowed to select all projects
|
||||
# if($permissions->{is_admin}==1){
|
||||
# $projects=project::get($config);
|
||||
# }
|
||||
|
||||
#set studios and projects as selected, TODO:do in JS
|
||||
my $selectedProject={};
|
||||
for my $project(@$projects){
|
||||
if ($project_id eq $project->{project_id}){
|
||||
$project->{selected}='selected="selected"';
|
||||
$selectedProject=$project;
|
||||
last;
|
||||
};
|
||||
}
|
||||
|
||||
my $selectedStudio={};
|
||||
for my $studio(@$studios){
|
||||
if ($studio_id eq $studio->{id}){
|
||||
$studio->{selected}='selected="selected"';
|
||||
$selectedStudio=$studio;
|
||||
last;
|
||||
};
|
||||
}
|
||||
|
||||
my $logout_url=(split(/\//, $0))[-1];
|
||||
|
||||
#print STDERR "ok\n";
|
||||
my $result={
|
||||
user => $user,
|
||||
logout_url => $logout_url,
|
||||
|
||||
project_id => $project_id, # from parameter or default
|
||||
projects => $projects,
|
||||
project => $selectedProject,
|
||||
|
||||
studio_id => $studio_id, # from parameter or default
|
||||
studios => $studios,
|
||||
studio => $selectedStudio,
|
||||
|
||||
permissions => $permissions, # from parameter or default
|
||||
config => $config
|
||||
};
|
||||
$result->{error}=$error if defined $error;
|
||||
return $result;
|
||||
}
|
||||
|
||||
#set user preset properties to request
|
||||
sub prepare_request{
|
||||
my $request=shift;
|
||||
my $user_presets=shift;
|
||||
|
||||
for my $key (keys %$user_presets){
|
||||
$request->{$key}=$user_presets->{$key};
|
||||
}
|
||||
#enrich menu parameters
|
||||
for my $key ('studio_id', 'project_id', 'studio', 'project', 'studios', 'projects', 'user', 'logout_url'){
|
||||
$request->{params}->{checked}->{presets}->{$key}=$user_presets->{$key};
|
||||
}
|
||||
return $request;
|
||||
}
|
||||
|
||||
#TODO: shift to permissions sub entry
|
||||
sub set_template_permissions{
|
||||
my $permissions = shift;
|
||||
my $params = shift;
|
||||
|
||||
for my $usecase (keys %$permissions){
|
||||
$params->{'allow'}->{$usecase}=1 if ($permissions->{$usecase}eq'1');
|
||||
}
|
||||
return $params;
|
||||
}
|
||||
|
||||
#print error message
|
||||
sub permissions_denied{
|
||||
my $message=shift;
|
||||
$message=~s/_/ /g;
|
||||
print '<div class="error">Sorry! Missing permissions to '.$message.'</div>'."\n";
|
||||
print STDERR 'Sorry! Missing permissions to '.$message."\n";
|
||||
}
|
||||
|
||||
sub print_info{
|
||||
print '<div class="ok head">'
|
||||
.'<span class="ui-icon ui-icon-check" style="float:left"></span> '
|
||||
.$_[0]
|
||||
.'</div>'."\n";
|
||||
}
|
||||
|
||||
sub print_warn{
|
||||
print '<div class="warn head">'
|
||||
.'<span class="ui-icon ui-icon-info" style="float:left"></span> '
|
||||
.$_[0]
|
||||
.'</div>'."\n";
|
||||
}
|
||||
|
||||
sub print_error{
|
||||
print '<div class="error" head>'
|
||||
.'<span class="ui-icon ui-icon-alert" style="float:left"></span> '
|
||||
.$_[0].
|
||||
'</div>'."\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
214
lib/calcms/user_settings.pm
Normal file
214
lib/calcms/user_settings.pm
Normal file
@@ -0,0 +1,214 @@
|
||||
package user_settings;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use series_dates;
|
||||
|
||||
# table: calcms_user_settings
|
||||
# columns: user, colors
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(getColors getColorCss get insert update delete get_columns defaultColors);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
our $defaultColors=[
|
||||
{
|
||||
name => 'color_event',
|
||||
css => '#content .event',
|
||||
color => '#c5e1a5'
|
||||
},{
|
||||
name => 'color_schedule',
|
||||
css => '#content .schedule',
|
||||
color => '#dde4e6',
|
||||
},{
|
||||
name => 'color_published',
|
||||
css => '#content .event.published',
|
||||
color => '#a5d6a7',
|
||||
},{
|
||||
name => 'color_no_series',
|
||||
css => '#content .event.no_series',
|
||||
color => '#fff59d',
|
||||
},{
|
||||
name => 'color_marked',
|
||||
css => '#content .event.marked',
|
||||
color => '#81d4fa',
|
||||
},{
|
||||
name => 'color_event_error',
|
||||
css => '#content.conflicts .event.error',
|
||||
color => '#ffab91',
|
||||
},{
|
||||
name => 'color_schedule_error',
|
||||
css => '#content.conflicts .schedule.error',
|
||||
color => '#ffcc80'
|
||||
},{
|
||||
name => 'color_work',
|
||||
css => '#content .work',
|
||||
color => '#b39ddb'
|
||||
},{
|
||||
name => 'color_playout',
|
||||
css => '#content .play',
|
||||
color => '#90caf9'
|
||||
}
|
||||
];
|
||||
|
||||
sub getColors{
|
||||
my $config=shift;
|
||||
my $conditions=shift;
|
||||
return unless defined $conditions->{user};
|
||||
my $user=$conditions->{user};
|
||||
|
||||
#get defaultColors
|
||||
my $colors=[];
|
||||
my $colorMap={};
|
||||
for my $defaultColor (@$defaultColors){
|
||||
my $color= {
|
||||
name => $defaultColor->{name},
|
||||
css => $defaultColor->{css},
|
||||
color => $defaultColor->{color},
|
||||
};
|
||||
push @$colors,$color;
|
||||
$colorMap->{$color->{css}}=$color;
|
||||
}
|
||||
|
||||
my $settings = user_settings::get($config, {user => $user });
|
||||
$settings->{colors} |='';
|
||||
#overwrite colors from user settings
|
||||
for my $line (split(/\n+/, $settings->{colors})){
|
||||
my ($key,$value)=split(/\=/,$line);
|
||||
$key=~s/^\s+//;
|
||||
$key=~s/\s+$//;
|
||||
$value=~s/^\s+//;
|
||||
$value=~s/\s+$//;
|
||||
$colorMap->{$key}->{color}=$value if (($key ne '')&&($value ne '')&&(defined $colorMap->{$key}));
|
||||
}
|
||||
return $colors;
|
||||
}
|
||||
|
||||
sub getColorCss{
|
||||
my $config=shift;
|
||||
my $conditions=shift;
|
||||
return unless defined $conditions->{user};
|
||||
|
||||
my $shift=20;
|
||||
my $limit=220;
|
||||
|
||||
my $colors=getColors($config, $conditions);
|
||||
my $style="<style>\n";
|
||||
for my $color (@$colors){
|
||||
$style.= $color->{css}."{\n\tbackground-color:".$color->{color}.";\n}\n";
|
||||
my $c=$color->{color};
|
||||
if ($c=~/#([a-fA-F0-9][a-fA-F0-9])([a-fA-F0-9][a-fA-F0-9])([a-fA-F0-9][a-fA-F0-9])/){
|
||||
my $r=hex($1);
|
||||
my $g=hex($2);
|
||||
my $b=hex($3);
|
||||
if ($r>$limit){$r-=$shift;}else{$r+=$shift;}
|
||||
if ($g>$limit){$g-=$shift;}else{$g+=$shift;}
|
||||
if ($b>$limit){$b-=$shift;}else{$b+=$shift;}
|
||||
$c=sprintf("#%x%x%x",$r,$g,$b);
|
||||
$style.= $color->{css}.":hover{\n\tbackground-color:".$c.";\n}\n";
|
||||
}
|
||||
}
|
||||
$style.="</style>\n";
|
||||
return $style;
|
||||
}
|
||||
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_user_settings');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{user}) && ($condition->{user} ne '')){
|
||||
push @conditions, 'user=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_user_settings
|
||||
$conditions
|
||||
};
|
||||
#print $query."\n";
|
||||
#print Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
return $entries->[0]||undef;
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless(defined $entry->{user});
|
||||
return unless(defined $entry->{colors});
|
||||
my $dbh=db::connect($config);
|
||||
return db::insert($dbh, 'calcms_user_settings', $entry);
|
||||
}
|
||||
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless(defined $entry->{user});
|
||||
return unless(defined $entry->{colors});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
push @bind_values,$entry->{user};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_user_settings
|
||||
set $values
|
||||
where user=?
|
||||
};
|
||||
db::put($dbh, $query, \@bind_values);
|
||||
print "done\n";
|
||||
}
|
||||
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return unless(defined $entry->{user});
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_user_settings
|
||||
where user=?
|
||||
};
|
||||
my $bind_values=[$entry->{user}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
247
lib/calcms/user_stats.pm
Normal file
247
lib/calcms/user_stats.pm
Normal file
@@ -0,0 +1,247 @@
|
||||
#!/bin/perl
|
||||
|
||||
package user_stats;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get update insert get_stats increase);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_user_stats');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
|
||||
push @conditions, 'series_id=?';
|
||||
push @bind_values, $condition->{series_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{user}) && ($condition->{user} ne '')){
|
||||
push @conditions, 'user=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_user_stats
|
||||
$conditions
|
||||
order by modified_at desc
|
||||
$limit
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
|
||||
my $results=db::get($dbh, $query, \@bind_values);
|
||||
return $results;
|
||||
}
|
||||
|
||||
sub get_stats{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{series_id}) && ($condition->{series_id} ne '')){
|
||||
push @conditions, 'series_id=?';
|
||||
push @bind_values, $condition->{series_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{user}) && ($condition->{user} ne '')){
|
||||
push @conditions, 'user=?';
|
||||
push @bind_values, $condition->{user};
|
||||
}
|
||||
|
||||
my $limit='';
|
||||
if ((defined $condition->{limit}) && ($condition->{limit} ne '')){
|
||||
$limit= 'limit '.$condition->{limit};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select user, project_id, studio_id,
|
||||
max(modified_at) modified_at,
|
||||
sum(create_events) create_events,
|
||||
sum(update_events) update_events,
|
||||
sum(delete_events) delete_events,
|
||||
sum(create_series) create_series,
|
||||
sum(update_series) update_series,
|
||||
sum(delete_series) delete_series
|
||||
from calcms_user_stats
|
||||
$conditions
|
||||
group by user, project_id, studio_id
|
||||
$limit
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
|
||||
my $results=db::get($dbh, $query, \@bind_values);
|
||||
for my $result (@$results){
|
||||
$result->{score}=0;
|
||||
for my $column ('create_events','update_events','delete_events','create_series','update_series','delete_series'){
|
||||
$result->{score}+=$result->{$column};
|
||||
}
|
||||
}
|
||||
my @results=reverse sort {$a->{score} <=> $b->{score}} @$results;
|
||||
return \@results;
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $stats=shift;
|
||||
|
||||
return undef unless defined $stats->{project_id};
|
||||
return undef unless defined $stats->{studio_id};
|
||||
return undef unless defined $stats->{series_id};
|
||||
return undef unless defined $stats->{user};
|
||||
|
||||
#TODO:filter for existing attributes
|
||||
my $columns=get_columns($config);
|
||||
my $entry={};
|
||||
for my $column (keys %$columns){
|
||||
$entry->{$column}=$stats->{$column} if defined $stats->{$column};
|
||||
}
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $id=db::insert($dbh, 'calcms_user_stats', $entry);
|
||||
return $id;
|
||||
}
|
||||
|
||||
# update project
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $stats=shift;
|
||||
|
||||
return undef unless defined $stats->{project_id};
|
||||
return undef unless defined $stats->{studio_id};
|
||||
return undef unless defined $stats->{series_id};
|
||||
return undef unless defined $stats->{user};
|
||||
|
||||
my $columns=get_columns($config);
|
||||
my $entry={};
|
||||
for my $column (keys %$columns){
|
||||
$entry->{$column}=$stats->{$column} if defined $stats->{$column};
|
||||
}
|
||||
$entry->{modified_at}= time::time_to_datetime(time());
|
||||
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
push @bind_values, $entry->{user};
|
||||
push @bind_values, $entry->{project_id};
|
||||
push @bind_values, $entry->{studio_id};
|
||||
push @bind_values, $entry->{series_id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_user_stats
|
||||
set $values
|
||||
where user=? and project_id=? and studio_id=? and series_id=?
|
||||
};
|
||||
#print STDERR Dumper($query).Dumper(\@bind_values);
|
||||
my $dbh=db::connect($config);
|
||||
return db::put($dbh, $query, \@bind_values);
|
||||
}
|
||||
|
||||
sub increase{
|
||||
my $config=shift;
|
||||
my $usecase=shift;
|
||||
my $options=shift;
|
||||
|
||||
#print STDERR Dumper($usecase)." ".Dumper($options);
|
||||
|
||||
return undef unless defined $usecase;
|
||||
return undef unless defined $options->{project_id};
|
||||
return undef unless defined $options->{studio_id};
|
||||
return undef unless defined $options->{series_id};
|
||||
return undef unless defined $options->{user};
|
||||
|
||||
#print STDERR "ok\n";
|
||||
|
||||
my $columns=get_columns($config);
|
||||
#print STDERR "columns:".Dumper($columns);
|
||||
return undef unless defined $columns->{$usecase};
|
||||
|
||||
my $entries= get($config,$options);
|
||||
#print STDERR "exist:".Dumper($columns);
|
||||
|
||||
if (@$entries==0){
|
||||
my $entry={
|
||||
project_id => $options->{project_id},
|
||||
studio_id => $options->{studio_id},
|
||||
series_id => $options->{series_id},
|
||||
user => $options->{user},
|
||||
$usecase => 1,
|
||||
};
|
||||
#print STDERR "user_stats::insert\n";
|
||||
return insert($config, $entry);
|
||||
}elsif (@$entries==1){
|
||||
my $entry=$entries->[0];
|
||||
$entry->{$usecase}++ if defined
|
||||
#print STDERR "user_stats::update\n";
|
||||
return update($config, $entry);
|
||||
}else{
|
||||
print STDERR "user_stats: to few options given: $usecase,".Dumper($options)."\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
385
lib/calcms/work_dates.pm
Normal file
385
lib/calcms/work_dates.pm
Normal file
@@ -0,0 +1,385 @@
|
||||
package work_dates;
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use time;
|
||||
use db;
|
||||
use log;
|
||||
use studio_timeslot_dates;
|
||||
use work_schedule;
|
||||
|
||||
# schedule dates for work_schedule
|
||||
# table: calcms_work_dates
|
||||
# columns: id, studio_id, schedule_id, start(datetime), end(datetime)
|
||||
# TODO: delete column schedule_id
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get insert update delete get_dates);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_work_dates');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
# get all work_dates for studio_id and schedule_id within given time range
|
||||
# calculate start_date, end_date, weeday, day from start and end(datetime)
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $date_range_include=0;
|
||||
$date_range_include=1 if $condition->{date_range_include}==1;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'schedule_id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{start_at}) && ($condition->{start_at} ne '')){
|
||||
push @conditions, 'start=?';
|
||||
push @bind_values, $condition->{start_at};
|
||||
}
|
||||
|
||||
if ((defined $condition->{from}) && ($condition->{from} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'end_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}else{
|
||||
push @conditions, 'start_date>=?';
|
||||
push @bind_values, $condition->{from};
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{till}) && ($condition->{till} ne '')){
|
||||
if ($date_range_include==1){
|
||||
push @conditions, 'start_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}else{
|
||||
push @conditions, 'end_date<=?';
|
||||
push @bind_values, $condition->{till};
|
||||
}
|
||||
}
|
||||
|
||||
if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
|
||||
push @conditions, 'exclude=?';
|
||||
push @bind_values, $condition->{exclude};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select date(start) start_date
|
||||
,date(end) end_date
|
||||
,dayname(start) weekday
|
||||
,start_date day
|
||||
,start
|
||||
,end
|
||||
,schedule_id
|
||||
,studio_id
|
||||
,project_id
|
||||
,exclude
|
||||
,type
|
||||
,title
|
||||
|
||||
from calcms_work_dates
|
||||
$conditions
|
||||
order by start
|
||||
};
|
||||
#print STDERR $query."\n";
|
||||
#print STDERR Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
for my $entry (@$entries){
|
||||
$entry->{weekday}=substr($entry->{weekday},0,2);
|
||||
}
|
||||
|
||||
return $entries;
|
||||
}
|
||||
|
||||
|
||||
#update work dates for all schedules of a work and studio_id
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id} ;
|
||||
return undef unless defined $entry->{studio_id} ;
|
||||
return undef unless defined $entry->{schedule_id} ;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
#delete all existing work dates (by project, studio and schedule id)
|
||||
work_dates::delete($config, $entry);
|
||||
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
|
||||
#get all schedules for schedule id ordered by exclude, date
|
||||
my $schedules=work_schedule::get($config, {
|
||||
project_id => $entry->{project_id},
|
||||
studio_id => $entry->{studio_id},
|
||||
schedule_id => $entry->{schedule_id},
|
||||
});
|
||||
|
||||
#add scheduled work dates and remove exluded dates
|
||||
my $work_dates={};
|
||||
|
||||
#TODO:set schedules exclude to 0 if not 1
|
||||
#insert all normal dates (not excludes)
|
||||
for my $schedule (@$schedules){
|
||||
my $dates=get_schedule_dates($schedule, {exclude => 0});
|
||||
for my $date (@$dates){
|
||||
$date->{exclude}=0;
|
||||
$work_dates->{$date->{start}}=$date;
|
||||
#print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
|
||||
}
|
||||
}
|
||||
|
||||
#insert / overwrite all exlude dates
|
||||
for my $schedule (@$schedules){
|
||||
my $dates=get_schedule_dates($schedule, {exclude => 1});
|
||||
for my $date (@$dates){
|
||||
$date->{exclude}=1;
|
||||
$work_dates->{$date->{start}}=$date;
|
||||
#print STDERR Dumper($date)."\n" if ($date->{start} eq'2014-02-05 19:00:00');
|
||||
}
|
||||
}
|
||||
|
||||
#print STDERR Dumper($work_dates->{'2014-02-05 19:00:00'});
|
||||
|
||||
my $request={
|
||||
config => $config
|
||||
};
|
||||
|
||||
my $i=0;
|
||||
my $j=0;
|
||||
for my $date (keys %$work_dates){
|
||||
my $work_date=$work_dates->{$date};
|
||||
#insert date
|
||||
my $entry={
|
||||
project_id => $entry->{project_id},
|
||||
studio_id => $entry->{studio_id},
|
||||
schedule_id => $entry->{schedule_id},
|
||||
title => $entry->{title},
|
||||
type => $entry->{type},
|
||||
schedule_id => $entry->{schedule_id},
|
||||
start => $work_date->{start},
|
||||
end => $work_date->{end},
|
||||
exclude => $work_date->{exclude}
|
||||
};
|
||||
if(studio_timeslot_dates::can_studio_edit_events($config, $entry)==1){ # by studio_id, start, end
|
||||
$entry->{start_date}= time::add_hours_to_datetime($entry->{start}, -$day_start);
|
||||
$entry->{end_date}= time::add_hours_to_datetime($entry->{end}, -$day_start);
|
||||
db::insert($dbh, 'calcms_work_dates', $entry);
|
||||
#print STDERR "$entry->{start_date}\n";
|
||||
$i++;
|
||||
}else{
|
||||
$j++;
|
||||
#print STDERR Dumper($entry);
|
||||
}
|
||||
}
|
||||
#print STDERR "$i work_dates updates\n";
|
||||
return $j." dates out of studio times, ".$i;
|
||||
}
|
||||
|
||||
sub get_schedule_dates{
|
||||
my $schedule=shift;
|
||||
my $options=shift;
|
||||
|
||||
my $is_exclude=$options->{exclude}||0;
|
||||
my $dates=[];
|
||||
return $dates if (($is_exclude eq'1') && ($schedule->{exclude}ne'1'));
|
||||
return $dates if (($is_exclude eq'0') && ($schedule->{exclude}eq'1'));
|
||||
|
||||
if ($schedule->{period_type}eq'single'){
|
||||
$dates=get_single_date($schedule->{start}, $schedule->{duration}) ;
|
||||
}elsif($schedule->{period_type}eq'days'){
|
||||
$dates=get_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{frequency}) ;
|
||||
}elsif($schedule->{period_type}eq'week_of_month'){
|
||||
$dates=get_week_of_month_dates($schedule->{start}, $schedule->{end}, $schedule->{duration}, $schedule->{week_of_month}, $schedule->{weekday}, $schedule->{month});
|
||||
}else{
|
||||
print STDERR "unknown schedule period_type\n";
|
||||
}
|
||||
return $dates;
|
||||
}
|
||||
|
||||
|
||||
sub get_week_of_month_dates{
|
||||
my $start =shift; # datetime string
|
||||
my $end =shift; # datetime string
|
||||
my $duration =shift; # in minutes
|
||||
my $week =shift; # every nth week of month
|
||||
my $weekday =shift; # weekday [1..7]
|
||||
my $frequency =shift; # every 1st,2nd,3th time
|
||||
|
||||
return undef if $start eq'';
|
||||
return undef if $end eq'';
|
||||
return undef if $duration eq'';
|
||||
return undef if $week eq'';
|
||||
return undef if $weekday eq'';
|
||||
return undef if $frequency eq'';
|
||||
return undef if $frequency==0;
|
||||
|
||||
my $start_dates=time::get_nth_weekday_in_month($start, $end, $week, $weekday-1);
|
||||
|
||||
my $results=[];
|
||||
|
||||
my $c=-1;
|
||||
for my $start_datetime (@$start_dates){
|
||||
$c++;
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
next unless @start>=6;
|
||||
next if (($c % $frequency)!=0);
|
||||
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$start[0], $start[1], $start[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, $duration, 0 # delta days, hours, minutes, seconds
|
||||
);
|
||||
my $end_datetime=time::array_to_datetime(\@end_datetime);
|
||||
|
||||
push @$results, {
|
||||
start => $start_datetime,
|
||||
end => $end_datetime
|
||||
};
|
||||
}
|
||||
return $results;
|
||||
}
|
||||
|
||||
#add duration to a single date
|
||||
sub get_single_date{
|
||||
my $start_datetime = shift;
|
||||
my $duration = shift;
|
||||
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
return unless @start>=6;
|
||||
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$start[0], $start[1], $start[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, $duration, 0 # delta days, hours, minutes, seconds
|
||||
);
|
||||
my $date={
|
||||
start => $start_datetime,
|
||||
end => time::array_to_datetime(\@end_datetime)
|
||||
};
|
||||
return [$date];
|
||||
}
|
||||
|
||||
#calculate all dates between start_datetime and end_date with duration(minutes) and frequency(days)
|
||||
sub get_dates{
|
||||
my $start_datetime = shift;
|
||||
my $end_date = shift;
|
||||
my $duration = shift; # in minutes
|
||||
my $frequency = shift; # in days
|
||||
#print "start_datetime:$start_datetime end_date:$end_date duration:$duration frequency:$frequency\n";
|
||||
|
||||
my @start = @{time::datetime_to_array($start_datetime)};
|
||||
return unless @start>=6;
|
||||
my @start_date = ($start[0], $start[1], $start[2]);
|
||||
my $start_time = sprintf('%02d:%02d:%02d', $start[3], $start[4], $start[5]);
|
||||
|
||||
#print STDERR "$start_datetime,$end_date,$duration,$frequency\n";
|
||||
|
||||
#return on single date
|
||||
my $date={};
|
||||
$date->{start}= sprintf("%04d-%02d-%02d",@start_date).' '.$start_time;
|
||||
return undef if $duration eq '';
|
||||
|
||||
return undef if (($frequency eq '')||($end_date eq''));
|
||||
|
||||
#continue on recurring date
|
||||
my @end = @{time::datetime_to_array($end_date)};
|
||||
return unless @end>=3;
|
||||
my @end_date = ($end[0], $end[1], $end[2]);
|
||||
|
||||
my $today=time::time_to_date();
|
||||
my ($year, $month, $day)=split(/\-/,$today);
|
||||
|
||||
#do not show dates one month back
|
||||
my $not_before= sprintf("%04d-%02d-%02d", Date::Calc::Add_Delta_Days($year, $month, $day, -30));
|
||||
|
||||
my $dates=[];
|
||||
return $dates if ($end_date lt $today);
|
||||
return $dates if ($frequency<1);
|
||||
|
||||
my $j = Date::Calc::Delta_Days(@start_date, @end_date);
|
||||
my $c=0;
|
||||
for (my $i = 0; $i <= $j; $i+=$frequency ){
|
||||
my @date = Date::Calc::Add_Delta_Days($start[0], $start[1], $start[2], $i);
|
||||
my $date={};
|
||||
$date->{start}=sprintf("%04d-%02d-%02d",@date).' '.$start_time;
|
||||
|
||||
my @end_datetime = Date::Calc::Add_Delta_DHMS(
|
||||
$date[0], $date[1], $date[2], # start date
|
||||
$start[3], $start[4], $start[5], # start time
|
||||
0, 0, $duration, 0 # delta days, hours, minutes, seconds
|
||||
);
|
||||
$date->{end}=time::array_to_datetime(\@end_datetime);
|
||||
|
||||
last if ($c>200);
|
||||
$c++;
|
||||
|
||||
next if $date->{end} lt $not_before;
|
||||
push @$dates,$date;
|
||||
|
||||
}
|
||||
return $dates;
|
||||
}
|
||||
|
||||
#remove all work_dates for studio_id and schedule_id
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{schedule_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_work_dates
|
||||
where project_id=? and studio_id=? and schedule_id=?
|
||||
};
|
||||
my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{schedule_id}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
156
lib/calcms/work_schedule.pm
Normal file
156
lib/calcms/work_schedule.pm
Normal file
@@ -0,0 +1,156 @@
|
||||
package work_schedule;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use series_dates;
|
||||
|
||||
# table: calcms_work_schedule
|
||||
# columns: id, studio_id, series_id,
|
||||
# start (datetime),
|
||||
# duration (minutes),
|
||||
# frequency (days),
|
||||
# end (date),
|
||||
# weekday (1..7)
|
||||
# week_of_month (1..5)
|
||||
# month
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(get_columns get insert update delete);
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
|
||||
|
||||
sub debug;
|
||||
|
||||
sub get_columns{
|
||||
my $config=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $cols=db::get_columns($dbh, 'calcms_work_schedule');
|
||||
my $columns={};
|
||||
for my $col (@$cols){
|
||||
$columns->{$col}=1;
|
||||
}
|
||||
return $columns;
|
||||
}
|
||||
|
||||
#map schedule id to id
|
||||
sub get{
|
||||
my $config=shift;
|
||||
my $condition=shift;
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my @conditions=();
|
||||
my @bind_values=();
|
||||
|
||||
if ((defined $condition->{project_id}) && ($condition->{project_id} ne '')){
|
||||
push @conditions, 'project_id=?';
|
||||
push @bind_values, $condition->{project_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{studio_id}) && ($condition->{studio_id} ne '')){
|
||||
push @conditions, 'studio_id=?';
|
||||
push @bind_values, $condition->{studio_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{schedule_id}) && ($condition->{schedule_id} ne '')){
|
||||
push @conditions, 'schedule_id=?';
|
||||
push @bind_values, $condition->{schedule_id};
|
||||
}
|
||||
|
||||
if ((defined $condition->{start}) && ($condition->{start} ne '')){
|
||||
push @conditions, 'start=?';
|
||||
push @bind_values, $condition->{start};
|
||||
}
|
||||
|
||||
if ((defined $condition->{exclude}) && ($condition->{exclude} ne '')){
|
||||
push @conditions, 'exclude=?';
|
||||
push @bind_values, $condition->{exclude};
|
||||
}
|
||||
|
||||
if ((defined $condition->{period_type}) && ($condition->{period_type} ne '')){
|
||||
push @conditions, 'period_type=?';
|
||||
push @bind_values, $condition->{period_type};
|
||||
}
|
||||
|
||||
my $conditions='';
|
||||
$conditions=" where ".join(" and ",@conditions) if (@conditions>0);
|
||||
|
||||
my $query=qq{
|
||||
select *
|
||||
from calcms_work_schedule
|
||||
$conditions
|
||||
order by exclude, start
|
||||
};
|
||||
#print STDERR $query."\n".Dumper(\@bind_values);
|
||||
|
||||
my $entries=db::get($dbh, $query, \@bind_values);
|
||||
return $entries;
|
||||
}
|
||||
|
||||
sub insert{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{start};
|
||||
my $dbh=db::connect($config);
|
||||
return db::insert($dbh, 'calcms_work_schedule', $entry);
|
||||
}
|
||||
|
||||
#schedule id to id
|
||||
sub update{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{schedule_id};
|
||||
return undef unless defined $entry->{start};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $values =join(",", map {$_.'=?'} (keys %$entry));
|
||||
my @bind_values =map {$entry->{$_}} (keys %$entry);
|
||||
|
||||
push @bind_values,$entry->{project_id};
|
||||
push @bind_values,$entry->{studio_id};
|
||||
push @bind_values,$entry->{schedule_id};
|
||||
|
||||
my $query=qq{
|
||||
update calcms_work_schedule
|
||||
set $values
|
||||
where project_id=? and studio_id=? and schedule_id=?
|
||||
};
|
||||
return db::put($dbh, $query, \@bind_values);
|
||||
print "done\n";
|
||||
}
|
||||
|
||||
#map schedule id to id
|
||||
sub delete{
|
||||
my $config=shift;
|
||||
my $entry=shift;
|
||||
|
||||
return undef unless defined $entry->{project_id};
|
||||
return undef unless defined $entry->{studio_id};
|
||||
return undef unless defined $entry->{schedule_id};
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $query=qq{
|
||||
delete
|
||||
from calcms_work_schedule
|
||||
where project_id=? and studio_id=? and schedule_id=?
|
||||
};
|
||||
my $bind_values=[$entry->{project_id}, $entry->{studio_id}, $entry->{schedule_id}];
|
||||
#print '<pre>$query'.$query.Dumper($bind_values).'</pre>';
|
||||
return db::put($dbh, $query, $bind_values);
|
||||
}
|
||||
|
||||
sub error{
|
||||
my $msg=shift;
|
||||
print "ERROR: $msg<br/>\n";
|
||||
}
|
||||
|
||||
#do not delete last line!
|
||||
1;
|
||||
125
tools/compress_templates.cgi
Executable file
125
tools/compress_templates.cgi
Executable file
@@ -0,0 +1,125 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
BEGIN{
|
||||
my $dir=$ENV{SCRIPT_FILENAME}||'';
|
||||
$dir=~s/(.*\/)[^\/]+/$1/;
|
||||
$dir=$ENV{PWD} if ($dir eq'');
|
||||
$dir=`pwd` if ($dir eq'');
|
||||
|
||||
#if located below extern CMS go on more down
|
||||
#$dir.='../';
|
||||
|
||||
#local perl installation libs
|
||||
unshift(@INC,$dir.'/../../perl/lib/');
|
||||
unshift(@INC,$dir.'/../../calcms/calcms/');
|
||||
}
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
use File::stat;
|
||||
use Time::localtime;
|
||||
use CGI qw(header param Vars escapeHTML uploadInfo cgi_error);
|
||||
use time;
|
||||
use config;
|
||||
use log;
|
||||
use projects;
|
||||
use markup;
|
||||
use template;
|
||||
|
||||
my $config =config::get('../config/config.cgi');
|
||||
|
||||
my $debug =$config->{system}->{debug};
|
||||
my $base_dir =$config->{locations}->{base_dir};
|
||||
my $local_base_url =$config->{locations}->{local_base_url};
|
||||
|
||||
$CGI::POST_MAX = 1024*10;
|
||||
my $cgi=new CGI();
|
||||
my %params=$cgi->Vars();
|
||||
#print $cgi->header();
|
||||
#print STDERR Dumper($config);
|
||||
|
||||
#print "a\n";
|
||||
template::exit_on_missing_permission('access_system');
|
||||
#print "b\n";
|
||||
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING}||'',
|
||||
params => {
|
||||
original => \%params,
|
||||
checked => check_params(\%params),
|
||||
},
|
||||
config => $config
|
||||
};
|
||||
my $params=$request->{params}->{checked};
|
||||
|
||||
log::init($request);
|
||||
log::mem('pic_manager init')if($debug>2);
|
||||
|
||||
my $errors='';
|
||||
my $action_result='';
|
||||
|
||||
log::error("base_dir '$base_dir' does not exist")unless(-e $base_dir);
|
||||
|
||||
my $template_dirs=[
|
||||
$base_dir.'/templates/',
|
||||
$base_dir.'/admin/templates/',
|
||||
$base_dir.'/planung/templates/',
|
||||
];
|
||||
my @results=();
|
||||
#print "<pre>\n";
|
||||
|
||||
for my $template_dir(@$template_dirs){
|
||||
my $dest_dir=$template_dir.'compressed/';
|
||||
log::error('template directory "'.$dest_dir.'" does not exist') unless(-e $dest_dir);
|
||||
log::error('cannot write into template directory "'.$dest_dir.'"') unless(-w $dest_dir);
|
||||
|
||||
#compress only: html, xml
|
||||
my @files=glob("$template_dir*.*ml");
|
||||
for my $file (@files){
|
||||
$file=~s/[\n\r]+$//g;
|
||||
next if ($file=~/\~$/);
|
||||
next if ($file=~/compressed/);
|
||||
next if ($file=~/\.old$/);
|
||||
push @results,$file;
|
||||
|
||||
my $content=log::load_file($file);
|
||||
# print "$file\n";
|
||||
markup::compress($content);
|
||||
|
||||
my $filename=(split(/\//,$file))[-1];
|
||||
my $dest_file=$template_dir.'compressed/'.$filename;
|
||||
log::error("cannot write '$dest_file'") if((-e $dest_file) && (!(-w $dest_file)));
|
||||
log::save_file($dest_file,$content);
|
||||
}
|
||||
}
|
||||
|
||||
my $out='';
|
||||
template::process('print',$params->{template},{
|
||||
'error' => $errors,
|
||||
'projects' => projects::get({all=>0}),
|
||||
|
||||
}
|
||||
);
|
||||
|
||||
print '<pre>';
|
||||
for my $result(@results){
|
||||
$result=~s/$base_dir//g;
|
||||
print $local_base_url.$result."\n";
|
||||
}
|
||||
print '</pre>';
|
||||
log::mem('pic_manager init')if($debug>1);
|
||||
|
||||
|
||||
sub check_params{
|
||||
my $params=shift;
|
||||
|
||||
my $result={};
|
||||
|
||||
#avoid checking templates
|
||||
$result->{template}='templates/default.html';
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
194
tools/get_source_page.pl
Executable file
194
tools/get_source_page.pl
Executable file
@@ -0,0 +1,194 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
use HTTP::Request;
|
||||
use LWP::UserAgent;
|
||||
use config;
|
||||
use markup;
|
||||
use Getopt::Long;
|
||||
|
||||
check_running_processes();
|
||||
|
||||
my $wget='/usr/local/bin/wget';
|
||||
|
||||
my $insertWidgets = undef;
|
||||
my $configFile = undef;
|
||||
my $help = undef;
|
||||
my $output = undef;
|
||||
|
||||
GetOptions (
|
||||
"config=s" => \$configFile,
|
||||
"insert_widgets" => \$insertWidgets,
|
||||
"output=s" => \$output,
|
||||
"help" => \$help
|
||||
)or die("Error in command line arguments\n");
|
||||
|
||||
if(($help) || (!(defined $configFile)) ){
|
||||
print get_usage();
|
||||
exit 1;
|
||||
}
|
||||
binmode STDOUT, ":encoding(UTF-8)";
|
||||
|
||||
my $config = config::get($configFile);
|
||||
|
||||
#what to grab from extern CMS
|
||||
my $source_url_http = $config->{locations}->{source_url_http};
|
||||
my $source_url_https = $config->{locations}->{source_url_https};
|
||||
|
||||
#external base url (relative links/images are located)
|
||||
my $source_base_url = $config->{locations}->{source_base_url};
|
||||
|
||||
my $source_base_url_http = $source_base_url;
|
||||
$source_base_url_http=~s/^http\:\//https\:\//g;
|
||||
|
||||
my $source_base_url_https=$source_base_url;
|
||||
$source_base_url_https=~s/^http\:\//https\:\//g;
|
||||
|
||||
# base url to get widgets from /website/agenda/
|
||||
my $base_url =$config->{controllers}->{domain};
|
||||
|
||||
# location of /website/agenda/
|
||||
my $base_dir =$config->{locations}->{base_dir};
|
||||
|
||||
unless (defined $source_url_http){
|
||||
print STDERR "source_url_http is not configured. Please check config.\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#setup UA
|
||||
my $ua = LWP::UserAgent->new;
|
||||
|
||||
our $results={};
|
||||
my $urls={base => $source_url_http};
|
||||
|
||||
#read source url
|
||||
$results->{base}= http_get($ua,$urls->{base});
|
||||
my $html_page=$results->{base};
|
||||
|
||||
#read widgets
|
||||
$html_page=load_widgets($ua,$html_page,{
|
||||
calcms_calendar => $base_url."kalender/\$date/",
|
||||
calcms_menu => $base_url."menu/\$date/",
|
||||
calcms_list => $base_url."sendungen/\$date/",
|
||||
calcms_categories => $base_url."kategorien/",
|
||||
calcms_series_names => $base_url."sendereihen/",
|
||||
calcms_newest_comments => $base_url."neueste_kommentare/",
|
||||
}) if (defined $insertWidgets);
|
||||
|
||||
#replace links
|
||||
$html_page=~s/(href\=\"\/)$source_base_url_http/$1/g;
|
||||
$html_page=~s/(src\=\"\/)$source_base_url_http/$1/g;
|
||||
$html_page=~s/(href\=\"\/)$source_base_url_https/$1/g;
|
||||
$html_page=~s/(src\=\"\/)$source_base_url_https/$1/g;
|
||||
$html_page=~s/(src\=\"\/)$source_base_url_https/$1/g;
|
||||
|
||||
#replace link to uncompressed or compressed drupal (first link in <head>)
|
||||
my @parts=split(/<\/head>/,$html_page);
|
||||
$parts[0]=~s|/misc/jquery.js|/agenda_files/js/jquery.js|;
|
||||
$parts[0]=~s|/sites/default/files/js/[a-z0-9\_]+\.js|/agenda_files/js/jquery.js|;
|
||||
$html_page=join('</head>',@parts);
|
||||
|
||||
#compress output
|
||||
markup::compress($html_page);
|
||||
|
||||
#print result
|
||||
if(defined $output){
|
||||
unless (-w $output){
|
||||
print STDERR "cannot write to '$output'\n";
|
||||
exit 1;
|
||||
}
|
||||
print STDERR "write to '$output'\n";
|
||||
open my $file,'>'.$output;
|
||||
print $file $html_page."\n";
|
||||
close $file;
|
||||
}else{
|
||||
print STDERR "write to STDOUT\n";
|
||||
print $html_page;
|
||||
}
|
||||
|
||||
|
||||
sub load_widgets{
|
||||
my $ua =shift;
|
||||
my $base=shift;
|
||||
my $urls=shift;
|
||||
|
||||
#set current date (or end date if above)
|
||||
my @date=localtime(time());
|
||||
my $year= $date[5]+1900;
|
||||
my $month= $date[4]+1;
|
||||
my $day = $date[3];
|
||||
$month ='0'.$month if (length($month)<2);
|
||||
$day ='0'.$day if (length($day)<2);
|
||||
my $date=join('-',($year,$month,$day));
|
||||
|
||||
my $project_name=$config->{project};
|
||||
my $project=$config->{projects}->{$project_name};
|
||||
|
||||
$date=$project->{start_date} if ($date lt $project->{start_date});
|
||||
$date=$project->{end_date} if ($date gt $project->{end_date});
|
||||
|
||||
#load widgets
|
||||
for my $block (keys %$urls){
|
||||
my $url=$urls->{$block};
|
||||
$url=~s/\$date/$date/gi;
|
||||
$results->{$block}= http_get($ua,$url);
|
||||
}
|
||||
|
||||
#set javascript
|
||||
my $preload_js=qq{
|
||||
set('preloaded','$date');
|
||||
set('last_list_url','}.$base_url.qq{sendungen/$date/');
|
||||
</script>
|
||||
<script>
|
||||
};
|
||||
$base=~s/(\/\/calcms_preload)/$1\n$preload_js/;
|
||||
|
||||
#replace widget containers
|
||||
for my $block (keys %$urls){
|
||||
if ($block ne 'base'){
|
||||
my $content=$results->{$block};
|
||||
$base=~s/( id\=\"$block\".*?\>)(.*?)(\<)/$1$content$3/;
|
||||
}
|
||||
}
|
||||
return $base;
|
||||
}
|
||||
|
||||
sub http_get{
|
||||
my $ua=shift;
|
||||
my $url=shift;
|
||||
|
||||
print STDERR "read url '$url'\n";
|
||||
my $request = HTTP::Request->new(GET => $url);
|
||||
my $response = $ua->request($request);
|
||||
return $response->{_content};
|
||||
}
|
||||
|
||||
sub check_running_processes{
|
||||
my $cmd=qq{ps -afex 2>/dev/null | grep preload_agenda | grep -v grep | grep -v "$$" };
|
||||
my $ps=`$cmd`;
|
||||
my @lines=split(/\n/,$ps);
|
||||
if (@lines>1){
|
||||
print STDERR "ERROR: ".@lines." preload_agenda.pl instances are running!\n"
|
||||
."$cmd\n"
|
||||
."$ps\n"
|
||||
."stop further processing of this preload_agenda.pl instance\n";
|
||||
exit 1;
|
||||
};
|
||||
}
|
||||
|
||||
sub get_usage{
|
||||
return qq{
|
||||
$0 --config FILE [--insert_widgets] --output FILE
|
||||
|
||||
read HTML document from base_url, insert widgets and save result to output file
|
||||
|
||||
--config FILE path of the config file
|
||||
--insert_widgets insert widgets, optional
|
||||
--output FILE path of output file
|
||||
--help this page
|
||||
};
|
||||
}
|
||||
|
||||
117
tools/setUserPassword.pl
Normal file
117
tools/setUserPassword.pl
Normal file
@@ -0,0 +1,117 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
use lib '../calcms';
|
||||
|
||||
use CGI;
|
||||
use config;
|
||||
use time;
|
||||
use uac;
|
||||
|
||||
my $cgi=new CGI();
|
||||
my $params=$cgi->Vars();
|
||||
|
||||
my $config =config::get('../../piradio.de/agenda/config/config.cgi');
|
||||
my $debug =$config->{system}->{debug};
|
||||
|
||||
$params=check_params($params);
|
||||
our $errors=[];
|
||||
change_password($config, $params);
|
||||
|
||||
|
||||
sub change_password{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
|
||||
my $userName=$params->{user_name}||'';
|
||||
if ($userName eq ''){
|
||||
error ("user '$userName' not found");
|
||||
exit;
|
||||
}
|
||||
|
||||
my $user=uac::get_user($config, $userName);
|
||||
|
||||
unless ( (defined $user) && (defined $user->{id}) && ($user->{id}ne'') ){
|
||||
error( "user id not found");
|
||||
exit;
|
||||
}
|
||||
|
||||
unless (defined $params->{user_password}){
|
||||
error("missing password for $userName");
|
||||
exit;
|
||||
}
|
||||
|
||||
unless(check_password($params->{user_password})){
|
||||
error ("password does not meet requirements");
|
||||
exit;
|
||||
}
|
||||
|
||||
my $crypt=auth::crypt_password($params->{user_password});
|
||||
$user={
|
||||
id => $user->{id}
|
||||
};
|
||||
$user->{salt}=$crypt->{salt};
|
||||
$user->{pass}=$crypt->{crypt};
|
||||
#print '<pre>'.Dumper($user).'</pre>';
|
||||
$config->{access}->{write}=1;
|
||||
uac::update_user($config, $user);
|
||||
$config->{access}->{write}=0;
|
||||
print STDERR "password changed for $userName\n";
|
||||
print STDERR Dumper($user);
|
||||
|
||||
}
|
||||
|
||||
sub check_password{
|
||||
my $password=shift;
|
||||
unless(defined $password || $password eq ''){
|
||||
error("password is empty");
|
||||
return 0;
|
||||
}
|
||||
if(length($password)<8){
|
||||
error("password to short");
|
||||
return 0;
|
||||
}
|
||||
unless($password=~/[a-z]/){
|
||||
error("password should contains at least one small character");
|
||||
return 0;
|
||||
}
|
||||
unless($password=~/[A-Z]/){
|
||||
error("password should contains at least one big character");
|
||||
return 0;
|
||||
}
|
||||
unless($password=~/[0-9]/){
|
||||
error("password should contains at least one number");
|
||||
return 0;
|
||||
}
|
||||
unless($password=~/[^a-zA-Z0-9]/){
|
||||
error("password should contains at least one special character");
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
sub check_params{
|
||||
my $params=shift;
|
||||
|
||||
my $checked={};
|
||||
|
||||
for my $param ('user_name', 'user_password', 'user_password2'){
|
||||
if (defined $params->{$param}){
|
||||
$checked->{$param}=$params->{$param};
|
||||
}
|
||||
}
|
||||
|
||||
#print Dumper($params);
|
||||
#print '<pre>'.Dumper($checked).'</pre>';
|
||||
return $checked;
|
||||
}
|
||||
|
||||
sub error{
|
||||
print STDERR "ERROR - ".$_[0]."\n";
|
||||
}
|
||||
|
||||
|
||||
90
tools/sync_cms/INSTALL
Executable file
90
tools/sync_cms/INSTALL
Executable file
@@ -0,0 +1,90 @@
|
||||
#install libxml2, libxml2-dev (for headers) to use XML::Atom (required by Net::Google::Calendar)
|
||||
#install perl modules: DateTime, DateTime::TimeZone, XML::Atom, XML::Atom::Feed, Net::Google::Calendar
|
||||
#if reading calendar fails, patch Entry line 184, from
|
||||
# if ($elem->hasAttribute($key)) {
|
||||
# to
|
||||
# if (defined $elem && $elem->hasAttribute($key)) {
|
||||
#
|
||||
#patch Entry before line 184, insert
|
||||
# return unless ($tmp);
|
||||
|
||||
|
||||
#patch Entry line 176, modify
|
||||
$val =~ s!^http://schemas.google.com/g/2005#event\.!! if (defined $val);
|
||||
|
||||
#admin,admin
|
||||
|
||||
#all available google calendar definitions, replace in url 'basic' by 'full' to get calendar entries!!! (basic covers feed content only, but no calendar data...)
|
||||
# google_calendars => {
|
||||
# programm => 'http://www.google.com/calendar/feeds/58ei894fakpf84hj0u7o6el4sc%40group.calendar.google.com/public/full',
|
||||
# programm_intern => 'http://www.google.com/calendar/feeds/lin4mscfdld2eiv22qda82t478%40group.calendar.google.com/public/full',
|
||||
# planung => 'http://www.google.com/calendar/feeds/0is4ruq5thsb6ndsqr5gicff2k%40group.calendar.google.com/public/full',
|
||||
# termine_intern => 'http://www.google.com/calendar/feeds/1n762hqutnsocd46h6nji3i2l4%40group.calendar.google.com/public/full',
|
||||
# termine => 'http://www.google.com/calendar/feeds/f29rqfutlkub911i8u0eerusb0%40group.calendar.google.com/public/full'
|
||||
# },
|
||||
|
||||
GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, FILE, INDEX, ALTER ON * . * TO 'root'@'localhost' IDENTIFIED BY 'calcms' WITH MAX_QUERIES_PER_HOUR 0 MAX_CONNECTIONS_PER_HOUR 0 MAX_UPDATES_PER_HOUR 0 MAX_USER_CONNECTIONS 0;
|
||||
|
||||
Query OK, 0 rows affected (0.02 sec)
|
||||
|
||||
flush previleges
|
||||
https://www.google.com/calendar/dav/peter_retep@gmx.de/events
|
||||
|
||||
|
||||
create database calcms-herbstradio;
|
||||
mysql calcms_herbstradio -u root -p < calcms/calcms.sql
|
||||
|
||||
|
||||
GRANT SELECT ON * . * TO 'root'@'localhost' IDENTIFIED BY 'calcms-agenda' WITH MAX_QUERIES_PER_HOUR 0 MAX_CONNECTIONS_PER_HOUR 0 MAX_UPDATES_PER_HOUR 0 MAX_USER_CONNECTIONS 0;
|
||||
|
||||
|
||||
flush previleges
|
||||
|
||||
|
||||
CREATE USER 'milan'@'localhost' IDENTIFIED BY 'eeGei3Yo';
|
||||
GRANT SELECT ON calcms_agenda.* TO 'calcms'@'localhost';
|
||||
|
||||
chmod 777 cache
|
||||
|
||||
GRANT SELECT ON calcms_herbstradio.* TO 'calcms_agenda'@'localhost' IDENTIFIED BY 'eeGei3Yo'
|
||||
GRANT SELECT, INSERT, UPDATE ON calcms_herbstradio.* TO 'calcms'@'localhost' IDENTIFIED BY 'CheiBai8'
|
||||
|
||||
|
||||
ERROR: Can't create '/usr/local/lib/perl5/5.8.6/man/man3'
|
||||
Do not have write permissions on '/usr/local/lib/perl5/5.8.6/man/man3'
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
at /home/milan/perl/lib/Module/Build/Base.pm line 2975
|
||||
SIMONW/Net-Google-Calendar-0.97.tar.gz
|
||||
./Build install -- NOT OK
|
||||
----
|
||||
You may have to su to root to install the package
|
||||
(Or you may want to run something like
|
||||
o conf make_install_make_command 'sudo make'
|
||||
to raise your permissions.Failed during this command:
|
||||
DROLSKY/DateTime-Locale-0.43.tar.gz : install NO
|
||||
DROLSKY/DateTime-TimeZone-0.91.tar.gz : install NO
|
||||
DROLSKY/DateTime-0.50.tar.gz : make_test NO
|
||||
SIMONW/Net-Google-AuthSub-0.5.tar.gz : install NO
|
||||
GRANTM/XML-SAX-0.96.tar.gz : make_test NO
|
||||
SIMONW/Net-Google-Calendar-0.97.tar.gz : install NO
|
||||
|
||||
See perldoc ExtUtils::MakeMaker for full details. For Module::Build
|
||||
modules, you need to create a ~/.modulebuildrc file containing
|
||||
bindoc=~/man/man1 libdoc=~/man/man3
|
||||
|
||||
o conf makepl_arg "PREFIX=/home/milan/perl/ LIB=/home/milan/perl/lib INST_LIB=/home/milan/perl/lib INSTALLSITELIB=/home/milan/perl/lib INSTALLMAN1DIR=/home/milan/perl/man/man1 INSTALLSITEMAN1DIR=/home/milan/perl/man/man1 INSTALLMAN3DIR=~/home/milan/perl/man/man3 INSTALLSITEMAN3DIR=/home/milan/perl/man/man3 INSTALLDIRS=/home/milan/perl/ SITEPREFIX=/home/milan/perl/ VENDORPREFIX=/home/milan/perl/"
|
||||
|
||||
LIB=$PREFIX/lib INST_LIB=$PREFIX/lib PREFIX=$PREFIX SITEPREFIX=$PREFIX VENDORPREFIX=$PREFIX
|
||||
|
||||
|
||||
|
||||
|
||||
o conf make_arg -I/home/twiki/lib/CPAN
|
||||
o conf make_install_arg -I/home/twiki/lib/CPAN
|
||||
o conf makepl_arg "install_base=/home/twiki/lib/CPAN LIB=/home/twiki/lib/CPAN/lib INSTALLPRIVLIB=/home/twiki/lib/CPAN/lib INSTALLARCHLIB=/home/twiki/lib/CPAN/lib/arch INSTALLSITEARCH=/home/twiki/lib/CPAN/lib/arch INSTALLSITELIB=/home/twiki/lib/CPAN/lib INSTALLSCRIPT=/home/twiki/lib/CPAN/bin INSTALLBIN=/home/twiki/lib/CPAN/bin INSTALLSITEBIN=/home/twiki/lib/CPAN/bin INSTALLMAN1DIR=/home/twiki/lib/CPAN/man/man1 INSTALLSITEMAN1DIR=/home/twiki/lib/CPAN/man/man1 INSTALLMAN3DIR=/home/twiki/lib/CPAN/man/man3 INSTALLSITEMAN3DIR=/home/twiki/lib/CPAN/man/man3 "
|
||||
o conf commit
|
||||
q
|
||||
|
||||
|
||||
|
||||
|
||||
35
tools/sync_cms/config/source/calcms.cfg
Normal file
35
tools/sync_cms/config/source/calcms.cfg
Normal file
@@ -0,0 +1,35 @@
|
||||
<source>
|
||||
type calcms_i
|
||||
|
||||
<access>
|
||||
hostname localhost
|
||||
port 3306
|
||||
database calcms_herbstradio
|
||||
username calcms
|
||||
password CheiBai8
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
project 88vier
|
||||
<projects>
|
||||
<88vier>
|
||||
name 88vier
|
||||
title 88vier PI-Radio 2010
|
||||
start_date 2010-05-01
|
||||
end_date 2013-08-31
|
||||
</88vier>
|
||||
</projects>
|
||||
location piradio
|
||||
|
||||
<mapping>
|
||||
event_details_url http://piradio.de/programm/sendung/<TMPL_VAR event_id>.html
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</source>
|
||||
|
||||
35
tools/sync_cms/config/source/calcms_ansage.cfg
Normal file
35
tools/sync_cms/config/source/calcms_ansage.cfg
Normal file
@@ -0,0 +1,35 @@
|
||||
<source>
|
||||
type calcms_i
|
||||
|
||||
<access>
|
||||
hostname localhost
|
||||
port 3306
|
||||
database calcms_herbstradio
|
||||
username calcms
|
||||
password CheiBai8
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
project 88vier
|
||||
<projects>
|
||||
<88vier>
|
||||
name 88vier
|
||||
title 88vier Studio Ansage
|
||||
start_date 2010-05-01
|
||||
end_date 2016-06-01
|
||||
</88vier>
|
||||
</projects>
|
||||
location ansage
|
||||
|
||||
<mapping>
|
||||
event_details_url http://senderberlin.org/programm/sendung/<TMPL_VAR event_id>.html
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</source>
|
||||
|
||||
35
tools/sync_cms/config/source/calcms_colabo.cfg
Normal file
35
tools/sync_cms/config/source/calcms_colabo.cfg
Normal file
@@ -0,0 +1,35 @@
|
||||
<source>
|
||||
type calcms_i
|
||||
|
||||
<access>
|
||||
hostname localhost
|
||||
port 3306
|
||||
database calcms_herbstradio
|
||||
username calcms
|
||||
password CheiBai8
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
project 88vier
|
||||
<projects>
|
||||
<88vier>
|
||||
name 88vier
|
||||
title 88vier Colaboradio
|
||||
start_date 2010-05-01
|
||||
end_date 2016-06-01
|
||||
</88vier>
|
||||
</projects>
|
||||
location colabo
|
||||
|
||||
<mapping>
|
||||
event_details_url http://senderberlin.org/programm/sendung/<TMPL_VAR event_id>.html
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</source>
|
||||
|
||||
35
tools/sync_cms/config/source/calcms_piradio.cfg
Normal file
35
tools/sync_cms/config/source/calcms_piradio.cfg
Normal file
@@ -0,0 +1,35 @@
|
||||
<source>
|
||||
type calcms_i
|
||||
|
||||
<access>
|
||||
hostname localhost
|
||||
port 3306
|
||||
database calcms_herbstradio
|
||||
username calcms
|
||||
password CheiBai8
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
project 88vier
|
||||
<projects>
|
||||
<88vier>
|
||||
name 88vier
|
||||
title 88vier PI-Radio
|
||||
start_date 2010-05-01
|
||||
end_date 2016-06-01
|
||||
</88vier>
|
||||
</projects>
|
||||
location piradio
|
||||
|
||||
<mapping>
|
||||
event_details_url http://piradio.de/programm/sendung/<TMPL_VAR event_id>.html
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</source>
|
||||
|
||||
35
tools/sync_cms/config/source/calcms_potsdam.cfg
Normal file
35
tools/sync_cms/config/source/calcms_potsdam.cfg
Normal file
@@ -0,0 +1,35 @@
|
||||
<source>
|
||||
type calcms_i
|
||||
|
||||
<access>
|
||||
hostname localhost
|
||||
port 3306
|
||||
database calcms_herbstradio
|
||||
username calcms
|
||||
password CheiBai8
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
project 88vier
|
||||
<projects>
|
||||
<88vier>
|
||||
name 88vier
|
||||
title 88vier Frrapo
|
||||
start_date 2010-05-01
|
||||
end_date 2016-06-01
|
||||
</88vier>
|
||||
</projects>
|
||||
location potsdam
|
||||
|
||||
<mapping>
|
||||
event_details_url http://senderberlin.org/programm/sendung/<TMPL_VAR event_id>.html
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</source>
|
||||
|
||||
23
tools/sync_cms/config/target/88vier_ansage.cfg
Normal file
23
tools/sync_cms/config/target/88vier_ansage.cfg
Normal file
@@ -0,0 +1,23 @@
|
||||
<target>
|
||||
type google_calendar2
|
||||
|
||||
<access>
|
||||
calendarId info@studioansage.de
|
||||
serviceAccount 433089473368-bv26eveq03b7nhb9p62nu3ts7htgb4g3@developer.gserviceaccount.com
|
||||
serviceAccountKeyFile /home/radio/googleApi.key
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
<mapping>
|
||||
title <TMPL_VAR location> : <TMPL_VAR series_name> - <TMPL_VAR title>
|
||||
content <TMPL_VAR excerpt> <a href="<TMPL_VAR event_details_url>">mehr zur Sendung</a>
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</target>
|
||||
|
||||
23
tools/sync_cms/config/target/88vier_colabo.cfg
Normal file
23
tools/sync_cms/config/target/88vier_colabo.cfg
Normal file
@@ -0,0 +1,23 @@
|
||||
<target>
|
||||
type google_calendar2
|
||||
|
||||
<access>
|
||||
calendarId colaboradio@gmail.com
|
||||
serviceAccount 433089473368-bv26eveq03b7nhb9p62nu3ts7htgb4g3@developer.gserviceaccount.com
|
||||
serviceAccountKeyFile /home/radio/googleApi.key
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
<mapping>
|
||||
title <TMPL_VAR location> : <TMPL_VAR series_name> - <TMPL_VAR title>
|
||||
content <TMPL_VAR excerpt> <a href="<TMPL_VAR event_details_url>">mehr zur Sendung</a>
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</target>
|
||||
|
||||
23
tools/sync_cms/config/target/88vier_piradio.cfg
Normal file
23
tools/sync_cms/config/target/88vier_piradio.cfg
Normal file
@@ -0,0 +1,23 @@
|
||||
<target>
|
||||
type google_calendar2
|
||||
|
||||
<access>
|
||||
calendarId li6if8drs373kf9ttot7er6suc@group.calendar.google.com
|
||||
serviceAccount 433089473368-bv26eveq03b7nhb9p62nu3ts7htgb4g3@developer.gserviceaccount.com
|
||||
serviceAccountKeyFile /home/radio/googleApi.key
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
<mapping>
|
||||
title <TMPL_VAR location> - <TMPL_VAR series_name> - <TMPL_VAR title>
|
||||
content <TMPL_VAR excerpt> <a href="<TMPL_VAR event_details_url>">mehr zur Sendung</a>
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</target>
|
||||
|
||||
23
tools/sync_cms/config/target/88vier_potsdam.cfg
Normal file
23
tools/sync_cms/config/target/88vier_potsdam.cfg
Normal file
@@ -0,0 +1,23 @@
|
||||
<target>
|
||||
type google_calendar2
|
||||
|
||||
<access>
|
||||
calendarId 8nh18f858098u4ji4qrsmfrcr4@group.calendar.google.com
|
||||
serviceAccount 433089473368-bv26eveq03b7nhb9p62nu3ts7htgb4g3@developer.gserviceaccount.com
|
||||
serviceAccountKeyFile /home/radio/googleApi.key
|
||||
</access>
|
||||
|
||||
<date>
|
||||
time_zone Europe/Berlin
|
||||
</date>
|
||||
|
||||
<mapping>
|
||||
title <TMPL_VAR location> : <TMPL_VAR series_name> - <TMPL_VAR title>
|
||||
content <TMPL_VAR excerpt> <a href="<TMPL_VAR event_details_url>">mehr zur Sendung</a>
|
||||
</mapping>
|
||||
|
||||
<system>
|
||||
debug 1
|
||||
</system>
|
||||
</target>
|
||||
|
||||
33
tools/sync_cms/export_db.pl
Normal file
33
tools/sync_cms/export_db.pl
Normal file
@@ -0,0 +1,33 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib "../calcms";
|
||||
use utf8;
|
||||
|
||||
use Data::Dumper;
|
||||
use Config::General;
|
||||
use Storable qw(nstore);
|
||||
|
||||
use db;
|
||||
use config;
|
||||
|
||||
our $default={
|
||||
configFile => '/home/radio/piradio.de/agenda/config/config.cgi',
|
||||
timezone => 'Europe/Berlin',
|
||||
local_media_url => 'http://piradio.de/agenda_files/media/',
|
||||
project => '88vier',
|
||||
location => 'piradio',
|
||||
};
|
||||
|
||||
my $config = config::get($default->{configFile});
|
||||
print Dumper($config);
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
my $query=q{
|
||||
select * from calcms_events
|
||||
order by start
|
||||
};
|
||||
|
||||
my $events=db::get($dbh, $query);
|
||||
nstore($events, 'event_export.dat');
|
||||
17
tools/sync_cms/ical_html_to_ical_creole.pl
Normal file
17
tools/sync_cms/ical_html_to_ical_creole.pl
Normal file
@@ -0,0 +1,17 @@
|
||||
require '../lib/text_markup.pl';
|
||||
|
||||
open FILE,"<$ARGV[0]";
|
||||
while (<FILE>){
|
||||
my $line=$_;
|
||||
if ($line=~/^DESCRIPTION:/){
|
||||
my $description=substr($line,length('DESCRIPTION:'));
|
||||
my $html=markup::ical_to_plain($description);
|
||||
my $creole=markup::html_to_creole($html);
|
||||
my $ical=markup::plain_to_ical($creole);
|
||||
$line= 'DESCRIPTION:'.$ical."\n";
|
||||
}
|
||||
print $line;
|
||||
}
|
||||
close FILE;
|
||||
|
||||
|
||||
162
tools/sync_cms/import_ical.pl
Executable file
162
tools/sync_cms/import_ical.pl
Executable file
@@ -0,0 +1,162 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib "../calcms";
|
||||
use utf8;
|
||||
|
||||
use DateTime;
|
||||
use Net::Google::Calendar;
|
||||
use DateTime::Format::ICal;
|
||||
use Data::Dumper;
|
||||
use Config::General;
|
||||
|
||||
use db;
|
||||
use config;
|
||||
use creole_wiki;
|
||||
use markup;
|
||||
use events;
|
||||
|
||||
my $filename=$ARGV[0];
|
||||
die("USAGE: $0 filename") unless defined $filename;
|
||||
die("cannot read from '$filename'") unless -e $filename;
|
||||
|
||||
our $default={
|
||||
configFile => '/home/radio/piradio.de/agenda/config/config.cgi',
|
||||
timezone => 'Europe/Berlin',
|
||||
local_media_url => 'http://piradio.de/agenda_files/media/',
|
||||
project => '88vier',
|
||||
location => 'piradio',
|
||||
};
|
||||
|
||||
my $config = config::get($default->{configFile});
|
||||
print Dumper($config);
|
||||
|
||||
parseICalFile($config, $filename);
|
||||
our $active=0;
|
||||
sub parseICalFile{
|
||||
my $config=shift;
|
||||
my $filename=shift;
|
||||
|
||||
print "open $filename\n";
|
||||
open my $file, "<:encoding(UTF-8)", $filename;
|
||||
my $parse=0;
|
||||
my $event=undef;
|
||||
my $lastKey=undef;
|
||||
|
||||
while (<$file>){
|
||||
my $line=$_;
|
||||
#print $parse." ".$line;
|
||||
if ($line=~/^BEGIN\:VEVENT/){
|
||||
$event={};
|
||||
$parse=1;
|
||||
#print "start event\n";
|
||||
next;
|
||||
}
|
||||
if ($line=~/^END\:VEVENT/){
|
||||
$parse=0;
|
||||
processEvent($config, $event) if defined $event;
|
||||
#print "end event\n";
|
||||
next;
|
||||
}
|
||||
if ($line=~/^\s/){
|
||||
my $key = $lastKey;
|
||||
my $value = substr($line, 1);
|
||||
$value=~s/[\r\n]+$//;
|
||||
$event->{$key}.=$value;
|
||||
$lastKey=$key;
|
||||
next;
|
||||
}else{
|
||||
my ($key,$value)=split(/\:/,$line,2);
|
||||
$value=~s/[\r\n]+$//;
|
||||
$event->{$key}=$value;
|
||||
$lastKey=$key;
|
||||
}
|
||||
|
||||
}
|
||||
close $file;
|
||||
}
|
||||
|
||||
sub processEvent{
|
||||
my $config=shift;
|
||||
my $source=shift;
|
||||
|
||||
my $event={};
|
||||
|
||||
$event->{title} = $source->{SUMMARY};
|
||||
$event->{content} = $source->{DESCRIPTION};
|
||||
$event->{title} = markup::ical_to_plain($event->{title});
|
||||
$event->{content} = markup::ical_to_plain($event->{content});
|
||||
|
||||
unless (defined $source->{DTSTART}){
|
||||
print STDERR "missing DTSTART in ".Dumper($source);
|
||||
return;
|
||||
}
|
||||
unless (defined $source->{DTEND}){
|
||||
print STDERR "missing DTEND in ".Dumper($source);
|
||||
return;
|
||||
}
|
||||
my $start = DateTime::Format::ICal->parse_datetime($source->{DTSTART});
|
||||
$start=$start->set_time_zone($default->{timezone});
|
||||
$event->{start} = $start->datetime();
|
||||
|
||||
my $end = DateTime::Format::ICal->parse_datetime($source->{DTEND});
|
||||
$end = $end->set_time_zone($default->{timezone});
|
||||
$event->{end} = $end->datetime();
|
||||
|
||||
my $params={
|
||||
title => $event->{title},
|
||||
content => $event->{content},
|
||||
local_media_url => $default->{local_media_url}
|
||||
};
|
||||
|
||||
#$params->{content}=~s/\x0A\x20/\n/g;
|
||||
$event=creole_wiki::extractEventFromWikiText($params, $event);
|
||||
|
||||
$event->{project} = $default->{project};
|
||||
$event->{location} = $default->{location};
|
||||
|
||||
return unless ($event->{start} ge '2015-09-01');
|
||||
|
||||
$active=1 if ($event->{series_name}=~/Brainwashed/);
|
||||
print "$active $event->{start} $event->{series_name} - $event->{title}\n";
|
||||
#saveEvent($config, $event);
|
||||
#exit;
|
||||
}
|
||||
|
||||
sub saveEvent{
|
||||
my $config = shift;
|
||||
my $event = shift;
|
||||
|
||||
$config->{access}->{write}=1;
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
$event->{'html_content'}=markup::creole_to_html($event->{'content'});
|
||||
|
||||
# set start date
|
||||
my $day_start=$config->{date}->{day_starting_hour};
|
||||
$event->{start_date} = time::add_hours_to_datetime($event->{start}, -$day_start);
|
||||
$event->{start_date} = time::datetime_to_date($event->{start_date});
|
||||
|
||||
# set end date
|
||||
$event->{end_date} = time::add_hours_to_datetime($event->{end}, -$day_start);
|
||||
$event->{end_date} = time::datetime_to_date($event->{end_date});
|
||||
|
||||
delete $event->{categories} if defined $event->{categories};
|
||||
|
||||
# set time of day
|
||||
my $day_times=$config->{date}->{time_of_day};
|
||||
my $event_hour=int((split(/[\-\:\sT]/,$event->{start}))[3]);
|
||||
for my $hour(sort {$a <=> $b} (keys %$day_times)){
|
||||
if ($event_hour >= $hour){
|
||||
$event->{time_of_day}=$day_times->{$hour};
|
||||
}else{
|
||||
last;
|
||||
};
|
||||
}
|
||||
$event->{published}=0;
|
||||
$event->{modified_by}='sync_cms';
|
||||
print Dumper($event);
|
||||
#db::insert($dbh,'calcms_events', $event);
|
||||
}
|
||||
|
||||
233
tools/sync_cms/lib/GoogleCalendarApi.pm
Normal file
233
tools/sync_cms/lib/GoogleCalendarApi.pm
Normal file
@@ -0,0 +1,233 @@
|
||||
package GoogleCalendarApi;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use JSON;
|
||||
use JSON::WebToken;
|
||||
use LWP::UserAgent;
|
||||
use HTML::Entities;
|
||||
use URI::Escape;
|
||||
use Data::Dumper;
|
||||
use DateTime;
|
||||
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $params = shift;
|
||||
|
||||
my $self={};
|
||||
for my $attr ('calendarId','debug'){
|
||||
$self->{$attr}=$params->{$attr} if defined $params->{$attr};
|
||||
}
|
||||
|
||||
my $instance=bless $self, $class;
|
||||
if ((defined $params->{serviceAccount}) && (defined $params->{privateKey})){
|
||||
$instance->login($params->{serviceAccount}, $params->{privateKey});
|
||||
}
|
||||
|
||||
return $instance;
|
||||
}
|
||||
|
||||
sub setCalendar{
|
||||
my $self=shift;
|
||||
my $calendarId=shift;
|
||||
$self->{calendarId}=$calendarId;
|
||||
}
|
||||
|
||||
sub getBasicUrl{
|
||||
my $self=shift;
|
||||
return 'https://www.googleapis.com/calendar/v3/calendars/'.encode_entities($self->{calendarId});
|
||||
}
|
||||
|
||||
#https://developers.google.com/google-apps/calendar/v3/reference/events/list
|
||||
|
||||
#returns {
|
||||
# 'timeZone' => 'Europe/Berlin',
|
||||
# 'description' => "Radioprogramm von Pi Radio f\x{fc}r 88vier.de",
|
||||
# 'defaultReminders' => [],
|
||||
# 'accessRole' => 'owner',
|
||||
# 'etag' => '"1415821582086000"',
|
||||
# 'kind' => 'calendar#events',
|
||||
# 'summary' => '88vier.de Pi Radio (Programm)',
|
||||
# 'updated' => '2014-11-12T19:46:22.086Z',
|
||||
# 'items' => [...]
|
||||
# }
|
||||
sub getEvents{
|
||||
my $self=shift;
|
||||
my $params=shift;
|
||||
|
||||
my $url='/events?';
|
||||
for my $param ('iCalUID','alwaysIncludeEmail','maxAttendees','maxResults','orderBy','pageToken','privateExtendedProperty',
|
||||
'q','sharedExtendedProperty','showDeleted','showHiddenInvitations','singleEvents','syncToken','timeZone'
|
||||
){
|
||||
$url.='&'.$param.'='.uri_escape($params->{$param}) if defined $params->{$param};
|
||||
}
|
||||
for my $param ('timeMin','timeMax','updatedMin'){
|
||||
$url.='&'.$param.'='.uri_escape($self->formatDateTime($params->{$param})) if defined $params->{$param};
|
||||
}
|
||||
my $result=$self->httpRequest('GET', $url);
|
||||
return $result;
|
||||
}
|
||||
|
||||
# sleep 0.25 seconds to prevent hitting the 5.0 requests/second/user rate
|
||||
sub sleep{
|
||||
my $this=shift;
|
||||
my $duration=shift || 0.25;
|
||||
select(undef, undef, undef, $duration);
|
||||
}
|
||||
|
||||
#https://developers.google.com/google-apps/calendar/v3/reference/events/delete
|
||||
sub deleteEvent{
|
||||
my $self=shift;
|
||||
my $eventId=shift;
|
||||
my $url='/events/'.$eventId;
|
||||
#DELETE https://www.googleapis.com/calendar/v3/calendars/calendarId/events/eventId
|
||||
my $result=$self->httpRequest('DELETE', $url);
|
||||
$self->sleep();
|
||||
return $result;
|
||||
}
|
||||
|
||||
#https://developers.google.com/google-apps/calendar/v3/reference/events/insert
|
||||
sub insertEvent{
|
||||
my $self=shift;
|
||||
my $params=shift;
|
||||
|
||||
my $event={
|
||||
start => {
|
||||
dateTime => $self->formatDateTime($params->{start})
|
||||
},
|
||||
end => {
|
||||
dateTime => $self->formatDateTime($params->{end})
|
||||
},
|
||||
summary => $params->{summary}||'',
|
||||
description => $params->{description}||'',
|
||||
location => $params->{location}||'',
|
||||
status => $params->{confirmed}||'confirmed'
|
||||
};
|
||||
$event= encode_json $event;
|
||||
|
||||
#POST https://www.googleapis.com/calendar/v3/calendars/calendarId/events
|
||||
my $url='/events';
|
||||
my $result=$self->httpRequest('POST', $url, $event);
|
||||
$self->sleep();
|
||||
return $result;
|
||||
}
|
||||
|
||||
# send a HTTP request
|
||||
sub httpRequest{
|
||||
my $self=shift;
|
||||
my $method=shift;
|
||||
my $url=shift;
|
||||
my $content=shift||'';
|
||||
|
||||
print STDERR "$method ".$url."\n" if $self->{debug};
|
||||
|
||||
die ("missing url") unless defined $url;
|
||||
die ("calendarId not set") unless defined $self->{calendarId};
|
||||
die ("not logged in ") unless defined $self->{api};
|
||||
|
||||
#prepend basic url including calendar id
|
||||
$url=$self->getBasicUrl().$url;
|
||||
print STDERR "$method ".$url."\n" if $self->{debug};
|
||||
|
||||
my $response=undef;
|
||||
if($method eq 'GET'){
|
||||
$response = $self->{api}->get($url);
|
||||
}elsif(($method eq 'POST')||($method eq 'PUT')){
|
||||
print STDERR $content."\n" if $self->{debug};
|
||||
my $request = HTTP::Request->new( $method, $url );
|
||||
$request->header( 'Content-Type' => 'application/json' );
|
||||
$request->content( $content );
|
||||
$response=$self->{api}->request( $request );
|
||||
}elsif($method eq 'DELETE'){
|
||||
$response = $self->{api}->delete($url);
|
||||
}
|
||||
|
||||
if($response->is_success) {
|
||||
my $content = $response->content;
|
||||
return {} if $content eq '';
|
||||
return decode_json($content);
|
||||
} else {
|
||||
print "ERROR:\n";
|
||||
print "Code: ".$response->code."\n";
|
||||
print "Message: ".$response->message."\n";
|
||||
print $response->content."\n";
|
||||
die;
|
||||
}
|
||||
}
|
||||
|
||||
# write datetime object to string
|
||||
sub formatDateTime{
|
||||
my $self=shift;
|
||||
my $dt=shift;
|
||||
|
||||
my $datetime= $dt->format_cldr("yyyy-MM-ddTHH:mm:ssZZZZZ");
|
||||
print STDERR "$dt -> $datetime\n" if $self->{debug};
|
||||
return $datetime;
|
||||
}
|
||||
|
||||
# parse datetime from string to object
|
||||
sub getDateTime{
|
||||
my $self=shift;
|
||||
my $datetime=shift;
|
||||
my $timezone=shift;
|
||||
|
||||
return if((!defined $datetime) or ($datetime eq ''));
|
||||
my @l=split /[\-\;T\s\:\+\.]/,$datetime;
|
||||
|
||||
$datetime=DateTime->new(
|
||||
year => $l[0],
|
||||
month => $l[1],
|
||||
day => $l[2],
|
||||
hour => $l[3],
|
||||
minute => $l[4],
|
||||
second => $l[5],
|
||||
time_zone => $timezone
|
||||
);
|
||||
return $datetime;
|
||||
}
|
||||
|
||||
# login with serviceAccount and webToken (from privateKey)
|
||||
sub login{
|
||||
my $self=shift;
|
||||
my $serviceAccount=shift;
|
||||
my $privateKey=shift;
|
||||
|
||||
# https://developers.google.com/accounts/docs/OAuth2ServiceAccount
|
||||
my $time = time;
|
||||
#create JSON Web Token
|
||||
my $jwt = JSON::WebToken->encode(
|
||||
{
|
||||
iss => $serviceAccount,
|
||||
scope => 'https://www.googleapis.com/auth/calendar',
|
||||
aud => 'https://accounts.google.com/o/oauth2/token',
|
||||
exp => $time + 3600,
|
||||
iat => $time,
|
||||
},
|
||||
$privateKey,
|
||||
'RS256',
|
||||
{typ => 'JWT'}
|
||||
);
|
||||
|
||||
#send JSON web token to authentication service
|
||||
$self->{auth} = LWP::UserAgent->new();
|
||||
my $response = $self->{auth}->post(
|
||||
'https://accounts.google.com/o/oauth2/token',
|
||||
{
|
||||
grant_type => encode_entities('urn:ietf:params:oauth:grant-type:jwt-bearer'),
|
||||
assertion => $jwt
|
||||
}
|
||||
);
|
||||
|
||||
die($response->code, "\n", $response->content, "\n") unless $response->is_success();
|
||||
my $data= decode_json($response->content);
|
||||
|
||||
#create a new user agent and set token to bearer
|
||||
$self->{api} = LWP::UserAgent->new();
|
||||
$self->{api}->default_header(Authorization => 'Bearer ' . $data->{access_token});
|
||||
|
||||
print STDERR "login successful\n" if $self->{debug};
|
||||
return $data;
|
||||
}
|
||||
|
||||
1;
|
||||
133
tools/sync_cms/lib/source/calcms_i.pl
Normal file
133
tools/sync_cms/lib/source/calcms_i.pl
Normal file
@@ -0,0 +1,133 @@
|
||||
#use markup;
|
||||
use creole_wiki;
|
||||
use DateTime;
|
||||
use events;
|
||||
use time;
|
||||
use config;
|
||||
#use DateTime::Format::ICal;
|
||||
|
||||
package source;
|
||||
use Data::Dumper;
|
||||
|
||||
my $settings={};
|
||||
|
||||
sub init{
|
||||
$source::settings=shift;
|
||||
#print STDERR Dumper($source::settings);
|
||||
}
|
||||
|
||||
#return a list of start_min, start_max request parameters. list is defined as timespan given by start_min and start_max in source_options
|
||||
sub split_request{
|
||||
|
||||
return undef if (
|
||||
(!(defined $source::settings->{start_min})) || ($source::settings->{start_min} eq'')
|
||||
||(!(defined $source::settings->{start_max})) || ($source::settings->{start_max} eq'')
|
||||
);
|
||||
|
||||
#print Dumper($source_options);
|
||||
my $dates=[];
|
||||
|
||||
my $start =time::get_datetime($source::settings->{start_min},$source::settings->{date}->{time_zone});
|
||||
my $end =time::get_datetime($source::settings->{start_max},$source::settings->{date}->{time_zone});
|
||||
my $date =$start;
|
||||
|
||||
#build a list of dates
|
||||
my @dates=();
|
||||
while ($date < $end){
|
||||
push @dates,$date;
|
||||
$date=$date->clone->add(days=>7);
|
||||
}
|
||||
my $duration=$end-$date;
|
||||
# print "sec:".($duration->delta_seconds/(60*60))."\n";
|
||||
if ($duration->delta_seconds <= 0){
|
||||
# pop @dates;
|
||||
push @dates,$end->clone;
|
||||
}
|
||||
|
||||
#build a list of parameters from dates
|
||||
my $start=shift @dates;
|
||||
for my $end (@dates){
|
||||
push @$dates,{
|
||||
start_min => $start,
|
||||
start_max => $end
|
||||
};
|
||||
$start=$end;
|
||||
}
|
||||
|
||||
# for $day(@$dates){print "$day->{start_min} - $day->{start_max}\n";}
|
||||
return $dates;
|
||||
|
||||
}
|
||||
|
||||
#get a hash with per-day-lists days of a google calendar, given by its url defined at $calendar_name
|
||||
sub get_events{
|
||||
my $block_number =$source::settings->{block_number};
|
||||
my $block_size =$source::settings->{block_size};
|
||||
my $last_update =$source::settings->{last_update};
|
||||
|
||||
#print Dumper($request);
|
||||
|
||||
my $request_parameters={
|
||||
from_date => $source::settings->{start_min},
|
||||
till_date => $source::settings->{start_max},
|
||||
archive => 'all',
|
||||
project => $source::settings->{project},
|
||||
template => 'no'
|
||||
};
|
||||
$request_parameters->{location}=$source::settings->{location} if ($source::settings->{location}ne'');
|
||||
|
||||
my $config = $source::settings;
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => \%params,
|
||||
checked => events::check_params($config,
|
||||
$request_parameters,
|
||||
$source::settings
|
||||
),
|
||||
},
|
||||
};
|
||||
#print Dumper($request);
|
||||
|
||||
my $source_events=events::get($config, $request, $source::settings);
|
||||
#print Dumper($source_events);
|
||||
|
||||
#return events by date
|
||||
my $sources_by_date={};
|
||||
my $old_start='';
|
||||
for my $source (@$source_events){
|
||||
$source->{calcms_start}=$source->{start};
|
||||
my $key=substr($source->{start},0,10);
|
||||
push @{$sources_by_date->{$key}},$source;
|
||||
}
|
||||
return $sources_by_date;
|
||||
}
|
||||
|
||||
sub get_event_attributes{
|
||||
my $source=shift;
|
||||
return $source;
|
||||
}
|
||||
|
||||
sub map_to_schema{
|
||||
my $event=shift;
|
||||
# print Dumper($source_options);
|
||||
# exit;
|
||||
|
||||
#override settings by source map filter
|
||||
for my $key (keys %{$source::settings->{mapping}}){
|
||||
$event->{$key}=$source::settings->{mapping}->{$key};
|
||||
}
|
||||
|
||||
#resolve variables set in mapped values
|
||||
for my $mkey (keys %{$source::settings->{mapping}}){
|
||||
for my $key (keys %{$event}){
|
||||
my $val=$event->{$key};
|
||||
$val=$event->{$key} if($mkey eq $key);
|
||||
$event->{$mkey}=~s/<TMPL_VAR $key>/$val/g;
|
||||
}
|
||||
}
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
eof;
|
||||
339
tools/sync_cms/lib/source/google_calendar.pl
Executable file
339
tools/sync_cms/lib/source/google_calendar.pl
Executable file
@@ -0,0 +1,339 @@
|
||||
#use markup;
|
||||
use creole_wiki;
|
||||
use DateTime;
|
||||
use Net::Google::Calendar;
|
||||
use DateTime::Format::ICal;
|
||||
|
||||
package source;
|
||||
#do 'time.pl';
|
||||
use Data::Dumper;
|
||||
|
||||
my $settings={};
|
||||
|
||||
sub init{
|
||||
$source::settings=shift;
|
||||
}
|
||||
|
||||
#return a list of start_min, start_max request parameters.
|
||||
#list is defined as timespan given by start_min and start_max in source::settings
|
||||
sub split_request{
|
||||
|
||||
return undef if (
|
||||
(!(defined $source::settings->{start_min})) || ($source::settings->{start_min} eq'')
|
||||
||(!(defined $source::settings->{start_max})) || ($source::settings->{start_max} eq'')
|
||||
);
|
||||
|
||||
my $dates=[];
|
||||
|
||||
my $start =get_datetime($source::settings->{start_min},$source::settings->{date}->{time_zone});
|
||||
my $end =get_datetime($source::settings->{start_max},$source::settings->{date}->{time_zone});
|
||||
my $date =$start;
|
||||
|
||||
#build a list of dates
|
||||
my @dates=();
|
||||
while ($date < $end){
|
||||
push @dates,$date;
|
||||
$date=$date->clone->add(days=>7);
|
||||
}
|
||||
my $duration=$end-$date;
|
||||
# print "sec:".($duration->delta_seconds/(60*60))."\n";
|
||||
if ($duration->delta_seconds <= 0){
|
||||
# pop @dates;
|
||||
push @dates,$end->clone;
|
||||
}
|
||||
|
||||
#build a list of parameters from dates
|
||||
my $start=shift @dates;
|
||||
for my $end (@dates){
|
||||
push @$dates,{
|
||||
start_min => $start,
|
||||
start_max => $end
|
||||
};
|
||||
$start=$end;
|
||||
}
|
||||
|
||||
# for $day(@$dates){print "$day->{start_min} - $day->{start_max}\n";}
|
||||
return $dates;
|
||||
|
||||
}
|
||||
|
||||
#get a hash with per-day-lists days of a google calendar, given by its url defined at $calendar_name
|
||||
sub get_events{
|
||||
|
||||
# print Dumper($source::settings);
|
||||
my $url =$source::settings->{access}->{url};
|
||||
my $email =$source::settings->{access}->{email};
|
||||
my $password =$source::settings->{access}->{password};
|
||||
|
||||
my $block_number =$source::settings->{block_number};
|
||||
my $block_size =$source::settings->{block_size};
|
||||
my $last_update =$source::settings->{last_update};
|
||||
|
||||
my $parameters={};
|
||||
my $start_index=undef;
|
||||
my $stop_index=undef;
|
||||
if ($source::settings->{read_blocks}==1){
|
||||
my $start_index=$block_number*$block_size+1 ;
|
||||
my $stop_index=$start_index+$block_size-1;
|
||||
$parameters->{"start-index"} = $start_index;
|
||||
$parameters->{"max-results"} = $block_size;
|
||||
$source::settings->{start_index}=$start_index;
|
||||
$source::settings->{stop_index}=$stop_index;
|
||||
}else{
|
||||
$parameters->{"max-results"} = 10000;
|
||||
}
|
||||
|
||||
#see http://code.google.com/intl/de/apis/calendar/data/2.0/reference.html
|
||||
$parameters->{singleevents}='true';
|
||||
$parameters->{orderby}='lastmodified';
|
||||
|
||||
my $more='modified' if (defined $last_update && $source::settings->{modified_events}==1);
|
||||
main::print_info("read $more events from google calendar: '".substr($url,0,40)."...".substr($url,length($url)-8)."'");
|
||||
|
||||
# print "\nblock '$block_number' (events ".$start_index."..".$stop_index.") \n" if (defined $block_number || defined $start_index || defined $stop_index);
|
||||
|
||||
# http://search.cpan.org/~simonw/Net-Google-Calendar-0.97/lib/Net/Google/Calendar.pm#get_events_[_%opts_]
|
||||
|
||||
my $cal = Net::Google::Calendar->new( url => $url );
|
||||
#main::print_info("new\n");
|
||||
if ($email ne'' && $password ne''){
|
||||
$cal->login($email, $password) ;
|
||||
# $cal->auth($email, $password) if ($email ne'' && $password ne'');
|
||||
# main::print_info("login $email $password");
|
||||
}
|
||||
#print Dumper($cal);
|
||||
|
||||
#set UTF-8
|
||||
$XML::Atom::ForceUnicode = 1;
|
||||
$XML::Atom::DefaultVersion = "1.0";
|
||||
|
||||
# my $xml=$cal->get_xml();
|
||||
# $xml=~s/<content/\n<content/gi;
|
||||
# print $xml."\n";
|
||||
# exit;
|
||||
|
||||
#set updated-min (using UTC)
|
||||
if ((defined $last_update) && ($source::settings->{modified_events}==1)){
|
||||
my $datetime=$last_update;
|
||||
$datetime=source::get_datetime($datetime,$source::settings->{date}->{time_zone}) if (ref($datetime)eq'');
|
||||
$datetime->set_time_zone('UTC');
|
||||
$parameters->{"updated-min"} = $datetime->datetime;
|
||||
#print "last update\n";
|
||||
}
|
||||
#set start min (using UTC)
|
||||
if ((defined $source::settings->{start_min}) && ($source::settings->{start_min}ne'')){
|
||||
my $datetime=$source::settings->{start_min};
|
||||
$datetime=source::get_datetime($datetime,$source::settings->{date}->{time_zone}) if (ref($datetime)eq'');
|
||||
$datetime->set_time_zone('UTC');
|
||||
$parameters->{"start-min"} = $datetime->datetime;
|
||||
$parameters->{"recurrence-expansion-start"}= $datetime->datetime;
|
||||
}
|
||||
#set start max (using UTC)
|
||||
if ((defined $source::settings->{start_max})&&($source::settings->{start_max} ne'')){
|
||||
my $datetime=$source::settings->{start_max};
|
||||
$datetime=source::get_datetime($datetime,$source::settings->{date}->{time_zone}) if (ref($datetime)eq'');
|
||||
$datetime->set_time_zone('UTC');
|
||||
$parameters->{"start-max"} = $datetime->datetime;
|
||||
$parameters->{"recurrence-expansion-end"}= $datetime->datetime;
|
||||
}
|
||||
|
||||
|
||||
# print Dumper($parameters);
|
||||
my @events=();
|
||||
my @source_events=$cal->get_events(%$parameters);
|
||||
main::print_info("found ".@source_events." events");
|
||||
|
||||
# print Dumper($parameters);
|
||||
# print Dumper($source::settings);
|
||||
# exit;
|
||||
|
||||
for my $source(@source_events) {
|
||||
(my $start,my $end)=$source->when;
|
||||
$start= $start->set_time_zone($source::settings->{date}->{time_zone})->datetime if (defined $start);
|
||||
$end= $end->set_time_zone ($source::settings->{date}->{time_zone})->datetime if (defined $end);
|
||||
$source->{calcms_start} = $start;
|
||||
$source->{calcms_end} = $end;
|
||||
$source->{status} = $source->status;
|
||||
}
|
||||
|
||||
#return events by date
|
||||
my $sources_by_date={};
|
||||
my $old_start='';
|
||||
# for my $source (sort{$a->{calcms_start} cmp $b->{calcms_start} }@source_events){
|
||||
for my $source (@source_events){
|
||||
# if ($source->{status}eq'confirmed'){
|
||||
my $key=substr($source->{calcms_start},0,10);
|
||||
# if ($old_start eq $source->{calcms_start}){
|
||||
# my $source=pop (@{$sources_by_date->{$key}});
|
||||
# print STDERR "WARNING: ignore canceled entry in google calendar: ".$source->{calcms_start}."\t".$source->{title}."\t".$source->{id}."\n";
|
||||
# }
|
||||
#
|
||||
push @{$sources_by_date->{$key}},$source;
|
||||
#
|
||||
# $old_start=$source->{calcms_start};
|
||||
# }
|
||||
}
|
||||
return $sources_by_date;
|
||||
}
|
||||
|
||||
sub map_to_schema{
|
||||
my $event=shift;
|
||||
|
||||
my $params={
|
||||
title => $event->{title},
|
||||
content => $event->{content},
|
||||
local_media_url => '<TMPL_VAR local_media_url>'
|
||||
};
|
||||
$params->{content}=~s/\x0A\x20/\n/g;
|
||||
#print Dumper($params);
|
||||
#open FILE,">/tmp/test";
|
||||
#print FILE Dumper($params);
|
||||
#close FILE;
|
||||
|
||||
#decode event
|
||||
$event=creole_wiki::extractEventFromWikiText($params, $event);
|
||||
#exit;
|
||||
|
||||
#override settings by source map filter
|
||||
for my $key (keys %{$source::settings->{mapping}}){
|
||||
$event->{$key}=$source::settings->{mapping}->{$key};
|
||||
}
|
||||
|
||||
#resolve variables set in mapped values
|
||||
for my $mkey (keys %{$source::settings->{mapping}}){
|
||||
for my $key (keys %{$event}){
|
||||
my $val=$event->{$key};
|
||||
$val=$event->{$key} if($mkey eq $key);
|
||||
$event->{$mkey}=~s/<TMPL_VAR $key>/$val/g;
|
||||
}
|
||||
}
|
||||
#print Dumper($event);
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub get_event_attributes{
|
||||
my $source=shift;
|
||||
|
||||
#print @source_events." ".Dumper($source)."\n";
|
||||
#use Data::Dumper;print Dumper($source->when);
|
||||
|
||||
#create an hash with calendar event settings
|
||||
my $event={
|
||||
start => $source->{calcms_start},
|
||||
end => $source->{calcms_end},
|
||||
status => $source->{status},
|
||||
# recurrence => $source->{recurrence},
|
||||
reference => $source->id,
|
||||
# program => $program,
|
||||
# series_name => $series_name,
|
||||
title => $source->title,
|
||||
content => $source->content->body,
|
||||
author_name => $source->author->name,
|
||||
author_uri => $source->author->uri,
|
||||
author_email => $source->author->email,
|
||||
transparency => $source->transparency,
|
||||
visibility => $source->visibility,
|
||||
location => $source->location,
|
||||
# podcast_url => $podcast_url,
|
||||
# media_url => $media_url,
|
||||
# comments => $source->comments
|
||||
# who_name => $source->who->name,
|
||||
# who_email => $source->who->email,
|
||||
# who_attendee_status => $source->who->attendee_status,
|
||||
};
|
||||
#print Dumper($event);
|
||||
|
||||
# if ($source->recurrence){
|
||||
# $event->{recurrence}=get_event_recurrence($source,$event);
|
||||
# }
|
||||
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub get_event_recurrence{
|
||||
my $source=shift;
|
||||
my $event=shift;
|
||||
#print Dumper();
|
||||
|
||||
my $event_recurrence=$source->recurrence;
|
||||
my $properties = $event_recurrence->properties;
|
||||
# print Dumper($properties);
|
||||
|
||||
my $dtstart = $properties->{dtstart}->[0]->{value};
|
||||
my $timezone = $properties->{dtstart}->[0]->{_parameters}->{TZID};
|
||||
my $dtend = $properties->{dtend}->[0]->{value};
|
||||
my $rrule = $properties->{rrule}->[0]->{value};
|
||||
# print $rrule."\n";
|
||||
|
||||
#convert timezone from "until=<datetime>" to same datetime as in dtstart
|
||||
if ($rrule=~/UNTIL=([\dT]+Z?)/){
|
||||
my $ical=$1;
|
||||
|
||||
#convert timezone at ical format
|
||||
my $datetime= DateTime::Format::ICal->parse_datetime($ical);
|
||||
$datetime=$datetime->set_time_zone($timezone);
|
||||
$ical=DateTime::Format::ICal->format_datetime($datetime);
|
||||
|
||||
#remove TZID=... from ical, since not implemented at format_datetime
|
||||
$ical=~s/[^\:]+\://;
|
||||
$rrule=~s/(UNTIL\=)([\dT]+Z?)/$1$ical/g;
|
||||
# print $datetime->datetime." --> $ical --> $rrule\n";
|
||||
}
|
||||
|
||||
$dtstart = DateTime::Format::ICal->parse_datetime($dtstart);
|
||||
$dtend = DateTime::Format::ICal->parse_datetime($dtend);#->add(seconds=>3600)->set_time_zone('UTC');
|
||||
|
||||
my $recurrence={
|
||||
dtstart => $dtstart,
|
||||
dtend => $dtend,
|
||||
rrule => $rrule
|
||||
};
|
||||
|
||||
#calc duration of the event
|
||||
my $duration=$dtend-$dtstart;
|
||||
my $duration_min=$duration->delta_minutes;
|
||||
|
||||
# print Dumper($duration_min);
|
||||
#print Dumper($recurrence);
|
||||
my $recurrence_start = DateTime::Format::ICal->parse_recurrence(
|
||||
recurrence =>$rrule,
|
||||
dtstart =>$dtstart
|
||||
);
|
||||
|
||||
#step through recurrent events and mark if event matchs
|
||||
my $start_iter = $recurrence_start->iterator;
|
||||
$c=1;
|
||||
while (my $start = $start_iter->next ){
|
||||
# print "$start eq $event->{start}, $end\n";
|
||||
$recurrence->{number}=$c if ($start eq $event->{start});
|
||||
# push @dates,{
|
||||
# start => $start->set_time_zone($source::settings->{time_zone})->datetime,
|
||||
# end => $start->set_time_zone($source::settings->{time_zone})->add(minutes=>$duration_min)->datetime
|
||||
# };
|
||||
$c++;
|
||||
}
|
||||
$event->{recurrence}=$recurrence;
|
||||
#print Dumper($event->{recurrence});
|
||||
|
||||
}
|
||||
|
||||
sub get_datetime{
|
||||
my $datetime=shift;
|
||||
my $timezone=shift;
|
||||
|
||||
return if((!defined $datetime) or ($datetime eq ''));
|
||||
my @l=@{time::datetime_to_array($datetime)};
|
||||
$datetime=DateTime->new(
|
||||
year =>$l[0],
|
||||
month =>$l[1],
|
||||
day =>$l[2],
|
||||
hour =>$l[3],
|
||||
minute =>$l[4],
|
||||
second =>$l[5],
|
||||
time_zone=> $timezone
|
||||
);
|
||||
return $datetime;
|
||||
}
|
||||
|
||||
eof;
|
||||
233
tools/sync_cms/lib/target/google_calendar.pl
Normal file
233
tools/sync_cms/lib/target/google_calendar.pl
Normal file
@@ -0,0 +1,233 @@
|
||||
#require 'db.pl';
|
||||
#use db;
|
||||
#use markup;
|
||||
|
||||
package target;
|
||||
use Data::Dumper;
|
||||
use Net::Google::Calendar;
|
||||
use time;
|
||||
|
||||
my $settings={};
|
||||
my $cal = undef;
|
||||
#my $op_count=0;
|
||||
|
||||
sub init{
|
||||
$target::settings=shift;
|
||||
my $access=$target::settings->{access};
|
||||
$target::cal = Net::Google::Calendar->new( url => $access->{url} );
|
||||
#main::print_info("init\n");
|
||||
#main::print_info("new\n");
|
||||
#print Dumper($access);
|
||||
|
||||
my $email=$access->{email};
|
||||
my $password=$access->{password};
|
||||
if ($email ne'' && $password ne''){
|
||||
$target::cal->login($email, $password) ;
|
||||
# $target::cal->auth($email, $password) if ($email ne'' && $password ne'');
|
||||
main::print_info("loged in");
|
||||
}
|
||||
#print Dumper($target::cal);
|
||||
|
||||
# for my $c($target::cal->get_calendars) {
|
||||
# print "'".$c->title."'\n";
|
||||
# print $c->id."\n\n";
|
||||
# if ($c->title eq 'petra poss'){
|
||||
# $target::cal->set_calendar($c);
|
||||
# main::print_info("found matching calendar!");
|
||||
# }
|
||||
# }
|
||||
# exit;
|
||||
|
||||
#set UTF-8
|
||||
$XML::Atom::ForceUnicode = 1;
|
||||
$XML::Atom::DefaultVersion = "1.0";
|
||||
|
||||
}
|
||||
|
||||
#map event schema to target schema
|
||||
sub map_to_schema{
|
||||
my $event=shift;
|
||||
|
||||
#clone event
|
||||
my $target_event={};
|
||||
for my $key (keys %{$event}){
|
||||
$target_event->{$key}=$event->{$key};
|
||||
}
|
||||
|
||||
$target_event->{reference}.='['.$event->{recurrence}->{number}.']' if ($event->{recurrence}->{number}>0);
|
||||
$target_event->{recurrence} => $event->{recurrence}->{number}+0;
|
||||
$target_event->{rating} => 0;
|
||||
$target_event->{visibility} => 0;
|
||||
# $target_event->{transparency} => $event->{transparency};
|
||||
|
||||
#set project by project's date range
|
||||
for my $project_name (keys %{$target::settings->{projects}}){
|
||||
my $project=$target::settings->{projects}->{$project_name};
|
||||
my $start=substr($event->{start},0,10);
|
||||
if ($start ge $project->{start_date} && $start le $project->{end_date}){
|
||||
$target_event->{project}=$project->{name};
|
||||
}
|
||||
# print "$event->{start} gt $project->{start_date} $target_event->{project}\n";
|
||||
}
|
||||
|
||||
#override settings by target map filter
|
||||
for my $key (keys %{$target::settings->{mapping}}){
|
||||
$target_event->{$key}=$target::settings->{mapping}->{$key};
|
||||
}
|
||||
#use Data::Dumper;print Dumper($target_event);
|
||||
|
||||
#resolve variables set in mapped values
|
||||
for my $mkey (keys %{$target::settings->{mapping}}){
|
||||
my $mval=$target_event->{$mkey};
|
||||
for my $key (sort keys %{$target_event}){
|
||||
my $val=$target_event->{$key};
|
||||
$val=$event->{$key} if($mkey eq $key);
|
||||
#print $target_event->{$mkey}."\t".$key."-> $val\n";
|
||||
$target_event->{$mkey}=~s/<TMPL_VAR $key>/$val/g;
|
||||
}
|
||||
}
|
||||
#use Data::Dumper;print Dumper($target_event);#exit;
|
||||
|
||||
#$schema->{event}=fix_fields($schema->{event});
|
||||
|
||||
my $schema={
|
||||
event => $target_event
|
||||
};
|
||||
|
||||
return $schema;
|
||||
}
|
||||
|
||||
# get a event by an existing google id, e.g. to check if the event exists in target
|
||||
sub get_event_by_reference_id{
|
||||
return undef;
|
||||
}
|
||||
|
||||
#try to find a event, matching to $event from google calendar
|
||||
sub find_event{
|
||||
my $event=shift;
|
||||
return undef;
|
||||
|
||||
}
|
||||
|
||||
sub pre_sync{
|
||||
my $event=shift;
|
||||
|
||||
$debug=1;
|
||||
return undef if(($target::settings->{date}->{'time_zone'} eq '') || ($event->{start} eq '' ) || ($event->{end} eq ''));
|
||||
|
||||
#delete a span of dates
|
||||
print "\n" if ($debug eq '1');
|
||||
my $time_zone=$target::settings->{date}->{'time_zone'};
|
||||
my $start=time::get_datetime($event->{start},$time_zone);
|
||||
$start->set_time_zone('UTC');
|
||||
$parameters->{"start-min"} = $start->datetime;
|
||||
#$parameters->{"recurrence-expansion-start"}= $start->datetime;
|
||||
|
||||
my $end=time::get_datetime($event->{end},$time_zone);
|
||||
$end->set_time_zone('UTC');
|
||||
$parameters->{"start-max"} = $end->datetime;
|
||||
#$parameters->{"recurrence-expansion-end"}= $end->datetime;
|
||||
|
||||
main::print_info("search target for events from ".$start." to ".$end) if ($debug eq '1');
|
||||
|
||||
my @events=$target::cal->get_events(%$parameters);
|
||||
|
||||
for my $event(@events){
|
||||
main::print_info("delete ".$event->title) if ($debug eq '1');
|
||||
$target::cal->delete_entry($event);
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
# insert a new event
|
||||
sub insert_event{
|
||||
my $event=shift;
|
||||
my $entity=$event->{event};
|
||||
|
||||
$entity->{'html_content'}=markup::creole_to_html($entity->{'content'});
|
||||
|
||||
my $time_zone =$target::settings->{date}->{'time_zone'};
|
||||
my $start =time::get_datetime($entity->{start},$time_zone);
|
||||
my $end =time::get_datetime($entity->{end},$time_zone);
|
||||
#print Dumper($start)."\n";
|
||||
#print Dumper($end)."\n";
|
||||
print "\n" if ($debug eq '1');
|
||||
|
||||
main::print_info("insert event") if ($debug eq '1');
|
||||
my $entry = Net::Google::Calendar::Entry->new();
|
||||
|
||||
#print Dumper($entity);
|
||||
$entry->title($entity->{title});
|
||||
$entry->content($entity->{content});
|
||||
$entry->location($entity->{location});
|
||||
$entry->transparency('transparent');
|
||||
$entry->status('confirmed');
|
||||
$entry->when($start, $end);
|
||||
#print Dumper($entry);
|
||||
|
||||
$target::cal->add_entry($entry);
|
||||
#exit;
|
||||
}
|
||||
|
||||
|
||||
# update an existing event
|
||||
sub update_event{
|
||||
return;
|
||||
}
|
||||
### end of interface implementation ###
|
||||
|
||||
|
||||
sub print_event{
|
||||
my $header=shift;
|
||||
my $event=shift;
|
||||
|
||||
if ($header eq'google'){
|
||||
print "\n===== $header =====";
|
||||
}else{
|
||||
print "$header\n" if $header ne '';
|
||||
}
|
||||
# print qq!$event->{start} $event->{program} : $event->{series_name} - $event->{title}!."\n";
|
||||
#content: >$event->{content}<
|
||||
};
|
||||
|
||||
sub delete_event{
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
sub fix_fields{
|
||||
my $event=shift;
|
||||
#lower case for upper case titles longer than 4 characters
|
||||
for my $attr qw(program series_name title){
|
||||
my $val=$event->{$attr};
|
||||
my $c=0;
|
||||
while ($val=~/\b([A-Z]{5,99})\b/ && $c<10){
|
||||
my $word=$1;
|
||||
my $lower=lc $word;
|
||||
$lower=~s/^([a-z])/\u$1/gi;
|
||||
$val=~s/$word/$lower/g;
|
||||
$c++;
|
||||
}
|
||||
if ($event->{$attr} ne $val){
|
||||
$event->{$attr}=$val;
|
||||
# print Dumper($event->{$attr}).'<>'.Dumper($val)."\n" ;
|
||||
}
|
||||
}
|
||||
|
||||
for my $attr qw(program series_name title excerpt content ){
|
||||
my $val=$event->{$attr};
|
||||
$val=~s/^\s*(.*?)\s*$/$1/g;
|
||||
$val=~s/^[ \t]/ /g;
|
||||
if ($event->{$attr} ne $val){
|
||||
$event->{$attr}=$val;
|
||||
# print Dumper($event->{$attr}).'<>'.Dumper($val)."\n" ;
|
||||
}
|
||||
}
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub clean_up{
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
254
tools/sync_cms/lib/target/google_calendar2.pl
Normal file
254
tools/sync_cms/lib/target/google_calendar2.pl
Normal file
@@ -0,0 +1,254 @@
|
||||
#require 'db.pl';
|
||||
#use db;
|
||||
#use markup;
|
||||
|
||||
package target;
|
||||
use lib '/home/radio/calcms/sync_cms/lib/';
|
||||
use Data::Dumper;
|
||||
#use Net::Google::Calendar;
|
||||
use GoogleCalendarApi;
|
||||
use time;
|
||||
|
||||
my $settings={};
|
||||
my $cal = undef;
|
||||
#my $op_count=0;
|
||||
|
||||
sub init{
|
||||
$target::settings=shift;
|
||||
my $access=$target::settings->{access};
|
||||
|
||||
# 1. create service account at https://console.developers.google.com/
|
||||
# 2. enable Calendar API
|
||||
# 3. share calendar with service account for update permissions
|
||||
|
||||
# see http://search.cpan.org/~shigeta/Google-API-Client-0.13/lib/Google/API/Client.pm
|
||||
|
||||
my $serviceAccount = $access->{serviceAccount};
|
||||
my $serviceAccountKeyFile = $access->{serviceAccountKeyFile};
|
||||
my $calendarId = $access->{calendarId};
|
||||
|
||||
my $serviceAccountKey = loadFile($serviceAccountKeyFile);
|
||||
|
||||
#print "connect...\n";
|
||||
my $calendar = new GoogleCalendarApi({
|
||||
'serviceAccount' => $serviceAccount,
|
||||
'privateKey' => $serviceAccountKey,
|
||||
'calendarId' => $calendarId,
|
||||
'debug' => 0
|
||||
});
|
||||
#print Dumper($calendar);
|
||||
$target::cal = $calendar;
|
||||
|
||||
}
|
||||
|
||||
#map event schema to target schema
|
||||
sub map_to_schema{
|
||||
my $event=shift;
|
||||
|
||||
#clone event
|
||||
my $target_event={};
|
||||
for my $key (keys %{$event}){
|
||||
$target_event->{$key}=$event->{$key};
|
||||
}
|
||||
|
||||
$target_event->{reference}.='['.$event->{recurrence}->{number}.']' if ($event->{recurrence}->{number}>0);
|
||||
$target_event->{recurrence} => $event->{recurrence}->{number}+0;
|
||||
$target_event->{rating} => 0;
|
||||
$target_event->{visibility} => 0;
|
||||
# $target_event->{transparency} => $event->{transparency};
|
||||
|
||||
#set project by project's date range
|
||||
for my $project_name (keys %{$target::settings->{projects}}){
|
||||
my $project=$target::settings->{projects}->{$project_name};
|
||||
my $start=substr($event->{start},0,10);
|
||||
if ($start ge $project->{start_date} && $start le $project->{end_date}){
|
||||
$target_event->{project}=$project->{name};
|
||||
}
|
||||
# print "$event->{start} gt $project->{start_date} $target_event->{project}\n";
|
||||
}
|
||||
|
||||
#override settings by target map filter
|
||||
for my $key (keys %{$target::settings->{mapping}}){
|
||||
$target_event->{$key}=$target::settings->{mapping}->{$key};
|
||||
}
|
||||
#use Data::Dumper;print Dumper($target_event);
|
||||
|
||||
#resolve variables set in mapped values
|
||||
for my $mkey (keys %{$target::settings->{mapping}}){
|
||||
my $mval=$target_event->{$mkey};
|
||||
for my $key (sort keys %{$target_event}){
|
||||
my $val=$target_event->{$key};
|
||||
$val=$event->{$key} if($mkey eq $key);
|
||||
#print $target_event->{$mkey}."\t".$key."-> $val\n";
|
||||
$target_event->{$mkey}=~s/<TMPL_VAR $key>/$val/g;
|
||||
}
|
||||
}
|
||||
#use Data::Dumper;print Dumper($target_event);#exit;
|
||||
|
||||
#$schema->{event}=fix_fields($schema->{event});
|
||||
|
||||
my $schema={
|
||||
event => $target_event
|
||||
};
|
||||
|
||||
return $schema;
|
||||
}
|
||||
|
||||
# get a event by an existing google id, e.g. to check if the event exists in target
|
||||
sub get_event_by_reference_id{
|
||||
return undef;
|
||||
}
|
||||
|
||||
#try to find a event, matching to $event from google calendar
|
||||
sub find_event{
|
||||
my $event=shift;
|
||||
return undef;
|
||||
|
||||
}
|
||||
|
||||
#this is done before sync and allows to delete old events before adding new
|
||||
sub pre_sync{
|
||||
my $event=shift;
|
||||
|
||||
$debug=1;
|
||||
return undef if(($target::settings->{date}->{'time_zone'} eq '') || ($event->{start} eq '' ) || ($event->{end} eq ''));
|
||||
|
||||
#delete a span of dates
|
||||
print "\n" if ($debug eq '1');
|
||||
|
||||
my $timeZone=$target::settings->{date}->{'time_zone'};
|
||||
|
||||
#get datetime in timezone
|
||||
my $start = time::get_datetime($event->{start}, $timeZone);
|
||||
my $end = time::get_datetime($event->{end}, $timeZone);
|
||||
|
||||
main::print_info("search target for events from ".$start." to ".$end) if ($debug eq '1');
|
||||
|
||||
my $events=$target::cal->getEvents({
|
||||
#search datetime with same timezone
|
||||
timeMin => $target::cal->getDateTime($start->datetime, $timeZone),
|
||||
timeMax => $target::cal->getDateTime($end->datetime, $timeZone),
|
||||
maxResults => 50,
|
||||
singleEvents => 'true',
|
||||
orderBy => 'startTime'
|
||||
});
|
||||
|
||||
my $now=DateTime->now()->set_time_zone('UTC')->epoch();
|
||||
#print Dumper($now->datetime);
|
||||
#exit;
|
||||
|
||||
for my $event(@{$events->{items}}){
|
||||
main::print_info("delete\t$event->{start}->{dateTime}\t".$event->{summary}) if ($debug eq '1');
|
||||
#my $updated = $target::cal->getDateTime($event->{updated},'UTC')->epoch();
|
||||
#my $delta = $now-$updated;
|
||||
#print $delta." seconds old\n";
|
||||
$target::cal->deleteEvent($event->{id})
|
||||
};
|
||||
#exit;
|
||||
}
|
||||
|
||||
|
||||
# insert a new event
|
||||
sub insert_event{
|
||||
my $event=shift;
|
||||
my $entity=$event->{event};
|
||||
|
||||
$entity->{'html_content'}=markup::creole_to_html($entity->{'content'});
|
||||
|
||||
my $timeZone = $target::settings->{date}->{'time_zone'};
|
||||
#print Dumper($timeZone);
|
||||
#print Dumper($entity);
|
||||
my $start = $target::cal->getDateTime($entity->{start}, $timeZone);
|
||||
my $end = $target::cal->getDateTime($entity->{end}, $timeZone);
|
||||
print "\n" if ($debug eq '1');
|
||||
#exit;
|
||||
main::print_info("insert event\t$start\t$entity->{title}") if ($debug eq '1');
|
||||
my $entry = {
|
||||
start => $start,
|
||||
end => $end,
|
||||
summary => $entity->{title},
|
||||
description => $entity->{content},
|
||||
location => $entity->{location},
|
||||
transparency => 'transparent',
|
||||
status => 'confirmed'
|
||||
};
|
||||
|
||||
my $result=$target::cal->insertEvent($entry);
|
||||
my $id=$result->{id};
|
||||
|
||||
#exit;
|
||||
}
|
||||
|
||||
sub loadFile{
|
||||
my $filename=shift;
|
||||
my $content='';
|
||||
|
||||
open my $file, '<', $filename || die("cannot load $filename");
|
||||
while(<$file>){
|
||||
$content.=$_;
|
||||
}
|
||||
close $file;
|
||||
return $content;
|
||||
}
|
||||
|
||||
# update an existing event
|
||||
sub update_event{
|
||||
return;
|
||||
}
|
||||
### end of interface implementation ###
|
||||
|
||||
|
||||
sub print_event{
|
||||
my $header=shift;
|
||||
my $event=shift;
|
||||
|
||||
if ($header eq'google'){
|
||||
print "\n===== $header =====";
|
||||
}else{
|
||||
print "$header\n" if $header ne '';
|
||||
}
|
||||
# print qq!$event->{start} $event->{program} : $event->{series_name} - $event->{title}!."\n";
|
||||
#content: >$event->{content}<
|
||||
};
|
||||
|
||||
sub delete_event{
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
sub fix_fields{
|
||||
my $event=shift;
|
||||
#lower case for upper case titles longer than 4 characters
|
||||
for my $attr qw(program series_name title){
|
||||
my $val=$event->{$attr};
|
||||
my $c=0;
|
||||
while ($val=~/\b([A-Z]{5,99})\b/ && $c<10){
|
||||
my $word=$1;
|
||||
my $lower=lc $word;
|
||||
$lower=~s/^([a-z])/\u$1/gi;
|
||||
$val=~s/$word/$lower/g;
|
||||
$c++;
|
||||
}
|
||||
if ($event->{$attr} ne $val){
|
||||
$event->{$attr}=$val;
|
||||
# print Dumper($event->{$attr}).'<>'.Dumper($val)."\n" ;
|
||||
}
|
||||
}
|
||||
|
||||
for my $attr qw(program series_name title excerpt content ){
|
||||
my $val=$event->{$attr};
|
||||
$val=~s/^\s*(.*?)\s*$/$1/g;
|
||||
$val=~s/^[ \t]/ /g;
|
||||
if ($event->{$attr} ne $val){
|
||||
$event->{$attr}=$val;
|
||||
# print Dumper($event->{$attr}).'<>'.Dumper($val)."\n" ;
|
||||
}
|
||||
}
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub clean_up{
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
195
tools/sync_cms/lib/target/playlist_csv.pl
Normal file
195
tools/sync_cms/lib/target/playlist_csv.pl
Normal file
@@ -0,0 +1,195 @@
|
||||
package target;
|
||||
use Data::Dumper;
|
||||
use time;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
my $settings={};
|
||||
my $cal = undef;
|
||||
|
||||
sub init{
|
||||
$target::settings=shift;
|
||||
my $access=$target::settings->{access};
|
||||
$cal = [];
|
||||
}
|
||||
|
||||
#map event schema to target schema
|
||||
sub map_to_schema{
|
||||
my $event=shift;
|
||||
#clone event
|
||||
my $target_event={};
|
||||
for my $key (keys %{$event}){
|
||||
$target_event->{$key}=$event->{$key};
|
||||
}
|
||||
|
||||
$event->{recurrence}->{number}=0 unless (defined $event->{recurrence} || defined $event->{recurrence}->{number});
|
||||
$target_event->{reference}.='['.$event->{recurrence}->{number}.']' if ($event->{recurrence}->{number}>0);
|
||||
$target_event->{recurrence} => $event->{recurrence}->{number};
|
||||
$target_event->{rating} => 0;
|
||||
$target_event->{visibility} => 0;
|
||||
# $target_event->{transparency} => $event->{transparency};
|
||||
|
||||
#set project by project's date range
|
||||
for my $project_name (keys %{$target::settings->{projects}}){
|
||||
my $project=$target::settings->{projects}->{$project_name};
|
||||
my $start=substr($event->{start},0,10);
|
||||
if ($start ge $project->{start_date} && $start le $project->{end_date}){
|
||||
$target_event->{project}=$project->{name};
|
||||
}
|
||||
}
|
||||
|
||||
#override settings by target map filter
|
||||
for my $key (keys %{$target::settings->{mapping}}){
|
||||
$target_event->{$key}=$target::settings->{mapping}->{$key};
|
||||
}
|
||||
|
||||
#resolve variables set in mapped values
|
||||
for my $mkey (keys %{$target::settings->{mapping}}){
|
||||
my $mval=$target_event->{$mkey};
|
||||
for my $key (keys %{$target_event}){
|
||||
my $val=$target_event->{$key};
|
||||
$val=$event->{$key} if($mkey eq $key);
|
||||
$target_event->{$mkey}=~s/<TMPL_VAR $key>/$val/g;
|
||||
}
|
||||
}
|
||||
|
||||
my $schema={
|
||||
event => $target_event
|
||||
};
|
||||
|
||||
return $schema;
|
||||
}
|
||||
|
||||
# get a event by an existing reference id, e.g. to check if the event exists in target
|
||||
sub get_event_by_reference_id{
|
||||
my $event_id=shift;
|
||||
my $event={};
|
||||
return undef;
|
||||
}
|
||||
|
||||
#try to find a event
|
||||
sub find_event{
|
||||
my $event=shift;
|
||||
return undef;
|
||||
}
|
||||
|
||||
# insert a new event
|
||||
sub insert_event{
|
||||
my $event=shift;
|
||||
my $entity=$event->{event};
|
||||
|
||||
my $time_zone =$target::settings->{date}->{'time_zone'};
|
||||
my $start =time::get_datetime($entity->{start},$time_zone);
|
||||
my $end =time::get_datetime($entity->{end},$time_zone);
|
||||
print "\n" if ($main::debug eq '1');
|
||||
|
||||
main::print_info("insert event") if ($main::debug eq '1');
|
||||
push @$cal,{
|
||||
start => $start,
|
||||
end => $end,
|
||||
title => $entity->{title}
|
||||
}
|
||||
#exit;
|
||||
}
|
||||
|
||||
|
||||
# update an existing event
|
||||
sub update_event{
|
||||
my $event=shift;
|
||||
my $entity=shift;
|
||||
}
|
||||
### end of interface implementation ###
|
||||
|
||||
|
||||
sub print_event{
|
||||
my $header=shift;
|
||||
my $event=shift;
|
||||
|
||||
if ($header eq'google'){
|
||||
print "\n===== $header =====";
|
||||
}else{
|
||||
print "$header\n" if $header ne '';
|
||||
}
|
||||
# print qq!$event->{start} $event->{program} : $event->{series_name} - $event->{title}!."\n";
|
||||
#content: >$event->{content}<
|
||||
};
|
||||
|
||||
sub delete_event{
|
||||
my $event_id=shift;
|
||||
|
||||
}
|
||||
|
||||
sub fix_fields{
|
||||
my $event=shift;
|
||||
|
||||
for my $attr qw(title){
|
||||
my $val=$event->{$attr};
|
||||
$val=~s/^\s*(.*?)\s*$/$1/g;
|
||||
$val=~s/^[ \t]/ /g;
|
||||
if ($event->{$attr} ne $val){
|
||||
$event->{$attr}=$val;
|
||||
# print Dumper($event->{$attr}).'<>'.Dumper($val)."\n" ;
|
||||
}
|
||||
}
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub pre_sync{
|
||||
}
|
||||
|
||||
sub clean_up{
|
||||
my $content='';
|
||||
|
||||
my @cal=sort {$a->{start} cmp $b->{end}} @$cal;
|
||||
my @cal2=();
|
||||
#print Dumper(\@cal);
|
||||
#fill in default
|
||||
if (defined $target::settings->{date}->{default_entry}){
|
||||
my $from=$main::from;
|
||||
if ($from=~/^\d\d\d\d\-\d\d\-\d\dT\d\d$/){
|
||||
$from.=':00';
|
||||
}
|
||||
my $till=$main::till;
|
||||
if ($till=~/^\d\d\d\d\-\d\d\-\d\dT\d\d$/){
|
||||
$till.=':59';
|
||||
}
|
||||
|
||||
my $default=$target::settings->{date}->{default_entry};
|
||||
if ($cal[0]->{start} gt $from){
|
||||
unshift @cal,{
|
||||
start => $from,
|
||||
end => $cal[0]->{start},
|
||||
title => $default
|
||||
}
|
||||
}
|
||||
if ($cal[-1]->{end} lt $till){
|
||||
push @cal,{
|
||||
start => $cal[-1]->{end},
|
||||
end => $till,
|
||||
title => $default
|
||||
}
|
||||
}
|
||||
my $old_event={end=>$from};
|
||||
for my $event (@cal){
|
||||
if ($event->{start} gt $old_event->{end}){
|
||||
push @cal2,{
|
||||
start => $old_event->{end},
|
||||
end => $event->{start},
|
||||
title => $default
|
||||
}
|
||||
}
|
||||
push @cal2,$event;
|
||||
$old_event=$event;
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
for my $event(@cal2){
|
||||
$content.= $event->{start}.";\t".$event->{end}.";\t".$event->{title}."\n";
|
||||
}
|
||||
log::save_file($target::settings->{access}->{file},$content);
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
567
tools/sync_cms/sync_cms.pl
Executable file
567
tools/sync_cms/sync_cms.pl
Executable file
@@ -0,0 +1,567 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
BEGIN{
|
||||
my $dir='';
|
||||
$ENV{SCRIPT_FILENAME}||'' if ($dir eq'');
|
||||
$dir=~s/(.*\/)[^\/]+/$1/ if ($dir ne '');
|
||||
$dir=$ENV{PWD} if ($dir eq'');
|
||||
$dir=`pwd` if ($dir eq'');
|
||||
|
||||
#add calcms libs
|
||||
unshift(@INC,$dir.'/../calcms/');
|
||||
}
|
||||
|
||||
use Data::Dumper;
|
||||
use Getopt::Long;
|
||||
use Config::General;
|
||||
use time;
|
||||
use DateTime;
|
||||
use DateTime::Duration;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
check_running_processes();
|
||||
|
||||
my $read_mode='';
|
||||
my $update_mode='';
|
||||
my $all_events='';
|
||||
my $modified_events='';
|
||||
my $source_config_file='';
|
||||
my $target_config_file='';
|
||||
my $block_number=0;
|
||||
my $block_size=2000;
|
||||
our $from='';
|
||||
our $till='';
|
||||
my $read_only=0;
|
||||
our $output_type='text';
|
||||
our $debug=0;
|
||||
|
||||
GetOptions(
|
||||
"read" => \$read_mode,
|
||||
"update" => \$update_mode,
|
||||
"all" => \$all_events,
|
||||
"modified" => \$modified_events,
|
||||
"from=s" => \$from,
|
||||
"till=s" => \$till,
|
||||
"source=s" => \$source_config_file,
|
||||
"target=s" => \$target_config_file,
|
||||
"block_number:i" => \$block_number,
|
||||
"block_size:i" => \$block_size,
|
||||
"output_type=s" => \$output_type,
|
||||
);
|
||||
|
||||
$|=1;
|
||||
|
||||
BEGIN {
|
||||
our $utf8dbi=1;
|
||||
$ENV{LANG}="en_US.UTF-8";
|
||||
}
|
||||
|
||||
#source and taget settings are loaded from config files
|
||||
our $settings={
|
||||
};
|
||||
|
||||
#user interface
|
||||
our $ask_before_insert=0;
|
||||
our $ask_before_update=0;
|
||||
|
||||
# end of configuration
|
||||
|
||||
if ($update_mode){
|
||||
$db::write=1;
|
||||
# print_info("enter update mode");
|
||||
}elsif($read_mode){
|
||||
#default
|
||||
$db::write=0;
|
||||
# print_info("enter read-only mode");
|
||||
}else{
|
||||
print_error("set parameter >read< or >update<");
|
||||
}
|
||||
|
||||
unless ($modified_events || $all_events || $from || $till){
|
||||
print_error("set one of folling parameters: --modified, --from, --till");
|
||||
}
|
||||
|
||||
init();
|
||||
sync();
|
||||
print_info("$0 done.");
|
||||
exit 0;
|
||||
|
||||
#sync all events, splitting multi-day-requests into multiple 1-day-requests to avoid large result sets
|
||||
sub sync{
|
||||
#prepare target
|
||||
print_info("$0 inited");
|
||||
print_info("last update: $settings->{source}->{last_update}");
|
||||
|
||||
if (my $days=source::split_request()){
|
||||
#set 1-day start-min and start-max parameters, requires --from and --till values
|
||||
for my $date (@$days){
|
||||
for my $key(keys %$date){
|
||||
$settings->{source}->{$key}=$date->{$key};
|
||||
}
|
||||
#print "\nrequest ".$settings->{source}->{"start_min"}." to ".$settings->{source}->{"start_max"}."\n";
|
||||
sync_timespan();
|
||||
}
|
||||
}else{
|
||||
#update without time span (e.g. --modified)
|
||||
sync_timespan();
|
||||
}
|
||||
|
||||
print_info("\nclean up old database entries...");
|
||||
target::clean_up();
|
||||
|
||||
print_info("\nset last-update time: $settings->{event}->{update_start}");
|
||||
set_last_update_time($source_config_file,$target_config_file,$settings->{event}->{update_start});
|
||||
}
|
||||
|
||||
#sync all events of a given source timespan
|
||||
sub sync_timespan{
|
||||
#get a list of all days and their events
|
||||
#print Dumper($settings->{source});
|
||||
my $source_events=source::get_events($settings->{source},$settings->{target});
|
||||
my @dates=(keys %$source_events);
|
||||
|
||||
#print "2\n";
|
||||
if (@dates==0){
|
||||
my $more='';
|
||||
if ((defined $settings->{source}->{block_number}) && ($settings->{source}->{block_number} ne '0')){
|
||||
$more='more ';
|
||||
}elsif ($modified_events){
|
||||
$more.='modified ';
|
||||
}
|
||||
print_info("\n".'no '.$more."entries found.");
|
||||
}else{
|
||||
print "<table>" if ($output_type eq 'html');
|
||||
#sort lists of date and time (same time events should be preserved)
|
||||
for my $date(sort {$a cmp $b} @dates){
|
||||
# for my $date(@dates){
|
||||
# print "\n$date:\n";
|
||||
sync_events($source_events->{$date}, $settings);
|
||||
}
|
||||
print "</table>" if ($output_type eq 'html');
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#syncronize a list of source events to target events
|
||||
sub sync_events{
|
||||
my $source_events=shift;
|
||||
my $settings=shift;
|
||||
|
||||
# my $source_settings =$settings->{source};
|
||||
# my $target_settings =$settings->{target};
|
||||
my $event_settings =$settings->{event};
|
||||
|
||||
my $c=0;
|
||||
$c=$source::settings->{start_index}+0 if (defined $source::settings->{start_index});
|
||||
|
||||
# print "<events>\n";
|
||||
print html_table_header() if ($output_type eq 'html');
|
||||
#order processing by start time (TODO: order by last-modified date)
|
||||
for my $event (sort{$a->{calcms_start} cmp $b->{calcms_start}} @$source_events){
|
||||
target::pre_sync({
|
||||
start =>$source_events->[0]->{start},
|
||||
end =>$source_events->[-1]->{end}
|
||||
});
|
||||
|
||||
print "<tr><td>"if ($output_type eq 'html');
|
||||
|
||||
#read event
|
||||
$event=source::get_event_attributes($event);
|
||||
|
||||
#convert to calcms schema
|
||||
$event=source::map_to_schema($event);
|
||||
|
||||
#map event to target schema
|
||||
$event=target::map_to_schema($event);
|
||||
|
||||
#deprecated: override defined attributes by configuration
|
||||
if ((defined $source::settings->{override}) && (ref($source::settings->{override})eq 'HASH')){
|
||||
for my $key (keys %{$source::settings->{override}}){
|
||||
my $value=$source::settings->{override}->{$key};
|
||||
if ($source::settings->{override} ne ''){
|
||||
print_info("override '$key'='$value'");
|
||||
$event->{event}->{$key}=$value;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($output_type eq'html'){
|
||||
print_event_html("[".($c+1)."]",$event);
|
||||
}else{
|
||||
print_event_text("[".($c+1)."]",$event);
|
||||
}
|
||||
|
||||
if ($event->{event}->{start} eq '' || $event->{event}->{end} eq ''){
|
||||
print ('WARNING: Cannot read start or end of event');
|
||||
print "\n";
|
||||
}else{
|
||||
# print Dumper($event);
|
||||
sync_event($event);
|
||||
}
|
||||
|
||||
# last;
|
||||
$event=undef;
|
||||
$c++;
|
||||
print "</td></tr>"if ($output_type eq 'html');
|
||||
}
|
||||
# print "\n</events>\n";
|
||||
|
||||
}
|
||||
|
||||
#syncronize a single source event with target
|
||||
sub sync_event{
|
||||
my $event=shift;
|
||||
|
||||
#look if target_event exists by reference id incl. recurrence counter
|
||||
#print Dumper($event);
|
||||
my $target_event=target::get_event_by_reference_id($event->{event}->{reference});
|
||||
|
||||
#if target_event exists
|
||||
if (defined $target_event){
|
||||
#delete canceled events
|
||||
if ($event->{event}->{status}eq'canceled'){
|
||||
print cell("delete canceled event:".qq{$target_event});
|
||||
# target::delete($target_event->{id});
|
||||
return;
|
||||
}
|
||||
|
||||
$event->{event_id}=$target_event->{id};
|
||||
|
||||
target::update_event($event,$target_event);
|
||||
print cell("(ref. update)");
|
||||
|
||||
}else{
|
||||
#find by date, time and title
|
||||
$target_event=target::find_event($event);
|
||||
|
||||
if (defined $target_event){
|
||||
target::update_event($event,$target_event);
|
||||
#print Dumper($event);
|
||||
$event->{event_id}=$target_event->{id};
|
||||
print cell("(update)");
|
||||
}else{
|
||||
target::insert_event($event);
|
||||
#print Dumper($event);
|
||||
$target_event=target::get_event_by_reference_id($event->{event}->{reference});
|
||||
#print Dumper($target_event);
|
||||
$event->{event_id}=$target_event->{id};
|
||||
print cell("(new)");
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
|
||||
for my $category (@{$event->{categories}}){
|
||||
target::assign_category_to_event($category,$event);
|
||||
}
|
||||
|
||||
for my $meta (@{$event->{meta}}){
|
||||
target::assign_meta_to_event($meta,$event);
|
||||
}
|
||||
# print Dumper($event);
|
||||
}
|
||||
|
||||
#import requested source and target libs
|
||||
sub init{
|
||||
binmode STDOUT, ":utf8";
|
||||
|
||||
#require source config file
|
||||
print_error ("missing source parameter!") unless ($source_config_file=~/\S/);
|
||||
print_error ("source file: '$source_config_file' does not exist") unless (-e $source_config_file);
|
||||
print_error ("cannot read source file: '$source_config_file'") unless (-r $source_config_file);
|
||||
#$settings->{source}=require $source_config_file;
|
||||
my $configuration = new Config::General($source_config_file);
|
||||
$settings->{source}=$configuration->{DefaultConfig}->{source};
|
||||
|
||||
#require source import lib from config file
|
||||
my $source_import_lib='lib/source/'.$settings->{source}->{type}.'.pl';
|
||||
print_error ("missing 'type' in 'source' config ") unless ($settings->{source}->{type}=~/\S/);
|
||||
print_error ("cannot read source type import lib: '$source_import_lib'")unless (-r $source_import_lib);
|
||||
require $source_import_lib;
|
||||
|
||||
#require target config file
|
||||
print_error ("missing target parameter!") unless ($target_config_file=~/\S/);
|
||||
print_error ("target file: '$target_config_file' does not exist") unless (-e $target_config_file);
|
||||
print_error ("cannot read target file: '$target_config_file'") unless (-r $target_config_file);
|
||||
$configuration = new Config::General($target_config_file);
|
||||
$settings->{target}=$configuration->{DefaultConfig}->{target};
|
||||
#$settings->{target}=require $target_config_file;
|
||||
|
||||
#require target import lib from config file
|
||||
my $target_import_lib='lib/target/'.$settings->{target}->{type}.'.pl';
|
||||
print_error ("missing 'type' in 'target' config ") unless ($settings->{target}->{type}=~/\S/);
|
||||
print_error ("cannot read target type import lib: '$target_import_lib'")unless (-r $target_import_lib);
|
||||
require $target_import_lib;
|
||||
|
||||
#print Dumper($settings);
|
||||
if ((defined $settings->{source}->{read_blocks}) && ($settings->{source}->{read_blocks}==1)){
|
||||
$settings->{source}->{block_number} =$block_number;
|
||||
$settings->{source}->{block_size} =$block_size;
|
||||
}
|
||||
$settings->{source}->{last_update} =get_last_update_time($source_config_file,$target_config_file);
|
||||
$settings->{source}->{modified_events} =$modified_events;
|
||||
|
||||
if ($from=~/^\d\d\d\d\-\d\d\-\d\d$/){
|
||||
$from.='T00:00';
|
||||
# print "from:$from\t";
|
||||
}
|
||||
|
||||
if ($till=~/^\d\d\d\d\-\d\d\-\d\d$/){
|
||||
$till.='T23:59';
|
||||
# print "till:$till\t";
|
||||
}
|
||||
|
||||
if ($from=~/^([-+]?\d+$)/){
|
||||
my $days=$1;
|
||||
my $duration=new DateTime::Duration(days=>$days);
|
||||
$from=DateTime->today->add_duration($duration);
|
||||
# print "from:$from\t";
|
||||
}
|
||||
if ($till=~/^([-+]?\d+$)/){
|
||||
my $days=$1+1;
|
||||
my $duration=new DateTime::Duration(days=>$days);
|
||||
$till=DateTime->today->add_duration($duration);
|
||||
# print "till:$till\t";
|
||||
|
||||
}
|
||||
|
||||
$settings->{source}->{start_min} =$from if defined ($from);
|
||||
$settings->{source}->{start_max} =$till if defined ($till);
|
||||
|
||||
my $gmt_difference =0;#*=3600;
|
||||
my $now =time();
|
||||
my $now_gmt =$now-$gmt_difference;
|
||||
$now =time::time_to_datetime($now);
|
||||
$now_gmt =time::time_to_datetime($now_gmt);
|
||||
|
||||
$settings->{event}={
|
||||
update_start => time::time_to_datetime(time()),
|
||||
modified_at => $now,
|
||||
modified_at_gmt => $now_gmt
|
||||
};
|
||||
|
||||
source::init($settings->{source});
|
||||
target::init($settings->{target});
|
||||
|
||||
}
|
||||
|
||||
# print date/time, title and excerpt of an calendar event
|
||||
# TODO: replace by output filter (text, html)
|
||||
sub print_event_text{
|
||||
my $header=shift;
|
||||
my $event=shift;
|
||||
|
||||
my $s=$header;
|
||||
$s=$s." "x (8-length($s));
|
||||
|
||||
my $start=$event->{event}->{start}||'';
|
||||
$start=~s/T/ /g;
|
||||
$start=~s/\:00$//g;
|
||||
|
||||
if (defined $event->{event}->{program}){
|
||||
$s.="$start $event->{event}->{program}";
|
||||
$s=$s." "x (45-length($s));
|
||||
}
|
||||
|
||||
if (defined $event->{event}->{series_name}){
|
||||
$s.=" : $event->{event}->{series_name}";
|
||||
$s=$s." "x (75-length($s));
|
||||
}
|
||||
|
||||
if (defined $event->{event}->{title}){
|
||||
$s.=" - $event->{event}->{title}";
|
||||
$s=$s." "x (110-length($s));
|
||||
}
|
||||
|
||||
if ($event->{categories}){
|
||||
$s.= "(".join(", ",(@{$event->{categories}})).")";
|
||||
}
|
||||
$s=$s." "x (135-length($s));
|
||||
|
||||
my $status=$event->{event}->{status};
|
||||
$s.=$status.' ' if (defined $status);
|
||||
$s=$s." "x (140-length($s));
|
||||
|
||||
my $reference=$event->{event}->{reference};
|
||||
$s.=substr($reference,length($reference)-25) if (defined $reference);
|
||||
|
||||
print $s;
|
||||
}
|
||||
|
||||
sub print_event_html{
|
||||
my $header=shift;
|
||||
my $event=shift;
|
||||
|
||||
#close error block
|
||||
my $s='</td>';
|
||||
|
||||
my $start=$event->{event}->{start}||'';
|
||||
$start=~s/T/ /g;
|
||||
$start=~s/\:00$//g;
|
||||
$s.=cell($start);
|
||||
$s.=cell($event->{event}->{program});
|
||||
$s.=cell($event->{event}->{series_name});
|
||||
$s.=cell($event->{event}->{title});
|
||||
|
||||
if ($event->{categories}){
|
||||
$s.=cell( join(", " , ( @{$event->{categories}} ) ) );
|
||||
}
|
||||
|
||||
my $status=$event->{event}->{status};
|
||||
$s.=cell($status) if (defined $status);
|
||||
|
||||
my $reference=$event->{event}->{reference};
|
||||
$reference=substr($reference,length($reference)-25) if (defined $reference);
|
||||
$s.=cell($reference);
|
||||
|
||||
$s.="<td>";
|
||||
|
||||
print $s;
|
||||
}
|
||||
|
||||
sub cell{
|
||||
if ($output_type eq 'html'){
|
||||
return "<td>$_[0]</td>";
|
||||
}else{
|
||||
return "\t".$_[0];
|
||||
};
|
||||
}
|
||||
|
||||
#output usage on error or --help parameter
|
||||
sub print_usage{
|
||||
print qq{
|
||||
update all/modified events from source at target.
|
||||
|
||||
USAGE: sync_cms.pl [--read,--update] [--modified,--all] --source s --target t [--block_number b] [--block_size s]
|
||||
|
||||
on using --from and --till requests will be processed as multiple single-day-requests.
|
||||
|
||||
parameters:
|
||||
--read show all events without updating database
|
||||
--update update target database with source events
|
||||
|
||||
--modified process only modified events.
|
||||
--all' process all events
|
||||
|
||||
--source source configuration file
|
||||
--target target configuration file
|
||||
|
||||
--from start of date range: datetime (YYYY-MM-DDTHH:MM::SS) or days from today (e.g. -1 for yesterday, +1 for tomorrow)
|
||||
--till end of date range: datetime (YYYY-MM-DDTHH:MM::SS) or days from today (e.g. -1 for yesterday, +1 for tomorrow)
|
||||
--output_type log output format [text,html]
|
||||
|
||||
--block_number which block is to be syncronized [0..n]. To split up processing into multiple blocks (for machines with small memory resources).
|
||||
--block_size size of a block, default=20 events
|
||||
|
||||
examples:
|
||||
update modified
|
||||
perl sync_cms.pl --update --modified --source=config/source/program.cfg --target=config/target/calcms.cfg
|
||||
update a given time range
|
||||
perl sync_cms.pl --update --all --from=2009-09-01T00:00:00 --till=2009-11-22T23:59:59 --source=config/source/program.cfg --target=config/target/calcms.cfg
|
||||
update from last 2 days until next 3 days
|
||||
perl sync_cms.pl --update --all --from=-2 --till=+3 --source=config/source/program.cfg --target=config/target/calcms.cfg
|
||||
};
|
||||
exit 1;
|
||||
};
|
||||
|
||||
#default error handling
|
||||
sub print_error{
|
||||
print "\nERROR: $_[0]\n" ;
|
||||
print_usage();
|
||||
}
|
||||
|
||||
sub print_info{
|
||||
my $message=shift;
|
||||
if ($message=~/^\n/){
|
||||
$message=~s/^\n//g;
|
||||
print "\n";
|
||||
}
|
||||
if ($output_type eq 'html'){
|
||||
print "$message<br/>";
|
||||
}else{
|
||||
print "INFO:\t$message\n";
|
||||
}
|
||||
}
|
||||
sub html_table_header{
|
||||
return qq{
|
||||
<tr>
|
||||
<th> </th>
|
||||
<th>start date</th>
|
||||
<th>project</th>
|
||||
<th>series</th>
|
||||
<th>title</th>
|
||||
<th>category</th>
|
||||
<th>status</th>
|
||||
<th>id</th>
|
||||
<th> </th>
|
||||
<th>action</th>
|
||||
</tr>
|
||||
};
|
||||
};
|
||||
|
||||
|
||||
#load last update time out of sync.data
|
||||
sub get_last_update_time{
|
||||
my $source=shift;
|
||||
my $target=shift;
|
||||
|
||||
my $date=undef;
|
||||
return undef unless(-r "sync.data");
|
||||
|
||||
open my $DATA, "<:utf8","sync.data" || die ('cannot read update timestamp');
|
||||
while (<$DATA>){
|
||||
my $line=$_;
|
||||
if ($line=~/$source\s+\->\s+$target\s+:\s+(\d{4}\-\d{2}\-\d{2} \d{2}:\d{2}:\d{2})/){
|
||||
$date=$1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $DATA;
|
||||
return $date;
|
||||
}
|
||||
|
||||
#save last update time to sync.data
|
||||
sub set_last_update_time{
|
||||
my $source =shift;
|
||||
my $target =shift;
|
||||
my $date =shift;
|
||||
|
||||
my $data='';
|
||||
if (-r "sync.data"){
|
||||
open my $DATA, "<:utf8","sync.data";
|
||||
$data=join("\n",(<$DATA>));
|
||||
close $DATA;
|
||||
}
|
||||
|
||||
if ($data=~/$source\s+\->\s+$target\s+:\s+(\d{4}\-\d{2}\-\d{2} \d{2}:\d{2}:\d{2})/){
|
||||
$data=~s/($source\s+\->\s+$target\s+:)\s+\d{4}\-\d{2}\-\d{2} \d{2}:\d{2}:\d{2}/$1\t$date/gi;
|
||||
}else{
|
||||
$data.="$source\t\->\t$target\t:\t$date\n";
|
||||
}
|
||||
|
||||
$data=~s/[\r\n]+/\n/g;
|
||||
|
||||
open my $DATA2, ">:utf8","sync.data" || die ('cannot write update timestamp');
|
||||
print $DATA2 $data;
|
||||
close $DATA2;
|
||||
|
||||
# print $data;
|
||||
}
|
||||
|
||||
#avoid to run more than one sync process in parallel
|
||||
sub check_running_processes{
|
||||
my $cmd="ps -afex 2>/dev/null | grep sync_cms.pl | grep -v nice | grep -v grep ";
|
||||
my $ps=`$cmd`;
|
||||
# print "$ps";
|
||||
my @lines=(split(/\n/,$ps));
|
||||
if (@lines>1){
|
||||
print "ERROR: another ".@lines." synchronization processes 'sync_cms.pl' instances are running!".qq{
|
||||
|
||||
$cmd
|
||||
$ps
|
||||
-> program will exit
|
||||
};
|
||||
exit;
|
||||
}
|
||||
|
||||
}
|
||||
74
tools/sync_cms/sync_days.pl
Normal file
74
tools/sync_cms/sync_days.pl
Normal file
@@ -0,0 +1,74 @@
|
||||
#!/usr/bin/perl -I ../lib #-w
|
||||
|
||||
BEGIN{
|
||||
my $dir='';
|
||||
$ENV{SCRIPT_FILENAME} if ($dir eq'');
|
||||
$dir=~s/(.*\/)[^\/]+/$1/;
|
||||
$dir=$ENV{PWD} if ($dir eq'');
|
||||
$dir=`pwd` if ($dir eq'');
|
||||
|
||||
#local perl installation libs
|
||||
unshift(@INC,$dir.'/../../perl/lib/');
|
||||
|
||||
#calcms libs + configuration
|
||||
unshift(@INC,$dir.'/../calcms/');
|
||||
}
|
||||
|
||||
#use utf8;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
#use CGI;
|
||||
#use HTML::Template;
|
||||
use Date::Calc;
|
||||
#use calendar;
|
||||
#use time;
|
||||
#use log;
|
||||
|
||||
if(@ARGV<2){
|
||||
print qq{ERROR: $0 yyyy-mm-dd yyyy-mm-dd
|
||||
syncronize from given start date to end date, day by day
|
||||
};
|
||||
exit 1;
|
||||
}
|
||||
|
||||
my $start =$ARGV[0];
|
||||
my $end =$ARGV[1];
|
||||
|
||||
(my $start_year,my $start_month,my $start_day)=split(/\-/,$start);
|
||||
my $last_day=Date::Calc::Days_in_Month($start_year,$start_month);
|
||||
$start_day = 1 if ($start_day<1);
|
||||
$start_day = $last_day if ($start_day gt $last_day);
|
||||
|
||||
(my $end_year,my $end_month,my $end_day)=split(/\-/,$end);
|
||||
$last_day=Date::Calc::Days_in_Month($end_year,$end_month);
|
||||
$end_day = 1 if ($end_day<1);
|
||||
$end_day = $last_day if ($end_day gt $last_day);
|
||||
|
||||
|
||||
|
||||
for my $year($start_year..$end_year){
|
||||
my $m1=1;
|
||||
my $m2=12;
|
||||
$m1=$start_month if($year eq $start_year);
|
||||
$m2=$end_month if($year eq $end_year);
|
||||
|
||||
for my $month($m1..$m2){
|
||||
$month='0'.$month if (length($month)==1);
|
||||
my $d1=1;
|
||||
my $d2=Date::Calc::Days_in_Month($year,$month);
|
||||
$d1=$start_day if($month eq $start_month);
|
||||
$d2=$end_day if($month eq $end_month);
|
||||
|
||||
for my $day($d1..$d2){
|
||||
$day='0'.$day if (length($day)==1);
|
||||
my $date=join('-',($year,$month,$day));
|
||||
my $cmd="perl sync_cms.pl --update --all --source config/source/program.cfg --target config/target/calcms.cfg --from ".$date."T00:00:00 --till ".$date."T23:59:59";
|
||||
#print "$cmd\n";
|
||||
print `nice -n 10 $cmd`;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
487
tools/sync_cms/time_gate.pl
Normal file
487
tools/sync_cms/time_gate.pl
Normal file
@@ -0,0 +1,487 @@
|
||||
#!/usr/bin/perl -I ../lib #-w
|
||||
|
||||
BEGIN{
|
||||
my $dir='';
|
||||
$ENV{SCRIPT_FILENAME}||'' if ($dir eq'');
|
||||
$dir=~s/(.*\/)[^\/]+/$1/ if ($dir ne '');
|
||||
$dir=$ENV{PWD} if ($dir eq'');
|
||||
$dir=`pwd` if ($dir eq'');
|
||||
|
||||
#local perl installation libs
|
||||
unshift(@INC,$dir.'/../../perl/lib/');
|
||||
|
||||
#calcms libs + configuration
|
||||
unshift(@INC,$dir.'/../calcms/');
|
||||
}
|
||||
|
||||
#use utf8;
|
||||
use Data::Dumper;
|
||||
#require 'time.pl';
|
||||
use Getopt::Long;
|
||||
use time;
|
||||
use DateTime;
|
||||
use DateTime::Duration;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
check_running_processes();
|
||||
|
||||
|
||||
my $read_mode='';
|
||||
my $update_mode='';
|
||||
my $all_events='';
|
||||
my $modified_events='';
|
||||
my $source_config_file='';
|
||||
my $target_config_file='';
|
||||
my $block_number=0;
|
||||
my $block_size=2000;
|
||||
my $from='';
|
||||
my $till='';
|
||||
my $read_only=0;
|
||||
my $project='';
|
||||
|
||||
GetOptions(
|
||||
"read" => \$read_mode,
|
||||
"update" => \$update_mode,
|
||||
"all" => \$all_events,
|
||||
"modified" => \$modified_events,
|
||||
"from=s" => \$from,
|
||||
"till=s" => \$till,
|
||||
"source=s" => \$source_config_file,
|
||||
"target=s" => \$target_config_file,
|
||||
"project=s" => \$project,
|
||||
"block_number:i" => \$block_number,
|
||||
"block_size:i" => \$block_size
|
||||
);
|
||||
|
||||
$|=1;
|
||||
|
||||
BEGIN {
|
||||
our $utf8dbi=1;
|
||||
$ENV{LANG}="en_US.UTF-8";
|
||||
# print Dumper(\%ENV);
|
||||
}
|
||||
|
||||
#source and taget settings are loaded from config files
|
||||
our $settings={
|
||||
};
|
||||
|
||||
#user interface
|
||||
our $ask_before_insert=0;
|
||||
our $ask_before_update=0;
|
||||
|
||||
# end of configuration
|
||||
|
||||
if ($update_mode){
|
||||
$db::write=1;
|
||||
# print "enter update mode\n";
|
||||
}elsif($read_mode){
|
||||
#default
|
||||
$db::write=0;
|
||||
# print "enter read-only mode\n";
|
||||
}else{
|
||||
print_error("set parameter >read< or >update<");
|
||||
}
|
||||
|
||||
unless ($modified_events || $all_events || $from || $till){
|
||||
print_error("set one of folling parameters: --modified, --from, --till");
|
||||
}
|
||||
|
||||
init();
|
||||
my $project_target=$source::settings->{sources}->{$project};
|
||||
unless (defined $project){
|
||||
print_error("missing parameter --project") unless(defined $project_target);
|
||||
print_error("cant find project configuration '$project_target'") unless (-f $project_target);
|
||||
print_error("cant read project configuration '$project_target'") unless (-r $project_target);
|
||||
}
|
||||
|
||||
my $events=[];
|
||||
print "TIME_GATE: READ ALL CALENDARS\n";
|
||||
sync();
|
||||
$events=compress_events($events);
|
||||
my $c=0;
|
||||
if ($project eq ''){
|
||||
for my $event (@$events){
|
||||
print_event("[".($c+1)."]",$event);
|
||||
print "\n";
|
||||
$c++;
|
||||
}
|
||||
}else{
|
||||
my $source=$source::settings->{sources}->{$project};
|
||||
my $target='config/target/calcms.cfg';
|
||||
|
||||
for my $event (@$events){
|
||||
my $from=$event->{start};
|
||||
#print Dumper($event->{end});
|
||||
#remove a second
|
||||
my $till=source::get_datetime($event->{end}, $source::settings->{date}->{time_zone})->add(seconds=>-1)->datetime();
|
||||
print_event("STATION TIMESLOT [".($c+1)."]\t",$event);
|
||||
print "\n";
|
||||
$c++;
|
||||
my $command="perl sync_cms.pl --update --all --from=$from --till=$till --source $source --target $target ";
|
||||
print_info($command);
|
||||
print `$command`;
|
||||
#exit;
|
||||
}
|
||||
|
||||
}
|
||||
print "\ndone.\n";
|
||||
exit 0;
|
||||
|
||||
sub compress_events{
|
||||
my $events=shift;
|
||||
|
||||
my @results=();
|
||||
my $old_event={end=>'', start=>'', title=>''};
|
||||
for my $event(sort {$a->{start} gt $b->{start}} @$events){
|
||||
# print "$event->{start}\t$event->{end}\t$event->{title}\n";
|
||||
if (
|
||||
# (defined $event) && (defined $event->{start}) && (defined $event->{end}) && (defined $event->{title})
|
||||
( #station continues
|
||||
($event->{start} eq $old_event->{end})
|
||||
|| (#multiple entries for same event
|
||||
($event->{start} ge $old_event->{start})
|
||||
&& ($event->{end} eq $old_event->{end})
|
||||
)
|
||||
)
|
||||
&& ($event->{title} eq $old_event->{title})
|
||||
&& (@results>0)
|
||||
){
|
||||
$results[-1]->{end}=$event->{end};
|
||||
# print @results."\tmerge \n";
|
||||
}else{
|
||||
push @results,{
|
||||
start => $event->{start},
|
||||
end => $event->{end},
|
||||
title => $event->{title},
|
||||
};
|
||||
# print @results."\tinsert \n";
|
||||
}
|
||||
$old_event=$results[-1];
|
||||
}
|
||||
# print Dumper(\@results);
|
||||
|
||||
return \@results;
|
||||
}
|
||||
|
||||
#sync all events, splitting multi-day-requests into multiple 1-day-requests to avoid large result sets
|
||||
sub sync{
|
||||
#prepare target
|
||||
target::init($settings->{target});
|
||||
print_info("last update: $settings->{source}->{last_update}");
|
||||
|
||||
if (my $days=source::split_request($settings->{source})){
|
||||
#set 1-day start-min and start-max parameters, requires --from and --till values
|
||||
for my $date (@$days){
|
||||
for my $key(keys %$date){
|
||||
$settings->{source}->{$key}=$date->{$key};
|
||||
}
|
||||
print "\nrequest ".$settings->{source}->{"start_min"}." to ".$settings->{source}->{"start_max"}."\n";
|
||||
sync_timespan();
|
||||
}
|
||||
}else{
|
||||
#update without time span (e.g. --modified)
|
||||
sync_timespan();
|
||||
}
|
||||
|
||||
print_info("\nset last-update time: $settings->{event}->{update_start}");
|
||||
set_last_update_time($source_config_file,$target_config_file,$settings->{event}->{update_start});
|
||||
}
|
||||
|
||||
#sync all events of a given source timespan
|
||||
sub sync_timespan{
|
||||
#get a list of all days and their events
|
||||
#print Dumper($settings->{source});
|
||||
my $source_events=source::get_events($settings->{source},$settings->{target});
|
||||
#print Dumper($source_events);
|
||||
my @dates=(keys %$source_events);
|
||||
|
||||
if (@dates==0){
|
||||
my $more='';
|
||||
if ((defined $settings->{source}->{block_number}) && ($settings->{source}->{block_number} ne '0')){
|
||||
$more='more ';
|
||||
}elsif ($modified_events){
|
||||
$more.='modified ';
|
||||
}
|
||||
print_info("\n".'no '.$more."entries found.");
|
||||
}else{
|
||||
#sort lists of date and time (same time events should be preserved)
|
||||
for my $date(sort {$a cmp $b} @dates){
|
||||
# for my $date(@dates){
|
||||
# print "\n$date:\n";
|
||||
sync_events($source_events->{$date}, $settings);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#syncronize a list of source events to target events
|
||||
sub sync_events{
|
||||
my $source_events=shift;
|
||||
my $settings=shift;
|
||||
|
||||
my $c=0;
|
||||
$c=$source::settings->{start_index}+0 if (defined $source::settings->{start_index});
|
||||
|
||||
# print "<events>\n";
|
||||
|
||||
#order processing by start time (TODO: order by last-modified date)
|
||||
for my $event (sort{$a->{calcms_start} cmp $b->{calcms_start}} @$source_events){
|
||||
#read event attributes
|
||||
$event=source::get_event_attributes($event);
|
||||
|
||||
$event->{title}=~s/\s//g;
|
||||
|
||||
$event->{event}={
|
||||
title => $event->{title},
|
||||
start => $event->{start},
|
||||
end => $event->{end},
|
||||
status => $event->{status},
|
||||
};
|
||||
|
||||
# print "\n";
|
||||
#print_event("[".($c+1)."]",$event);
|
||||
#print "\n".$event->{event}->{title}." ".$project."\n";
|
||||
|
||||
if ($event->{event}->{status}eq'canceled'){
|
||||
print "canceled event:".qq{$event};
|
||||
}elsif ($event->{event}->{start} eq ''){
|
||||
print ('WARNING: Cannot read start of event'."\n");
|
||||
}elsif ($event->{event}->{end} eq ''){
|
||||
print ('WARNING: Cannot read start of end'."\n");
|
||||
}elsif ($event->{event}->{title} eq ''){
|
||||
print ('WARNING: Cannot read start of title'."\n");
|
||||
}elsif ($project ne ''){
|
||||
if ($event->{event}->{title} eq $project){
|
||||
push @$events, $event->{event};
|
||||
}
|
||||
}else{
|
||||
push @$events, $event->{event};
|
||||
}
|
||||
$event=undef;
|
||||
$c++;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#import requested source and target libs
|
||||
sub init{
|
||||
binmode STDOUT, ":utf8";
|
||||
|
||||
#require source config file
|
||||
print_error ("missing source parameter!") unless ($source_config_file=~/\S/);
|
||||
print_error ("source file: '$source_config_file' does not exist") unless (-e $source_config_file);
|
||||
print_error ("cannot read source file: '$source_config_file'") unless (-r $source_config_file);
|
||||
#$settings->{source}=require $source_config_file;
|
||||
my $configuration = new Config::General($source_config_file);
|
||||
$settings->{source}=$configuration->{DefaultConfig}->{source};
|
||||
|
||||
#require source import lib from config file
|
||||
my $source_import_lib='lib/source/'.$settings->{source}->{type}.'.pl';
|
||||
print_error ("missing 'type' in 'source' config ") unless ($settings->{source}->{type}=~/\S/);
|
||||
print_error ("cannot read source type import lib: '$source_import_lib'")unless (-r $source_import_lib);
|
||||
require $source_import_lib;
|
||||
|
||||
#require target config file
|
||||
print_error ("missing target parameter!") unless ($target_config_file=~/\S/);
|
||||
print_error ("target file: '$target_config_file' does not exist") unless (-e $target_config_file);
|
||||
print_error ("cannot read target file: '$target_config_file'") unless (-r $target_config_file);
|
||||
#$settings->{target}=require $target_config_file;
|
||||
$configuration = new Config::General($target_config_file);
|
||||
$settings->{target}=$configuration->{DefaultConfig}->{target};
|
||||
|
||||
#require target import lib from config file
|
||||
my $target_import_lib='lib/target/'.$settings->{target}->{type}.'.pl';
|
||||
print_error ("missing 'type' in 'target' config ") unless ($settings->{target}->{type}=~/\S/);
|
||||
print_error ("cannot read target type import lib: '$target_import_lib'")unless (-r $target_import_lib);
|
||||
require $target_import_lib;
|
||||
|
||||
#print Dumper($settings);
|
||||
if ((defined $settings->{source}->{read_blocks}) && ($settings->{source}->{read_blocks}==1)){
|
||||
$settings->{source}->{block_number} =$block_number;
|
||||
$settings->{source}->{block_size} =$block_size;
|
||||
}
|
||||
$settings->{source}->{last_update} =get_last_update_time($source_config_file,$target_config_file);
|
||||
$settings->{source}->{modified_events} =$modified_events;
|
||||
|
||||
if ($from=~/^\d\d\d\d\-\d\d\-\d\d$/){
|
||||
$from.='T00:00';
|
||||
}
|
||||
|
||||
if ($till=~/^\d\d\d\d\-\d\d\-\d\d$/){
|
||||
$till.='T23:59';
|
||||
}
|
||||
|
||||
if ($from=~/^([-+]?\d+$)/){
|
||||
my $days=$1;
|
||||
my $duration=new DateTime::Duration(days=>$days);
|
||||
$from=DateTime->today->add_duration($duration);
|
||||
# print "from:$from\t";
|
||||
}
|
||||
if ($till=~/^([-+]?\d+$)/){
|
||||
my $days=$1+1;
|
||||
my $duration=new DateTime::Duration(days=>$days);
|
||||
$till=DateTime->today->add_duration($duration);
|
||||
# print "till:$till\t";
|
||||
|
||||
}
|
||||
|
||||
|
||||
$settings->{source}->{start_min} =$from if defined ($from);
|
||||
$settings->{source}->{start_max} =$till if defined ($till);
|
||||
|
||||
my $gmt_difference =0;#*=3600;
|
||||
my $now =time();
|
||||
my $now_gmt =$now-$gmt_difference;
|
||||
$now =time::time_to_datetime($now);
|
||||
$now_gmt =time::time_to_datetime($now_gmt);
|
||||
|
||||
$settings->{event}={
|
||||
update_start => time::time_to_datetime(time()),
|
||||
modified_at => $now,
|
||||
modified_at_gmt => $now_gmt
|
||||
};
|
||||
source::init($settings->{source});
|
||||
|
||||
}
|
||||
|
||||
# print date/time, title and excerpt of an calendar event
|
||||
# TODO: replace by output filter (text, html)
|
||||
sub print_event{
|
||||
my $header=shift;
|
||||
my $event=shift;
|
||||
|
||||
my $s=$header;
|
||||
$s=$s." "x (8-length($s));
|
||||
|
||||
# print Dumper($event);
|
||||
my $start=$event->{start}||'';
|
||||
$start=~s/T/ /g;
|
||||
$start=~s/\:00$//g;
|
||||
|
||||
my $end=$event->{end}||'';
|
||||
$end=~s/T/ /g;
|
||||
$end=~s/\:00$//g;
|
||||
|
||||
$s.="$start\t$end\t'$event->{title}'";
|
||||
|
||||
# print Dumper($event->{event});
|
||||
print $s;
|
||||
#excerpt: >$event->{excerpt}<
|
||||
#content: >$event->{content}<
|
||||
#content: >$event->{content}<
|
||||
|
||||
}
|
||||
|
||||
#output usage on error or --help parameter
|
||||
sub print_usage{
|
||||
print qq{
|
||||
update all/modified events from source at target.
|
||||
|
||||
USAGE: $0 [--read,--update] [--modified,--all] --source s --target t [--block_number b] [--block_size s]
|
||||
|
||||
on using --from and --till requests will be processed as multiple single-day-requests.
|
||||
|
||||
parameters:
|
||||
--read show all events without updating database
|
||||
--update update target database with source events
|
||||
|
||||
--modified process only modified events.
|
||||
--all' process all events
|
||||
|
||||
--source source configuration file
|
||||
--target target configuration file
|
||||
|
||||
--from start of date range: datetime (YYYY-MM-DDTHH:MM::SS) or days from today (e.g. -1 for yesterday, +1 for tomorrow)
|
||||
--till end of date range: datetime (YYYY-MM-DDTHH:MM::SS) or days from today (e.g. -1 for yesterday, +1 for tomorrow)
|
||||
|
||||
--block_number which block is to be syncronized [0..n]. To split up processing into multiple blocks (for machines with small memory resources).
|
||||
--block_size size of a block, default=20 events
|
||||
|
||||
examples:
|
||||
perl $0 --update --modified --source=config/source/einheit.cfg --target=config/target/calcms.cfg
|
||||
perl $0 --update --all --from=2009-09-01T00:00:00 --till=2009-11-22T23:59:59 --source=config/source/einheit.cfg --target=config/target/calcms.cfg
|
||||
};
|
||||
exit 1;
|
||||
};
|
||||
|
||||
#load last update time out of sync.data
|
||||
sub get_last_update_time{
|
||||
my $source=shift;
|
||||
my $target=shift;
|
||||
|
||||
my $date=undef;
|
||||
return undef unless(-r "sync.data");
|
||||
|
||||
open my $DATA, "<:utf8","sync.data" || die ('cannot read update timestamp');
|
||||
while (<$DATA>){
|
||||
my $line=$_;
|
||||
if ($line=~/$source\s+\->\s+$target\s+:\s+(\d{4}\-\d{2}\-\d{2} \d{2}:\d{2}:\d{2})/){
|
||||
$date=$1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $DATA;
|
||||
return $date;
|
||||
}
|
||||
|
||||
#save last update time to sync.data
|
||||
sub set_last_update_time{
|
||||
my $source =shift;
|
||||
my $target =shift;
|
||||
my $date =shift;
|
||||
|
||||
my $data='';
|
||||
if (-r "sync.data"){
|
||||
open my $DATA, "<:utf8","sync.data";
|
||||
$data=join("\n",(<$DATA>));
|
||||
close $DATA;
|
||||
}
|
||||
|
||||
if ($data=~/$source\s+\->\s+$target\s+:\s+(\d{4}\-\d{2}\-\d{2} \d{2}:\d{2}:\d{2})/){
|
||||
$data=~s/($source\s+\->\s+$target\s+:)\s+\d{4}\-\d{2}\-\d{2} \d{2}:\d{2}:\d{2}/$1\t$date/gi;
|
||||
}else{
|
||||
$data.="$source\t\->\t$target\t:\t$date\n";
|
||||
}
|
||||
|
||||
$data=~s/[\r\n]+/\n/g;
|
||||
|
||||
open my $DATA2, ">:utf8","sync.data" || die ('cannot write update timestamp');
|
||||
print $DATA2 $data;
|
||||
close $DATA2;
|
||||
|
||||
# print $data;
|
||||
}
|
||||
|
||||
#default error handling
|
||||
sub print_error{
|
||||
print "\nERROR:\t$_[0]\n" ;
|
||||
print_usage();
|
||||
}
|
||||
|
||||
sub print_info{
|
||||
my $message=shift;
|
||||
if ($message=~/^\n/){
|
||||
$message=~s/^\n//g;
|
||||
print "\n";
|
||||
}
|
||||
print "INFO:\t$message\n";
|
||||
}
|
||||
|
||||
#avoid to run more than one sync process simultaniously
|
||||
sub check_running_processes{
|
||||
my $cmd="ps -afex 2>/dev/null | grep $0.pl | grep -v nice | grep -v grep ";
|
||||
my $ps=`$cmd`;
|
||||
# print "$ps";
|
||||
my @lines=(split(/\n/,$ps));
|
||||
if (@lines>1){
|
||||
print "ERROR:\tanother ".@lines." synchronization processes '$0.pl' instances are running!".qq{
|
||||
|
||||
$cmd
|
||||
$ps
|
||||
-> program will exit
|
||||
};
|
||||
exit;
|
||||
}
|
||||
|
||||
}
|
||||
18
tools/sync_jobs/calcms_to_google.sh
Executable file
18
tools/sync_jobs/calcms_to_google.sh
Executable file
@@ -0,0 +1,18 @@
|
||||
#!/bin/sh
|
||||
|
||||
from=$1
|
||||
till=$2
|
||||
project=$3
|
||||
|
||||
#. /etc/profile
|
||||
set LC_ALL="de_DE.utf8"
|
||||
export LC_ALL="de_DE.utf8"
|
||||
set LANGUAGE="de_DE.utf8"
|
||||
export LANGUAGE="de_DE.utf8"
|
||||
|
||||
cd /home/radio/calcms/sync_cms
|
||||
|
||||
echo "nice -n 10 perl sync_cms.pl --update --all --from=$from --till=$till --source=config/source/calcms_$project.cfg --target=config/target/88vier_$project.cfg 2>&1"
|
||||
nice -n 10 perl sync_cms.pl --update --all --from=$from --till=$till --source=config/source/calcms_$project.cfg --target=config/target/88vier_$project.cfg 2>&1
|
||||
|
||||
|
||||
6
tools/sync_jobs/sync.sh
Executable file
6
tools/sync_jobs/sync.sh
Executable file
@@ -0,0 +1,6 @@
|
||||
#/bin/sh
|
||||
|
||||
./sync_project.sh "$1" "$2" piradio
|
||||
./sync_project.sh "$1" "$2" potsdam
|
||||
./sync_project.sh "$1" "$2" ansage
|
||||
./sync_project.sh "$1" "$2" collabo
|
||||
6
tools/sync_jobs/update_ansage.sh
Executable file
6
tools/sync_jobs/update_ansage.sh
Executable file
@@ -0,0 +1,6 @@
|
||||
#!/bin/sh
|
||||
|
||||
file=/home/radio/senderberlin.org/agenda/admin/jobs/start/ansage_sender_berlin_to_88vier.de.start.txt
|
||||
touch $file
|
||||
chown radio:www-data $file
|
||||
|
||||
6
tools/sync_jobs/update_colabo.sh
Executable file
6
tools/sync_jobs/update_colabo.sh
Executable file
@@ -0,0 +1,6 @@
|
||||
#!/bin/sh
|
||||
|
||||
file=/home/radio/senderberlin.org/agenda/admin/jobs/start/colabo_sender_berlin_to_88vier.de.start.txt
|
||||
touch $file
|
||||
chown radio:www-data $file
|
||||
|
||||
6
tools/sync_jobs/update_piradio.sh
Executable file
6
tools/sync_jobs/update_piradio.sh
Executable file
@@ -0,0 +1,6 @@
|
||||
#!/bin/sh
|
||||
|
||||
file=/home/radio/senderberlin.org/agenda/admin/jobs/start/piradio_sender_berlin_to_88vier.de.start.txt
|
||||
touch $file
|
||||
chown radio:www-data $file
|
||||
|
||||
6
tools/sync_jobs/update_potsdam.sh
Executable file
6
tools/sync_jobs/update_potsdam.sh
Executable file
@@ -0,0 +1,6 @@
|
||||
#!/bin/sh
|
||||
|
||||
file=/home/radio/senderberlin.org/agenda/admin/jobs/start/potsdam_sender_berlin_to_88vier.de.start.txt
|
||||
touch $file
|
||||
chown radio:www-data $file
|
||||
|
||||
28
tools/update_page.sh
Executable file
28
tools/update_page.sh
Executable file
@@ -0,0 +1,28 @@
|
||||
#!/bin/sh
|
||||
|
||||
perl -I /home/calcms/lib/calcms update_program.pl
|
||||
|
||||
exit;
|
||||
|
||||
##clear cache
|
||||
##echo "cd /home/radio/radio/agenda/admin;perl clear_cache.cgi online=0"
|
||||
#cd /home/radio/radio/agenda/admin
|
||||
#perl clear_cache.cgi online=0
|
||||
|
||||
##get current layout
|
||||
##cd /home/radio/calcms
|
||||
##perl preload_agenda.pl read /home/radio/radio/agenda/index.html
|
||||
|
||||
##cd /home/radio/calcms/
|
||||
##perl preload_agenda.pl replace /home/radio/radio/sites/default/files/programm.html;
|
||||
##perl preload_agenda.pl replace /home/radio/radio/programm.html;
|
||||
#
|
||||
##update cache (important for night hours!)
|
||||
##echo "cd /home/radio/radio/agenda;perl aggregate.cgi date=today 2>/dev/null > /home/radio/radio/agenda/programm.html "
|
||||
#cd /home/radio/radio/agenda;
|
||||
#perl -I /home/radio/calcms/calcms aggregate.cgi date=today 2>/dev/null > /home/radio/radio/agenda/programm.html
|
||||
#
|
||||
#find /home/radio/radio/agenda/cache/ -type f -exec chmod 664 {} \; 2>/dev/null
|
||||
#find /home/radio/radio/agenda/cache/ -type f -exec chgrp www-data {} \; 2>/dev/null
|
||||
#
|
||||
|
||||
104
tools/update_program.pl
Executable file
104
tools/update_program.pl
Executable file
@@ -0,0 +1,104 @@
|
||||
#! /usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Data::Dumper;
|
||||
use Date::Calc;
|
||||
use config;
|
||||
use template;
|
||||
use projects;
|
||||
|
||||
my $perlPath='-I /home/calcms/lib/calcms';
|
||||
my $configPath=$ARGV[0]||'/home/calcms/website/agenda/config/config.cgi';
|
||||
|
||||
unless (defined $config::config){
|
||||
config::get($configPath);
|
||||
}
|
||||
clean_up_cache();
|
||||
|
||||
sub clean_up_cache{
|
||||
my $base_dir =$config::config->{locations}->{base_dir}||'';
|
||||
my $cache =$config::config->{cache}->{cache_dir}||'';
|
||||
my $cache_dir=$base_dir.'/'.$cache.'/';
|
||||
|
||||
print_error("'base_dir' directory not configured! Please check config!") if($base_dir eq'');
|
||||
print_error("invalid 'base_dir' directory '$base_dir'! Please check config!") unless ($base_dir=~/[a-zA-Z]\/[a-zA-Z]/);
|
||||
print_error("'base_dir' directory '$base_dir' does not exist! Please check config!") unless (-e $base_dir);
|
||||
print_error("cannot read 'base_dir' directory '$base_dir'! Please check permissions!") unless (-r $base_dir);
|
||||
|
||||
print_error("'cache_dir' directory $cache_dir not configured! Please check config!") if ($cache_dir eq '/');
|
||||
print_error("invalid 'cache_dir' directory '$cache_dir'! Please check config!") unless ($cache_dir=~/[a-zA-Z]\/[a-zA-Z]/);
|
||||
print_error("'cache_dir' directory '$cache_dir' does not exist! Please check filesystem!") unless (-e $cache_dir);
|
||||
print_error("cannot write to 'cache_dir' directory '$cache_dir'! Please check filesystem!") unless (-w $cache_dir);
|
||||
|
||||
# update basic layout
|
||||
print_header("update basic layout");
|
||||
|
||||
my $file="$base_dir/index.html";
|
||||
if ((-e $file) && (!-w $file)){
|
||||
print_error("Please check write permission on '$file'");
|
||||
}else{
|
||||
my $config=$base_dir.'/config/config.cgi';
|
||||
my $cmd="perl $perlPath get_source_page.pl --config $config --output $file 2>&1";
|
||||
execute($cmd);
|
||||
}
|
||||
|
||||
# clear all files from cache
|
||||
print_header("clear cache");
|
||||
|
||||
for my $controller (qw(sendung sendungen kalender kommentare)){
|
||||
clear($cache_dir.'/'.$controller.'/*');
|
||||
clear($cache_dir.'/programm/'.$controller.'/*');
|
||||
}
|
||||
|
||||
# update start page
|
||||
print_header("update agenda start page");
|
||||
$file="$base_dir/programm.html";
|
||||
if ((-e $file) && (!-w $file)){
|
||||
print_error("Please check write permission on '$file'\n");
|
||||
}else{
|
||||
my $cmd="cd $base_dir; perl $perlPath aggregate.cgi date=today >$file 2>&1";
|
||||
execute($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sub clear{
|
||||
my $path=shift;
|
||||
|
||||
print_error("invalid path '$path' to delete!") unless ($path=~/cache/);
|
||||
return if ($path=~/\.htaccess$/);
|
||||
|
||||
print_info("clear $path:");
|
||||
|
||||
for my $file (glob($path) ){
|
||||
if (-f $file){
|
||||
print_info($file);
|
||||
unlink $file;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub print_header{
|
||||
print "\n# $_[0]\n";
|
||||
}
|
||||
|
||||
sub execute{
|
||||
my $cmd=$_[0];
|
||||
print_info($cmd."\n");
|
||||
print eval{`$cmd`}."\n";
|
||||
print_info('ok') if ($? == 0);
|
||||
print_error("error $! $?") if ($? != 0);
|
||||
}
|
||||
|
||||
sub print_info{
|
||||
print $_[0]."\n";
|
||||
}
|
||||
|
||||
sub print_error{
|
||||
print STDERR "ERROR: $_[0]\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
116
website/agenda/.htaccess
Normal file
116
website/agenda/.htaccess
Normal file
@@ -0,0 +1,116 @@
|
||||
<IfModule mod_rewrite.c>
|
||||
RewriteBase /agenda
|
||||
|
||||
RewriteEngine on
|
||||
RewriteCond %{REQUEST_FILENAME} -f
|
||||
RewriteRule (.*) $1 [L]
|
||||
RewriteCond %{REQUEST_FILENAME} -d
|
||||
RewriteRule (.*) $1 [L]
|
||||
|
||||
RewriteRule ^kommentare/(\d+)/(\d{4}-\d{2}-\d{2}[T\+]\d{2}\:\d{2})(\:\d{2})?/(.*)$ comments.cgi?template=comments.html&event_id=$1&event_start=$2&sort_order=asc&$4 [L]
|
||||
RewriteRule ^neueste_kommentare/(.*)$ comments.cgi?template=comments_newest.html&limit=20&show_max=3&type=list&$1 [L]
|
||||
RewriteRule ^feed_kommentare/(.*)$ comments.cgi?template=comments.xml&limit=20&$1 [L]
|
||||
RewriteRule ^kommentar_neu/(.*)$ add_comment.cgi?$1 [L]
|
||||
|
||||
RewriteRule ^sendung/(\d+)/[^&]*(&.*)?$ events.cgi?template=event_details.html&event_id=$1&$2 [L]
|
||||
RewriteRule ^sendung/(.*)$ events.cgi?$1 [L]
|
||||
|
||||
RewriteRule ^sendungen/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/(\d)/(.*)$ events.cgi?template=event_list.html&from_date=$1&till_date=$2&weekday=$3&$4 [L]
|
||||
RewriteRule ^sendungen/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/(.*)$ events.cgi?template=event_list.html&from_date=$1&till_date=$2&$3 [L]
|
||||
RewriteRule ^sendungen/(\d{4}-\d{2}-\d{2})/(.*)$ events.cgi?template=event_list.html&date=$1&$2 [L]
|
||||
RewriteRule ^sendungen/heute/(.*)$ events.cgi?template=event_list.html&date=today&$1 [L]
|
||||
RewriteRule ^sendungen/(.*)$ events.cgi?$1 [L]
|
||||
|
||||
RewriteRule ^menu/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/(\d)/(.*)$ events.cgi?template=event_menu.html&from_date=$1&till_date=$2&weekday=$3&$4 [L]
|
||||
RewriteRule ^menu/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/(.*)$ events.cgi?template=event_menu.html&from_date=$1&till_date=$2&$3 [L]
|
||||
RewriteRule ^menu/(\d{4}-\d{2}-\d{2})/(.*)$ events.cgi?template=event_menu.html&date=$1&$2 [L]
|
||||
RewriteRule ^menu/heute/(.*)$ events.cgi?template=event_menu.html&date=today&$1 [L]
|
||||
RewriteRule ^menu/(.*)$ events.cgi?$1 [L]
|
||||
|
||||
RewriteRule ^kalender/(\d{4}-\d{2}-\d{2})/$ cal.cgi?date=$1 [L]
|
||||
RewriteRule ^kalender/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/$ cal.cgi?from_date=$1&till_date=$2 [L]
|
||||
RewriteRule ^kalender/(.*)$ cal.cgi?$1 [L]
|
||||
|
||||
RewriteRule ^kategorien/(.*)$ category.cgi?$1 [L]
|
||||
RewriteRule ^sendereihen/(.*)$ series_names.cgi?$1 [L]
|
||||
|
||||
RewriteRule ^playlist/(.*)$ events.cgi?template=event_playlist.html&time=future&limit=5&$1 [L]
|
||||
RewriteRule ^playlistLong/(.*)$ events.cgi?template=event_playlist_long.html&time=future&limit=20&$1 [L]
|
||||
RewriteRule ^playlistUtc/(.*)$ events.cgi?template=event_utc_time.json&limit=1
|
||||
|
||||
RewriteRule ^running_event/(.*)$ events.cgi?template=event_running.html&time=now&limit=1&$1 [L]
|
||||
RewriteRule ^feed/(.*)$ events.cgi?template=event.atom.xml&time=future&limit=100&$1 [L]
|
||||
RewriteRule ^feed.xml[\?]?(.*)$ events.cgi?template=event.atom.xml&time=future&limit=100&$1 [L]
|
||||
RewriteRule ^atom/(.*)$ events.cgi?template=event.atom.xml&time=future&limit=100&$1 [L]
|
||||
RewriteRule ^atom.xml[\?]?(.*)$ events.cgi?template=event.atom.xml&time=future&limit=100&$1 [L]
|
||||
RewriteRule ^rss/(.*)$ events.cgi?template=event.rss.xml&time=future&limit=100&$1 [L]
|
||||
RewriteRule ^rss.xml[\?]?(.*)$ events.cgi?template=event.rss.xml&time=future&limit=100&$1 [L]
|
||||
|
||||
RewriteRule ^ical/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/(\d)/(.*)$ events.cgi?template=event.ics&from_date=$1&till_date=$2&weekday=$3&$4 [L]
|
||||
RewriteRule ^ical/(\d{4}-\d{2}-\d{2})/(\d{4}-\d{2}-\d{2})/(.*)$ events.cgi?template=event.ics&from_date=$1&till_date=$2&$3 [L]
|
||||
RewriteRule ^ical/(\d{4}-\d{2})/(.*?)$ events.cgi?template=event.ics&from_date=$1-01&till_date=$1-31&$2 [L]
|
||||
RewriteRule ^ical/(\d{4}-\d{2}-\d{2})/(.*)$ events.cgi?template=event.ics&date=$1&$2 [L]
|
||||
RewriteRule ^ical/(\d+)/(.*)?$ events.cgi?template=event.ics&event_id=$1&$2 [L]
|
||||
|
||||
RewriteRule ^ical/(.*)$ events.cgi?template=event.ics&$1 [L]
|
||||
RewriteRule ^ical\.ics[\?]?(.*)$ events.cgi?template=event.ics&$1 [L]
|
||||
|
||||
RewriteRule ^suche/(.*?)/(.*?)/kommende/(.*)$ events.cgi?template=event_list.html&project=$1&search=$2&archive=coming&$3 [L]
|
||||
RewriteRule ^suche/(.*?)/(.*?)/vergangene/(.*)$ events.cgi?template=event_list.html&project=$1&search=$2&archive=gone&$3 [L]
|
||||
RewriteRule ^suche/(.*?)/(.*?)/(.*)$ events.cgi?template=event_list.html&project=$1&search=$2&$3 [L]
|
||||
RewriteRule ^suche/(.*?)/(.*)$ events.cgi?template=event_list.html&search=$1&$2 [L]
|
||||
|
||||
RewriteRule ^kategorie/(.*?)/(.*?)/kommende/(.*)$ events.cgi?template=event_list.html&project=$1&category=$2&archive=coming&$3 [L]
|
||||
RewriteRule ^kategorie/(.*?)/(.*?)/vergangene/(.*)$ events.cgi?template=event_list.html&project=$1&category=$2&archive=gone&$3 [L]
|
||||
RewriteRule ^kategorie/(.*?)/(.*?)/(.*)$ events.cgi?template=event_list.html&project=$1&category=$2&$3 [L]
|
||||
RewriteRule ^kategorie/(.*?)/(.*)$ events.cgi?template=event_list.html&category=$1&$2 [L]
|
||||
|
||||
RewriteRule ^rds/(.*)$ events.cgi?template=event_playlist.txt&time=now&limit=1&$1 [L]
|
||||
RewriteRule ^playlist_show/(.*)$ events.cgi?template=event_playlist_show.html&time=future&limit=3&$1 [L]
|
||||
RewriteRule ^json/(.*)$ events.cgi?template=event.json&time=now&limit=15&$1 [L]
|
||||
|
||||
RewriteRule ^sendereihe/(.*?)/(.*?)/kommende/(.*)$ events.cgi?template=event_list.html&project=$1&series_name=$2&archive=coming&$3 [L]
|
||||
RewriteRule ^sendereihe/(.*?)/(.*?)/vergangene/(.*)$ events.cgi?template=event_list.html&project=$1&series_name=$2&archive=gone&$3 [L]
|
||||
RewriteRule ^sendereihe/(.*?)/(.*?)/(.*)$ events.cgi?template=event_list.html&project=$1&series_name=$2&$3 [L]
|
||||
RewriteRule ^sendereihe/(.*?)/(.*)$ events.cgi?template=event_list.html&series_name=$1&$2 [L]
|
||||
|
||||
RewriteRule ^freefm.xml$ events.cgi?template=event_freefm.xml&location=piradio&limit=40
|
||||
RewriteRule ^future$ events.cgi?template=event_list_image.html&limit=20
|
||||
RewriteRule ^dt64-festival.html$ events.cgi?location=dt64&template=event_dt64&archive=all
|
||||
RewriteRule ^frrapo-programm.html$ events.cgi?location=potsdam&template=event_frrapo
|
||||
RewriteRule ^upload_playout_piradio$ upload_playout.cgi?project_id=1&studio_id=1
|
||||
</IfModule>
|
||||
|
||||
# MOD_PERL
|
||||
Options -Indexes +FollowSymLinks +MultiViews +ExecCGI
|
||||
|
||||
#PerlResponseHandler ModPerl::RegistryPrefork
|
||||
<IfModule mod_perl.c>
|
||||
<FilesMatch "\.cgi$">
|
||||
SetHandler perl-script
|
||||
PerlResponseHandler ModPerl::RegistryPrefork
|
||||
PerlOptions +ParseHeaders
|
||||
PerlSetVar PerlRunOnce On
|
||||
Options +ExecCGI
|
||||
</FilesMatch>
|
||||
</IfModule>
|
||||
|
||||
<IfModule !mod_perl.c>
|
||||
AddHandler cgi-script .cgi .pl
|
||||
</IfModule>
|
||||
|
||||
#Order allow,deny
|
||||
#allow from all
|
||||
Require all granted
|
||||
|
||||
## compress
|
||||
<IfModule mod_headers.c>
|
||||
# SetOutputFilter DEFLATE
|
||||
# SetEnvIfNoCase Request_URI \.(?:gif|jpe?g|png|zip|mp3)$ no-gzip dont-vary
|
||||
# Header append Vary User-Agent env=!dont-vary
|
||||
|
||||
# <FilesMatch "\.(ico|pdf|flv|jpg|jpeg|png|gif|js|css|swf)$">
|
||||
# Header set Cache-Control "max-age=600, public"
|
||||
# </FilesMatch>
|
||||
</IfModule>
|
||||
|
||||
255
website/agenda/add_comment.cgi
Executable file
255
website/agenda/add_comment.cgi
Executable file
@@ -0,0 +1,255 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
use warnings "all";
|
||||
use diagnostics;
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
use CGI qw(header param Vars escapeHTML uploadInfo cgi_error);
|
||||
$CGI::POST_MAX=1024 * 100;
|
||||
|
||||
use params;
|
||||
use config;
|
||||
use db;
|
||||
use markup;
|
||||
use cache;
|
||||
use comments;
|
||||
use template;
|
||||
use log;
|
||||
use time;
|
||||
|
||||
binmode STDOUT, ":utf8";
|
||||
|
||||
my $r=shift;
|
||||
(my $cgi, my $params, my $error)=params::get($r);
|
||||
|
||||
my $config = config::get('./config/config.cgi');
|
||||
my $debug = $config->{system}->{debug};
|
||||
|
||||
$cache::debug=$debug;
|
||||
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => $params,
|
||||
checked => check_params($config, $params),
|
||||
},
|
||||
config => $config,
|
||||
};
|
||||
$params=$request->{params}->{checked};
|
||||
log::init($request);
|
||||
|
||||
print $cgi->header('text/plain')."\n";
|
||||
|
||||
print STDERR "add comment: ".Dumper($params);
|
||||
my $comment =$params->{comment};
|
||||
|
||||
$config->{access}->{write}=1;
|
||||
my $dbh=db::connect($config,undef);
|
||||
|
||||
print "ok\n";
|
||||
|
||||
$comment->{content}=~s/(^|\s)((https?\:\/\/)(.*?))(\s|$|\<)/$1\<a href\=\"$2\"\>$2\<\/a\>$5/g;
|
||||
$comment->{content}=~s/(^|\s)((https?\:\/\/)(.*?))(\s|$|\<)/$1\<a href\=\"$2\"\>$2\<\/a\>$5/g;
|
||||
$comment->{content}=~s/(^|\s)((www\.)(.*?))(\s|$|\<)/$1\<a href\=\"http\:\/\/$2\"\>$2\<\/a\>$5/g; #"
|
||||
$comment->{content}=~s/(^|\s)((www\.)(.*?))(\s|$|\<)/$1\<a href\=\"http\:\/\/$2\"\>$2\<\/a\>$5/g; #"
|
||||
|
||||
if (comments::check($dbh, $config, $comment)){
|
||||
my $nslookup=nslookup();
|
||||
#if (is_blocked($nslookup)==1){
|
||||
# send_mail($comment, $nslookup, 'blocked');
|
||||
# return;
|
||||
#};
|
||||
$comment->{comment_id}=comments::insert($dbh, $config, $comment);
|
||||
if($comment->{comment_id}>0){
|
||||
comments::update_comment_count($dbh, $config, $comment);
|
||||
delete_cache($config);
|
||||
send_mail($comment, $nslookup, 'new');
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub is_blocked{
|
||||
my $nslookup=shift;
|
||||
|
||||
my $user_agent=$ENV{HTTP_USER_AGENT};
|
||||
|
||||
my $block=0;
|
||||
$block=1 if (
|
||||
($user_agent eq 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:35.0) Gecko/20100101 Firefox/35.0')
|
||||
&& ($nslookup=~/alicedsl/)
|
||||
);
|
||||
return $block;
|
||||
}
|
||||
|
||||
|
||||
sub send_mail{
|
||||
my $comment = shift;
|
||||
my $nslookup = shift;
|
||||
my $status = shift || 'new';
|
||||
|
||||
my $ip = $ENV{REMOTE_ADDR}||'';
|
||||
my $user_agent = $ENV{HTTP_USER_AGENT}||'';
|
||||
my $cookie = $ENV{HTTP_COOKIE}||'';
|
||||
|
||||
my $from = 'no-reply@';
|
||||
my $to = 'info@';
|
||||
my $subject = "$status comment from '$comment->{author}': $comment->{content}";
|
||||
my $content = "$status comment
|
||||
|
||||
FROM: '$comment->{author}'
|
||||
EMAIL: $comment->{email}
|
||||
|
||||
CONTENT: '$comment->{content}'
|
||||
|
||||
view event
|
||||
https://piradio.de/programm/sendung/$comment->{event_id}.html#comments
|
||||
";
|
||||
|
||||
if ($status eq 'new'){
|
||||
$content.="
|
||||
manage comments:
|
||||
https://piradio.de/agenda/planung/comment.cgi?project_id=1&studio_id=1
|
||||
|
||||
lock this comment
|
||||
https://piradio.de/agenda/planung/comment.cgi?event_id=$comment->{event_id}&comment_id=$comment->{comment_id}&set_lock_status=blocked
|
||||
";
|
||||
}
|
||||
|
||||
$content.=qq{
|
||||
-----------------------------------------------------------
|
||||
|
||||
SENDER IP: $ip ($comment->{ip})
|
||||
USER AGENT: $user_agent
|
||||
COOKIE: $cookie
|
||||
|
||||
$nslookup
|
||||
};
|
||||
|
||||
use MIME::Lite;
|
||||
my $msg = MIME::Lite->new(
|
||||
From => $from,
|
||||
To => $to,
|
||||
Subject => $subject,
|
||||
Data => $content
|
||||
#.Dumper($comment)
|
||||
);
|
||||
|
||||
$msg->send;
|
||||
}
|
||||
|
||||
sub nslookup{
|
||||
my $ip =$ENV{REMOTE_ADDR};
|
||||
my $nslookup='';
|
||||
if($ip=~/^([\d\.]+)$/){
|
||||
$ip=$1;
|
||||
return `nslookup '$ip'`;
|
||||
}
|
||||
return '';
|
||||
}
|
||||
|
||||
sub delete_cache{
|
||||
my $config=shift;
|
||||
|
||||
unless($config->{locations}->{base_dir}=~/a-zA-Z/){
|
||||
print STDERR "add_comment.cgi: base_dir is not configured\n";
|
||||
return;
|
||||
}
|
||||
unless($config->{cache}->{cache_dir}=~/a-zA-Z/){
|
||||
print STDERR "add_comment.cgi: cache_dir is not configured\n";
|
||||
return;
|
||||
}
|
||||
unless($config->{controllers}->{comments}=~/a-zA-Z/){
|
||||
print STDERR "add_comment.cgi: contoller 'comments' is not configured\n";
|
||||
return;
|
||||
}
|
||||
|
||||
my $cache_dir=$config->{locations}->{base_dir}.'/'.$config->{cache}->{cache_dir}.'/';
|
||||
|
||||
my $widget_cache=$cache_dir.'/'.$config->{controllers}->{comments};
|
||||
`rm -f $widget_cache/*` if (-d $widget_cache);
|
||||
|
||||
my $aggregator_dir=$cache_dir.'/programm/'.$config->{controllers}->{comments};
|
||||
`rm -f $aggregator_dir/*` if (-d $aggregator_dir);
|
||||
}
|
||||
|
||||
sub check_params{
|
||||
my $config=shift;
|
||||
my $params=shift;
|
||||
|
||||
my $template=template::check($params->{'template'}, 'comments.html');
|
||||
|
||||
my $comment={};
|
||||
|
||||
my $event_start=$params->{'event_start'}||'';
|
||||
if ($event_start=~/^(\d\d\d\d\-\d\d\-\d\d[ T]\d\d\:\d\d)(\:\d\d)?$/){
|
||||
$comment->{event_start}=$1;
|
||||
}else{
|
||||
log::error($config, 'add_comment.cgi: invalid date "'.$event_start.'"');
|
||||
}
|
||||
|
||||
my $event_id=$params->{'event_id'}||'';
|
||||
if ($event_id=~/^(\d+)$/){
|
||||
$comment->{event_id}=$1;
|
||||
}else{
|
||||
log::error($config, 'add_comment.cgi: invalid id');
|
||||
}
|
||||
|
||||
my $parent_id=$params->{'parent_id'}||'';
|
||||
if ($parent_id=~/^(\d+)$/){
|
||||
$comment->{parent_id}=$1;
|
||||
}else{
|
||||
$comment->{parent_id}=0;
|
||||
}
|
||||
|
||||
$comment->{content}=$params->{'content'}||'';
|
||||
$comment->{content}=escape_text($comment->{content});
|
||||
$comment->{content}=substr($comment->{content},0,1000);
|
||||
log::error($config, 'add_comment.cgi: missing body') if ($comment->{content}eq'');
|
||||
|
||||
$comment->{author}=$params->{'author'}||'';
|
||||
$comment->{author}=escape_text($comment->{author});
|
||||
$comment->{author}=substr($comment->{author},0,40);
|
||||
log::error($config, 'add_comment.cgi: missing name') if ($comment->{author}eq'');
|
||||
|
||||
$comment->{email}=$params->{'email'}||'';
|
||||
$comment->{email}=escape_text($comment->{email});
|
||||
$comment->{email}=substr($comment->{email},0,40);
|
||||
|
||||
$comment->{title}=$params->{'title'}||'';
|
||||
$comment->{title}=escape_text($comment->{title});
|
||||
$comment->{title}=substr($comment->{title},0,80);
|
||||
|
||||
$comment->{ip}=$ENV{REMOTE_ADDR}||'';
|
||||
log::error($config, 'missing ip') if ($comment->{ip}eq'');
|
||||
$comment->{ip}=Digest::MD5::md5_base64($comment->{ip});
|
||||
|
||||
my $today=time::datetime_to_array(time::time_to_datetime());
|
||||
my $date =time::datetime_to_array($comment->{event_start});
|
||||
my $delta_days=time::days_between($today,$date);
|
||||
log::error($config, 'add_comment.cgi: no comments allowed, yet') if ($delta_days > $config->{permissions}->{no_new_comments_before} );
|
||||
log::error($config, 'add_comment.cgi: no comments allowed anymore') if ($delta_days < -1*$config->{permissions}->{no_new_comments_after} );
|
||||
|
||||
return {
|
||||
template =>$template,
|
||||
comment =>$comment
|
||||
}
|
||||
}
|
||||
|
||||
sub escape_text{
|
||||
my $s=shift;
|
||||
$s=~s/^\s+//g;
|
||||
$s=~s/\s+$//g;
|
||||
|
||||
#remove broken HTML
|
||||
$s=~s/<[a-z\!\?\[\/][^\>]+?\>//gi;
|
||||
$s=~s/<[a-z\!\?\[\/]\>//gi;
|
||||
|
||||
$s=CGI::escapeHTML($s);
|
||||
$s=~s/[\n\r]+/\<br \/\>/g;
|
||||
$s=~s/\<br \/\>/\<br \/\>\n/g;
|
||||
$s=~s/\<br \/\>\s*$//g;
|
||||
return $s;
|
||||
}
|
||||
|
||||
|
||||
170
website/agenda/aggregate.cgi
Executable file
170
website/agenda/aggregate.cgi
Executable file
@@ -0,0 +1,170 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
#use Data::Dumper;
|
||||
|
||||
#use DBI;
|
||||
use CGI qw(header param Vars);
|
||||
#use Time::Local qw(timelocal);
|
||||
#use Benchmark;
|
||||
#use Devel::Profiler;
|
||||
|
||||
use db;
|
||||
use events;
|
||||
use time;
|
||||
use aggregator;
|
||||
use markup;
|
||||
use log;
|
||||
use config;
|
||||
|
||||
#use params;
|
||||
#my $r=shift;
|
||||
|
||||
if ($0=~/aggregate.*?\.cgi$/){
|
||||
binmode STDOUT, ":encoding(UTF-8)";
|
||||
|
||||
#(my $cgi, my $params, my $error)=params::get($r);
|
||||
my $cgi=new CGI();
|
||||
my %params=$cgi->Vars();
|
||||
my $params=\%params;
|
||||
#print STDERR Dumper($params);
|
||||
|
||||
my $config = config::get('config/config.cgi');
|
||||
my $debug = $config->{system}->{debug};
|
||||
my $mem_debug = $config->{system}->{debug_memory};
|
||||
my $base_dir = $config->{locations}->{base_dir};
|
||||
|
||||
#my $cgi=new CGI();
|
||||
my $output_header='';
|
||||
if(exists $ENV{REQUEST_URI} && $ENV{REQUEST_URI}ne''){
|
||||
$output_header.="Content-type:text/html; charset=UTF-8;\n\n";
|
||||
};
|
||||
# $output_header.='<!DOCTYPE html>'."\n";
|
||||
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => $params,
|
||||
checked => aggregator::check_params($config, $params),
|
||||
},
|
||||
};
|
||||
$params=$request->{params}->{checked};
|
||||
|
||||
my $mem=0;
|
||||
log::init($request);
|
||||
|
||||
#get result from cache
|
||||
my $cache=aggregator::get_cache($config, $request);
|
||||
|
||||
if ((defined $cache->{content}) && ($cache->{content}ne'')){
|
||||
my $content=$cache->{content};
|
||||
print $output_header;
|
||||
print $content;
|
||||
return;
|
||||
}
|
||||
|
||||
my $content=load_file($base_dir.'./index.html');
|
||||
$content=$$content||'';
|
||||
|
||||
#replace HTML escaped calcms_title span by unescaped one
|
||||
$content=~s/\<\;span id\="\;calcms_title"\;\>\;[^\&]*\<\;\/span\>\;/\<span id=\"calcms_title\" \>\<\/span\>/g;
|
||||
# print $content;
|
||||
|
||||
my $list=aggregator::get_list($config, $request);
|
||||
|
||||
my $menu={content=>''};
|
||||
$list->{day}=$params->{date} if ((!defined $list->{day}) || ($list->{day} eq''));
|
||||
$list->{day}='today' if ($list->{day} eq'' && $params->{date} eq'');
|
||||
|
||||
$menu=aggregator::get_menu($config, $request, $list->{day}, $list->{results});
|
||||
|
||||
my $calendar=aggregator::get_calendar($config, $request, $list->{day});
|
||||
my $newest_comments=aggregator::get_newest_comments($config, $request);
|
||||
|
||||
#my $newest_comments={};
|
||||
#db::disconnect($request) if (defined $request && defined $request->{connection});
|
||||
#print STDERR "$list->{project_title}\n";
|
||||
|
||||
#build results list
|
||||
my $output={};
|
||||
$output->{calcms_menu} = \$menu->{content};
|
||||
$output->{calcms_list} = \$list->{content};
|
||||
$output->{calcms_calendar} = \$calendar->{content};
|
||||
$output->{calcms_newest_comments} = \$newest_comments->{content};
|
||||
|
||||
# $output->{calcms_categories} = load_file($base_dir.'/cache/categories.html');
|
||||
# $output->{calcms_series_names} = load_file($base_dir.'/cache/series_names.html');
|
||||
# $output->{calcms_programs} = load_file($base_dir.'/cache/programs.html');
|
||||
|
||||
my $url=$list->{url};
|
||||
my $js=qq{
|
||||
set('preloaded','1');
|
||||
set('last_list_url','$url');
|
||||
};
|
||||
$content=~s/\/\/\s*(calcms_)?preload/$js/;
|
||||
|
||||
#insert results into page
|
||||
for my $key (keys %$output){
|
||||
my $val=${$output->{$key}};
|
||||
my $start=index($val,"<body>");
|
||||
if ($start!=-1){
|
||||
$val=substr($val,$start+length('<body>'));
|
||||
}
|
||||
my $end=index($val,"</body>");
|
||||
if ($end!=-1){
|
||||
$val=substr($val,0,$end);
|
||||
}
|
||||
$content=~s/(<(div|span)\s+id="$key".*?>).*?(<\/(div|span)>)/$1$val$3/g;
|
||||
}
|
||||
|
||||
#replace whole element span with id="calcms_title" by value
|
||||
$list->{project_title}='' unless (defined $list->{project_title});
|
||||
$content=~s/(<(div|span)\s+id="calcms_title".*?>).*?(<\/(div|span)>)/$list->{project_title}/g;
|
||||
|
||||
my $title=$list->{program}||'';
|
||||
$title.=' - '.$list->{series_name} if ((defined $list->{series_name}) && ($list->{series_name} ne''));
|
||||
$title.=' - '.$list->{title} if ((defined $list->{title}) && ($list->{title} ne''));
|
||||
$title=' | '.$title if($title ne'');
|
||||
$title.='Programmplan';
|
||||
$title.=' | '.$list->{project_title} if $list->{project_title}ne'';
|
||||
#$content=~s/(<title>)(.*?)(<\/title>)/$1$title$3/;
|
||||
|
||||
$js='';
|
||||
if ((defined $list->{event_id}) && ($list->{event_id}ne'')){
|
||||
$js.=qq{showCommentsByEventIdOrEventStart('$list->{event_id}','$list->{start_datetime}')};
|
||||
}
|
||||
|
||||
$content=~s/startCalcms\(\)\;/$js/gi;
|
||||
|
||||
#replace link to uncompressed or compressed drupal (first link in <head>)
|
||||
my @parts=split(/<\/head>/,$content);
|
||||
$parts[0]=~s|/misc/jquery.js|/agenda_files/js/jquery.js|;
|
||||
$parts[0]=~s|/sites/default/files/js/[a-z0-9\_]+\.js|/agenda_files/js/jquery.js|;
|
||||
$content=join('</head>',@parts);
|
||||
|
||||
print $output_header;
|
||||
print $content;
|
||||
# $r->print("done");
|
||||
|
||||
if ($config->{cache}->{use_cache} eq '1'){
|
||||
$cache->{content}=$content;
|
||||
log::write($config, 'cache_file',$cache->{filename}) if ($debug);
|
||||
cache::save($cache);
|
||||
}
|
||||
# $config=undef;
|
||||
$content=undef;
|
||||
$cache=undef;
|
||||
log::mem($config, 'aggregate done',$mem) if ($mem_debug>0);
|
||||
}
|
||||
|
||||
sub load_file{
|
||||
my $filename=shift;
|
||||
my $content="cannot load '$filename'";
|
||||
open my $FILE,'<:utf8',$filename or return \$content;
|
||||
$content=join ("",(<$FILE>));
|
||||
close $FILE;
|
||||
return \$content;
|
||||
}
|
||||
|
||||
|
||||
3
website/agenda/cache/.htaccess
vendored
Normal file
3
website/agenda/cache/.htaccess
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
Order deny,allow
|
||||
deny from all
|
||||
|
||||
2
website/agenda/cache/kalender/README.md
vendored
Normal file
2
website/agenda/cache/kalender/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
2
website/agenda/cache/kommentare/README.md
vendored
Normal file
2
website/agenda/cache/kommentare/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
38
website/agenda/cache/programm/.htaccess
vendored
Normal file
38
website/agenda/cache/programm/.htaccess
vendored
Normal file
@@ -0,0 +1,38 @@
|
||||
<IfModule mod_rewrite.c>
|
||||
RewriteBase /programm
|
||||
|
||||
RewriteEngine on
|
||||
RewriteCond %{REQUEST_FILENAME} -f
|
||||
RewriteRule (.*) $1 [L]
|
||||
RewriteCond %{REQUEST_FILENAME} -d
|
||||
RewriteRule (.*) $1 [L]
|
||||
|
||||
#controller
|
||||
RewriteRule ^kalender/(\d{4}-\d{2}-\d{2})_(\d{4}-\d{2}-\d{2})\.html[\?]?(.*)$ /agenda/aggregate.cgi?from_date=$1&till_date=$2&$3 [L]
|
||||
RewriteRule ^kalender/(\d{4}-\d{2}-\d{2})\.html[\?]?(.*)$ /agenda/aggregate.cgi?date=$1&$2 [L]
|
||||
RewriteRule ^sendungen/(\d{4}-\d{2}-\d{2})\.html[\?]?(.*)$ /agenda/aggregate.cgi?date=$1&$2 [L]
|
||||
# RewriteRule ^sendung/(\d+)\.html/[^&]*(&.*)?$ /agenda/aggregate.cgi?event_id=$1&$2 [L]
|
||||
RewriteRule ^sendung/(\d+)\.html[\?]?(.*)$ /agenda/aggregate.cgi?event_id=$1&$2 [L]
|
||||
RewriteRule ^sendung/serie_plus/(\d+)\.html[\?]?(.*)$ /agenda/aggregate.cgi?next_series=$1&$2 [L]
|
||||
RewriteRule ^sendung/serie_minus/(\d+)\.html[\?]?(.*)$ /agenda/aggregate.cgi?previous_series=$1&$2 [L]
|
||||
#controller end
|
||||
</IfModule>
|
||||
|
||||
Options -Indexes +FollowSymLinks +MultiViews +ExecCGI
|
||||
|
||||
<IfModule mod_perl.c>
|
||||
<FilesMatch "\.cgi$">
|
||||
SetHandler perl-script
|
||||
PerlHandler ModPerl::RegistryPrefork
|
||||
PerlSendHeader On
|
||||
Options +ExecCGI
|
||||
</FilesMatch>
|
||||
</IfModule>
|
||||
|
||||
<IfModule !mod_perl.c>
|
||||
AddHandler cgi-script .cgi .pl
|
||||
</IfModule>
|
||||
|
||||
#Order allow,deny
|
||||
#allow from all
|
||||
Require all granted
|
||||
2
website/agenda/cache/programm/kalender/README.md
vendored
Normal file
2
website/agenda/cache/programm/kalender/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
2
website/agenda/cache/programm/kommentare/README.md
vendored
Normal file
2
website/agenda/cache/programm/kommentare/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
2
website/agenda/cache/programm/sendung/README.md
vendored
Normal file
2
website/agenda/cache/programm/sendung/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
2
website/agenda/cache/programm/sendungen/README.md
vendored
Normal file
2
website/agenda/cache/programm/sendungen/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
2
website/agenda/cache/sendung/README.md
vendored
Normal file
2
website/agenda/cache/sendung/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
2
website/agenda/cache/sendungen/README.md
vendored
Normal file
2
website/agenda/cache/sendungen/README.md
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
# racalmas
|
||||
radio calendar management system
|
||||
44
website/agenda/cal.cgi
Executable file
44
website/agenda/cal.cgi
Executable file
@@ -0,0 +1,44 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
#use utf8;
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use CGI qw(header param Vars);
|
||||
$CGI::POST_MAX = 1000;
|
||||
$CGI::DISABLE_UPLOADS = 1;
|
||||
|
||||
use Data::Dumper;
|
||||
use params;
|
||||
use config;
|
||||
use log;
|
||||
use calendar;
|
||||
|
||||
my $r=shift;
|
||||
|
||||
#binmode STDOUT, ":utf8";
|
||||
binmode STDOUT, ":encoding(UTF-8)";
|
||||
|
||||
if ($0=~/cal.*?\.cgi$/){
|
||||
(my $cgi, my $params, my $error)=params::get($r);
|
||||
|
||||
my $config=config::get('config/config.cgi');
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => $params,
|
||||
checked => calendar::check_params($config, $params),
|
||||
},
|
||||
};
|
||||
$params=$request->{params}->{checked};
|
||||
|
||||
log::init($request);
|
||||
|
||||
my $out='';
|
||||
calendar::get_cached_or_render($out, $config, $request);
|
||||
print $out."\n";
|
||||
}
|
||||
|
||||
1;
|
||||
145
website/agenda/category.cgi
Executable file
145
website/agenda/category.cgi
Executable file
@@ -0,0 +1,145 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Data::Dumper;
|
||||
use CGI qw(header param Vars);
|
||||
$CGI::POST_MAX = 1000;
|
||||
$CGI::DISABLE_UPLOADS = 1;
|
||||
|
||||
use params;
|
||||
use db;
|
||||
use markup;
|
||||
use cache;
|
||||
use log;
|
||||
use config;
|
||||
use template;
|
||||
use project;
|
||||
|
||||
binmode STDOUT, ":utf8";
|
||||
|
||||
my $r=shift;
|
||||
(my $cgi, my $params, my $error)=params::get($r);
|
||||
|
||||
my $config=config::get('config/config.cgi');
|
||||
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => $params,
|
||||
checked => check_params($config, $params),
|
||||
},
|
||||
};
|
||||
|
||||
log::init($request);
|
||||
|
||||
$params=$request->{params}->{checked};
|
||||
|
||||
my $cache={};
|
||||
if ($config->{cache}->{use_cache} eq '1'){
|
||||
cache::configure('categories.html');
|
||||
$cache=cache::load($config, $params);
|
||||
if (defined $cache->{content}){
|
||||
print $cache->{content};
|
||||
return;
|
||||
};
|
||||
}
|
||||
|
||||
my $dbh=db::connect($config);
|
||||
|
||||
my $template_parameters={};
|
||||
$template_parameters->{projects} = getProjects($dbh, $config);
|
||||
#$template_parameters->{categories} = get_categories($dbh,$params->{project});
|
||||
$template_parameters->{debug} = $config->{system}->{debug};
|
||||
$template_parameters->{server_cache} = $config->{cache}->{server_cache} if ($config->{cache}->{server_cache});
|
||||
$template_parameters->{use_client_cache}= $config->{cache}->{use_client_cache} if ($config->{cache}->{use_client_cache});
|
||||
|
||||
my $template=$params->{template};
|
||||
my $out='';
|
||||
template::process($out, $params->{template}, $template_parameters);
|
||||
print $out;
|
||||
|
||||
#write to cache
|
||||
if ($config->{cache}->{use_cache} eq '1'){
|
||||
$cache->{content}=$out;
|
||||
cache::save($cache);
|
||||
}
|
||||
|
||||
sub getProjects{
|
||||
my $dbh=shift;
|
||||
my $config=shift;
|
||||
|
||||
my $excludedProjects={};
|
||||
if (defined $config->{filter}->{exclude_projects}){
|
||||
for my $project ( split(/\,/, $config->{filter}->{exclude_projects}) ){
|
||||
$project=~s/^\s+//g;
|
||||
$project=~s/\s+$//g;
|
||||
$excludedProjects->{$project}=1;
|
||||
}
|
||||
}
|
||||
|
||||
my $projects=project::get_sorted($config);
|
||||
my $results=[];
|
||||
for my $project (@$projects){
|
||||
next if defined $excludedProjects->{$project->{name}};
|
||||
my $categories=getCategories($dbh, $config, $project->{name});
|
||||
$project->{isEmpty}=1 if scalar(@$categories)==0;
|
||||
$project->{categories}=$categories;
|
||||
|
||||
$project->{js_name}=$project->{name};
|
||||
$project->{js_name}=~s/[^a-zA-Z\_0-9]/\_/g;
|
||||
$project->{js_name}=~s/\_+/\_/g;
|
||||
push @$results, $project;
|
||||
}
|
||||
return $results;
|
||||
}
|
||||
|
||||
sub getCategories{
|
||||
my $dbh=shift;
|
||||
my $config=shift;
|
||||
my $project=shift;
|
||||
|
||||
my $cond='';
|
||||
my $bind_values=[];
|
||||
if (($project ne '') && ($project ne 'all')){
|
||||
$cond='where project=?';
|
||||
$bind_values=[$project];
|
||||
}
|
||||
|
||||
my $query=qq{
|
||||
select name, count(name) sum
|
||||
from calcms_categories
|
||||
$cond
|
||||
group by name
|
||||
order by sum desc, name
|
||||
};
|
||||
my $categories=db::get($dbh, $query, $bind_values);
|
||||
|
||||
my $results=[];
|
||||
for my $category (@$categories){
|
||||
push @$results, $category if $category->{sum}>1;
|
||||
}
|
||||
|
||||
return $results;
|
||||
}
|
||||
|
||||
sub check_params{
|
||||
my $config=$_[0];
|
||||
my $params=$_[1];
|
||||
|
||||
my $template=template::check($params->{template},'categories.html');
|
||||
|
||||
my $debug=$params->{debug}||'';
|
||||
if ($debug=~/([a-z\_\,]+)/){
|
||||
$debug=$1;
|
||||
}
|
||||
|
||||
return {
|
||||
template =>$template,
|
||||
debug =>$debug
|
||||
}
|
||||
}
|
||||
|
||||
45
website/agenda/comments.cgi
Executable file
45
website/agenda/comments.cgi
Executable file
@@ -0,0 +1,45 @@
|
||||
#! /usr/bin/perl -w
|
||||
|
||||
use warnings "all";
|
||||
use strict;
|
||||
|
||||
use CGI qw(header param Vars);
|
||||
$CGI::POST_MAX = 1000;
|
||||
$CGI::DISABLE_UPLOADS = 1;
|
||||
|
||||
use Data::Dumper;
|
||||
use params;
|
||||
use config;
|
||||
use comments;
|
||||
use db;
|
||||
use markup;
|
||||
use time;
|
||||
use cache;
|
||||
use log;
|
||||
|
||||
my $r=shift;
|
||||
(my $cgi, my $params, my $error)=params::get($r);
|
||||
|
||||
binmode STDOUT, ":encoding(UTF-8)";
|
||||
|
||||
if ($0=~/comments.*?\.cgi$/){
|
||||
my $config=config::get('config/config.cgi');
|
||||
my $debug=$config->{system}->{debug};
|
||||
|
||||
my $request={
|
||||
url => $ENV{QUERY_STRING},
|
||||
params => {
|
||||
original => $params,
|
||||
checked => comments::check_params($config, $params),
|
||||
},
|
||||
};
|
||||
log::init($request);
|
||||
|
||||
my $output='';
|
||||
comments::get_cached_or_render($output, $config, $request, 'filter_locked');
|
||||
print $output;
|
||||
}
|
||||
|
||||
|
||||
#do not delete last line
|
||||
1;
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user