view release on metacpan or  search on metacpan

script/sitelen-mute  view on Meta::CPAN

  $props->{OrigImageWidth} = $props->{ExifImageWidth} || undef;
  $props->{OrigImageHeight} = $props->{ExifImageHeight} || undef;
  for(my $n = 1; exists $props->{"ExifImageWidth ($n)"}; $n++) {
    $props->{OrigImageWidth} = $props->{"ExifImageWidth ($n)"};
    $props->{OrigImageHeight} = $props->{"ExifImageHeight ($n)"};
  }

  # extract caption
  for my $m (@captions) {
    if ($m eq 'cmt') {
      if ($props->{Comment}) {
        my $cmt = Encode::decode_utf8($props->{Comment});
        $props->{caption} = cap_from_str($cmt);
        last;
      }
    } elsif ($m eq 'txt') {
      my $txt = catfile($absDir, $base . '.txt');
      if (-f $txt) {
        $props->{caption} = cap_from_str(read_text($txt));
        last;
      }
    } elsif ($m eq 'exif') {
      if ($props->{Title} || $props->{Description}) {
        $props->{caption} = cap_from_props($props);
        last;
      }
    } elsif ($m eq 'xmp') {
      my $xmp = ImageInfo("$file.xmp", {PrintConv => 0, Sort => 'File'});
      if (defined($xmp) && ($xmp->{Title} || $xmp->{Description})) {
        $props->{caption} = cap_from_props($xmp);
        last;
      }
    } else {
      fatal "Encountered unknown caption method '$m'";
    }
  }
  return $props;
}

# get image properties of files with image extensions
if (@files) {
  printf "Found %d prospective image files\n", scalar @files
    if $verbose;
  map { say } @files if @files && $verbose > 1;
  $aprops = analyze_files(@files);
  # remove any files that failed analysis (from the back to the front)
  for (my $n = $#files; $n > 0; $n--) {
    if (not defined $aprops->[$n]) {
      splice(@files, $n, 1);
      splice(@$aprops, $n, 1);
    }
  }
  printf "Processing %d image files\n", scalar @files;
}

# gather dates and megapixel sizes of image files
my $amp = 0;
my $ostamp = 0;
for my $props (@$aprops) {
  # file timestamp
  my $idate = $props->{DateTimeOriginal} || $props->{DateTime} || '';
  $idate =~ s/^\s+|\s+$//g;
  my $t = Time::Piece->strptime($idate, "%Y:%m:%d %H:%M:%S");
  if ($t && $t->epoch()) {
    $props->{date} = $t->strftime("%Y-%m-%d %H:%M");
    $props->{stamp} = $ostamp = $t->epoch();
  } else {
    # no date available, cheat by using the previous timestamp
    $props->{stamp} = $ostamp = $ostamp + 1;
  }
  # megapixels and average thereof
  $props->{mp} = ($props->{ImageWidth} * $props->{ImageHeight} / 1e6);
  $amp += $props->{mp};
}
$amp /= @files if @files;

# 2nd pass: produce output files
sub process_images {
  my $p = Time::Progress->new(min => 0, max => scalar @_);
  local $| = 1; # autoflush progress bar
  my ($i, @result);
  for (@_) {
    print $p->report("\rImage file processing %20b ETA: %E", $i++);
    push(@result, process_image($_));
  }
  say $p->report("\rImage file processing %20b done       ", $i);
  return \@result;
}

sub process_image {
  my %props = %{$_[0]};
  my $root = $props{root};
  my $suffix = $props{suffix};
  my $file = $props{file};

  # derived file names
  my $ofile = (splitpath($file))[2];
  my $ffile = catfile('files', "$root.$suffix");
  my $fbase = "$root.$ext";
  my $fimg = catfile('imgs', $fbase);
  my $fthumb = catfile('thumbs', $fbase);
  my $fblur = catfile('blurs', $fbase);

  my $absFout = catfile($absOut, $ffile);
  my $absFtmp = catfile($absOut, "$ffile.tmp");

  # copy source image, apply tranforms, set mode and file timestamp
  copy_source_file($file, $absFout);
  unless ($use_orig) {
    if ($orient && $props{FileType} eq "JPEG" && ($props{Orientation} // 0)) {
      sys("$exiftrancmd '$absFout' 2>/dev/null");
      if (($props{Orientation} // 0) > 4) {
        ($props{ImageWidth}, $props{ImageHeight})
          = ($props{ImageHeight}, $props{ImageWidth});
      }
    }
    if ($jpegoptim && $props{FileType} eq "JPEG") {
      sys('jpegoptim', '-q', $absFout);
    } elsif ($pngoptim && $props{FileType} eq "PNG") {
      sys('pngcrush', '-s', $absFout, $absFtmp);
      rename($absFtmp, $absFout);