シンタックスハイライト
はてダでもシンタックスハイライトが使えるようになったので、今書きかけのコードをちょっと貼り付けてみる。まだまだ手を入れないとなぁ。なんていうか、美しくない。動けばいいってだけのコードだから汚くて当然なんだけど。ていうか、そもそもから未完成だしね。
package Tangerine::Plugin::Evangeline; use strict; use warnings; use version; our $VERSION = qv('0.1.0'); use base qw/Tangerine::Plugin::Base::Rename/; use lib 'D:/Perl/Evangeline/lib/'; use File::Copy (); use File::Spec; use Encode qw/encode decode from_to/; use Image::Magick; use Tangerine::Core::Builtin qw/lc link/; use Tangerine::Core::Carp qw/carp croak/; use aliased 'Evangeline::Model::DBIC::Schema'; my $reg = '^(?:\(.+\)\s*?)+.*' . Tangerine->Extension; $reg = qr/$reg/; sub _regexp { [$reg] } sub _directory { 'D:\Perl\Evangeline\root\static\images' } #sub getCategory { # my ($self, $f) = @_; # return map { # exists $self->_alias->{lc $_} ? $self->_alias->{lc $_} : $_; # } $f =~ /\G\((.+?)\)\s*/g; #} sub dest { my $self = shift; my $dest = $self->rename(shift); return [File::Spec->catfile($self->_directory, split(//, substr $dest, 0, 3), $dest)]; } sub rename { my $self = shift; return $self->digest(@_); } sub move { my $self = shift; my ($src, $dest) = @_; $dest = shift @{$dest}; if (-e $dest) { carp "already exists. $dest"; return; } else { $self->say(scalar(localtime), " $src"); $self->say(" move $src => $dest"); # thumbnail: 300px comp: 60; # jpg, png => jpg, gif => gif my $tmp = (File::Spec->splitpath($dest))[2]; link $src, $tmp or croak $!; my $img = Image::Magick->new; my $x = $img->Read(filename => $tmp); die $x if $x; $x = $img->Resize(geometry => '300x300'); die $x if $x; (my $thumb_out = $tmp) =~ s/\.(\w+)$/.thumb.$1/; $thumb_out =~ s/png$/jpg/i; print "$src => $thumb_out\n"; $x = $img->Set(quality => 60) if $thumb_out =~ m/jpg$/; die $x if $x; $x = $img->Write($thumb_out); die $x if $x; unlink $tmp; #File::Copy::move($src, $dest) or croak "$!" unless $self->_debug; $self->say; } } 1
追記
サムネイルを作る処理は外に括りだそう。[http://search.cpan.org/~lgoddard/Image-Magick-Thumbnail/:title=Image::Magick::Thumbnail]
を使ってもいいけど、関数指向なのがちょっと気に入らない。OOなラッパー書こうかな。
追記 [12/19 22:37]
今はこんな感じ。まだまだ手を入れないといけない。最近あんまりやる気が出ないけど。
package Tangerine::Plugin::Evangeline; use strict; use warnings; use version; our $VERSION = qv('0.1.0'); use base qw/Tangerine::Plugin::Base::Rename/; use lib 'D:/Perl/Evangeline/lib/'; use File::Copy (); use File::Spec; use Encode qw/encode decode from_to/; use Image::Magick; use Image::Magick::Thumbnail; use Tangerine::Core::Builtin qw/lc link/; use Tangerine::Core::Carp qw/carp croak/; use aliased 'Evangeline::Model::DBIC::Schema'; my $reg = '^(?:\[.+\]\s*?)+.*' . Tangerine->Extension; $reg = qr/$reg/; sub _regexp { [$reg] } sub _directory { 'D:/Perl/Evangeline/root/static/images' } sub getCategory { my ($self, $f) = @_; $f = decode 'Shift_JIS', $f; return map { $_ = encode 'Shift_JIS', $_; exists $self->_alias->{lc $_} ? $self->_alias->{lc $_} : $_; } $f =~ /\G\[(.+?)\]\s*/g; } sub dest { my $self = shift; my $dest = $self->rename(shift); return [File::Spec->catfile($self->_directory, split(//, substr $dest, 0, 3), $dest)]; } sub rename { my $self = shift; return $self->digest(@_); } sub move { my $self = shift; my ($src, $dest) = @_; $dest = shift @{$dest}; if (-e $dest) { carp "already exists. $dest"; return; } else { $self->say(scalar(localtime), " $src"); $self->say(" move $src => $dest"); # thumbnail: 300px comp: 60; # rename $src, (File::Spec->splitpath($dest))[2] or croak $!; # my $img = Image::Magick->new; # my $x = $img->Read(filename => $src); # die $x if $x; # $x = $img->Resize(geometry => '300x300'); # die $x if $x; # (my $thumb_out = $src) =~ s/\.(\w+)$/.thumb.jpg/; # $x = $img->Set(quality => 60); # die $x if $x; # $x = $img->Write($thumb_out); # die $x if $x; #File::Copy::move($src, $dest) or croak "$!" unless $self->_debug; my @categories = $self->getCategory($src); my $schema = Schema->connect('dbi:SQLite:db/Evangeline.db') or croak $!; my %table; foreach (qw/Image ImageTag Tag/) { $table{$_} = $schema->resultset($_); } foreach my $category (@categories) { my $tag = $category; from_to($tag, 'Shift_JIS' => 'UTF-8'); $table{Tag}->find_or_create({tag => $tag}); print "$category\n"; } $self->say; } } 1;