#!/usr/bin/perl use strict; use warnings; use Image::Magick; use Getopt::Long; use LWP::Simple; use File::Spec::Functions; use Cwd 'abs_path'; use Image::Size; my $vers = 'v.0.0.0.3'; my $url = 'http://brorabbit.g0x.ru/files/perl/'; abs_path($0) =~ /([^\\\/]+)\.pl$/i; my $progname = $1; #my $desc = './desk'; my $header = 'Fido stickers'; my $foot = '
'; my $file = './index.html'; my $body = ''; my ($line,$img,$needhelp,$prinver,$whatsnew,$check_updates,$logfile,$desc, %adesc, $dirname, $thumbnailsonly ); sub help { print "Creates index.html for directory with images.\n". "Usage: $0 [options]\n". "~~~~~\n". " -d,--dir dir_name - the name of directory with image files.\n". " -f,--file file_name - the name of file with descriptions.\n". " -t,--thumbnails-only - don't write index.html, create thumbnails only.\n". # " -c,--config - Configuration file name. Command line options\n". # " override it. Optional. Not needed by default.\n". # " Use command \'callip.pl -e > callip.conf\' to\n". # " create a new one.\n". # " -l,--log log_file_name - file name of log file\n". # " -e,--export - export configuration and exit.\n". " -u,--update - How to update the program. Optional.\n". " =a - auto. Check for a new version, download\n". " and update.\n". " =d - download. Check for a new version and\n". " download the update to a new file.\n". " =f - Force download callip.pl end exit even\n". " if no new version is found.\n". " =w - warn. Check for a new version and warn\n". " the sysop. Default.\n". " =n - no. Do nothing.\n". " -V,--ver show version and exit.\n". " -w,--whatsnew show whatsnew.\n"; exit; } sub writelog($) { my ( $str ) = @_; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); $str =~ s/([\r\n])$//; my $startstr = sprintf("%04d-%02d-%02d %02d:%02d:%02d ",$year+1900,$mon+1,$mday,$hour,$min,$sec); $str =~ s/([\r\n]+)/$1$startstr/g; $str = "${startstr}$str\n"; print $str; return unless defined $logfile; if ( open( FLOG, ">>$logfile") ) { syswrite( FLOG, $str ); close( FLOG ); } else { printf( STDERR "Can't open $logfile. ($!)\n" ); } } sub update() { # return if $check_updates eq 'n'; return unless $check_updates =~ /^[wdaf]$/; my ( $ver_s, $upd, $of ); my $curpath = abs_path($0); # $curpath = Cwd::realpath($0) unless defined $curpath; # $curpath = Cwd::realpath('./') unless defined $curpath; $ver_s = get( $url . "$progname.v"); if (defined ($ver_s) ) { if ( $check_updates eq 'f' ) { if ( $curpath =~ /^(.*?)\.pl$/ ) { $of = "$1_$ver_s\.pl"; } elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) { $of = $1 . "${progname}_${ver_s}\.pl"; } else { $of = "${curpath}_${ver_s}\.pl"; } # print "Latest version is $ver_s\!\n"; writelog("Latest version is $ver_s\! Downloaded filename is \'$of\'.\n"); } elsif ( $vers lt $ver_s ) { if ( $check_updates eq 'w' ) { print " \*\*\* You should update to $ver_s\! \*\*\* \n"; writelog(" \*\*\* You should update to $ver_s\! \*\*\* \n"); return; } elsif ( $check_updates eq 'a' ) { $of = $curpath; # print "$progname.pl will be updated to $ver_s\!\n"; writelog(" \*\*\* Updating $progname.pl to $ver_s\!\n"); } elsif ( $check_updates eq 'd' ) { if ( $curpath =~ /^(.*?)\.pl$/ ) { $of = "$1_$ver_s\.pl"; } elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) { $of = $1 . "${progname}_${ver_s}\.pl"; } else { $of = "${curpath}_${ver_s}\.pl"; } # print "You should update to $ver_s\!\n"; writelog(" \*\*\* You should update to $ver_s\! Update filename is \'$of\'.\n"); } } else { print "You have actual version.\n"; return; } $upd = get( $url . "$progname.pl" ); unless( defined $upd ) { # print STDERR "Can't get update.\n"; writelog("Can't get update. ${url}$progname.pl\n"); return; } if ( open ( OF, ">$of") ) { binmode(OF); print( OF $upd ); close(OF); chmod 0755, $of if $^O eq 'linux'; print "$of saved.\n\n"; } else { print STDERR "Can't open $of ($!).\n"; } } else { # print STDERR "Can't connect to $url\n"; writelog("Can't connect to $url\n"); } } sub nicesize($) { my ( $size ) = @_; if( $size >= 1024 && $size < (1024*1024) ){ return sprintf("%.3f kb", $size / 1024); } if( $size >= (1024*1024) && $size < (1024*1024*1024) ){ return sprintf("%.3f Mb", $size / ( 1024*1024 ) ); } if( $size >= (1024*1024*1024) && $size < (1024*1024*1024*1024) ){ return sprintf("%.3f Gb", $size / ( 1024*1024*1024 ) ); } return $size; } GetOptions ( # "config=s" => \$configfile, "dir=s" => \$dirname, "file=s" => \$desc, "thumbnails-only" => \$thumbnailsonly, "help" => \$needhelp, "ver" => \$prinver, "whatsnew" => \$whatsnew, # "export" => \$export, "update=s" => \$check_updates, # "debug" => \$debug, "log=s" => \$logfile # string ) or die("Error in command line arguments\n"); $needhelp = 1 unless defined $dirname; $check_updates = 'w' unless defined $check_updates; if ( $prinver ) { print "Current version $vers.\n"; $check_updates = 'w' unless defined $check_updates; update(); exit; } if ( $whatsnew ) { my $wn = get( $url . "$progname.w"); if( defined( $wn) ) { if ( $wn =~ /^$vers/i ) { print $wn; } elsif ( $wn =~ /$vers/i ) { print $`; } else { print $wn; } } else { print "Can't get what's new.\n"; } exit; } help() if $needhelp; update(); #------------ if( defined($desc) ) { writelog( 'Reading file with descriptions.' ); unless ( open(F, "<$desc") ) { writelog( "Can't open $desc ($!).\n" ); exit; } while ( $line = ) { next unless $line =~ /^([^ ]+) (.*)$/; $adesc{$1} = $2; } close(F); } writelog('Reading directory with image files.'); unless ( opendir(D, $dirname) ) { writelog( "Can't open $dirname ($!).\n" ); exit; } mkdir catfile( $dirname, 'tumb' ); my ( %allfiles ); my $f = 0; while( readdir(D) ){ next unless $_ =~ /\.(jpg|png)$/i; $allfiles{$_}{name} = catfile( $dirname, $_ ); $allfiles{$_}{size} = nicesize( ( stat( $allfiles{$_}{name} ) )[7] ); my ($x, $y) = imgsize($allfiles{$_}{name}); if( defined($adesc{$_}) ) { $allfiles{$_}{descr} = "$adesc{$_}\"; $allfiles{$_}{alt} = "$adesc{$_}\n"; } else { $allfiles{$_}{descr} = "$_\"; $allfiles{$_}{alt} = "$_\n"; } $allfiles{$_}{descr} .= "${x}x$y\$allfiles{$_}{size}"; $allfiles{$_}{alt} .= "${x}x$y\n$allfiles{$_}{size}"; $img = Image::Magick->new; $x = $img->Read( $allfiles{$_}{name} ); my ($ox,$oy)=$img->Get('base-columns','base-rows'); my $nx=int(($oy/$ox)*100); $img->Resize(geometry=>"100x${nx}"); $x = $img->Write( catfile( $dirname, 'tumb', $_ ) ); $f++; } writelog("$f files found and thumbnails created."); unless( defined( $thumbnailsonly ) ) { writelog('Building index.html file.'); my $i = 0; foreach $f ( sort keys %allfiles ) { $body .= '' if $i == 0; $body .= "\\". "\\<\/a\>\". "\$allfiles{$f}{descr}\<\/a\>\<\/td\>\n"; $i++; if ( $i == 5 ) { $body .= ''; $i = 0; } } my $html = "$header$body$foot"; $file = catfile($dirname,$file); unless ( open(FH, ">$file") ) { print STDERR "Can't open $file ($!).\n"; exit; } print( FH $html ); close(FH); writelog("File $file created."); }