git.infodrom.org Git - infodrom.org/www.zeitungsliste.de/blob - bin/zeitungen-tidy

   1 #! /usr/bin/perl
   2
   3 # zeitungen-tidy - Daily Tidy run for www.zeitungsliste.de
   4 # Copyright (c) 2008  Joey Schulze <joey@infodrom.org>
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111, USA.
  19
  20 use strict;
  21 use warnings;
  22
  23 use DBI;
  24
  25 my $dsn = 'dbi:Pg:dbname=zlist';
  26
  27 my $dbh = DBI->connect('dbi:Pg:dbname=zlist') or die "Can't connect to database\n";
  28
  29 sub tidy_online
  30 {
  31     my $query = q{SELECT uid FROM online WHERE activity < now() - interval'12 hours'};
  32
  33     my $sth = $dbh->prepare ($query) or die "Can't prepare Query: $DBI::errstr\n";
  34     my $rv = $sth->execute or die "Can't execute query: $DBI::errstr\n";
  35
  36     my @uids = ();
  37     push @uids, $_->{uid} while ($_ = $sth->fetchrow_hashref);
  38
  39     if ($#uids > -1) {
  40         $query = sprintf('DELETE FROM online WHERE uid in (%s)',
  41                          join(',', @uids));
  42         $dbh->do($query);
  43     }
  44 }
  45
  46 sub tidy_activation
  47 {
  48     my $query = q{SELECT uid,id FROM activation WHERE register_date < now() - interval'35 days'};
  49
  50     my $sth = $dbh->prepare ($query) or die "Can't prepare Query: $DBI::errstr\n";
  51     my $rv = $sth->execute or die "Can't execute query: $DBI::errstr\n";
  52
  53     my @uids = ();
  54     push @uids, $_->{uid} while ($_ = $sth->fetchrow_hashref);
  55
  56     if ($#uids > -1) {
  57         $query = sprintf('DELETE FROM users WHERE id in (%s)',
  58                          join(',', @uids));
  59         $dbh->do($query);
  60     }
  61 }
  62
  63 sub archive_topics
  64 {
  65     my $query = q{SELECT id FROM topics WHERE archived IS false AND modified < now() - interval'2 weeks'};
  66
  67     my $sth = $dbh->prepare ($query) or die "Can't prepare Query: $DBI::errstr\n";
  68     my $rv = $sth->execute or die "Can't execute query: $DBI::errstr\n";
  69
  70     my @ids = ();
  71     push @ids, $_->{id} while ($_ = $sth->fetchrow_hashref);
  72
  73     if ($#ids > -1) {
  74         $query = sprintf('UPDATE topics SET archived=true WHERE id in (%s)',
  75                          join(',', @ids));
  76         $dbh->do($query);
  77     }
  78 }
  79
  80 sub tidy_tags
  81 {
  82     my $query = q{SELECT id FROM tags WHERE id NOT IN (SELECT DISTINCT tag FROM zeitung_tags)};
  83
  84     my $sth = $dbh->prepare ($query) or die "Can't prepare Query: $DBI::errstr\n";
  85     my $rv = $sth->execute or die "Can't execute query: $DBI::errstr\n";
  86
  87     my @ids = ();
  88     push @ids, $_->{id} while ($_ = $sth->fetchrow_hashref);
  89
  90     if ($#ids > -1) {
  91         $query = sprintf('DELETE FROM SET tags WHERE id in (%s)',
  92                          join(',', @ids));
  93         $dbh->do($query);
  94     }
  95 }
  96
  97 tidy_online;
  98 archive_topics;
  99 # tidy_tags;
 100 tidy_activation;