シンタックスハイライト

はてダでもシンタックスハイライトが使えるようになったので、今書きかけのコードをちょっと貼り付けてみる。まだまだ手を入れないとなぁ。なんていうか、美しくない。動けばいいってだけのコードだから汚くて当然なんだけど。ていうか、そもそもから未完成だしね。

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;