149 lines
4.8 KiB
Perl
Executable File
149 lines
4.8 KiB
Perl
Executable File
#!/usr/bin/perl5
|
|
# ==================================================================
|
|
# Links SQL - enhanced directory management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# Revision : $Id: nph-imageresize.cgi,v 1.4 2006/07/31 18:41:26 aki Exp $
|
|
#
|
|
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
|
|
# Redistribution in part or in whole strictly prohibited. Please
|
|
# see LICENSE file for full details.
|
|
# ==================================================================
|
|
use lib '.';
|
|
|
|
use strict;
|
|
use vars qw/$USE_HTML/;
|
|
use Links qw/$IN $DB $CFG/;
|
|
use Links::Plugins;
|
|
use Plugins::SlideShow;
|
|
use GT::TempFile;
|
|
use GT::SQL::File;
|
|
|
|
$| = 1;
|
|
Links::init('.');
|
|
|
|
main();
|
|
|
|
sub main {
|
|
# --------------------------------------------------
|
|
$USE_HTML = exists $ENV{REQUEST_METHOD} ? 1 : 0;
|
|
local $SIG{__DIE__} = \&Links::fatal if $USE_HTML;
|
|
|
|
my $links = $DB->table( 'Links' ) or die $GT::SQL::error;
|
|
|
|
# Beautify output...
|
|
my $lcount = $links->count;
|
|
if ( $USE_HTML ) {
|
|
print qq~
|
|
<html>
|
|
<head>
|
|
<title>Resizing images database</title>
|
|
</head>
|
|
<body bgcolor="white">
|
|
~;
|
|
print Links::header ('Updating Links ...', 'Links SQL is now attempting to update your $lcount links, please be patient, this can take a while.', 0);
|
|
print '<pre>';
|
|
}
|
|
else {
|
|
print "\nUpdating $lcount links\n\n";
|
|
}
|
|
|
|
# Get the fields we need to check
|
|
my $cfg = Links::Plugins->get_plugin_user_cfg( 'SlideShow' );
|
|
my ( $max_width, $max_height, $image_cols, $temp_dir ) =
|
|
map { $cfg->{$_} || undef } qw| max_width max_height image_cols temp_dir |;
|
|
|
|
# Prepare the required resize parameters
|
|
my %con;
|
|
foreach my $ind (1..2) {
|
|
my @constraints;
|
|
foreach ( @Plugins::SlideShow::image_types ) {
|
|
my $c = $cfg->{"${_}_constraints_${ind}"} or next;
|
|
my ( $crop, $mx, $my ) = $c =~ /(crop)?(\d+)\s*[,x]\s*(\d+)/i;
|
|
push @constraints, [ $_, $crop, $mx, $my];
|
|
}
|
|
$con{$cfg->{"link_type_$ind"}} = \@constraints;
|
|
}
|
|
|
|
my @image_cols = grep { s,^(\s*),,; s,(\s*)$,,; $_ } split /,/, $image_cols;
|
|
|
|
my $tmp_dir = $CFG->{admin_root_path} . "/tmp";
|
|
# Now do it. This is the really slow part.
|
|
$links->select_options( "order by ID" );
|
|
my $link_handle = $links->select([ 'ID', 'Link_Type', @image_cols ]) or die $GT::SQL::error;
|
|
|
|
my $i = 1;
|
|
while ( my $link = $link_handle->fetchrow_hashref ) {
|
|
my %new_rec = ();
|
|
my @ftemp = ();
|
|
|
|
foreach my $c ( @image_cols ) {
|
|
next unless $link->{$c};
|
|
|
|
my $source_path = $links->file_info( $c, $link->{ID} ) or do {
|
|
warn "Could not fetch file for link $link->{ID} '$GT::SQL::error'\n";
|
|
next;
|
|
};
|
|
|
|
my ( $target_image_name ) = $source_path =~ /([\.\w]+)$/;
|
|
my $link_type = ($link->{Link_Type}) ? $link->{Link_Type} : 'article';
|
|
my $constraints = $con{$link_type};
|
|
foreach my $r ( @$constraints ) {
|
|
my $target_fpath = "$tmp_dir/$r->[0]_$target_image_name";
|
|
next unless -f $source_path;
|
|
next unless -s $source_path;
|
|
|
|
if ( $r->[1] ) { # if set to crop
|
|
Plugins::SlideShow::crop_resize_image(
|
|
$source_path,
|
|
$target_fpath,
|
|
$r->[2], # max width
|
|
$r->[3], # max height
|
|
$cfg->{image_quality}
|
|
);
|
|
}
|
|
else { # It's a standard resize
|
|
Plugins::SlideShow::resize_image(
|
|
$source_path,
|
|
$target_fpath,
|
|
$r->[2], # max width
|
|
$r->[3], # max height
|
|
$cfg->{image_quality}
|
|
);
|
|
}
|
|
|
|
if ( $cfg->{watermark_path} and $r->[0] > 100 and $r->[1] > 100 ) {
|
|
apply_watermark( $target_fpath, $cfg->{watermark_path}, $cfg->{image_quality} );
|
|
}
|
|
|
|
push @ftemp, $target_fpath;
|
|
$new_rec{"${c}_$r->[0]"} = GT::SQL::File->open( $target_fpath );
|
|
}
|
|
}
|
|
|
|
print $link->{ID} . ( keys %new_rec ? "*" : "" ) . " ";
|
|
$i++ % 10 or print "\n";
|
|
|
|
next unless keys %new_rec;
|
|
|
|
$new_rec{SlideShowCache} = ''; # flush the cache
|
|
|
|
$links->update( \%new_rec, { ID => $link->{ID} } ) or do {
|
|
warn "Could not update link $link->{ID} '$GT::SQL::error'\n";
|
|
next;
|
|
};
|
|
}
|
|
|
|
# End beautiful output
|
|
if ($USE_HTML) {
|
|
print "\nDone!</pre></body></html>\n\n";
|
|
}
|
|
else {
|
|
print "\n\nDone!\n"
|
|
}
|
|
}
|
|
|
|
1;
|
|
|