Commit 851d3e50 authored by Luc Didry's avatar Luc Didry

Merge branch 'development' into 'master'

Development

Closes #51

See merge request !44
parents e944c18f 209f4df7
Pipeline #183239 passed with stages
in 8 minutes and 48 seconds
image: hatsoftwares/lstu-test-ci:latest
stages:
- podcheck
- tags
- carton
- carton_bdd
- tests
before_script:
- rm -f *db
variables:
POSTGRES_DB: lstu_db
POSTGRES_USER: lstu
......@@ -15,55 +13,108 @@ variables:
MYSQL_PASSWORD: lstu_pwd
MYSQL_ROOT_PASSWORD: root
before_script:
- if [[ $CI_JOB_NAME == "postgresql 3/3" ]]; then export PGPASSWORD=lstu_pwd; echo 'CREATE DATABASE lstu_minion WITH OWNER lstu;' | psql -h postgres -U lstu lstu_db; fi
- if [[ $CI_JOB_NAME == "mysql 3/3" ]]; then echo "CREATE DATABASE lstu_minion; GRANT ALL ON lstu_minion.* TO lstu@'%'; FLUSH PRIVILEGES;" | mysql -h mariadb -u root -proot; fi
### Jobs templates
##
#
.retry: &retry
retry: 2
except:
- tags
.carton_bdd_template: &carton_bdd_definition
<<: *retry
stage: carton_bdd
retry: 2
artifacts:
cache:
key: "$CI_COMMIT_REF_NAME"
paths:
- local/
expire_in: 1 week
dependencies:
- carton
.sqlite_template: &sqlite_definition
policy: pull
artifacts:
paths:
- local.tar
expire_in: 3 hours
after_script:
- tar cf local.tar local/
.tests_template: &tests_definition
<<: *retry
stage: tests
retry: 2
parallel: 3
script:
- tar xf local.tar && rm local.tar
- export CI_JOB_NAME=$(echo $CI_JOB_NAME | sed -e 's@ .*@@')
- echo "Database $CI_JOB_NAME test $CI_NODE_INDEX on $CI_NODE_TOTAL"
- if [[ $CI_NODE_INDEX -eq 3 ]]; then MOJO_CONFIG="t/${CI_JOB_NAME}${CI_NODE_INDEX}.conf" make minion & sleep 5; fi
- MOJO_CONFIG="t/${CI_JOB_NAME}${CI_NODE_INDEX}.conf" make test
- MOJO_CONFIG="t/${CI_JOB_NAME}${CI_NODE_INDEX}.conf" make cover
coverage: '/Total.* (\d+\.\d+)$/'
.sqlite_template: &sqlite_definition
<<: *tests_definition
dependencies:
- carton_sqlite
services:
- name: rroemhild/test-openldap
alias: rroemhild-test-openldap
coverage: '/Total.* (\d+\.\d+)$/'
.pg_template: &pg_definition
stage: tests
retry: 2
<<: *tests_definition
dependencies:
- carton_postgresql
services:
- name: postgres:9.6
alias: postgres
- name: rroemhild/test-openldap
alias: rroemhild-test-openldap
coverage: '/Total .*(\d+\.\d+)$/'
- name: postgres:9.6
alias: postgres
.mysql_template: &mysql_definition
stage: tests
retry: 2
<<: *tests_definition
dependencies:
- carton_mysql
services:
- name: mariadb:10.1
alias: mariadb
- name: rroemhild/test-openldap
alias: rroemhild-test-openldap
coverage: '/Total .*(\d+\.\d+)$/'
- name: mariadb:10.1
alias: mariadb
### Publish tag changelog
##
#
publish_changelog:
image: hatsoftwares/curl-jq:latest
stage: tags
script:
- export PROJECT_API_URL="https://framagit.org/api/v4/projects/${CI_PROJECT_ID}"
- export DESCRIPTION_URL="${PROJECT_API_URL}/repository/tags/${CI_COMMIT_TAG}/release"
- 'export HEADER="Private-Token: ${GITLAB_API_TOKEN}"'
- sed -n '/^'$CI_COMMIT_TAG'[[:space:]]/,/^[^\t]/p' CHANGELOG | sed -e 's/^[^\t].*//' -e 's/\t//g' | sed '/^[[:space:]]*$/d' > /tmp/text
- if [[ ! -z $GITLAB_API_TOKEN ]]; then curl -s --request POST --data-urlencode "description@/tmp/text" --header "${HEADER}" "${DESCRIPTION_URL}"; fi
only:
- tags
### Toot tag
##
#
pouet-it:
image: hatsoftwares/pouet-it-from-ci:latest
stage: tags
script:
- cd /opt/pouet-it-from-ci
- export project="$(echo $CI_PROJECT_NAME | perl -p -e 's/(?:^(.)|-(.))/\U$1\U$2/g')"
- export MESSAGE=$(echo -e "Je viens de sortir "'#'"${project} en version ${CI_COMMIT_TAG} !""\n${CI_PROJECT_URL}/tags/${CI_COMMIT_TAG}")
- carton exec ./pouet-it-from-ci.pl
only:
- tags
### Podcheck
##
#
podcheck:
stage: podcheck
<<: *retry
stage: carton
script:
- make podcheck
......@@ -71,16 +122,14 @@ podcheck:
##
#
carton:
<<: *retry
stage: carton
artifacts:
cache:
key: "$CI_COMMIT_REF_NAME"
paths:
- local/
expire_in: 1 week
dependencies: []
script:
- carton install --deployment --without=sqlite --without=postgresql --without=mysql
when: always
retry: 2
### Install DB related dependencies
##
......@@ -98,67 +147,12 @@ carton_mysql:
script:
- carton install --deployment --without=sqlite --without=postgresql
### SQLite tests
### Tests
##
#
sqlite1:
<<: *sqlite_definition
script:
- MOJO_CONFIG=t/sqlite1.conf make test
- MOJO_CONFIG=t/sqlite1.conf make cover
sqlite2:
sqlite:
<<: *sqlite_definition
script:
- MOJO_CONFIG=t/sqlite2.conf make test
- MOJO_CONFIG=t/sqlite2.conf make cover
sqlite3:
<<: *sqlite_definition
script:
- MOJO_CONFIG=t/sqlite3.conf make minion &
- sleep 5
- MOJO_CONFIG=t/sqlite3.conf make test
- MOJO_CONFIG=t/sqlite3.conf make cover
### PostgreSQL tests
##
#
postgresql1:
<<: *pg_definition
script:
- MOJO_CONFIG=t/postgresql1.conf make test
- MOJO_CONFIG=t/postgresql1.conf make cover
postgresql2:
postgresql:
<<: *pg_definition
script:
- MOJO_CONFIG=t/postgresql2.conf make test
- MOJO_CONFIG=t/postgresql2.conf make cover
postgresql3:
<<: *pg_definition
script:
- export PGPASSWORD=lstu_pwd; echo 'CREATE DATABASE lstu_minion WITH OWNER lstu;' | psql -h postgres -U lstu lstu_db
- MOJO_CONFIG=t/postgresql3.conf make minion &
- sleep 5
- MOJO_CONFIG=t/postgresql3.conf make test
- MOJO_CONFIG=t/postgresql3.conf make cover
### MySQL tests
##
#
mysql1:
<<: *mysql_definition
script:
- MOJO_CONFIG=t/mysql1.conf make test
- MOJO_CONFIG=t/mysql1.conf make cover
mysql2:
mysql:
<<: *mysql_definition
script:
- MOJO_CONFIG=t/mysql2.conf make test
- MOJO_CONFIG=t/mysql2.conf make cover
mysql3:
<<: *mysql_definition
script:
- echo "CREATE DATABASE lstu_minion; GRANT ALL ON lstu_minion.* TO lstu@'%'; FLUSH PRIVILEGES;" | mysql -h mariadb -u root -proot
- MOJO_CONFIG=t/mysql3.conf make minion &
- sleep 5
- MOJO_CONFIG=t/mysql3.conf make test
- MOJO_CONFIG=t/mysql3.conf make cover
[weblate]
url = https://weblate.framasoft.org/api/
translation = lstu
......@@ -13,4 +13,6 @@
* Pierre Rudloff
* Belvar (Gwenn M) (breton translation)
* Ira W. Snyder
* Arnaud de Mouhy (docker port)
\ No newline at end of file
* Arnaud de Mouhy (docker port)
* Mathieu Aubin
* frju365 (Julien Gomes Dias)
\ No newline at end of file
Revision history for Perl application Lstu
0.22-0 ????-??-??
- Disable URLs instead of removing them (prevents spammers to reuse a
deleted shortened URL)
- Slugify custom URLs and add a suffix (-2, -3…) if the custom URL is
already taken
- Allow to search several IP addresses at once
- New logo and update theme!
- Now use https://weblate.framasoft.org/projects/lstu for translations
0.21-4 2018-12-17
- Add a lockfile to GSB database update to prevent concurrent updates
......
# How to contribute?
The official git repository is <https://framagit.org/luc/lstu>.
The official git repository is <https://framagit.org/fiat-tux/hat-softwares/lstu>.
You can create an account on Framagit with your Github/Gitlab/Bitbucket account.
## Issues
Please, post any issue on <https://framagit.org/luc/lstu/issues>.
Please, post any issue on <https://framagit.org/fiat-tux/hat-softwares/lstu/issues>.
## Merge requests
Please, post any merge request on <https://framagit.org/luc/lstu/merge_requests>.
Please, post any merge request on <https://framagit.org/fiat-tux/hat-softwares/lstu/merge_requests>.
For your merge request to be accepted, please:
- use 4 spaces for indentation
......
......@@ -7,7 +7,7 @@ LABEL org.label-schema.build-date=$BUILD_DATE \
org.label-schema.name="Let's Shorten That URL" \
org.label-schema.url="https://lstu.fr/" \
org.label-schema.vcs-ref=$VCS_REF \
org.label-schema.vcs-url="https://git.framasoft.org/luc/lstu" \
org.label-schema.vcs-url="https://framagit.org/fiat-tux/hat-softwares/lstu" \
org.label-schema.vendor="Luc Didry" \
org.label-schema.version=$VERSION \
org.label-schema.schema-version="1.0"
......
EXTRACTDIR=-D lib -D themes/default
EXTRACTDIR=-D lib -D themes/default/templates
POT=themes/default/lib/Lstu/I18N/lstu.pot
XGETTEXT=carton exec local/bin/xgettext.pl
CARTON=carton exec
......@@ -14,15 +14,6 @@ locales:
$(XGETTEXT) $(EXTRACTDIR) -o $(POT) 2>/dev/null
cd ./themes/milligram && make locales
push-locales:
zanata-cli -q -B push
pull-locales:
zanata-cli -q -B pull --min-doc-percent 40
stats-locales:
zanata-cli -q stats
podcheck:
podchecker lib/Lstu/DB/*pm lib/Lstu/Command/*pm
......
......@@ -10,9 +10,9 @@ Lstu is licensed under the terms of the WTFPL. See the LICENSE file.
## Installation
Please, see the [wiki](https://framagit.org/luc/lstu/wikis/home).
Please, see the [wiki](https://framagit.org/fiat-tux/hat-softwares/lstu/wikis/home).
Or you can see [usage with Docker](https://framagit.org/luc/lstu/wikis/usage-with-docker).
Or you can see [usage with Docker](https://framagit.org/fiat-tux/hat-softwares/lstu/wikis/usage-with-docker).
## How many URLs can it handle ?
......
......@@ -17,11 +17,12 @@ sub run {
my @args = @_;
getopt \@args,
'u|url=s{1,}' => \my @urls_to_check,
's|seconds=i' => \my $delay,
'r|remove' => \my $remove,
'a|all' => \my $all,
'b|ban' => \my $ban;
'u|url=s{1,}' => \my @urls_to_check,
't|test=s{1,}' => \my @urls_to_test,
's|seconds=i' => \my $delay,
'r|remove' => \my $remove,
'a|all' => \my $all,
'b|ban' => \my $ban;
if ($c->app->gsb) {
my $urls;
......@@ -29,6 +30,8 @@ sub run {
$urls = c(get_shorts($c, @urls_to_check));
} elsif ($delay) {
$urls = Lstu::DB::URL->new(app => $c->app)->get_all_urls_created_ago($delay);
} elsif (@urls_to_test) {
$urls = c(@urls_to_test);
} else {
$urls = Lstu::DB::URL->new(app => $c->app)->get_all_urls;
}
......@@ -43,40 +46,52 @@ sub run {
);
my (@bad, %bad_ips, @bad_from_ips);
my $gsb = $c->app->gsb;
my $deleted = 0;
my $disabled = 0;
my @testing_results;
$urls->each(sub {
my ($e, $num) = @_;
my $u = (@urls_to_test) ? $e : $e->{url};
$progress->update($num);
my @matches = $gsb->lookup(url => $e->{url});
my @matches = $gsb->lookup(url => $u);
if (@matches) {
push @bad, $e->{short};
$bad_ips{$e->{created_by}} = 1 if $e->{created_by};
$deleted += Lstu::DB::URL->new(
app => $c->app,
short => $e->{short}
)->remove if $remove;
if (@urls_to_test) {
push @testing_results, sprintf('%s is in GSB base!', $e);
} else {
push @bad, $e->{short};
$bad_ips{$e->{created_by}} = 1 if $e->{created_by};
$disabled += Lstu::DB::URL->new(
app => $c->app,
short => $e->{short}
)->remove if $remove;
}
} elsif (@urls_to_test) {
push @testing_results, sprintf('%s is safe.', $e);
}
});
if (@urls_to_test) {
map {say $_;} @testing_results;
exit;
}
say sprintf('All URLs (%d) have been scanned.', $urls->size);
say sprintf('%d bad URLs detected.', scalar(@bad));
if ($remove) {
say sprintf('%d bad URLs deleted.', $deleted) if $deleted;
say sprintf('%d bad URLs disabled.', $disabled) if $disabled;
} else {
say sprintf("If you want to delete the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad)) if @bad;
say sprintf("If you want to disable the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad)) if @bad;
}
$deleted = 0;
$disabled = 0;
for my $ip (keys %bad_ips) {
my $u = Lstu::DB::URL->new(app => $c->app)->search_creator($ip);
$u->each(sub {
my ($e, $num) = @_;
push @bad_from_ips, $e->{short};
$deleted += Lstu::DB::URL->new(
$disabled += Lstu::DB::URL->new(
app => $c->app,
short => $e->{short}
)->remove if ($remove && $all);
......@@ -96,9 +111,9 @@ sub run {
}
if ($remove && $all) {
say sprintf('%d URLs from same IPs deleted.', $deleted) if $deleted;
say sprintf('%d URLs from same IPs disabled.', $disabled) if $disabled;
} else {
say sprintf("If you want to delete the URLs created by the same IPs than the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad_from_ips)) if @bad_from_ips;
say sprintf("If you want to disable the URLs created by the same IPs than the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad_from_ips)) if @bad_from_ips;
}
} else {
say 'It seems that safebrowsing_api_key isn\'t set. Please, check your configuration';
......@@ -113,7 +128,7 @@ sub get_shorts {
for my $short (@shorts) {
my $u = Lstu::DB::URL->new(app => $c->app, short => $short);
if ($u->url) {
if ($u->url && !$u->disabled) {
push @results, $u->to_hash;
} else {
say sprintf('Sorry, unable to find an URL with short = %s', $short);
......@@ -131,11 +146,12 @@ Lstu::Command::safebrowsing - Checks all URLs in database against Google Safe Br
=head1 SYNOPSIS
Usage:
carton exec script/lstu safebrowsingcheck Checks all URLs in database against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck -u|--url <short> <short> Checks the space-separated URLs against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck -s|--seconds <xxx> Checks URLs created the last xxx seconds against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck Checks all URLs in database against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck -u|--url <short> <short> Checks the space-separated URLs against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck -s|--seconds <xxx> Checks URLs created the last xxx seconds against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck -t|--test <url> <url> Checks URLs against Google Safe Browsing database
Options (available with all commands):
Options (available with all commands except --test):
-r|--remove Remove bad URLs that have been found
-a|--all Remove all URLs created by the same IP addresses that created bad URLs (only in combination with the `-r|--remove` option)
-b|--ban Ban IP addresses that created bad URLs
......
......@@ -15,10 +15,10 @@ sub run {
my @args = @_;
getopt \@args,
'info=s{1,}' => \my @info,
'info=s{1,}' => \my @info,
'r|remove=s{1,}' => \my @remove,
's|search=s' => \my $search,
'ip=s' => \my $ip,
'ip=s{1,}' => \my @ips,
'y|yes' => \my $yes;
if (scalar @info) {
......@@ -31,11 +31,13 @@ sub run {
);
}
if (scalar @remove) {
my @r_ips;
c(@remove)->each(
sub {
my ($e, $num) = @_;
my $u = get_short($c, $e);
if ($u) {
push @r_ips, $u->created_by if $u->created_by;
print_infos($u->to_hash);
my $confirm = ($yes) ? 'yes' : undef;
unless (defined $confirm) {
......@@ -55,28 +57,41 @@ sub run {
}
}
);
say sprintf("If you want to ban the uploaders' IPs, please do:\n carton exec script/lstu ban --ban %s", join(' ', @r_ips)) if @r_ips;
}
if ($search) {
my $u = Lstu::DB::URL->new(app => $c->app)->search_url($search);
my @shorts;
my @s_ips;
$u->each(sub {
my ($e, $num) = @_;
push @shorts, $e->{short};
push @s_ips, $e->{created_by} if $e->{created_by};
print_infos($e);
});
say sprintf('%d matching URLs', $u->size);
say sprintf("If you want to delete those URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @shorts)) if @shorts;
say sprintf("If you want to delete those URLs, please do:\n carton exec script/lstu url --yes --remove %s", join(' ', @shorts)) if @shorts;
say sprintf("If you want to ban those IPs, please do:\n carton exec script/lstu ban --ban %s", join(' ', @s_ips)) if @s_ips;
}
if ($ip) {
my $u = Lstu::DB::URL->new(app => $c->app)->search_creator($ip);
my @shorts;
$u->each(sub {
my ($e, $num) = @_;
push @shorts, $e->{short};
print_infos($e);
if (scalar(@ips)) {
my @recap;
c(@ips)->each(sub {
my ($ip, $num) = @_;
my $u = Lstu::DB::URL->new(app => $c->app)->search_creator($ip);
my @shorts;
$u->each(sub {
my ($e, $num) = @_;
push @shorts, $e->{short};
print_infos($e);
});
say sprintf('[%s] %d matching URLs', $ip, $u->size);
if (@shorts) {
say sprintf("[%s] If you want to delete those URLs, please do:\n carton exec script/lstu url --yes --remove %s", $ip, join(' ', @shorts));
push @recap, @shorts;
}
});
say sprintf('%d matching URLs', $u->size);
say sprintf("If you want to delete those URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @shorts)) if @shorts;
say sprintf("If you want to delete all those URLs, please do:\n carton exec script/lstu url --yes --remove %s", join(' ', @recap)) if @recap;
say sprintf("If you want to ban those IPs, please do:\n carton exec script/lstu ban --ban %s", join(' ', @ips)) if @ips;
}
}
......@@ -85,7 +100,7 @@ sub get_short {
my $short = shift;
my $u = Lstu::DB::URL->new(app => $c->app, short => $short);
if ($u->url) {
if ($u->url && !$u->disabled) {
return $u;
} else {
say sprintf('Sorry, unable to find an URL with short = %s', $short);
......@@ -128,7 +143,7 @@ Lstu::Command::url - Manage URL in Lstu's database
carton exec script/lstu url --remove <short> <short> [--yes] Remove the space-separated URLs (ask for confirmation unless --yes is given)
Will print infos about URL before confirmation
carton exec script/lstu url --search <url> Search URLs by its true URL (LIKE match)
carton exec script/lstu url --ip <ip address> Search URLs by the IP address of its creator (exact match)
carton exec script/lstu url --ip <ip address> <ip address> Search URLs by the IP address of its creator (exact match)
=cut
......
......@@ -6,7 +6,7 @@ use Lstu::DB::Ban;
use Data::Validate::URI qw(is_http_uri is_https_uri);
use Mojo::JSON qw(to_json decode_json);
use Mojo::URL;
use Mojo::Util qw(b64_encode);
use Mojo::Util qw(b64_encode slugify);
use Image::PNG::QRCode 'qrpng';
sub add {
......@@ -54,13 +54,9 @@ sub add {
my ($msg, $short);
if (defined($custom_url) &&
(
$custom_url =~ m#^(a|d|cookie|stats|fullstats|login|logout|api)$# ||
$custom_url =~ m/\.json$/ || $custom_url !~ m/^[-a-zA-Z0-9_]+$/
)) {
$msg = $c->l('The shortened text can contain only numbers, letters and the - and _ character, can\'t be "a", "api", "d" or "stats" or end with ".json". Your URL to shorten: %1', $url);
} elsif (defined($custom_url) && Lstu::DB::URL->new(app => $c)->exist($custom_url) > 0) {
$msg = $c->l('The shortened text (%1) is already used. Please choose another one.', $custom_url);
($custom_url =~ m#^(a|d|cookie|stats|fullstats|login|logout|api)$# || $custom_url =~ m/\.json$/)
) {
$msg = $c->l('The shortened text can\'t be "a", "api", "d", "cookie", "stats", "fullstats", "login" or "logout" or end with ".json". Your URL to shorten: %1', $url);
} elsif (is_http_uri($url->to_string) || is_https_uri($url->to_string) || (defined($url->host) && $url->host =~ m/\.onion$/)) {
my $res = ($url->host =~ m/\.onion$/) ? {} : $c->is_spam($url, 0);
......@@ -85,6 +81,13 @@ sub add {
$short = $db_url->short;
} else {
if (defined($custom_url)) {
$custom_url = slugify $custom_url;
my $suffix = 2;
my $original_custom_url = $custom_url;
while (Lstu::DB::URL->new(app => $c)->exist($custom_url) > 0) {
$custom_url = $original_custom_url.'-'.$suffix;
$suffix++;
}
Lstu::DB::URL->new(
app => $c,
short => $custom_url,
......@@ -184,10 +187,13 @@ sub get {
my $url;
if (scalar(@{$c->config('memcached_servers')})) {
$url = $c->chi('lstu_urls_cache')->compute($short, undef, sub {
return Lstu::DB::URL->new(app => $c, short => $short)->url;
my $db_url = Lstu::DB::URL->new(app => $c, short => $short);
return $db_url->url unless $db_url->disabled;
return undef;
});
} else {
$url = Lstu::DB::URL->new(app => $c, short => $short)->url;
my $db_url = Lstu::DB::URL->new(app => $c, short => $short);
$url = $db_url->url unless $db_url->disabled;
}
if ($url) {
......
......@@ -7,6 +7,7 @@ has 'url';
has 'counter' => 0;
has 'timestamp';
has 'created_by';
has 'disabled' => 0;
has 'record' => 0;
has 'app';
......@@ -35,6 +36,8 @@ Have a look at Lstu::DB::URL::SQLite's code: it's simple and may be more underst
=item B<created_by> : the IP address of the creator
=item B<disabled> : boolean (0 or 1), is the URL active?
=item B<app> : a mojolicious object
=back
......@@ -139,9 +142,9 @@ sub write {
my $c = shift;
if ($c->record) {
$c->app->dbi->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ?, created_by = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->created_by, $c->short);
$c->app->dbi->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ?, created_by = ?, disabled = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->created_by, $c->disabled, $c->short);
} else {
$c->app->dbi->db->query('INSERT INTO lstu (short, url, counter, timestamp, created_by) VALUES (?, ?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp, $c->created_by);
$c->app->dbi->db->query('INSERT INTO lstu (short, url, counter, timestamp, created_by, disabled) VALUES (?, ?, ?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp, $c->created_by, $c->disabled);
$c->record(1);
}
......@@ -167,20 +170,15 @@ sub write {
sub remove {
my $c = shift;
$c->app->dbi->db->query('DELETE FROM lstu WHERE short = ?', $c->short);
my $h = $c->app->dbi->db->query('SELECT * FROM lstu WHERE short = ?', $c->short)->hashes;
if ($h->size) {
# We found the URL, it hasn't been removed
return 0;
} else {
$c->app->dbi->db->query('UPDATE lstu SET disabled = 1 WHERE short = ?', $c->short);
my $disabled = $c->app->dbi->db->query('SELECT disabled FROM lstu WHERE short = ?', $c->short)->hashes->first->{disabled};
if ($disabled) {
if (scalar(@{$c->app->config('memcached_servers')})) {
$c->app->chi('lstu_urls_cache')->remove($c->short);
}
$c = Lstu::DB::URL->new(app => $c->app);
# We didn't found the URL, it has been removed
return 1;
}
return $disabled;
}
=head2 exist
......@@ -494,6 +492,7 @@ sub _slurp {
$c->counter($h->first->{counter});
$c->timestamp($h->first->{timestamp});
$c->created_by($h->first->{created_by});
$c->disabled($h->first->{disabled});
$c->record(1);
}
......
......@@ -24,18 +24,15 @@ sub increment_counter {
sub remove {
my $c = shift;
my $h = $c->app->dbi->db->query('DELETE FROM lstu WHERE short = ? RETURNING *', $c->short)->hashes;
# $h->size is the number of deleted rows
# 0 means failure
# 1 means success
if ($h->size) {
my $disabled = $c->app->dbi->db->query('UPDATE lstu SET disabled = 1 WHERE short = ? RETURNING disabled', $c->short)->hashes->first->{disabled};
if ($disabled) {
if (scalar(@{$c->app->config('memcached_servers')})) {
$c->app->chi('lstu_urls_cache')->remove($c->short);
}
$c = Lstu::DB::URL->new(app => $c->app);
}
return $h->size;
return $disabled;
}
1;
......@@ -25,9 +25,9 @@ sub register {
my $sql = Mojo::SQLite->new('sqlite:'.$app->config('db_path'));