The "CMS" that runs this site
#!/usr/bin/perl
use Switch;
use File::stat;
use File::Basename;
use POSIX 'strftime';
use Cwd qw{getcwd abs_path};
# Options
# Flattr ID (Use name, not the number. Undefined to disable.)
my $flattrid = 'jwalck';
# Base url, e.g. http://example.com/album (only used by flattr)
my $baseurl = 'http://xwalck.se/j/img';
# License, possible options:
# none - No license tag
# by - Creative Commons Attribution
# by-sa - Creative Commons Attribution-ShareAlike
# by-nd - Creative Commons Attribution-NoDerivs
# by-nc - Creative Commons Attribution-NonCommercial
# by-nc-sa - Creative Commons Attribution-NonCommercial-ShareAlike
my $license = 'by-sa';
# Used like backticks, but automatically chomps output.
sub sh
{
chomp(my $res = `$_[0]`);
return $res;
}
# Gets mtime of a file or directory, caches the result for speed.
# Should not be used if mtimes might change while the script is running.
sub mtime
{
my $file = abs_path shift;
return 0 unless -f $file or -d $file;
return $mtime{$file} ||= lstat($file)->mtime;
}
# Prints an html header to index.html.
sub header
{
my ($lastdir) = @_;
my $descriptionfile = "../" . basename(getcwd()) .".desc";
my $description = do { local $/; open F, $descriptionfile; }
if -f $descriptionfile;
open INDEX, ">index.html";
print INDEX <<"EOF";
$lastdir
EOF
print INDEX <<"EOF" if defined $flattrid and (-f '.flattr');
EOF
print INDEX <<"EOF";
EOF
print INDEX qq{ \n}
if $flattrid or $license ne 'none' or $description;
print INDEX <<"EOF" if defined $flattrid and !(-e '.no-flattr');
EOF
print INDEX <<"EOF" if $license ne 'none' and !(-f '.no-license');
EOF
print INDEX <<"EOF" if $flattrid or $license ne 'none' or $description;
$description
EOF
close INDEX;
}
# Appends an image link with thumbnail to index.html.
sub href
{
my ($target, $image) = @_;
my ($descriptionfile, $original, $label, $type, $imagefile, $labelfile);
if (-d $target)
{
open F, "$target/index.html";
$label = basename($target) .' ('. scalar(grep { /a href/ } ) .')';
close F;
$labelfile = basename($target) . '.label';
$descriptionfile = basename($target) . '.desc';
$imagefile = basename($target) . '.img';
$typefile = basename($target) . '.type';
}
else
{
$original = dirname($target) .'/'. do { basename($target) =~ /^\.?(.*)$/; $1 };
$labelfile = $original .'.label';
$descriptionfile = $original .'.desc';
$imagefile = $original .'.img';
$label = strftime('%H:%M', localtime mtime($target));
}
$label = do { local $/; open F, $labelfile; }
if -f $labelfile;
my $description = do { local $/; open F, $descriptionfile; }
if -f $descriptionfile;
$image = do { local $/; open F, $imagefile; }
if -f $imagefile;
$type = do { local $/; open F, $typefile; }
if -f $typefile;
chomp $type;
chomp $label;
chomp $description;
$type = "text" if $target =~ /.(txt|asc|pl)$/;
$type = "no-image" if !$image and !$type;
# Different folder types, default to image directory.
open INDEX, '>>index.html';
switch ($type) {
case "no-image" {
print INDEX <<"EOF";
$label
$description
EOF
}
case "folder" {
print INDEX <<"EOF";
$label
$description
EOF
}
case "text" {
$description = do { local $/; open F, $target; };
print INDEX <<"EOF";
$target
$description
EOF
}
else {
print INDEX <<"EOF";
$label
$description
EOF
}
}
close INDEX;
}
sub footer
{
open INDEX, '>>index.html';
print INDEX " \n\n";
}
# Queues an image to be resized with convert.
sub resize
{
my $size = shift;
my ($input, $output) = map { abs_path $_ } @_;
print CONVERT qq{"$input" -auto-orient -quality 90 -resize "$size" "$output"\n};
$converting++;
}
# Tries to figure out the number of processor cores.
sub cores
{
switch (sh 'uname')
{
case 'Linux' { return scalar do { open F, '/proc/cpuinfo';
grep { /^processor/ } } }
case 'SunOS' { return my $c =()= sh('psrinfo -v') =~ /^Status/mg }
case 'Darwin' { return sh 'sysctl -na hw.ncpu' }
case /^CYGWIN/ { return $ENV{NUMBER_OF_PROCESSORS} }
else { return 1 }
}
}
# Sets timestamp of a file, optionally copies timestamp from another file.
sub touch
{
my ($target, $source) = @_;
my $time = $source ? mtime($source) : time;
delete $mtime{$target};
utime $time, $time, $target;
}
# The main function, which generates an image index.
sub generate_index
{
my ($lastdir) = @_;
header($lastdir);
for my $subdir (sort { mtime($a) <=> mtime($b) }
grep { -d }
glob "*")
{
$typefile = $subdir . '.type';
my $type = do { local $/; open F, $typefile; }
if -f $typefile;
chomp $type;
chdir $subdir;
generate_index($lastdir .'/'. basename(getcwd()))
if !($type eq "folder");
my $html = do { open F, 'index.html'; local $/; };
chdir '..';
if ($html =~ /a href/)
{
my @thumbs = $html =~ /img src="(.*?)"/g;
href "$subdir/", "$subdir/$thumbs[rand @thumbs]"
if !(-e "$subdir/.no-index");
}
if ($type eq "folder")
{
href "$subdir/";
}
}
for my $text (sort { mtime($a) <=> mtime($b) }
grep { /^[^\.].*\.(txt|asc|pl)$/i }
glob "*" )
{
# (my $view = $text) =~ s/^/./;
# my $fulltext = do { local $/; open F, $text; };
# (my $summary = $fulltext) =~ s/^(.{100}).*/$1/;
# $summary =~ s/\n/ /g;
href $text;
}
for my $image (sort { mtime($a) <=> mtime($b) }
grep { /^[^\.].*\.(jpg|png)$/i }
glob "*" )
{
(my $view = $image) =~ s/^/./;
(my $thumb = $image) =~ s/^(.+)\.(.+)$/.$1_T.$2/;
href $view, $thumb;
-f $view or resize '2048x2048', $image, $view;
-f $thumb or resize '800x225', $image, $thumb;
# Fix timestamps of thumbnails and medium size images.
# This currently needs a second run of the script when adding images.
touch $view, $image unless mtime($view) == mtime($image);
touch $thumb, $image unless mtime($thumb) == mtime($image);
}
footer();
}
# Add multi processing options if xargs is GNUish.
$xargsopts = sh('xargs --help') =~ /-P/ ? '-r -P '.cores() : '';
open CONVERT, "| xargs -L1 ${xargsopts} convert";
print STDERR "Generating HTML ...\n";
generate_index basename getcwd;
print STDERR "Converting images ...\n" if $converting;
close CONVERT;
Boxxy CMS --------- A perlscript originally to generate image archives, now doing all sorts of things and ever expanding into a practical mess.:)
#!/usr/bin/perl
use Switch;
use File::stat;
use File::Basename;
use POSIX 'strftime';
use Cwd qw{getcwd abs_path};
# Options
# Flattr ID (Use name, not the number. Undefined to disable.)
my $flattrid = 'jwalck';
# Base url, e.g. http://example.com/album (only used by flattr)
my $baseurl = 'http://xwalck.se/j/img';
# License, possible options:
# none - No license tag
# by - Creative Commons Attribution
# by-sa - Creative Commons Attribution-ShareAlike
# by-nd - Creative Commons Attribution-NoDerivs
# by-nc - Creative Commons Attribution-NonCommercial
# by-nc-sa - Creative Commons Attribution-NonCommercial-ShareAlike
my $license = 'by-sa';
# Used like backticks, but automatically chomps output.
sub sh
{
chomp(my $res = `$_[0]`);
return $res;
}
# Gets mtime of a file or directory, caches the result for speed.
# Should not be used if mtimes might change while the script is running.
sub mtime
{
my $file = abs_path shift;
return 0 unless -f $file or -d $file;
return $mtime{$file} ||= lstat($file)->mtime;
}
# Prints an html header to index.html.
sub header
{
my ($lastdir) = @_;
my $descriptionfile = "../" . basename(getcwd()) .".desc";
my $description = do { local $/; open F, $descriptionfile; }
if -f $descriptionfile;
open INDEX, ">index.html";
print INDEX <<"EOF";
$lastdir
EOF
print INDEX <<"EOF" if defined $flattrid and (-f '.flattr');
EOF
print INDEX <<"EOF";
EOF
print INDEX qq{ \n}
if $flattrid or $license ne 'none' or $description;
print INDEX <<"EOF" if defined $flattrid and !(-e '.no-flattr');
EOF
print INDEX <<"EOF" if $license ne 'none' and !(-f '.no-license');
EOF
print INDEX <<"EOF" if $flattrid or $license ne 'none' or $description;
$description
EOF
close INDEX;
}
# Appends an image link with thumbnail to index.html.
sub href
{
my ($target, $image) = @_;
my ($descriptionfile, $original, $label, $type, $imagefile, $labelfile);
if (-d $target)
{
open F, "$target/index.html";
$label = basename($target) .' ('. scalar(grep { /a href/ } ) .')';
close F;
$labelfile = basename($target) . '.label';
$descriptionfile = basename($target) . '.desc';
$imagefile = basename($target) . '.img';
$typefile = basename($target) . '.type';
}
else
{
$original = dirname($target) .'/'. do { basename($target) =~ /^\.?(.*)$/; $1 };
$labelfile = $original .'.label';
$descriptionfile = $original .'.desc';
$imagefile = $original .'.img';
$label = strftime('%H:%M', localtime mtime($target));
}
$label = do { local $/; open F, $labelfile; }
if -f $labelfile;
my $description = do { local $/; open F, $descriptionfile; }
if -f $descriptionfile;
$image = do { local $/; open F, $imagefile; }
if -f $imagefile;
$type = do { local $/; open F, $typefile; }
if -f $typefile;
chomp $type;
chomp $label;
chomp $description;
$type = "text" if $target =~ /.(txt|asc|pl)$/;
$type = "no-image" if !$image and !$type;
# Different folder types, default to image directory.
open INDEX, '>>index.html';
switch ($type) {
case "no-image" {
print INDEX <<"EOF";
$label
$description
EOF
}
case "folder" {
print INDEX <<"EOF";
$label
$description
EOF
}
case "text" {
$description = do { local $/; open F, $target; };
print INDEX <<"EOF";
$target
$description
EOF
}
else {
print INDEX <<"EOF";
$label
$description
EOF
}
}
close INDEX;
}
sub footer
{
open INDEX, '>>index.html';
print INDEX " \n\n";
}
# Queues an image to be resized with convert.
sub resize
{
my $size = shift;
my ($input, $output) = map { abs_path $_ } @_;
print CONVERT qq{"$input" -auto-orient -quality 90 -resize "$size" "$output"\n};
$converting++;
}
# Tries to figure out the number of processor cores.
sub cores
{
switch (sh 'uname')
{
case 'Linux' { return scalar do { open F, '/proc/cpuinfo';
grep { /^processor/ } } }
case 'SunOS' { return my $c =()= sh('psrinfo -v') =~ /^Status/mg }
case 'Darwin' { return sh 'sysctl -na hw.ncpu' }
case /^CYGWIN/ { return $ENV{NUMBER_OF_PROCESSORS} }
else { return 1 }
}
}
# Sets timestamp of a file, optionally copies timestamp from another file.
sub touch
{
my ($target, $source) = @_;
my $time = $source ? mtime($source) : time;
delete $mtime{$target};
utime $time, $time, $target;
}
# The main function, which generates an image index.
sub generate_index
{
my ($lastdir) = @_;
header($lastdir);
for my $subdir (sort { mtime($a) <=> mtime($b) }
grep { -d }
glob "*")
{
$typefile = $subdir . '.type';
my $type = do { local $/; open F, $typefile; }
if -f $typefile;
chomp $type;
chdir $subdir;
generate_index($lastdir .'/'. basename(getcwd()))
if !($type eq "folder");
my $html = do { open F, 'index.html'; local $/; };
chdir '..';
if ($html =~ /a href/)
{
my @thumbs = $html =~ /img src="(.*?)"/g;
href "$subdir/", "$subdir/$thumbs[rand @thumbs]"
if !(-e "$subdir/.no-index");
}
if ($type eq "folder")
{
href "$subdir/";
}
}
for my $text (sort { mtime($a) <=> mtime($b) }
grep { /^[^\.].*\.(txt|asc|pl)$/i }
glob "*" )
{
# (my $view = $text) =~ s/^/./;
# my $fulltext = do { local $/; open F, $text; };
# (my $summary = $fulltext) =~ s/^(.{100}).*/$1/;
# $summary =~ s/\n/ /g;
href $text;
}
for my $image (sort { mtime($a) <=> mtime($b) }
grep { /^[^\.].*\.(jpg|png)$/i }
glob "*" )
{
(my $view = $image) =~ s/^/./;
(my $thumb = $image) =~ s/^(.+)\.(.+)$/.$1_T.$2/;
href $view, $thumb;
-f $view or resize '2048x2048', $image, $view;
-f $thumb or resize '800x225', $image, $thumb;
# Fix timestamps of thumbnails and medium size images.
# This currently needs a second run of the script when adding images.
touch $view, $image unless mtime($view) == mtime($image);
touch $thumb, $image unless mtime($thumb) == mtime($image);
}
footer();
}
# Add multi processing options if xargs is GNUish.
$xargsopts = sh('xargs --help') =~ /-P/ ? '-r -P '.cores() : '';
open CONVERT, "| xargs -L1 ${xargsopts} convert";
print STDERR "Generating HTML ...\n";
generate_index basename getcwd;
print STDERR "Converting images ...\n" if $converting;
close CONVERT;