view release on metacpan or  search on metacpan

lib/Prty/ImagePool.pm  view on Meta::CPAN

# -----------------------------------------------------------------------------

sub directory {
    my ($self,$name) = @_;

    # Directory-Namen auf den Anfang 'YYYY-MM-DD-X' reduzieren

    ($name) = $name =~ /^(\d{4}-\d{2}-\d{2}-[A-Z])/;
    if (!$name) {
        $self->throw;
    }

    return $self->{'directoryH'}->{$name} //= do {
        my $pattern = sprintf '%s/dir/%s*',$self->root,$name;
        my $path = Prty::Path->glob($pattern);
        Prty::ImagePool::Directory->new($path);
    };
}

# -----------------------------------------------------------------------------

=head2 Cache

=head3 cacheFile() - Generiere Pfad einer Cache-Datei

=head4 Synopsis

    $path = $ipl->cacheFile($img,$op,@args);

=head4 Arguments

=over 4

=item $op

Bezeichner für die angewendete Bild-Operation.

=item @args

Argumente für die Bild-Operation.

=back

=head4 Description

Generiere einen Cache-Pfad für Bild $img und Bild-Operation $op
mit den Argumenten @args und liefere diesen zurück.

=cut

# -----------------------------------------------------------------------------

sub cacheFile {
    my $self = shift;
    my $img = shift;
    # @_: @args

    my $cacheId;
    my $basename = $img->basename;
    my @path = split m|/|,$self->path;
    if ($path[-2] eq 'img') {
        $cacheId = "$path[-3]/$basename"; # Subdirectoy-Path
    }
    else {
        $cacheId = "$path[-2]/$basename"; # Cache-Path
    }
    
    my $file = $self->root('cache/img');
    $file .= sprintf '/%s,%s.%s',$cacheId,join('-',@_),$img->type;

    return $file;
}

# -----------------------------------------------------------------------------

=head2 Bilder

=head3 images() - Bilder gemäß Suchkriterium

=head4 Synopsis

    @images|$imageA = $ipl->images($key,@opt);

=head4 Arguments

=over 4

=item $key

Bezeichner Bild-Sequenz.

=back

=head4 Options

=over 4

=item -count => $n (Default: 0 = keine Beschränkung)

Liefere maximal $n Bilder.

=back

=cut

# -----------------------------------------------------------------------------

sub images {
    my ($self,$key) = @_;

    # Optionen

    my $count = 0;

    Prty::Option->extract(\@_,
        -count=>\$count,
    );

    my @images;