package Bottlenose::CKFinder;
# $Id$
use Object::InsideOut qw(Bottlenose);
use warnings;
use strict;
use Carp;
use XML::API;
use feature 'switch';
use Class::Date;
use File::Copy;
use File::Path;
use Image::Magick;
use Digest::MD5 qw(md5_base64);
my @userfiles_dir :Field :Std_All(userfiles_dir);
my @base_url :Field :Std_All(base_url);
my @xml :Field :Acc(xml);
my @err_num :Field :Std_All(err_num);
my @err_msg :Field :Std_All(err_msg);
sub _init :Init {
my $self = shift;
my $opt = shift;
if ( $self->get_userfiles_dir !~ /^\// ) {
$self->set_userfiles_dir(
$self->get_ICDataDir . '/' . $self->get_userfiles_dir );
}
$self->set_base_url('/userfiles/');
$self->set_err_num(0);
$self->set( \@xml,
XML::API->new( doctype => 'xhtml', encoding => 'UTF-8' ) );
}
sub do :MergeArgs {
my ( $self, $opt ) = @_;
do { $self->log_error( msg => 'No cgi name space available' ); return; }
unless $opt->{cgi};
my $params = $opt->{cgi};
$params->{type} = 'Image'
if $params->{type} && $params->{type} eq 'Images';
if ( $params->{upload} && !$params->{command} ) {
return $self->upload_file($params);
}
do { $self->log_error( msg => 'No command given' ); return; }
unless $params->{command};
$self->header($params);
given ( $params->{command} ) {
when ('Init') { $self->init($params) };
when ('GetFolders') { $self->get_folders($params); }
when ('GetFiles') { $self->get_files($params); }
when ('Thumbnail') {
return $self->thumbnail($params);
}
when ('CreateFolder') {
$params->{command} = 'create';
$self->folder($params);
}
when ('RenameFolder') {
$params->{command} = 'rename';
$self->folder($params);
}
when ('DeleteFolder') {
$params->{command} = 'delete';
$self->folder($params);
}
when ('RenameFile') { $self->rename_file($params); }
when ('DeleteFile') { $self->delete_file($params); }
when ('FileUpload') { return $self->upload_file($params); }
when ('DownloadFile') { return $self->download_file($params); }
default {
$self->log_error(
msg => qq{Command: $params->{command} not defined} );
return;
}
}
$self->footer($params);
$self->xml->{has_root_element} = 1;
return qq{Content-Type: text/xml\n\n} . $self->xml->_as_string;
}
# License
sub get_license_key {
my $lk;
@$lk = split / */, 'XXXX-XXXX-XXXX-XXXX-XXXX-XXXX-XXXX';
return
$lk->[11]
. $lk->[0]
. $lk->[8]
. $lk->[12]
. $lk->[26]
. $lk->[2]
. $lk->[3]
. $lk->[25]
. $lk->[1];
}
sub init :MergeArgs {
my ( $self, $opt ) = @_;
my $docroot = $opt->{docroot} || $::Variable->{DOCROOT} || '/www';
$self->xml->Error( -number => 0 );
$self->xml->ConnectorInfo(
-enabled => 'true',
-s => 'Bottlenose',
-c => $self->get_license_key(),
-thumbsEnabled => 'true',
-imgWidth => 1600,
-imgHeight => 1200
);
$self->xml->ResourceTypes_open();
$self->xml->ResourceType(
-name => 'Image',
-url => '/userfiles/Image/',
-hasChildren => 'true',
-allowedExtensions => 'jpg,gif,jpeg,png',
-deniedExtensions => '',
-defaultView => 'Thumbnails',
-acl => '255',
-hash => md5_base64(qq{$docroot/userfiles/Image/}),
);
$self->xml->ResourceType(
-name => 'PDF',
-url => '/userfiles/PDF/',
-hasChildren => 'true',
-allowedExtensions => 'pdf',
-deniedExtensions => '',
-defaultView => 'Thumbnails',
-acl => '255',
-hash => md5_base64(qq{$docroot/userfiles/PDF/}),
);
$self->xml->ResourceType(
-name => 'SWF',
-url => '/userfiles/SWF/',
-hasChildren => 'true',
-allowedExtensions => 'swf',
-deniedExtensions => '',
-defaultView => 'Thumbnails',
-acl => '255',
-hash => md5_base64(qq{$docroot/userfiles/SWF/}),
);
$self->xml->ResourceTypes_close();
return;
}
sub header :MergeArgs {
my ( $self, $opt ) = @_;
no warnings 'uninitialized';
if ( $opt->{type} ) {
$self->xml->Connector_open( -resourceType => $opt->{type} );
} else {
$self->xml->Connector_open();
}
if ( $opt->{command} ne 'Init' ) {
$self->xml->CurrentFolder(
-path => "$opt->{currentFolder}",
-url => "/userfiles$opt->{currentFolder}",
-acl => "255"
);
}
return;
}
sub footer :MergeArgs {
my ( $self, $opt ) = @_;
$self->xml->Error(
-number => $self->get_err_num,
-text => $self->get_err_msg
);
$self->xml->Connector_close();
return;
}
sub get_folders :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $self->get_dir($opt);
$self->xml->Folders_open();
opendir( DIR, "$dir" ) || croak "Can't open dir $dir: $!\n";
for my $file ( grep { !/^(\.|ct_previews|slides)/ && -d qq{$dir/$_} }
readdir(DIR) ) {
$self->xml->Folder(
-name => $file,
-hasChildren => $self->has_children( dir => qq{$dir/$file} )
? 'true'
: 'false',
-acl => '255'
);
}
closedir(DIR);
$self->xml->Folders_close();
return;
}
sub has_children :MergeArgs {
my ( $self, $opt ) = @_;
do { $self->log_error( msg => 'No directory given' ); return; }
unless $opt->{dir};
my $dir = $opt->{dir};
return 0 unless -d $dir;
my @files = glob qq{$dir/*};
for (@files) {
return 1 if -d $_;
}
return 0;
}
sub get_files :MergeArgs {
my ( $self, $opt ) = @_;
$self->xml->Files_open();
my $dir = $self->get_dir($opt);
opendir( DIR, "$dir" );
my @files = grep !/^\.\.?$/, readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?/;
next if -d qq{$dir/$file};
next if $file =~ /^thumb_/;
my ( $iFileSize, $refdate, $filedate, $fileperm )
= ( stat("$dir/$file") )[ 7, 8, 9, 2 ];
if ( $iFileSize > 0 ) {
$iFileSize = int( $iFileSize / 1024 );
if ( $iFileSize < 1 ) {
$iFileSize = 1;
}
}
my $date = Class::Date->new($refdate);
local $Class::Date::DATE_FORMAT = "%Y%m%d%H%M%S";
$self->xml->File(
-name => $file,
-size => $iFileSize,
-date => $date->string
);
}
$self->xml->Files_close();
return;
}
sub get_dir :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $self->get_userfiles_dir;
$dir .= qq{/$opt->{type}} if $opt->{type};
$dir .= qq{$opt->{currentFolder}} if $opt->{currentFolder};
$dir =~ s!%2F!/!g;
$dir =~ s!/+$!!;
unless ( -d $dir ) {
unless ( mkdir $dir ) {
$self->log_error( msg => qq{Could not make directory, $dir: $!} );
return;
}
}
return $dir;
}
sub rename_file :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $self->get_dir($opt);
do {
$self->log_error( msg => 'Existing file name not available' );
return;
} unless $opt->{fileName};
do { $self->log_error( msg => 'New file name not given' ); return; }
unless $opt->{newFileName};
my $old = qq{$dir/$opt->{fileName}};
my $new = qq{$dir/$opt->{newFileName}};
if ( move( $old, $new ) ) {
$self->xml->RenamedFile(
-name => $opt->{fileName},
-newName => $opt->{newFileName}
);
} else {
$self->log_error( msg => qq{Could not rename $old to $new: $!} );
}
return;
}
sub delete_file :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $self->get_dir($opt);
do { $self->log_error( msg => 'File name not available' ); return }
unless $opt->{FileName};
my $file = qq{$dir/$opt->{FileName}};
if ( unlink $file ) {
my $thumb = qq{$dir/thumb_$opt->{FileName}};
$self->log( msg => qq{Unable to remove thumbnail, $thumb: $!})
unless unlink $thumb;
$self->xml->DeletedFile( -name => $opt->{FileName} );
} else {
$self->log_error( msg => qq{Unable to remove file, $file: $!} );
}
return;
}
sub upload_file :MergeArgs {
my ( $self, $opt ) = @_;
my $status = 0;
my $file_param
= $opt->{upload}
? 'upload'
: 'undefined'; # handle trailing & in form action
my $file = $opt->{$file_param};
if ($file) {
$file =~ s!.*?([^/\\]+)$!$1!;
$file =~ s/[^\w\.]+/_/g;
my $dir = $self->get_dir($opt);
my $outfile = qq{$dir/$file};
open my $FILE, '>', $outfile;
print $FILE $::Tag->value_extended(
{ name => $file_param, file_contents => 1 } );
close $FILE;
} else {
$status = 202;
}
my $msg = {
'0' => 'File upload complete',
'202' => 'Error uploading file',
};
my $out
= qq{Content-Type: text/html; charset=utf-8\n\n};
return $out;
}
sub folder :MergeArgs {
my ( $self, $opt ) = @_;
do { $self->log_error( msg => 'No command given' ); return; }
unless $opt->{command};
my $dir = $self->get_dir($opt);
my $err_msg;
given ( $opt->{command} ) {
when ('create') {
if ( $opt->{NewFolderName} ) {
my $res = $self->create_dir(
dir => qq{$dir/$opt->{NewFolderName}} );
unless ($res) {
$self->xml->NewFolder( -name => $opt->{NewFolderName} );
}
} else {
$self->log_error( msg => 'No folder name given' );
}
}
when ('rename') {
if ( $opt->{NewFolderName} ) {
( my $new = $dir ) =~ s![^/]+/$!$opt->{NewFolderName}!;
if ( move( $dir, $new ) ) {
$self->xml->RenamedFolder(
-newName => $opt->{NewFolderName},
-newPath => $new,
-newUrl => $self->get_base_url . '/' . $new . '/'
);
} else {
$self->log_error( msg =>
qq{Could not rename directory ($dir -> $new): $!}
);
}
} else {
$self->log_error( msg => 'No folder name given' );
}
}
when ('delete') {
if ( rmtree($dir) ) {
} else {
$self->log_error(
msg => qq{Could not delete folder $dir: $!} );
}
}
}
return;
}
sub create_dir :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $opt->{dir};
unless ($dir) {
$self->log_error( msg => 'No directory name given' );
return -1;
}
if ( -d $dir ) {
$self->log_error( msg => qq{Directory $dir already exists} );
return -1;
}
mkdir $dir;
# my $mode = '0775';
# chmod $mode, $dir;
return 0;
}
sub download_file :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $self->get_dir($opt);
my $file = $dir . '/' . $opt->{FileName};
my $image = Image::Magick->new;
my $err = $image->Read($file);
do {
$self->log_error( msg => qq{Could not read file $file: $err} );
return;
}
if $err;
my $magick = $image->Get('magick');
my $out = <<"EOF";
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=$opt->{FileName}
EOF
$out .= $image->ImageToBlob();
return $out;
}
sub thumbnail :MergeArgs {
my ( $self, $opt ) = @_;
my $dir = $self->get_dir($opt);
my $file = $dir . '/' . $opt->{FileName};
my $thumb = $dir . '/thumb_' . $opt->{FileName};
$self->make_thumbnail( file => $file )
unless -f $thumb;
( my $url = $thumb ) =~ s/.*(userfiles.*)/$::Variable->{VendURL}\/$1/;
return qq{Location: $url\n\n};
}
sub make_thumbnail :MergeArgs {
my ( $self, $opt ) = @_;
my $image = Image::Magick->new;
my $status = $image->Read( $opt->{file} );
do {
$self->log_error(
msg => qq{Could not read image file, $opt->{file}: $!} );
return;
} if $status;
$status = $image->Thumbnail( geometry => '96x96>' );
do {
$self->log_error( msg => qq{Could not make thumbnail: $!} );
return;
} if $status;
$status = $image->Crop( geometry => '96x96' );
do {
$self->log_error( msg => qq{Could not crop thumbnail: $!} );
return;
} if $status;
( my $thumb = $opt->{file} ) =~ s!/([^/]+)$!/thumb_$1!;
$status = $image->Write( filename => $thumb );
do {
$self->log_error(
msg => qq{Could not write thumbnail file, $opt->{thumb}: $!} );
return;
} if $status;
return;
}
sub log_error :MergeArgs {
my ( $self, $opt ) = @_;
$self->log( $opt->{msg} );
$self->set_err_msg( $opt->{msg} );
$self->set_err_num(1);
}
1;
__END__
=head1 NAME
CKFinder
=head1 SYNOPSIS
use Bottlenose::CKFinder;
my $ckf = Bottlenose::CKFinder;
$ckf->do( cgi => $CGI );
=head1 DESCRIPTION
CKFinder is an Ajax application where the front end is completely written in
JavaScript, which communicates to the server through XML messages. In the
server side, there is a “connector”, written in a specific server language,
which handles the front end requests.
This module provides the “connector” between CKFinder and Bottlenose's
Interchange implementation.
=head1 INTERFACE
=over
=item C
$ckf->do( cgi => $CGI );
Handle a request from CKFinder. The C should contain a reference to the
CGI namespace containing the relevant CKFinder parameters. Returns an XML
response for CKFinder. At minimum C should contain a C parameter.
B
B this is the first command issued by CKFinder. It returns the general settings of the connector and all configured resource types.
B gets the list of the children folders of a folder.
B similar to the above command, gets the list of the children files of a folder.
B creates a child folder.
B renames a folder.
B deletes a folder.
B renames a file.
B deletes a file.
B (non XML) adds a file in a folder.
B (non XML) adds a file in a folder.
B (non XML) downloads a file from the server.
B (non XML) downloads the thumbnail of an image file.
The C method is the primary public interface to our CKFinder connector.
The rest of the methods are primarily called from this module.
=item C
$ckf->xml->Element( -attr1 => $value );
When a CKFinder object is initialized an XML::API object is created. This xml
object is used to build the XML response from the connector.
=item C
$ckf->init($params);
This method handles CKFinder's initialization. CKFinder sends the Init command
the first time it is invoked. Do not confuse this method with our object's
initialization method, C<_init>.
=item C
=item C