Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 66 lines (52 sloc) 1.5 KB
# Script to regenerate the html pages for all current shrtn db entries
use strict;
use warnings;
use File::Basename;
use Getopt::Long qw(:config no_ignore_case bundling);
use YAML qw(LoadFile Dump);
use FindBin qw($Bin);
use lib "$Bin/lib";
use Shrtn::Utils qw(generate_new_redirect_page);
my $CONFIG_FILE = "$Bin/data/config.yml";
my $DB_FILE = "$Bin/data/db.yml";
sub usage {
warn @_ if @_;
die "usage: " . basename($0) . "[--noop]\n";
my $verbose = 0;
my ($help, $noop);
usage unless GetOptions(
'help|h|?' => \$help,
'verbose|v+' => \$verbose,
'noop|n' => \$noop,
usage if $help;
usage if @ARGV;
# Setup
or die "Error: config file $CONFIG_FILE not found - have you run shrtn_setup?\n";
my $config = LoadFile($CONFIG_FILE);
my $db_file = $config->{db} || $DB_FILE;
-f $db_file
or die "Error: database file $db_file not found?\n";
my $db = LoadFile($db_file);
my $base_url = $config->{base_url}
or die "Error: no base_url setting found in config.yml\n";
# Process all db entries, generating new html redirect pages
for my $code (sort keys %$db) {
my $url = $db->{$code};
printf "%-12s => %s\n", $code, $url;
generate_new_redirect_page($Bin, $code, $url) if ! $noop;
# And push remotely if config 'rsync_path' is set
if (my $rsync_path = $config->{rsync_path}) {
my $rsync_cmd = "rsync -cv $Bin/htdocs/* $rsync_path";
print "\n$rsync_cmd\n";
if (! $noop) {
system($rsync_cmd) == 0 or die "rsync failed: $?/$!";