stat\( results from the CPAN

Album

view release on metacpan or search on metacpan

        if ( $doing ) {         # uudecoding...
            if ( /^Xend/ ) {
                close($out);
                $doing = 0;	# Done
		next;
            }
            # Select lines to process.
            next if /[a-z]/;
	    next unless /^X(.*)/s;
	    $_ = $1;
            next unless int((((ord() - 32) & 077) + 2) / 3)
              == int(length() / 4);
            # Decode.
            print $out unpack("u",$_);
            next;
        }

        # Otherwise, search for the uudecode 'begin' line.
        if ( /^Xbegin\s+\d+\s+(.+)$/ ) {
	    next if !$clobber && -s d_icons($1);
	    print STDERR ("Creating icons: ") if $verbose > 1 && !defined($name);
	    $did++;
            $name = d_icons($1);
	    print STDERR ("$1 ") if $verbose > 1;
            open($out, ">", $name);
	    binmode($out);
            $doing = 1;         # Doing
            next;
        }
    }
    print STDERR ("\n") if $verbose > 1;
    if ( $doing ) {
        die("Error in DATA: still processing $name\n");
        unlink($name);
    }
}

################ Style Sheets ################

################ End Style Sheets ################

sub detab {
    my ($line) = @_;
    return $line unless $line;
    my $orig = $line;
    my (@l) = split(/\t/, $line, -1);

    # Replace tabs with blanks, retaining layout

    $line = shift(@l);
    $line .= " " x (8-length($line)%8) . shift(@l) while @l;

    $line;
}

################ Copying: plain files ################

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 -vf 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");
	}
    }

    $canvas->Write($new);
    my $time = $el->timestamp;
    utime($time, $time, $new);
    $canvas;
}

################ Copying: Voice files ################

