Verified Commit 321a2fb6 authored by Luc Didry's avatar Luc Didry
Browse files

- Add tests

parent e41e198a
dolomon.conf
!t/dolomon.conf
local
last_cleaning_time.txt
*.swp
*.bak
script/hypnotoad.pid
themes/*
!themes/default
!themes/default/*
.zanata-cache/
exports/*
imports/*
cover_db/*
image: hatsoftwares/dolomon-test-ci:latest
stages:
# - publish_changelog
# - pouet_it
- carton
- tests
- cover
variables:
POSTGRES_DB: dolomon_test_db
POSTGRES_USER: dolomon_test_user
POSTGRES_PASSWORD: dolo
POSTGRES_HOST_AUTH_METHOD: md5
PGPASSWORD: dolo
### Jobs templates
##
#
.retry: &retry
retry: 2
except:
- tags
### Publish tag changelog and create a toot
##
#
#include:
# - 'https://framagit.org/fiat-tux/gitlabci-snippets/raw/4e4e03322e95e9b0124c714456ebf1bdc02ad43f/publish_changelog.gitlab-ci.yml'
# - 'https://framagit.org/fiat-tux/gitlabci-snippets/raw/4e4e03322e95e9b0124c714456ebf1bdc02ad43f/pouet-it-from-ci.gitlab-ci.yml'
### Install dependencies
##
#
carton:
<<: *retry
stage: carton
cache:
key: "$CI_COMMIT_REF_NAME"
paths:
- local/
policy: push
script:
- carton install --deployment
when: always
### Syntax
##
#
syntax:
<<: *retry
script:
- make check-syntax
stage: tests
cache:
key: "$CI_COMMIT_REF_NAME"
paths:
- local/
policy: pull
needs:
- carton
### PostgreSQL tests
##
#
postgresql:
<<: *retry
before_script:
- echo 'CREATE DATABASE dolomon_minion_test_db WITH OWNER dolomon_test_user;' | psql -h postgres -U dolomon_test_user dolomon_test_db
- echo 'CREATE EXTENSION "uuid-ossp";' | psql -h postgres -U dolomon_test_user dolomon_test_db
script:
- make test
after_script:
- echo 'TRUNCATE users CASCADE;' | psql -h postgres -U dolomon_test_user dolomon_test_db
- for i in applications_id_seq categories_id_seq data_exports_id_seq dolos_day_id_seq dolos_hits_id_seq dolos_id_seq dolos_month_id_seq dolos_week_id_seq dolos_year_id_seq tags_id_seq users_id_seq; do echo "ALTER SEQUENCE $i RESTART WITH 1;" | psql -h postgres -U dolomon_test_user dolomon_test_db; done
- make test-junit-output
stage: tests
cache:
key: "$CI_COMMIT_REF_NAME"
paths:
- local/
- cover_db/
- tap.xml
needs:
- carton
services:
- name: postgres:11
alias: postgres
- name: rroemhild/test-openldap
alias: rroemhild-test-openldap
### Code coverage
##
#
cover:
stage: cover
script:
- make cover
coverage: '/Total .* (\d+\.\d+)$/'
needs:
- postgresql
cache:
key: "$CI_COMMIT_REF_NAME"
paths:
- local/
- cover_db/
policy: pull
artifacts:
reports:
junit: tap.xml
except:
- tags
SHELL=/bin/bash
EXTRACTDIR=-D lib -D themes/default/templates
POT=themes/default/lib/Dolomon/I18N/dolomon.pot
PO=themes/default/lib/Dolomon/I18N/en.po
ENPO=themes/default/lib/Dolomon/I18N/en.po
XGETTEXT=carton exec local/bin/xgettext.pl
CARTON=carton exec
REAL_DOLOMON=script/dolomon
DOLOMON=script/mounter
.PHONY: locales dev devlog minion minion-test cover check-syntax ldap clear-db test clear-and-test full-test
locales:
$(XGETTEXT) $(EXTRACTDIR) -o $(POT) 2>/dev/null
$(XGETTEXT) $(EXTRACTDIR) -o $(PO) 2>/dev/null
$(XGETTEXT) $(EXTRACTDIR) -o $(ENPO) 2>/dev/null
dev:
MOJO_REVERSE_PROXY=1 $(CARTON) morbo $(DOLOMON) --listen http://127.0.0.1:8400 --watch themes/ --watch dolomon.conf --watch lib/
MOJO_REVERSE_PROXY=1 $(CARTON) morbo $(DOLOMON) --listen http://0.0.0.0:3000 --watch themes/ --watch dolomon.conf --watch lib/
devlog:
multitail log/development.log
minion:
$(CARTON) $(REAL_DOLOMON) minion worker -- -m development
minion-test:
MOJO_CONFIG=t/dolomon.conf $(CARTON) $(REAL_DOLOMON) minion worker -- -m development
cover:
PERL5OPT='-Ilib/' $(CARTON) cover --ignore_re '^local/'
check-syntax:
find lib/ themes/ -name \*.pm -exec carton exec perl -Ilib -c {} \;
find t/ -name \*.t -exec carton exec perl -Ilib -c {} \;
ldap:
sudo docker run --privileged -d -p 389:389 rroemhild/test-openldap; exit 0
clear-db:
pkill --signal SIGTSTP -f "$(DOLOMON)" &
sudo su postgres -c "echo \"SELECT pg_terminate_backend(pg_stat_activity.pid) FROM pg_stat_activity WHERE pg_stat_activity.datname IN ('dolomon_test_db', 'dolomon_minion_test_db') AND pid <> pg_backend_pid();\" | psql"
sudo su postgres -c "dropdb dolomon_test_db; createdb -O dolomon_test_user dolomon_test_db; echo 'CREATE EXTENSION \"uuid-ossp\";' | psql dolomon_test_db"
sudo su postgres -c "dropdb dolomon_minion_test_db; createdb -O dolomon_test_user dolomon_minion_test_db"
pkill --signal SIGCONT -f "$(DOLOMON)" && exit 0
test:
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover=+ignore,^(local|t)/' MOJO_CONFIG=t/dolomon.conf $(CARTON) -- prove -l --failures
test-junit-output:
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover=+ignore,^(local|t)/' MOJO_CONFIG=t/dolomon.conf $(CARTON) -- prove -l --failures --formatter TAP::Formatter::JUnit > tap.xml
clear-and-test: clear-db test
full-test: check-syntax ldap just-test
......@@ -5,6 +5,7 @@ requires 'Mojolicious::Plugin::DebugDumperHelper';
requires 'Mojolicious::Plugin::PgURLHelper';
requires 'Mojolicious::Plugin::StaticCache';
requires 'Mojolicious::Plugin::Mail';
requires 'Mojolicious::Plugin::CoverDb';
requires 'Mojolicious::Plugin::FiatTux::Helpers', '== 0.12', url => 'https://framagit.org/fiat-tux/mojolicious/fiat-tux/mojolicious-plugin-fiattux-helpers/-/archive/0.12/mojolicious-plugin-fiattux-helpers-0.12.tar.gz';
requires 'Mojo::Pg';
requires 'Minion';
......@@ -27,3 +28,8 @@ requires 'IO::Socket::INET6';
requires 'IO::Socket::SSL';
requires 'Net::SSLeay', '>= 1.81';
requires 'ISO::639_1';
feature 'test' => sub {
requires 'Devel::Cover';
requires 'Try::Tiny';
};
......@@ -50,6 +50,15 @@ DISTRIBUTIONS
ExtUtils::MakeMaker 6.42
Test::More 0
perl 5.005
B-Debug-1.26
pathname: R/RU/RURBAN/B-Debug-1.26.tar.gz
provides:
B::Debug 1.26
requirements:
B 0
ExtUtils::MakeMaker 0
Test::More 0
deprecate 0.03
B-Hooks-EndOfScope-0.21
pathname: E/ET/ETHER/B-Hooks-EndOfScope-0.21.tar.gz
provides:
......@@ -881,6 +890,65 @@ DISTRIBUTIONS
perl 5.008004
strict 0
warnings 0
Devel-Cover-1.36
pathname: P/PJ/PJCJ/Devel-Cover-1.36.tar.gz
provides:
Devel::Cover 1.36
Devel::Cover::Annotation::Git 1.36
Devel::Cover::Annotation::Random 1.36
Devel::Cover::Annotation::Svk 1.36
Devel::Cover::Branch 1.36
Devel::Cover::Collection 1.36
Devel::Cover::Collection::Template::Provider 1.36
Devel::Cover::Condition 1.36
Devel::Cover::Condition_and_2 1.36
Devel::Cover::Condition_and_3 1.36
Devel::Cover::Condition_or_2 1.36
Devel::Cover::Condition_or_3 1.36
Devel::Cover::Condition_xor_4 1.36
Devel::Cover::Criterion 1.36
Devel::Cover::DB 1.36
Devel::Cover::DB::Criterion 1.36
Devel::Cover::DB::Digests 1.36
Devel::Cover::DB::File 1.36
Devel::Cover::DB::IO 1.36
Devel::Cover::DB::IO::Base 1.36
Devel::Cover::DB::IO::JSON 1.36
Devel::Cover::DB::IO::Sereal 1.36
Devel::Cover::DB::IO::Storable 1.36
Devel::Cover::DB::Run 1.36
Devel::Cover::DB::Structure 1.36
Devel::Cover::Html_Common 1.36
Devel::Cover::Op 1.36
Devel::Cover::Pod 1.36
Devel::Cover::Report::Compilation 1.36
Devel::Cover::Report::Html 1.36
Devel::Cover::Report::Html_basic 1.36
Devel::Cover::Report::Html_basic::Template::Provider 1.36
Devel::Cover::Report::Html_minimal 1.36
Devel::Cover::Report::Html_subtle 1.36
Devel::Cover::Report::Html_subtle::Template::Provider 1.36
Devel::Cover::Report::Json 1.36
Devel::Cover::Report::Sort 1.36
Devel::Cover::Report::Text 1.36
Devel::Cover::Report::Text2 1.36
Devel::Cover::Report::Vim 1.36
Devel::Cover::Report::Vim::Template::Provider 1.36
Devel::Cover::Statement 1.36
Devel::Cover::Subroutine 1.36
Devel::Cover::Test 1.36
Devel::Cover::Time 1.36
Devel::Cover::Truth_Table 1.36
Devel::Cover::Truth_Table::Row 1.36
Devel::Cover::Util 1.36
Devel::Cover::Web 1.36
requirements:
B::Debug 0
Digest::MD5 0
ExtUtils::MakeMaker 0
HTML::Entities 3.69
Storable 0
Test::More 0
Devel-GlobalDestruction-0.14
pathname: H/HA/HAARG/Devel-GlobalDestruction-0.14.tar.gz
provides:
......@@ -1551,8 +1619,8 @@ DISTRIBUTIONS
Mojolicious 7.53
SQL::Abstract 1.85
perl 5.010001
Mojolicious-8.57
pathname: S/SR/SRI/Mojolicious-8.57.tar.gz
Mojolicious-8.58
pathname: S/SR/SRI/Mojolicious-8.58.tar.gz
provides:
Mojo undef
Mojo::Asset undef
......@@ -1621,7 +1689,7 @@ DISTRIBUTIONS
Mojo::UserAgent::Transactor undef
Mojo::Util undef
Mojo::WebSocket undef
Mojolicious 8.57
Mojolicious 8.58
Mojolicious::Command undef
Mojolicious::Command::Author::cpanify undef
Mojolicious::Command::Author::generate undef
......@@ -1679,6 +1747,13 @@ DISTRIBUTIONS
perl 5.010
strict 0
warnings 0
Mojolicious-Plugin-CoverDb-0.02
pathname: L/LD/LDIDRY/Mojolicious-Plugin-CoverDb-0.02.tar.gz
provides:
Mojolicious::Plugin::CoverDb 0.02
requirements:
ExtUtils::MakeMaker 0
Mojolicious 8.58
Mojolicious-Plugin-DebugDumperHelper-0.03
pathname: L/LD/LDIDRY/Mojolicious-Plugin-DebugDumperHelper-0.03.tar.gz
provides:
......
......@@ -85,6 +85,8 @@ sub startup {
$self->plugin('Minion::Admin' => { return_to => '/admin', route => $self->routes->any('/admin/minion')->over(is_admin => 1) });
$self->plugin('CoverDb' => { route => 'c' });
$self->plugin('authentication' =>
{
autoload_user => 1,
......@@ -96,8 +98,9 @@ sub startup {
return undef unless defined $uid;
my $user = Dolomon::User->new(app => $c->app, 'id', $uid);
if (defined $c->config('admins')) {
my $is_admin = c(@{$c->app->config('admins')})->grep(sub {$_ eq $user->login});
my $admins = c(@{$c->app->config('admins')});
if ($admins->size) {
my $is_admin = $admins->grep(sub {$_ eq $user->login});
$user->{is_admin} = $is_admin->size;
} else {
$user->{is_admin} = 0;
......
......@@ -2,15 +2,27 @@ package Dolomon::Admin;
use Mojo::Base 'Dolomon::DoloCommon';
use Mojo::Collection 'c';
=head1 Dolomon::Admin
=head2 search_user
Search user on login or mail
=cut
sub search_user {
my $c = shift;
my $search = shift;
my $sort = shift;
my $dir = shift;
return $c->app->pg->db->query('SELECT u.id, u.login, u.first_name, u.last_name, u.mail, EXTRACT(\'epoch\' FROM u.last_login) AS last_login, u.confirmed, count(d.id) AS dolos_nb FROM users u JOIN categories c ON c.user_id = u.id LEFT JOIN dolos d ON d.category_id = c.id WHERE u.login LIKE ? OR u.mail LIKE ? GROUP BY u.id ORDER BY '.$sort.' '.$dir, '%'.$search.'%', '%'.$search.'%')->hashes;
return $c->app->pg->db->query('SELECT u.id, u.login, u.first_name, u.last_name, u.mail, EXTRACT(\'epoch\' FROM u.last_login) AS last_login, u.confirmed, count(d.id) AS dolos_nb FROM users u JOIN categories c ON c.user_id = u.id LEFT JOIN dolos d ON d.category_id = c.id WHERE u.login LIKE ? OR u.mail LIKE ? GROUP BY u.id ORDER BY '.$sort.' '.$dir.', id ASC', '%'.$search.'%', '%'.$search.'%')->hashes;
}
=head2 get_users
Get paginated array of users
=cut
sub get_users {
my $c = shift;
my $page = shift;
......@@ -27,9 +39,14 @@ sub get_users {
$dir = 'DESC' unless $dir eq 'ASC';
return $c->app->pg->db->query('SELECT u.id, u.login, u.first_name, u.last_name, u.mail, EXTRACT(\'epoch\' FROM u.last_login) AS last_login, u.confirmed, count(d.id) AS dolos_nb FROM users u JOIN categories c ON c.user_id = u.id LEFT JOIN dolos d ON d.category_id = c.id GROUP BY u.id ORDER BY '.$sort.' '.$dir.' LIMIT ? OFFSET ?', $nb, $page)->hashes;
return $c->app->pg->db->query('SELECT u.id, u.login, u.first_name, u.last_name, u.mail, EXTRACT(\'epoch\' FROM u.last_login) AS last_login, u.confirmed, count(d.id) AS dolos_nb FROM users u JOIN categories c ON c.user_id = u.id LEFT JOIN dolos d ON d.category_id = c.id GROUP BY u.id ORDER BY '.$sort.' '.$dir.', id ASC LIMIT ? OFFSET ?', $nb, $page)->hashes;
}
=head2 get_nb_users
Get total number of users
=cut
sub get_nb_users {
my $c = shift;
......
......@@ -9,6 +9,16 @@ has 'dolos' => sub {
return Mojo::Collection->new();
};
=head1 Dolomon::Category
=head2 new
Get a L<Dolomon::Category>.
If the id is provided, fetch the informations from the database and fill the C<dolos> attribute
with a L<Mojo::Collection> of L<Dolomon::Dolo> belonging to the category.
=cut
sub new {
my $c = shift;
......@@ -71,42 +81,77 @@ sub new {
return $c;
}
=head2 evacuate_to
Changes the C<category_id> of all the L<Dolomon::Dolo> belonging to the current category.
=cut
sub evacuate_to {
my $c = shift;
my $new_cat_id = shift;
$c->app->pg->db->query('UPDATE dolos SET category_id = ? WHERE category_id = ?', ($new_cat_id, $c->id));
}
=head2 count
Returns the number of L<Dolomon::Dolo> belonging to the current category.
=cut
sub count {
my $c = shift;
return $c->app->pg->db->query('SELECT SUM(count) FROM dolos WHERE category_id = ?', $c->id)->array->[0];
}
=head2 get_raw_dys
Returns a L<Mojo::Collection> of hash tables representing the yearly stats of the dolos belonging to the current category.
=cut
sub get_raw_dys {
my $c = shift;
return $c->app->pg->db->query('SELECT y.year, SUM(y.count) AS count FROM dolos_year y JOIN dolos d ON y.dolo_id = d.id WHERE d.category_id = ? GROUP BY y.year ORDER BY y.year ASC', $c->id)->hashes;
}
=head2 get_raw_dms
Returns a L<Mojo::Collection> of hash tables representing the monthly stats of the dolos belonging to the current category.
=cut
sub get_raw_dms {
my $c = shift;
return $c->app->pg->db->query('SELECT m.year, m.month, SUM(m.count) AS count FROM dolos_month m JOIN dolos d ON m.dolo_id = d.id WHERE d.category_id = ? GROUP BY m.year, m.month ORDER BY m.year, m.month ASC', $c->id)->hashes;
}
=head2 get_raw_dws
Returns a L<Mojo::Collection> of hash tables representing the weekly stats of the dolos belonging to the current category.
=cut
sub get_raw_dws {
my $c = shift;
return $c->app->pg->db->query('SELECT w.year, w.week, SUM(w.count) AS count FROM dolos_week w JOIN dolos d ON w.dolo_id = d.id WHERE d.category_id = ? GROUP BY w.year, w.week ORDER BY w.year, w.week ASC', $c->id)->hashes;
}
=head2 get_raw_dds
Returns a L<Mojo::Collection> of hash tables representing the dayly stats of the dolos belonging to the current category.
=cut
sub get_raw_dds {
my $c = shift;
return $c->app->pg->db->query('SELECT a.year, a.month, a.day, SUM(a.count) AS count FROM dolos_day a JOIN dolos d ON a.dolo_id = d.id WHERE d.category_id = ? GROUP BY a.year, a.month, a.day ORDER BY a.year, a.month, a.day ASC', $c->id)->hashes;
}
=head2 get_raw_dhs
Returns a L<Mojo::Collection> of hash tables representing the hits’ stats of the dolos belonging to the current category.
=cut
sub get_raw_dhs {
my $c = shift;
......
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Dolomon::Command::theme;
use Mojo::Base 'Mojolicious::Commands';
use Mojo::Base 'Mojolicious::Commands', -signatures;
use FindBin qw($Bin);
use File::Spec qw(catfile cat dir);
use File::Path qw(make_path);
......@@ -10,12 +10,10 @@ has usage => sub { shift->extract_usage };
has message => sub { shift->extract_usage . "\nCreate new theme skeleton:\n" };
has namespaces => sub { ['Dolomon::Command::theme'] };
sub run {
my $c = shift;
my $name = shift;
unless (defined $name) {
sub run ($c, $name = '', $test = 0) {
if ($name eq '') {
say $c->extract_usage;
return 'Undefined or empty name' if $test;
exit 1;
}
......@@ -41,14 +39,14 @@ use Locale::Maketext::Lexicon {
_style => 'gettext',
'*' => [
Gettext => dirname(__FILE__) . '/I18N/*.po',
Gettext => $app_dir . 'themes/default/lib/Dolomon/I18N/*.po',
Gettext => \$app_dir . 'themes/default/lib/Dolomon/I18N/*.po',
]
};
use vars qw($app_dir);
use vars qw(\$app_dir);
BEGIN {
use Cwd;
my $app_dir = getcwd;
my \$app_dir = getcwd;
}
1;
......@@ -79,8 +77,13 @@ EOF
open $f, '>', File::Spec->catfile($home, 'Makefile') or die "Unable to open $home/Makefile: $!";
print $f $makefile;
close $f;
return 'OK' if $test;
exit 0;
} else {
say "$name theme already exists. Aborting.";
my $msg = "$name theme already exists. Aborting.";
return $msg if $test;
say $msg;
exit 1;
}
}
......
......@@ -126,7 +126,7 @@ sub remove_user {
my $user = Dolomon::User->new(app => $c->app, id => $id);
my $success = false;
my $msg;
if ($user) {
if ($user->login) {
$c->app->minion->enqueue(delete_user => [$user->id]);
$success = true;
$msg = {
......
......@@ -24,7 +24,7 @@ sub get {
if (defined $id) {
my $app = Dolomon::Application->new(app => $c->app, id => $id);
unless ($app->user_id == $c->current_user->id) {
unless (defined($app->user_id) && $app->user_id == $c->current_user->id) {
return $c->render(
json => {
success => false,
......@@ -42,7 +42,7 @@ sub get {
return $c->render(
json => {
success => true,
object => $c->current_user->get_tags()->map(sub { $_->as_struct })->to_array
object => $c->current_user->get_applications()->map(sub { $_->as_struct })->to_array
}
);
}
......@@ -99,7 +99,7 @@ sub rename {
if (defined $newname && $newname ne '') {
my $app = Dolomon::Application->new(app => $c->app, id => $id);
my $name = $app->name;
unless ($app->user_id == $c->current_user->id) {
unless (defined($app->user_id) && $app->user_id == $c->current_user->id) {
return $c->render(
json => {
success => false,
......@@ -137,7 +137,7 @@ sub rename {
return $c->render(
json => {
success => false,
msg => $c->l('New application name blank or undefined. I refuse to rename the category.')
msg => $c->l('New application name blank or undefined. I refuse to rename the application.')
}
);
}
......
......@@ -23,7 +23,7 @@ sub get {
if (defined $id) {
my $cat = Dolomon::Category->new(app => $c->app, id => $id);
unless ($cat->user_id == $c->current_user->id) {
unless (defined($cat->user_id) && $cat->user_id == $c->current_user->id) {
return $c->render(
json => {
success => false,
......@@ -53,7 +53,7 @@ sub show {
my ($msg, %agg_referrers);
my $cat = Dolomon::Category->new(app => $c->app, id => $id);
unless (defined $cat->user_id && $cat->user_id == $c->current_user->id) {
unless (defined($cat->user_id) && $cat->user_id == $c->current_user->id) {
$msg = {
class => 'alert-warning',
title => $c->l('Error'),
......@@ -88,7 +88,7 @@ sub get_data {
$agg = 60 unless (defined $agg && 0 < $agg && $agg < 60*24);
my $cat = Dolomon::Category->new(app => $c->app, id => $id);
unless (defined $cat->user_id && $cat->user_id == $c->current_user->id) {
unless (defined($cat->user_id) && $cat->user_id == $c->current_user->id) {
return $c->render(
json => {
success => false,
......@@ -158,6 +158,8 @@ sub get_data {
}
}
@data = sort { $a->{x} <=> $b->{x} } @data;
return $c->render(
json => {
success => true,
......@@ -178,7 +180,7 @@ sub get_zip {
$agg = 60 unless (defined $agg && 0 < $agg && $agg < 60*24);
my $cat = Dolomon::Category->new(app => $c->app, id => $id);
unless (defined $cat->user_id && $cat->user_id == $c->current_user->id) {
unless (defined($cat->user_id) && $cat->user_id == $c->current_user->id) {
return $c->render(
json => {
success => false,
......@@ -330,7 +332,7 @@ sub rename {
if (defined $newname && $newname ne '') {
my $cat = Dolomon::Category->new(app => $c->app, id => $id);
my $name = $cat->name;
unless ($cat->user_id == $c->current_user->id) {
unless (defined($cat->user_id)