]>
git.p6c8.net - devedit.git/blob - modules/Command.pm
4 # Dev-Editor - Module Command
6 # Execute Dev-Editor's commands
8 # Author: Patrick Canterino <patshaping@gmx.net>
9 # Last modified: 10-04-2003
24 use POSIX
qw(strftime) ;
27 $script = $ENV { 'SCRIPT_NAME' };
31 use base
qw(Exporter) ;
33 @EXPORT = qw(exec_show
46 # View a directory or a file
48 # Params: 1. Reference to user input hash
49 # 2. Reference to config hash
51 # Return: Output of the command (Scalar Reference)
55 my ( $data , $config ) = @_ ;
56 my $physical = $data ->{ 'physical' };
57 my $virtual = $data ->{ 'virtual' };
62 # Create directory listing
64 my $direntries = dir_read
( $physical );
65 return error
( "Reading of directory $virtual failed" ) unless ( $direntries );
67 my $files = $direntries ->{ 'files' };
68 my $dirs = $direntries ->{ 'dirs' };
70 $output .= htmlhead
( "Directory listing of $virtual " );
71 $output .= equal_url
( $config ->{ 'httproot' }, $virtual );
72 $output .= "<hr> \n\n <pre> \n " ;
74 # Create the link to the upper directory
75 # (only if we are not in the root directory)
77 unless ( $virtual eq "/" )
79 my $upper = $physical . "/.." ;
80 my @stat = stat ( $upper );
82 $output .= " [SUBDIR] " ;
83 $output .= strftime
( " %d . %m . %Y %H : %M " , localtime ( $stat [ 9 ]));
85 $output .= "<a href= \" $script ?command=show&file=" . encode_entities
( upper_path
( $virtual )). " \" >../</a> \n " ;
88 # Get the length of the longest file/directory name
92 foreach ( @
$dirs , @
$files )
94 my $length = length ( $_ );
95 $max_name_len = $length if ( $length > $max_name_len );
100 foreach my $dir ( @
$dirs )
102 my @stat = stat ( $physical . "/" . $dir );
105 $output .= "[SUBDIR] " ;
106 $output .= strftime
( $config ->{ 'timeformat' }, localtime ( $stat [ 9 ]));
108 $output .= "<a href= \" $script ?command=show&file=" . encode_entities
( $virtual . $dir ). "/ \" >" . encode_entities
( $dir ). "/</a> \n " ;
113 foreach my $file ( @
$files )
115 my $phys_path = $physical . "/" . $file ; # Not exactly...
116 my $virt_path = encode_entities
( $virtual . $file );
118 my @stat = stat ( $phys_path );
119 my $in_use = $data ->{ 'uselist' }-> in_use ( $virtual . $file );
121 $output .= " " x
( 10 - length ( $stat [ 7 ]));
124 $output .= strftime
( $config ->{ 'timeformat' }, localtime ( $stat [ 9 ]));
125 $output .= ( $in_use ) ?
" (IN USE) " : ( not - T
$phys_path ) ?
" (BINARY) " : " " x
10 ;
126 $output .= encode_entities
( $file );
127 $output .= " " x
( $max_name_len - length ( $file )). " \t (" ;
129 $output .= (- T
$phys_path )
130 ?
"<a href= \" $script ?command=show&file= $virt_path \" >View</a>"
131 : '<span style="color:#C0C0C0">View</span>' ;
135 $output .= ( $in_use || not - T
$phys_path )
136 ?
'<span style="color:#C0C0C0">Edit</span>'
137 : "<a href= \" $script ?command=beginedit&file= $virt_path \" >Edit</a>" ;
139 $output .= " | <a href= \" $script ?command=workwithfile&file= $virt_path \" >Do other stuff</a>) \n " ;
142 $output .= "</pre> \n\n <hr> \n\n " ;
144 # Bottom of directory listing
145 # (Fields for creating files and directories)
150 <form action=" $script ">
151 <input type="hidden" name="command" value="mkdir">
152 <input type="hidden" name="curdir" value=" $virtual ">
153 <td>Create new directory:</td>
154 <td> $virtual <input type="text" name="newfile"> <input type="submit" value="Create!"></td>
158 <td>Create new file:</td>
159 <form action=" $script ">
160 <input type="hidden" name="command" value="mkfile">
161 <input type="hidden" name="curdir" value=" $virtual ">
162 <td> $virtual <input type="text" name="newfile"> <input type="submit" value="Create!"></td>
175 # Check on binary files
176 # We have to do it in this way, or empty files
177 # will be recognized as binary files
183 return error
( "This editor is not able to view/edit binary files." );
189 $output = htmlhead
( "Contents of file " . encode_entities
( $virtual ));
190 $output .= equal_url
( $config ->{ 'httproot' }, $virtual );
191 $output .= dir_link
( $virtual );
193 $output .= '<div style="background-color:#FFFFE0;border:1px solid black;margin-top:10px;width:100%">' . " \n " ;
194 $output .= '<pre style="color:#0000C0;">' . " \n " ;
195 $output .= encode_entities
(${ file_read
( $physical )});
196 $output .= " \n </pre> \n </div>" ;
207 # Lock a file and display a form to edit it
209 # Params: 1. Reference to user input hash
210 # 2. Reference to config hash
212 # Return: Output of the command (Scalar Reference)
214 sub exec_beginedit
($$)
216 my ( $data , $config ) = @_ ;
217 my $physical = $data ->{ 'physical' };
218 my $virtual = $data ->{ 'virtual' };
219 my $uselist = $data ->{ 'uselist' };
221 return error
( "You cannot edit directories." ) if (- d
$physical );
222 return error_in_use
( $virtual ) if ( $uselist -> in_use ( $virtual ));
224 # Check on binary files
230 return error
( "This editor is not able to view/edit binary files." );
236 $uselist -> add_file ( $virtual );
239 my $dir = upper_path
( $virtual );
240 my $content = encode_entities
(${ file_read
( $physical )});
242 my $equal_url = equal_url
( $config ->{ 'httproot' }, $virtual );
244 $virtual = encode_entities
( $virtual );
246 my $output = htmlhead
( "Edit file $virtual " );
247 $output .= $equal_url ;
249 <p><b style="color:#FF0000">Caution!</b> This file is locked for other users while you are editing it. To unlock it, click <i>Save and exit</i> or <i>Exit WITHOUT saving</i>. Please <b>don't</b> click the <i>Reload</i> button in your browser! This will confuse the editor.</p>
251 <form action=" $script " method="get">
252 <input type="hidden" name="command" value="canceledit">
253 <input type="hidden" name="file" value=" $virtual ">
254 <p><input type="submit" value="Exit WITHOUT saving"></p>
257 <form action=" $script " method="post">
258 <input type="hidden" name="command" value="endedit">
259 <input type="hidden" name="file" value=" $virtual ">
261 <table width="100%" border="1">
263 <td width="50%" align="center">
264 <input type="hidden" name="file" value=" $virtual ">
265 <input type="checkbox" name="saveas" value="1"> Save as new file: $dir <input type=text name="newfile" value=""></td>
266 <td width="50%" align="center"><input type="checkbox" name="encode_iso" value="1"> Encode ISO-8859-1 special chars</td>
269 <td align="center"><input type="reset" value="Reset form"></td>
270 <td align="center"><input type="submit" value="Save and exit"></td>
274 <textarea name="filecontent" rows="25" cols="120"> $content </textarea>
286 # Save a file, unlock it and return to directory view
288 # Params: 1. Reference to user input hash
289 # 2. Reference to config hash
291 # Return: Output of the command (Scalar Reference)
295 my ( $data , $config ) = @_ ;
296 my $physical = $data ->{ 'physical' };
297 my $virtual = $data ->{ 'virtual' };
298 my $content = $data ->{ 'cgi' }-> param ( 'filecontent' );
300 return error
( "You cannot edit directories." ) if (- d
$physical );
302 if ( $data ->{ 'cgi' }-> param ( 'encode_iso' ))
304 # Encode all ISO-8859-1 special chars
306 $content = encode_entities
( $content , " \200 - \377 " );
309 if ( $data ->{ 'cgi' }-> param ( 'saveas' ))
311 # Create the new filename
313 $physical = $data ->{ 'new_physical' };
314 $virtual = $data ->{ 'new_virtual' };
317 if ( file_save
( $physical , \
$content ))
319 # Saving of the file was successful - so unlock it!
321 return exec_unlock
( $data , $config );
325 return error
( "Saving of file '" . encode_entities
( $virtual ). "' failed'." );
331 # Create a file and return to directory view
333 # Params: 1. Reference to user input hash
334 # 2. Reference to config hash
336 # Return: Output of the command (Scalar Reference)
340 my ( $data , $config ) = @_ ;
341 my $new_physical = $data ->{ 'new_physical' };
342 my $new_virtual = $data ->{ 'new_virtual' };
343 my $dir = upper_path
( $new_virtual );
344 $new_virtual = encode_entities
( $new_virtual );
346 return error
( "A file or directory called ' $new_virtual ' does already exist." ) if (- e
$new_physical );
348 file_create
( $new_physical ) or return error
( "Could not create file ' $new_virtual '." );
350 my $output = redirect
( "http:// $ENV {'HTTP_HOST'} $script ?command=show&file= $dir " );
356 # Create a directory and return to directory view
358 # Params: 1. Reference to user input hash
359 # 2. Reference to config hash
361 # Return: Output of the command (Scalar Reference)
365 my ( $data , $config ) = @_ ;
366 my $new_physical = $data ->{ 'new_physical' };
367 my $new_virtual = $data ->{ 'new_virtual' };
368 my $dir = upper_path
( $new_virtual );
369 $new_virtual = encode_entities
( $new_virtual );
371 return error
( "A file or directory called ' $new_virtual ' does already exist." ) if (- e
$new_physical );
373 mkdir ( $new_physical ) or return error
( "Could not create directory ' $new_virtual '." );
375 my $output = redirect
( "http:// $ENV {'HTTP_HOST'} $script ?command=show&file= $dir " );
379 # exec_workwithfile()
381 # Display a form for renaming/copying/deleting/unlocking a file
383 # Params: 1. Reference to user input hash
384 # 2. Reference to config hash
386 # Return: Output of the command (Scalar Reference)
388 sub exec_workwithfile
($$)
390 my ( $data , $config ) = @_ ;
391 my $physical = $data ->{ 'physical' };
392 my $virtual = $data ->{ 'virtual' };
393 my $unused = $data ->{ 'uselist' }-> unused ( $virtual );
395 my $dir = encode_entities
( upper_path
( $virtual ));
397 my $output = htmlhead
( "Work with file " . encode_entities
( $virtual ));
398 $output .= equal_url
( $config ->{ 'httproot' }, $virtual );
400 $virtual = encode_entities
( $virtual );
402 $output .= dir_link
( $virtual );
403 $output .= "<p><b>Note:</b> On UNIX systems, filenames are <b>case-sensitive</b>!</p> \n\n " ;
405 $output .= "<p>Someone else is currently editing this file. So not all features are available.</p> \n\n " unless ( $unused );
407 # Copying of the file as always allowed
414 <form action=" $script ">
415 <input type="hidden" name="command" value="copy">
416 <input type="hidden" name="file" value=" $virtual ">
417 <p>Copy file ' $virtual ' to: $dir <input type="text" name="newfile" size="50"> <input type="submit" value="Copy!"></p>
427 # Allow renaming and deleting the file
432 <form action=" $script ">
433 <input type="hidden" name="command" value="rename">
434 <input type="hidden" name="file" value=" $virtual ">
435 <p>Move/Rename file ' $virtual ' to: $dir <input type="text" name="newfile" size="50"> <input type="submit" value="Move/Rename!"></p>
442 <form action=" $script " method="get">
443 <input type="hidden" name="file" value=" $virtual ">
444 <input type="hidden" name="command" value="remove">
445 <p><input type="submit" value="Delete file ' $virtual '!"></p>
452 # Just display a button for unlocking it
457 <p>Someone else is currently editing this file. At least, the file is marked so. Maybe, someone who was editing the file has forgotten to unlock it. In this case (and <b>only</b> in this case) you can unlock the file using this button:</p>
459 <form action=" $script " method="get">
460 <input type="hidden" name="file" value=" $virtual ">
461 <input type="hidden" name="command" value="unlock">
462 <p><input type="submit" value="Unlock file ' $virtual '"></p>
475 # Copy a file and return to directory view
477 # Params: 1. Reference to user input hash
478 # 2. Reference to config hash
480 # Return: Output of the command (Scalar Reference)
484 my ( $data , $config ) = @_ ;
485 my $physical = $data ->{ 'physical' };
486 my $virtual = encode_entities
( $data ->{ 'virtual' });
487 my $new_physical = $data ->{ 'new_physical' };
488 my $new_virtual = $data ->{ 'new_virtual' };
489 my $dir = upper_path
( $new_virtual );
490 $new_virtual = encode_entities
( $new_virtual );
492 return error
( "This editor is not able to copy directories." ) if (- d
$physical );
496 return error
( "A file or directory called ' $new_virtual ' does already exists and this editor is currently not able to ask to overwrite the existing file or directory." );
499 copy
( $physical , $new_physical ) or return error
( "Could not copy ' $virtual ' to ' $new_virtual '" );
501 my $output = redirect
( "http:// $ENV {'HTTP_HOST'} $script ?command=show&file= $dir " );
507 # Rename/move a file and return to directory view
509 # Params: 1. Reference to user input hash
510 # 2. Reference to config hash
512 # Return: Output of the command (Scalar Reference)
516 my ( $data , $config ) = @_ ;
517 my $physical = $data ->{ 'physical' };
518 my $virtual = $data ->{ 'virtual' };
519 my $new_physical = $data ->{ 'new_physical' };
520 my $new_virtual = $data ->{ 'new_virtual' };
521 my $dir = upper_path
( $new_virtual );
522 $new_virtual = encode_entities
( $new_virtual );
524 return error_in_use
( $virtual ) if ( $data ->{ 'uselist' }-> in_use ( $virtual ));
528 return error
( "A file or directory called ' $new_virtual ' does already exists and this editor is currently not able to ask to overwrite the existing file or directory." );
531 rename ( $physical , $new_physical ) or return error
( "Could not move/rename '" . encode_entities
( $virtual ). "' to ' $new_virtual '." );
533 my $output = redirect
( "http:// $ENV {'HTTP_HOST'} $script ?command=show&file= $dir " );
539 # Remove a file and return to directory view
541 # Params: 1. Reference to user input hash
542 # 2. Reference to config hash
544 # Return: Output of the command (Scalar Reference)
548 my ( $data , $config ) = @_ ;
549 my $physical = $data ->{ 'physical' };
550 my $virtual = $data ->{ 'virtual' };
552 return error
( "Deleting directories is currently unsupported" ) if (- d
$physical );
553 return error_in_use
( $virtual ) if ( $data ->{ 'uselist' }-> in_use ( $virtual ));
555 unlink ( $physical ) or return error
( "Could not delete file '" . encode_entities
( $virtual ). "'." );
557 my $output = redirect
( "http:// $ENV {'HTTP_HOST'} $script ?command=show&file=" . upper_path
( $virtual ));
563 # Remove a file from the list of used files and
564 # return to directory view
566 # Params: 1. Reference to user input hash
567 # 2. Reference to config hash
569 # Return: Output of the command (Scalar Reference)
573 my ( $data , $config ) = @_ ;
574 my $virtual = $data ->{ 'virtual' };
575 my $uselist = $data ->{ 'uselist' };
577 $uselist -> remove_file ( $virtual );
580 my $output = redirect
( "http:// $ENV {'HTTP_HOST'} $script ?command=show&file=" . upper_path
( $virtual ));
584 # it's true, baby ;-)
patrick-canterino.de