view release on metacpan or  search on metacpan

lib/App/Chart/Vacuum.pm  view on Meta::CPAN

    if (-t STDOUT) {
      binmode (STDOUT, ':via(EscStatus)')
        or die 'Cannot push EscStatus';
    } else {
      require PerlIO::via::EscStatus::ShowNone;
      binmode (STDOUT, ':via(EscStatus::ShowNone)')
        or die 'Cannot push EscStatus::ShowNone';
    }
  } elsif ($output eq 'all-status') {
    require PerlIO::via::EscStatus::ShowAll;
    binmode (STDOUT, ':via(EscStatus::ShowAll)')
      or die 'Cannot push EscStatus::ShowAll';
  }

  my %option;
  foreach my $arg (@$args) {
    if ($arg =~ /^no-?/ip) {
      $option{${^POSTMATCH}} = 0;
    } else {
      $option{$arg} = 1;
    }
  }
  vacuum(%option);
}

sub vacuum {
  my %option = @_;
  if (! exists $option{'compact'})     { $option{'compact'} = 1; }
  if (! exists $option{'consistency'}) { $option{'consistency'} = 1; }

  $verbose = $App::Chart::option{'verbose'};
  if (exists $option{'verbose'}) { $verbose = $option{'verbose'}; }

  App::Chart::Download::status (__('Vacuuming database'));

  expire_latest();
  expire_intraday();

  if ($option{'consistency'}) {
    check_listseq();
    check_alerts();
    check_historical();
    check_alphabetical();
  }
  if ($option{'compact'}) {
    vacuum_database();
    vacuum_notes();
  }
}

sub vacuum_notes {
  my $notes_filename = App::Chart::DBI::notes_filename();
  my $notes_oldsize = -s $notes_filename;
  App::Chart::Download::status (__x('VACUUM notes.sqdb ({oldsize} bytes)',
                                   oldsize => $notes_oldsize));

  require DBI;
  my $nbh = DBI->connect ("dbi:SQLite:dbname=$notes_filename",
                          '', '', {RaiseError=>1});
  $nbh->func(90_000, 'busy_timeout');  # 90 seconds
  $nbh->{sqlite_unicode} = 1;
  $nbh->do ('VACUUM');
  my $notes_newsize = -s $notes_filename;
  print __x("Notes was {oldsize} now {newsize} bytes\n",
            oldsize => $notes_oldsize,
            newsize => $notes_newsize);
}

sub vacuum_database {
  my $dbh = App::Chart::DBI->instance;
  my $database_filename = App::Chart::DBI::database_filename();
  my $database_oldsize = -s $database_filename;
  App::Chart::Download::status (__x('VACUUM database.sqdb ({oldsize} bytes)',
                                   oldsize => $database_oldsize));
  $dbh->do ('VACUUM');
  my $database_newsize = -s $database_filename;
  print __x("Database was {oldsize} now {newsize} bytes\n",
            oldsize => $database_oldsize,
            newsize => $database_newsize);
}

# old latest records discarded, except symbols in the database kept
# indefinitely, which in particular is for when the latest in fact comes
# from the daily data
#
sub expire_latest {
  App::Chart::Download::status (__('Delete old "latest" quotes'));

  my $dbh = App::Chart::DBI->instance;
  my $age_seconds = 86400 * VACUUM_AGE_DAYS;
  my @timestamp_range = App::Chart::Download::timestamp_range ($age_seconds);

  # "0+" avoids 0E0 when no records deleted
  my $n = 0 + $dbh->do
    ('DELETE FROM latest
      WHERE fetch_timestamp < ? OR fetch_timestamp > ?
      AND NOT EXISTS (SELECT * FROM info WHERE info.symbol=latest.symbol)',
     undef,
     @timestamp_range);
  my ($kept) = $dbh->selectrow_array ('SELECT COUNT(*) FROM latest');

  print __nx("deleted {n} old latest record (leaving {kept})\n",
             "deleted {n} old latest records (leaving {kept})\n",
             $n,
             n => $n,
             kept => $kept);
}

sub expire_intraday {
  App::Chart::Download::status (__('Delete old intraday images'));

  my $dbh = App::Chart::DBI->instance;
  my $age_seconds = 86400 * VACUUM_AGE_DAYS;
  my @timestamp_range = App::Chart::Download::timestamp_range ($age_seconds);

  # "0+" avoids 0E0 when no records deleted
  my $n = 0 + $dbh->do
    ('DELETE FROM intraday_image
      WHERE fetch_timestamp < ? OR fetch_timestamp > ?',
     undef,
     @timestamp_range);