/usr/local/CPAN/Web-App/Web/App/Lib/IO.pm
package Web::App::Lib::IO;
# $Id: IO.pm,v 1.1 2009/03/29 10:12:26 apla Exp $
use strict;
use Imager;
use Image::Thumbnail;
use IO::Easy;
use IO::Easy::Dir;
use IO::Easy::File;
sub nodes {
my $class = shift;
my $app = shift;
my $params = shift;
my $place = $params->{place} || 'htdocs';
my $node = $app->request->params->param ('node') || '';
return # bwahaha
if $node =~ /\.\./;
my $images_root = $app->root->append ($place, $node)->as_dir;
my $list = [];
foreach my $dir_item ($images_root->items) {
my $name = $dir_item->name;
my $type = $dir_item->type;
$type = 'folder' if $type eq 'dir';
next
if $params->{'no-files'} and $type eq 'file';
push @$list, {
text => $name,
id => ($node eq '' ? '' : $node . '/') . $name,
cls => $type,
};
if ($type eq 'file') {
$list->[-1]->{leaf} = 1;
$list->[-1]->{extension} = $dir_item->extension;
}
}
return $list;
}
sub file_contents {
my $class = shift;
my $app = shift;
my $params = shift;
my $place = $params->{place} || 'htdocs';
my $node = $app->request->path_info;
return # bwahaha
if $node =~ /\.\./;
my $contents = $app->root->append ($place, $node)->as_file->contents;
return {
contents => $contents,
path => $node
};
}
sub store_file {
my $class = shift;
my $app = shift;
my $params = shift;
my $place = $params->{place} || 'htdocs';
my $entity = $params->{entity} || 'contents';
my $type = $params->{type} || 'xml';
my $node = $app->request->path_info;
my $cgi = $app->request->params;
my $path = $cgi->param ('doc-path');
my $name = $cgi->param ('doc-name');
my $cont = $cgi->param ('doc-contents');
return # bwahaha
if $node =~ /\.\./;
my $file;
if ($name ne '') {
$file = $app->root->append ($place, $path, "$name.$type")->as_file;
} else {
$file = $app->root->append ($place, $path)->as_file;
}
$file->store ($cont);
$app->var->{result} = 'ok';
return;
}
sub document_files {
my $class = shift;
my $app = shift;
my $params = shift;
my $place = $params->{place} || 'htdocs';
my $node = $app->request->params->param ('node') || '';
return # bwahaha
if $node =~ /\.\./;
my $node_path = $app->root->append ($place, $node)->as_dir;
my $list = [];
foreach my $dir_item ($node_path->items ($params->{filter})) {
my $name = $dir_item->name;
my $type = $dir_item->type;
next
if $type eq 'dir';
push @$list, {
name => $name,
size => $dir_item->size,
mtime => $dir_item->mtime,
url => '/' . ($node eq '' ? '' : $node . '/') . $name,
};
}
return $list;
}
sub image_files {
my $class = shift;
my $app = shift;
my $params = shift;
my $place = $params->{place} || 'htdocs';
my $node = $app->request->params->param ('node') || '';
return # bwahaha
if $node =~ /\.\./;
my $images_root = $app->root->append ($place, $node)->as_dir;
my $list = [];
foreach my $dir_item ($images_root->items ($params->{filter})) {
my $name = $dir_item->name;
my $type = $dir_item->type;
next
if $type eq 'dir';
next
if $name =~ /^--/;
my $thumb_file = $images_root->append ('--'.$name)->as_file;
my $im = Imager->new;
if (!$im->read (file => $dir_item->path)) {
warn $im->errstr;
next;
}
my ($w, $h) = ($im->getwidth, $im->getheight);
my $small_dims = 0;
$small_dims = 1
if $w < 351 and $h < 351;
if (! -f $thumb_file and ! $small_dims) {
my $t = Image::Thumbnail->new (
size => 300,
create => 1,
module => 'Imager',
quality => '90',
input => $dir_item->path,
outputpath => $thumb_file->path,
);
}
my $uri_dir = '/' . ($node eq '' ? '' : $node . '/');
push @$list, {
name => $name,
size => $dir_item->size,
mtime => $dir_item->mtime,
width => $w,
height => $h,
thumb_url => $uri_dir . ($small_dims ? '' : '--') . $name,
image_url => $uri_dir . $name
};
}
return $list;
}
sub make_dir {
my $class = shift;
my $app = shift;
my $params = shift;
my $place = $params->{place} || 'htdocs';
my $entity = $params->{entity} || 'makeDir';
my $cgi = $app->request->params;
my $path = $cgi->param ('dir-path');
my $name = $cgi->param ('dir-name');
my $dir = $app->root->append ($place, $path, $name)->as_dir;
if (-e $dir) {
if (-d $dir) {
$app->var->{$entity} = {result => 'ok', reason => 'already-exists'};
} else {
$app->var->{$entity} = {result => 'error', reason => 'not-a-dir'};
}
} else {
$dir->create;
$app->var->{$entity} = {result => 'ok'};
}
return;
}
sub upload {
my $class = shift;
my $app = shift;
my $params = shift;
my $dir = $params->{dir} || 'htdocs';
my $req = $app->request;
my $location = $req->param ('location');
return # bwahaha
if $location =~ /\.\./;
my $file_contents = $req->param ('file');
my $file_name = $req->params->param_filename ('file');
my $file = $app->root->append ($dir, $location, $file_name)->as_file;
$file->store ($file_contents);
$app->var->{success} = 'true';
return;
}
1;