sub copy_voice {
    my ($orig, $new, $time) = @_;
    $time = (stat($orig))[9] unless defined($time);
    $orig =~ s/\.\w+$/.mpg/;
    return if -s $new;
    return unless $prog_mplayer;

    # This will produce an MP2 file. Good enough for now...
    my $cmd = "$prog_mplayer -nojoystick -nolirc -vo null ".
      "-dumpaudio -dumpfile " . squote($new) . " " . squote($orig);
    warn("\n+ $cmd\n") if $trace;
    my $res = `$cmd 2>&1`;
    die("${res}Aborted\n") if $?;
    die("${res}Aborted\n") unless -s $new;

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

################ Index Icon Maintenance ################

sub create_master_index {
    my $index = d_dest("index.html");
    return if -e $index;
    update_if_needed($index,
		     process_fmt($format_for{main},
				 title    => html($album_title),
				 css      => css_for("main"),
				 version  => $my_version,
				 link     => ixname(0),
				));
}

sub create_index_icon {
    return unless $icon;
    print STDERR ("Creating index icon\n") if $verbose > 1;
    unless ( indexicon() ) {
	print STDERR ("(Index icon not modified)\n") if $verbose > 1;
    }
}

sub indexicon {
    my @imgs;
    for ( my $i = 0; $i < $index_rows*$index_columns; $i++ ) {
	next if $i >= $num_entries;
	my $el = $filelist->byseq($i+1);
	my $file = $el->dest_name;
	my $img;
	if ( $el->type == T_REF ) {
	    $img = $el->assoc_name;
	}
	else {
	    $img = $el->type == T_MPG ? $el->assoc_name : $file;
	    $img = d_index($img);
	}
	push(@imgs, $img);
    }

    my $iconfile = "icon.jpg";
    my $ii = cache_entry(" indexicon ");
    if ( -f $iconfile && $ii && $ii->dest_name eq "@imgs" ) {
	return 0;
    }
    my $el = new ImageInfo($iconfile);

script/album view on Meta::CPAN

my @std_fields;
my @exif_fields;
my $exif_rot;

INIT {
    @std_fields  = qw(type seq next prev hidden
		      dest_name orig_name assoc_name
		      timestamp file_size medium_size
		      tag description annotation
		      rotation mirror);

    @exif_fields = qw(DateTime DateTimeOriginal ExifImageLength ExifImageWidth
		      ExposureMode ExposureProgram ExposureTime
		      FNumber Flash FocalLength FocalLengthIn35mmFormat
		      FocusMode ISOSpeedRatings
		      ImageDescription Make Model
		      MeteringMode SceneCaptureType Orientation
		      CreateDate MediaCreateDate TimeZone
		      WhiteBalance
		      height width file_ext);

    $exif_rot = { top_left   => [   0, ''  ],    # 1: no corr. needed
		  top_right  => [   0, 'v' ],    # 2: flop (V)
		  bot_right  => [ 180, ''  ],    # 3: 180
		  bot_left   => [   0, 'h' ],    # 4: flip (H)
		  left_top   => [  90, 'h' ],    # 5: flip 90
		  right_top  => [  90, ''  ],    # 6: 90
		  right_bot  => [  90, 'v' ],    # 7: flop 90
		  left_bot   => [ 270, ''  ],    # 8: 270
		  'Rotate 270 CW' => [ 270, ''  ],    # 270 CW =  90 CCW
		  'Rotate 180'    => [ 180, ''  ],    # 180 CW = 180 CCW
		  'Rotate 90 CW'  => [  90, ''  ],    #  90 CW = 270 CCW
		};
}

my $largepat;
sub basename_nolarge {
    my ($f) = @_;
    unless ( $largepat ) {
	$largepat = quotemeta(::d_large());
	$largepat = qr;^$largepat[/\\];;
    }
    $f =~ s;$largepat;;;
    $f;
}

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) if ref($pkg);

    my $self = { $file ?
		 (orig_name    => $file,
		  dest_name    => basename_nolarge($file)) : (),
		 description  => "",
		 annotation   => [],
		 tag	      => "",
		 hidden       => 0,
	       };

    if ( $file && -f $file ) {
	my @st = stat(_);
	my $ii = ::cache_entry($file);
	if ( $ii  ){
	    $self = $ii;
	    delete($self->{$_}) foreach grep { /^_/ } keys(%$self);
	}

	# Else, get image info.
	else {
#	    my $ii = Image::Info::image_info($file);
	    my $ii = Image::ExifTool->new->ImageInfo($file);
	    $self->{file_size} = $st[7];
	    $self->{timestamp} = $st[9];
	    unless ( exists($ii->{error}) ) {
		for my $key ( @exif_fields ) {
		    my $val = $ii->{$key};
		    next unless defined $val;
		    if ( $key eq "Orientation" ) {
			($self->{rotation}, $self->{mirror}) =
			  @{$exif_rot->{$val}}
			    if exists $exif_rot->{$val};
		    }
		    else {
			$val = $val->as_float
			  if UNIVERSAL::can($val,"as_float");
			$self->{$key} = $val;
		    }
		}
		::cache_entry($file, $self);
	    }
	}
	# Actualize.
	$self->{file_size} = $st[7];
	$self->{timestamp} = $st[9];
    }

    bless($self, $pkg);
}

INIT {
    no strict 'refs';
    for my $sub ( @std_fields, @exif_fields ) {
	$sub = "_".$sub if $sub eq "rotation";
	*{"ImageInfo::$sub"} = sub {
	    my ($self, $value) = @_;
	    $self->{$sub} = $value if defined($value);
	    $self->{$sub};
	};
    }
}

sub xDateTime {
    my ( $self ) = @_;
    my $skew = $skew;
    my $dt = $self->DateTimeOriginal || $self->CreateDate || $self->MediaCreateDate || $self->DateTime;

    if ( $self->TimeZone ) {
	my ( $m, $h, $min ) = $self->TimeZone =~ /^([-+])(\d+):(\d+)/;
	$min += 60 * $h;
	$min = -$min if $m eq "-";
	$skew += $min * 60;

( run in 2.030 seconds using v1.01-cache-2.11-cpan-0b5f733616e )