httemplate/elements/fckeditor/editor/filemanager/browser/default/connectors/perl/io.pl

   1 #####\r
   2 #  FCKeditor - The text editor for Internet - http://www.fckeditor.net\r
   3 #  Copyright (C) 2003-2007 Frederico Caldeira Knabben\r
   4 #\r
   5 #  == BEGIN LICENSE ==\r
   6 #\r
   7 #  Licensed under the terms of any of the following licenses at your\r
   8 #  choice:\r
   9 #\r
  10 #   - GNU General Public License Version 2 or later (the "GPL")\r
  11 #     http://www.gnu.org/licenses/gpl.html\r
  12 #\r
  13 #   - GNU Lesser General Public License Version 2.1 or later (the "LGPL")\r
  14 #     http://www.gnu.org/licenses/lgpl.html\r
  15 #\r
  16 #   - Mozilla Public License Version 1.1 or later (the "MPL")\r
  17 #     http://www.mozilla.org/MPL/MPL-1.1.html\r
  18 #\r
  19 #  == END LICENSE ==\r
  20 #\r
  21 #  This is the File Manager Connector for Perl.\r
  22 #####\r
  23 \r
  24 sub GetUrlFromPath\r
  25 {\r
  26         local($resourceType, $folderPath) = @_;\r
  27 \r
  28         if($resourceType eq '') {\r
  29                 $rmpath = &RemoveFromEnd($GLOBALS{'UserFilesPath'},'/');\r
  30                 return("$rmpath$folderPath");\r
  31         } else {\r
  32                 return("$GLOBALS{'UserFilesPath'}$resourceType$folderPath");\r
  33         }\r
  34 }\r
  35 \r
  36 sub RemoveExtension\r
  37 {\r
  38         local($fileName) = @_;\r
  39         local($path, $base, $ext);\r
  40         if($fileName !~ /\./) {\r
  41                 $fileName .= '.';\r
  42         }\r
  43         if($fileName =~ /([^\\\/]*)\.(.*)$/) {\r
  44                 $base = $1;\r
  45                 $ext  = $2;\r
  46                 if($fileName =~ /(.*)$base\.$ext$/) {\r
  47                         $path = $1;\r
  48                 }\r
  49         }\r
  50         return($path,$base,$ext);\r
  51 \r
  52 }\r
  53 \r
  54 sub ServerMapFolder\r
  55 {\r
  56         local($resourceType,$folderPath) = @_;\r
  57 \r
  58         # Get the resource type directory.\r
  59         $sResourceTypePath = $GLOBALS{'UserFilesDirectory'} . $resourceType . '/';\r
  60 \r
  61         # Ensure that the directory exists.\r
  62         &CreateServerFolder($sResourceTypePath);\r
  63 \r
  64         # Return the resource type directory combined with the required path.\r
  65         $rmpath = &RemoveFromStart($folderPath,'/');\r
  66         return("$sResourceTypePath$rmpath");\r
  67 }\r
  68 \r
  69 sub GetParentFolder\r
  70 {\r
  71         local($folderPath) = @_;\r
  72 \r
  73         $folderPath =~ s/[\/][^\/]+[\/]?$//g;\r
  74         return $folderPath;\r
  75 }\r
  76 \r
  77 sub CreateServerFolder\r
  78 {\r
  79         local($folderPath) = @_;\r
  80 \r
  81         $sParent = &GetParentFolder($folderPath);\r
  82         # Check if the parent exists, or create it.\r
  83         if(!(-e $sParent)) {\r
  84                 $sErrorMsg = &CreateServerFolder($sParent);\r
  85                 if($sErrorMsg == 1) {\r
  86                         return(1);\r
  87                 }\r
  88         }\r
  89         if(!(-e $folderPath)) {\r
  90                 umask(000);\r
  91                 mkdir("$folderPath",0777);\r
  92                 chmod(0777,"$folderPath");\r
  93                 return(0);\r
  94         } else {\r
  95                 return(1);\r
  96         }\r
  97 }\r
  98 \r
  99 sub GetRootPath\r
 100 {\r
 101 #use Cwd;\r
 102 \r
 103 #       my $dir = getcwd;\r
 104 #       print $dir;\r
 105 #       $dir  =~ s/$ENV{'DOCUMENT_ROOT'}//g;\r
 106 #       print $dir;\r
 107 #       return($dir);\r
 108 \r
 109 #       $wk = $0;\r
 110 #       $wk =~ s/\/connector\.cgi//g;\r
 111 #       if($wk) {\r
 112 #               $current_dir = $wk;\r
 113 #       } else {\r
 114 #               $current_dir = `pwd`;\r
 115 #       }\r
 116 #       return($current_dir);\r
 117 use Cwd;\r
 118 \r
 119         if($ENV{'DOCUMENT_ROOT'}) {\r
 120                 $dir = $ENV{'DOCUMENT_ROOT'};\r
 121         } else {\r
 122                 my $dir = getcwd;\r
 123                 $workdir =~ s/\/connector\.cgi//g;\r
 124                 $dir  =~ s/$workdir//g;\r
 125         }\r
 126         return($dir);\r
 127 \r
 128 \r
 129 \r
 130 }\r
 131 1;\r