view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    $medium = 0 if defined($medium) && $medium < 0;

    # Caption values.
    setopt("caption", DEFAULTS->{( -s $info_file || $import_dir) ?
				 "caption" : "captionmin" });
    die("Invalid value for caption: $caption\n")
      unless $caption =~ /^[fsct]*$/i;
    $caption = lc($caption);

    if ( $locale ) {
	setlocale(LC_TIME, $locale);
	setlocale(LC_COLLATE, $locale);
    }

    if ( defined($lib_common) ) {
	$lib_common =~ s;/+$;;;
    }
    $lib_common ||= "";
}

sub load_info {
    my %typemap = ( 'p' => T_JPG, 'm' => T_MPG, 'v' => T_VOICE );

    # If an info has been supplied, it'd better exist.
    if ( $info_file ) {
	die("$info_file: $!\n") unless -s $info_file;
    }
    else {
	# Try default.
	$info_file = d_dest(DEFAULTS->{info});
	unless ( -s $info_file ) {
	    my $add_new; $add_new++ if $import_dir;
	    my $add_src; $add_src++ if -d d_large();
	    print STDERR ("No ", d_dest(DEFAULTS->{info}));
	    print STDERR (", adding images from ") if $add_src || $add_new;
	    print STDERR (d_large())               if $add_src;
	    print STDERR (" and ")                 if $add_src && $add_new;
	    print STDERR ($import_dir)             if $add_new;
	    print STDERR ("\n");
	    return;
	}
    }

    my $err = 0;
    my $file;
    my $tag;

    my $fh = do { local *FH; *FH };
    die("$info_file: $!\n")
      unless open($fh, "<:encoding(UTF-8)", $info_file);
    warn("parsing: $info_file\n") if $trace;

    my $el;
    my %dirs;

    while ( <$fh> ) {
	chomp;

	# Detection of condig system for info_file.
	# Uses GNU Emacs syntax, e.g.,
	#  # blah        -*- mode: album; coding: utf-8 -*-
	if ( $. == 1
	     &&
	     m/^\s*\#			# start with #
	      .*			# arb
	      -\*-			# -*-
	      (?:.*?;)*			# things, must be ; terminated
	      \s*			# ws
	      coding\s*:\s*([\w\d-]+)	# coding: utf-8
	      \s*			# ws
	      (?:;.*)*			# things, must be ; started
	      -\*-			# -*-
	      /x ) {
	    $encoding = $1;
	    warn("using encoding $encoding for $info_file\n") if $trace;

	    # Remember position, reopen and restart IO.
	    my $pos = tell($fh);
	    close($fh);
	    open($fh, "<:encoding($encoding)", $info_file)
	      or die("$info_file: $!\n");
	    seek($fh, $pos, 0);
	    next;
	}

	next if /^\s*#/;
	next unless /\S/;

	if ( /^\s+/ && $el ) {
	    $el->description($el->description . "\n" . $_);
	    next;
	}

	if ( /^!\s*(\S.*)/ ) {
	    $_ = $1;
	    if ( /^tag\s*(.*)/ ) {
		$tag = $1;
		$tag =~ s/\s$//;
		$tag =~ s/\s+/ /g;
	    }
	    elsif ( /^subdirs\s*(.*)/ ) {
		foreach ( split(' ', $1)) {
		    $dirs{$_}++;
		}
	    }
	    elsif ( /^journal\s*(.*)/ ) {
		if ( $filelist->tally ) {
		    warn("\"!journal\" must precede image info\n");
		    $err++;
		}
		load_info_journal($err, $fh);
		return;
	    }
	    else {
		$err += parse_line("!".$_);
	    }
	    next;
	}

	($file, $a) = $_ =~ /^(.+?$xsuffixpat)\s*(.*)/;
	($file, $a) = $_ =~ /^([^\s]+)\s+(.*)/ unless defined($file);

	my $rotate;
	my $type = T_JPG;
	my $assc;
	while ( $a && $a =~ /^-(\w):(\S+)\s*(.*)/ ) {
	    if ( lc($1) eq 'o' ) {
		$rotate = 90 * ($2 % 4);
	    }

script/album  view on Meta::CPAN

	}

	$i_large = d_large($file);
	my $movie = $el->type == T_MPG;

	# Copy the file into place.
	if ( ! -s $i_large && $el->orig_name ) {
	    my $i_src = $el->orig_name;
	    my $time = $el->timestamp;

	    if ( $movie ) {

		# Need copy?
		my $copyit = !$linkthem
		  || (($el->rotation || $el->mirror) && $prog_mencoder);

		# Try to link.
		if ( !$copyit ) {
		    $msg->("link ");
		    if ( link($i_src, $i_large) == 1 ) {
			# Ok, done.
		    }
		    else {
			# Need copy.
			unlink($i_large); # just in case
			$msg->("[copy] ");
			$copyit = 1;
		    }
		}
		else {
		    $msg->("copy");
		}

		# Need copy?
		if ( $copyit ) {
		    if ( $prog_mencoder ) {
			$msg->("/rotate (be patient)") if $el->rotation;
			$msg->(" ");
			# Currently. movies have a bad ugly copy routine...
			copy_mpg($i_src, $i_large, $time,
				 $el->rotation, $el->mirror);
		    }
		    else {
			$msg->(" [no rotation]") if $el->rotation;
			$msg->(" ");
			copy($i_src, $i_large, $time);
		    }
		}
	    }
	    elsif ( $el->rotation || $el->mirror ) {
		$msg->("copy");
		$msg->("/rotate") if $el->rotation;
		$msg->("/mirror") if $el->mirror;
		$msg->(" ");

		# Use jpegtran to rotate jpg files.
		if ( ($el->file_ext || "") eq "jpg" && $prog_jpegtran ) {
		    my $cmd = "$prog_jpegtran -copy all -rotate " . $el->rotation . " ";
		    $cmd .= $el->mirror eq 'h' ? "-transpose " : "-transverse "
		      if $el->mirror;
		    $cmd .= "-outfile " . squote($i_large) .
		      " " . squote($i_src);
		    my $t = `$cmd 2>&1`;
		    $msg->($t) if $t;
		    utime($time, $time, $i_large);
		}
		# Otherwise, let Image::Magick handle it.
		else {
		    $readimage->($i_src);
		    $image->Rotate( $el->rotation );
		    if ( $el->mirror ) {
			$image->Flip if $el->mirror eq 'h';
			$image->Flop if $el->mirror eq 'v';
		    }
		    # After rotation, the orientation is top_left.
		    $image->Set(orientation => 1);
		    my $t = $image->Write($i_large);
		    $msg->($t) if $t;
		    utime($time, $time, $i_large);
		}
	    }
	    elsif ( $linkthem ) {
		$msg->("link ");
		unless ( link($i_src, $i_large) == 1 ) {
		    unlink($i_large); # just in case
		    $msg->("[copy] ");
		    copy($i_src, $i_large, $time);
		}
	    }
	    else {
		$msg->("copy ");
		copy($i_src, $i_large, $time);
	    }
	    if ( $el->type == T_VOICE ) {
		$msg->("sound ");
		copy_voice($i_src, d_large($el->assoc_name),
			   $time);
	    }
	}
	if ( $movie ) {
	    $movie = $file;
	    $file = $el->assoc_name;
	    $i_large = d_large($file);
	    unless ( -s $i_large ) {
		$msg->("still ");
		$image = still($el);
	    }
	}

	my $i_medium = d_medium($file);
	my $i_small  = d_index($file);

	if ( $medium && ! -s $i_medium ) {
	    $readimage->() unless $image;
	    $msg->("medium ");
	    $resize->($medium);
	    my $t = $image->Write($i_medium);
	    $msg->($t) if $t;
	}
	$el->medium_size(-s $i_medium) if $medium && !$movie;