view release on metacpan or  search on metacpan

lib/Labyrinth/Media.pm  view on Meta::CPAN

    }

    my $fn = $cgi->param($param);
    LogDebug("CGIFile: $param fn=$fn");
    return unless($fn);

    my ($bytes,$filename,$dir,$name,$suffix);

    eval {
        my $f = $cgi->upload($param) || die "Cannot access filehandle\n";
        ($name, $dir, $suffix) = fileparse($fn,qr/\.[^.]*/);
        #LogDebug("CGIFile: fileparse dir=$dir, name=$name, suffix=$suffix");

        my $tries = 0;
        while(1) {
            last    if($tries++ > 10);
            $filename = "$path/" . _randname('imgXXXXXX') . lc($suffix);
            next    if(-f $filename);
            last;
        }

        my $buffer = read_file($f, binmode => ':raw');
        $bytes = length($buffer);
        write_file($filename, { binmode => ':raw' }, $buffer);
    };

    die $@ if $@;

    if($bytes == 0) {
        LogError("CGIFile: no bytes read for input file [$param]");
        return;
    }

    $filename =~ s!^$settings{webdir}/!!;
    $image_store{$param} = [$name,$filename,$suffix,$stock];
    #LogDebug("CGIFile: returning $param image_store=".Dumper($image_store{$param}));
    return ($name,$filename,$suffix);
}

=head2 Stock Control Functions

The stock list relates to the directory paths where uploaded files should be
saved on the local filesystem.

=over

=item StockName

Return the name for the given stock id.

=item StockPath

Return the path for the given stock id.

=item StockType

Return the stock id for the given stock code.

=item StockSelect

Returns an XHTML snippet for a dropdown selection box of stock entries.

=item PathMove

=back

=cut

sub StockName {
    my $stock = shift || 1;
    _init_stock()   unless(%stock);
    return $stock{$stock}->{title};
}

sub StockPath {
    my $stock = shift || 1;
    _init_stock()   unless(%stock);
    return $stock{$stock}->{path};
}

sub StockType {
    my $stock = shift || 'DRAFT';
    _init_stock()   unless(%stock);
    for(keys %stock) {
        return $_   if($stock{$_}->{title} eq $stock);
    }
    return 1;   # default
}

sub StockSelect {
    my $opt   = shift || 0;
    my $blank = shift || 1;
    _init_stock()   unless(%stock);

    my $html = "<select name='type'>";
    $html .= "<option value='0'>Select</option>"    if(defined $blank && $blank == 1);

    foreach (sort {$a <=> $b} keys %stock) {
        $html .= "<option value='$_'";
        $html .= ' selected="selected"' if($opt == $_);
        $html .= ">$stock{$_}->{title}</option>";
    }
    $html .= "</select>";

    return $html;
}

sub PathMove {
    my ($stockid,$link) = @_;
    my ($path,$name) = ($link =~ m!(.+)/([^/]+)!);
    return $link    if($stock{$stockid}->{path} eq $path);

    my $old = "$settings{webdir}/$link";
    my $new = "$settings{webdir}/$stock{$stockid}->{path}/$name";

    rename $old, $new;
    return "$stock{$stockid}->{path}/$name";
}

# -------------------------------------
# Private Functions