view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    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);
	    }
	    elsif ( lc($1) eq 'i' ) {
		$assc = fjoin(basename($file), $2);
		unless ( -s $assc && -r _ ) {
		    warn("$file (info): $assc [$!]\n");
		    undef $assc;
		}
	    }
	    elsif ( lc($1) eq 't' ) {