view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

sub copy {
    my ($orig, $new, $time) = @_;

    $time = (stat($orig))[9] unless defined($time);

    my $in = do { local *F; *F };
    open($in, "<", $orig) or die("$orig: $!\n");
    binmode($in);

    my $out = do { local *F; *F };
    open($out, ">", $new) or die("$new: $!\n");
    binmode($out);

    my $buf;

    for (;;) {
	my ($r, $w, $t);
	defined($r = sysread($in, $buf, 10240))
	  or die("$orig: $!\n");
	last unless $r;
	for ( $w = 0; $w < $r; $w += $t ) {
	    $t = syswrite($out, $buf, $r - $w, $w)
	      or die("$new: $!\n");
	}
    }
    close($in);
    close($out) or die("$new: $!\n");
    utime($time, $time, $new);
}

################ Copying: MPG files ################

sub copy_mpg {
    my ($orig, $new, $time, $rotate, $mirror) = @_;
    $time = (stat($orig))[9] unless defined($time);

    # I'm not sure what this does. The resultant file is about 10% of
    # the original, without missing something...
    my $cmd = "$prog_mencoder -of mpeg -oac copy -ovc ".
	($rotate ? "lavc -lavcopts vcodec=mpeg1video -vop rotate=".int($rotate/90)." " : "copy ") .
	  squote($orig) . " -o ". squote($new);
    warn("\n+ $cmd\n") if $verbose > 2;

    my $res = `$cmd 2>&1`;
    die("${res}Aborted\n") if $?;

    utime($time, $time, $new);
}

sub still {
    my ($el) = @_;

    my $new = d_large($el->assoc_name);
    my $still = new Image::Magick;
    if ( $prog_mplayer ) {
	my $tmp = "00000001.jpg";
	my $tmp2 = "00000002.jpg";
	if ( -e $tmp ) {
	    die("ERROR: mplayer needs to create a file $tmp, but it already exists!\n");
	}
	# Sometimes, -frames 1 does not produce anything. Need -frames 2.
	my $cmd = "$prog_mplayer -really-quiet -nojoystick -nolirc -nosound -frames 2 -vo jpeg " .
	  squote(d_large($el->dest_name));
	warn("\n+ $cmd\n") if $verbose > 2;
	my $t = `$cmd 2>&1`;
	warn("$t\n") unless -s $tmp;
	$still->Read($tmp);
	unlink($tmp, $tmp2);
    }
    else {
	# This may take minutes.
	$still->Read(d_large($el->dest_name)."[0]");
    }

    # Get still dimensions.
    my ($hs, $ws) = $still->Get(qw(height width));
    unless ( $hs && $ws ) {
	$still->Read(d_icons("movie.jpg"));
	$still->Write($new);
	return $still;
    }
    # Scale to 640x480 if needed.
    my $r = $hs > $ws ? 640 / $hs : 640 / $ws;
    if ( abs($r - 1) > 0.05 ) {
	$still->Resize(width => $r*$ws, height => $r*$hs);
	($hs, $ws) = $still->Get(qw(height width));
    }

    # Create black canvas.
    my $canvas = new Image::Magick;
    $canvas->Set(size => ($ws+240).'x'.($hs+180));
    $canvas->ReadImage('xc:black');
    my ($hc, $wc) = $canvas->Get(qw(height width));

    # Place the still on top of it.
    # Center image
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => 90);
    # Bottom slice.
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => $hs+135);
    # Top slice. Cannot place at negative offsets, so crop the still first.
    $still->Crop(width => $ws, height => 45, x => 0, 'y' => $hs-45);
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => 0);
    undef $still;

    # Drill spocket holes.
    my $hole = new Image::Magick;
    $hole->Set(size => '60x40');
    $hole->ReadImage("xc:grey90");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => " 0,0   5,0   0,5");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => "60,0  55,0  60,5");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => "60,40 55,40 60,35");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => " 0,40  5,40  0,35");

    for ( my $v = 0; $v < $hc;  $v += 80 ) {
	for my $h ( 30, $wc-90 ) {
	    $canvas->Composite(image => $hole, compose => 'Atop',
			    geometry => "+$h+$v");
	}