encryptio.com

#!/usr/bin/perl
#############################################################################
# screenmaker.pl - Automated creation of screenshots for video files.
# The latest version of this can be found at:
# http://encryptio.com/code/screenmaker
#############################################################################
# Copyright (c) 2007-2008 Chris Kastorff
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions, and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * The name Chris Kastorff may not be used to endorse or promote
#       products derived from this software without specific prior written
#       permission.
#############################################################################
use warnings;
use strict;
our $VERSION = 1.5;
$| = 1;

sub diehelp {
    print <<EOF;
Usage: $0 [ -q quality ] [ -r rate ] [ -s size ] [ -t toss_early ]
          [ -T toss_late ] [ -c columns ] videofile ...

Creates an image file containing screenshots of the video files given.

The rate option controls the grab rate (how many seconds per frame)
    Default is 30
The quality option controls the JPEG quality option given to imagemagick.
    Default is 85
The size option controls the maximum thumbnail size.
    Default is 320.
The "toss" options control the number of frames dropped from the start and end
    of the file(s).
    Default is 1 for both.
The column option controls the number of columns.
    Default is 2.

Requires ffmpeg and imagemagick (montage) be installed and in your \$PATH.

EOF
    print $_[0]."\n\n" if $_[0]; # if we were given an extra string, show it
    exit 1;
}

# options
my $quality    = 85;
my $size       = 320;
my $rate       = 30;
my $toss_late  = 1;
my $toss_early = 1;
my $columns    = 2;
my @files      = ();

# parse command line options
while ( @ARGV ) {
    my $arg = shift;
    if ( $arg =~ /^-/ ) {

        if ( $arg eq "-q" or $arg eq "--quality" ) {
            $quality = shift @ARGV;
            diehelp "quality must be a positive integer from 0 to 100"
                unless $quality =~ /^\d+$/ and $quality >= 0 and $quality <= 100;

        } elsif ( $arg eq "-r" or $arg eq "--rate" ) {
            $rate = shift @ARGV;
            diehelp "Grab rate must be a positive number"
                unless $rate =~ /^\d*\.?\d*$/ and $rate > 0;

        } elsif ( $arg eq "-s" or $arg eq "--size" ) {
            $size = shift @ARGV;
            diehelp "Size must be a positive integer"
                unless $rate =~ /^\d+$/ and $rate > 0;

        } elsif ( $arg eq "-t" or $arg eq "--toss_early" ) {
            $toss_early = shift @ARGV;
            diehelp "toss_early must be a nonnegative integer"
                unless $rate =~ /^\d+$/;

        } elsif ( $arg eq "-T" or $arg eq "--toss_late" ) {
            $toss_late = shift @ARGV;
            diehelp "toss_late must be a nonnegative integer"
                unless $rate =~ /^\d+$/;

        } elsif ( $arg eq "-c" or $arg eq "--columns" ) {
            $columns = shift @ARGV;
            diehelp "Column count must be a positive integer"
                unless $columns =~ /^\d+$/ and $columns > 0;

        } elsif ( $arg eq "-h" or $arg eq "--help" ) {
            diehelp;

        } elsif ( $arg eq "--" ) {
            @files = @ARGV;
            last;

        } else {
            diehelp "unknown option $arg";
        }

    } else {
        push @files, $arg;
    }
}

# get paths
chomp(my $ffmpeg  = `which ffmpeg` );
chomp(my $montage = `which montage`);
chomp(my $convert = `which convert`);

# make sure the programs exist
if ( ! -e $ffmpeg ) {
    diehelp "Install ffmpeg and try this script again.";
} elsif ( ! -e $montage or ! -e $convert ) {
    diehelp "Install imagemagick and try this script again.";
}

diehelp "I need some files to process!" unless @files;

# grab our temporary directory
my $tempdir = "screenmaker.$$";
do { $tempdir = "screenmaker.$$.".int(rand 10000) } while -e $tempdir;
mkdir $tempdir or die "Couldn't mkdir $tempdir: $!";

for my $infilename ( @files ) {
    if ( ! -e $infilename ) {
        print "$infilename doesn't exist! Skipping...\n";
        next;
    }

    print "Grabbing screens for $infilename...\n";
    
    # grab the screens
    system(
        "ffmpeg",
        "-i" => $infilename,
        "-r" => 1/$rate,
        "-vcodec" => "png",
        "-y",
        $tempdir."/screens.%08d.png"
    ) and die "ffmpeg failed.\n";

    # make a list of the files we have
    my @screensfiles = ();
    opendir my $dh, $tempdir or die "Couldn't opendir $tempdir: $!";
    while ( my $item = readdir $dh ) {
        if ( $item =~ /^screens/ ) {
            push @screensfiles, $item;
        }
    }
    @screensfiles = sort @screensfiles; # sorts by frame numbers

    # remove the edge items
    splice @screensfiles, 0, $toss_early if $toss_early;
    splice @screensfiles, -$toss_late    if $toss_late;

    # scale all the images
    print "Scaling images...\n";
    # scale 20 images at a time - this way we don't overload the shell buffer
    # and we keep a decent speed even on systems with a slow fork
    # TODO: multi-threaded
    for my $i ( 0 .. int(@screensfiles/20) ) {
        my $st = $i*20;
        my $et = $st+19;
        $et = $#screensfiles if $et > $#screensfiles;
        system(
            "mogrify",
            "-resize" => $size."x".$size,
            map "$tempdir/$_", @screensfiles[$st..$et]
        ) and die "ImageMagick (mogrify) failed.\n";
    }

    my $height = @screensfiles/$columns;

    $height = int($height+1)
        if $height != int( $height );

    print "Joining images...\n";
    
    system( # options given by the manpage
        "montage",
        "-tile" => $columns."x".$height,
        "-bordercolor" => "black",
        "-border" => "0x0",
        "-background" => "black",
        "-geometry" => "+0+0",
        "-quality" => $quality,
        (map "$tempdir/$_", @screensfiles),
        "$infilename.screenies.jpg"
    ) and system( # options given by a different version of the manpage
        "montage",
        "-tile" => $columns."x".$height,
        "-borderwidth" => "0",
        "-background" => "black",
        "-geometry" => "+0+0",
        "-quality" => $quality,
        (map "$tempdir/$_", @screensfiles),
        "$infilename.screenies.jpg"
    ) and die "ImageMagick (montage) failed.\n";

    # remove all the files in our temporary directory
    opendir $dh, $tempdir or die "Couldn't opendir $tempdir: $!";
    while ( my $item = readdir $dh ) {
        unlink "$tempdir/$item"
            or die "Couldn't remove $tempdir/$item: $!"
            if -f "$tempdir/$item";
    }
    closedir $dh;
}

print "Cleaning up...\n";
rmdir $tempdir or die "Couldn't remove $tempdir: $!"; # remove the temporary directory

__END__

Version History:

v1.0: First hacked together

v1.5:
    * Added options: quality, rate, size, toss_early, toss_late, columns
    * Removed dependency on jpegoptim
    * Faster processing (removed O(n^2) copy process)
    * Puts all temporary files into a seperate directory
    * Extreme decreases in memory usage
    * Added version history
    * Added version number