Initial version

diff --git a/devedit.pl b/devedit.pl
new file mode 100644 (file)
index 0000000..42e1d40
--- /dev/null
+++ b/devedit.pl
@@ -0,0 +1,106 @@
+#!C:/Programme/Perl/bin/perl.exe -w
+
+#
+# Dev-Editor
+#
+# Dev-Editor's main program
+#
+# Author:        Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+use CGI::Carp qw(fatalsToBrowser);
+
+use lib 'modules';
+
+use CGI;
+use Command;
+use File::UseList;
+use Output;
+use Tool;
+
+our $VERSION = '0.7';
+
+### Settings ###
+
+our %config = (
+               fileroot     => 'D:/Server/WWW/Root',
+               httproot     => '/',
+               uselist_file => 'uselist',
+               lock_file    => 'uselist.lock',
+               lock_timeout => '10'
+              );
+
+### End Settings ###
+
+# Read the most important form data
+
+my $cgi = new CGI;
+
+my $command = $cgi->param('command') || 'show';
+my $file    = $cgi->param('file')    || '/';
+
+# This check has to be performed first, or abs_path() will be confused
+
+if(-e clean_path($config{'fileroot'}."/".$file))
+{
+ if(my ($physical,$virtual) = check_path($config{'fileroot'},$file))
+ {
+  # Copied from old Dev-Editor (great idea)
+
+  my %dispatch = ('show'         => \&exec_show,
+                  'beginedit'    => \&exec_beginedit,
+                  'canceledit'   => \&exec_unlock,
+                  'endedit'      => \&exec_endedit,
+                  # 'mkdir'        => \&exec_mkdir,
+                  # 'mkfile'       => \&exec_mkfile,
+                  'workwithfile' => \&exec_workwithfile,
+                  # 'copy'         => \&exec_copy,
+                  # 'rename'       => \&exec_rename,
+                  'remove'       => \&exec_remove,
+                  'unlock'       => \&exec_unlock
+                 );
+
+  # Create a File::UseList object and load the list
+
+  my $uselist = new File::UseList(listfile => $config{'uselist_file'},
+                                  lockfile => $config{'lock_file'},
+                                  timeout  => $config{'lock_timeout'});
+
+  $uselist->lock or abort("Locking failed. Try it again in a moment. If the problem persists, ask someone to recreate the lockfile ($config{'lock_file'}).");
+  $uselist->load;
+
+  # Create a hash with data submitted by user
+  # (the CGI and the File::UseList objects will also be included)
+
+  my %data = (physical     => $physical,
+              virtual      => $virtual,
+              new_physical => '',
+              new_virtual  => '',
+              uselist      => $uselist,
+              cgi          => $cgi);
+
+  unless($dispatch{$command})
+  {
+   $uselist->unlock;
+   abort("Unknown command: $command");
+  }
+
+  my $output = &{$dispatch{$command}}(\%data,\%config); # Execute the command...
+
+  $uselist->unlock; # ... unlock the list with used files...
+  print $$output;   # ... and print the output of the command
+ }
+ else
+ {
+  abort("Accessing files and directories above the virtual root directory is forbidden.");
+ }
+}
+else
+{
+ abort("File/directory does not exist.");
+}
+
+#
+### End ###
\ No newline at end of file

diff --git a/modules/Command.pm b/modules/Command.pm
new file mode 100644 (file)
index 0000000..1a39d67
--- /dev/null
+++ b/modules/Command.pm
@@ -0,0 +1,480 @@
+package Command;
+
+#
+# Dev-Editor - Module Command
+#
+# Execute Dev-Editor's commands
+#
+# Author:        Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT
+            $script);
+
+use CGI qw(header
+           redirect);
+
+use File::Access;
+use File::Copy;
+
+use HTML::Entities;
+use Output;
+use POSIX qw(strftime);
+use Tool;
+
+$script = $ENV{'SCRIPT_NAME'};
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(exec_show
+             exec_beginedit
+             exec_endedit
+             exec_mkfile
+             exec_mkdir
+             exec_workwithfile
+             exec_copy
+             exec_rename
+             exec_remove
+             exec_unlock);
+
+# exec_show()
+#
+# View a directory or a file
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_show($$$)
+{
+ my ($data,$config) = @_;
+ my $physical       = $data->{'physical'};
+ my $virtual        = $data->{'virtual'};
+ my $output;
+
+ if(-d $physical)
+ {
+  # Create directory listing
+
+  my $direntries = dir_read($physical);
+  return error("Reading of directory $virtual failed") unless($direntries);
+
+  my $files = $direntries->{'files'};
+  my $dirs  = $direntries->{'dirs'};
+
+  $output .= htmlhead("Directory listing of $virtual");
+  $output .= equal_url($config->{'httproot'},$virtual);
+  $output .=  "<hr>\n\n<pre>\n";
+
+  # Create the link to the upper directory
+  # (only if we are not in the root directory)
+
+  unless($virtual eq "/")
+  {
+   my $upper = $physical."/..";
+   my @stat  = stat($upper);
+
+   $output .= "  [SUBDIR]  ";
+   $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
+   $output .= " " x 10;
+   $output .= "<a href=\"$script?command=show&file=".upper_path($virtual)."\">../</a>\n";
+  }
+
+  # Get the longest file/directory name
+
+  my $max_name_len = 0;
+
+  foreach(@$dirs,@$files)
+  {
+   my $length    = length($_);
+   $max_name_len = $length if($length > $max_name_len);
+  }
+
+  # Directories
+
+  foreach my $dir(@$dirs)
+  {
+   my @stat = stat($physical."/".$dir);
+
+   $output .= "  ";
+   $output .= "[SUBDIR]  ";
+   $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
+   $output .= " " x 10;
+   $output .= "<a href=\"$script?command=show&file=$virtual$dir/\">".encode_entities($dir)."/</a>\n";
+  }
+
+  # Files
+
+  foreach my $file(@$files)
+  {
+   my @stat      = stat($physical."/".$file);
+   my $virt_path = $virtual.$file;
+   my $in_use    = $data->{'uselist'}->in_use($virtual.$file);
+
+   $output .= " " x (10 - length($stat[7]));
+   $output .= $stat[7];
+   $output .= "  ";
+   $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
+   $output .= ($in_use) ? " (IN USE) " : " " x 10;
+   $output .= encode_entities($file);
+   $output .= " " x ($max_name_len - length($file))."\t  (";
+   $output .= "<a href=\"$script?command=show&file=$virt_path\">View</a> | ";
+
+   $output .= ($in_use)
+              ? '<span style="color:#C0C0C0">Edit</span>'
+              : "<a href=\"$script?command=beginedit&file=$virt_path\">Edit</a>";
+
+   $output .= " | <a href=\"$script?command=workwithfile&file=$virt_path\">Do other stuff</a>)\n";
+  }
+
+  $output .= "</pre>\n\n<hr>\n\n";
+  $output .= <<END;
+<table border="0">
+<tr>
+<td>Create new directory:</td>
+<td>$virtual <input type="text" name="newdirname"> <input type="submit" value="Create!"></td>
+</tr>
+<tr>
+<td>Create new file:</td>
+<td>$virtual <input type="text" name="newfilename"> <input type="submit" value="Create!"></td>
+</tr>
+</table>
+
+<hr>
+END
+  $output .= htmlfoot;
+ }
+ else
+ {
+  # View a file
+
+  # Check on binary files
+
+  if(-B $physical)
+  {
+   # Binary file
+
+   return error("This editor is not able to view/edit binary files.");
+  }
+  else
+  {
+   # Text file
+
+   $output  = htmlhead("Contents of file $virtual");
+   $output .= equal_url($config->{'httproot'},$virtual);
+   $output .= dir_link($virtual);
+
+   $output .= '<div style="background-color:#FFFFE0;border:1px solid black;margin-top:10px;width:100%">'."\n";
+   $output .= '<pre style="color:#0000C0;">'."\n";
+   $output .= encode_entities(${file_read($physical)});
+   $output .= "\n</pre>\n</div>";
+
+   $output .= htmlfoot;
+  }
+ }
+
+ return \$output
+}
+
+# exec_beginedit
+#
+# Lock a file and display a form to edit it
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_beginedit($$)
+{
+ my ($data,$config) = @_;
+ my $physical       = $data->{'physical'};
+ my $virtual        = $data->{'virtual'};
+ my $uselist        = $data->{'uselist'};
+
+ return error("You cannot edit directories.") if(-d $physical);
+ return error_in_use($virtual) if($uselist->in_use($virtual));
+
+ # Check on binary files
+
+ if(-B $physical)
+ {
+  # Binary file
+
+  return error("This editor is not able to view/edit binary files.");
+ }
+ else
+ {
+  # Text file
+
+  $uselist->add_file($virtual);
+  $uselist->save;
+
+  my $dir     = upper_path($virtual);
+  my $content = encode_entities(${file_read($physical)});
+
+  my $output = htmlhead("Edit file $virtual");
+  $output   .= equal_url($config->{'httproot'},$virtual);
+  $output   .= <<END;
+<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>
+
+<form action="$ENV{'SCRIPT_NAME'}" method="get">
+<input type="hidden" name="command" value="canceledit">
+<input type="hidden" name="file" value="$virtual">
+<p><input type="submit" value="Exit WITHOUT saving"></p>
+</form>
+
+<form action="$ENV{'SCRIPT_NAME'}" method="post">
+<input type="hidden" name="command" value="endedit">
+<input type="hidden" name="file" value="$virtual">
+
+<table width="100%" border="1">
+<tr>
+<td width="50%" align="center"><input type="checkbox" name="save_as_new_file" value="1"> Save as new file: $dir <input type=text name="new_filename" value=""></td>
+<td width="50%" align="center"><input type="checkbox" name="encode_iso" value="1"> Encode ISO-8859-1 special chars</td>
+</tr>
+<tr>
+<td align="center"><input type="reset" value="Reset form"></td>
+<td align="center"><input type="submit" value="Save and exit"></td>
+</tr>
+</table>
+
+<textarea name="filecontent" rows="25" cols="120">$content</textarea>
+</form>
+END
+
+  $output .= htmlfoot;
+
+  return \$output;
+ }
+}
+
+# exec_endedit()
+#
+# Save a file, unlock it and return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_endedit($$)
+{
+ my ($data,$config) = @_;
+ my $physical       = $data->{'physical'};
+ my $virtual        = $data->{'virtual'};
+ my $content        = $data->{'cgi'}->param('filecontent');
+
+ return error("You cannot edit directories.") if(-d $physical);
+
+ if($data->{'cgi'}->param('encode_iso'))
+ {
+  # Encode all ISO-8859-1 special chars
+
+  $content = encode_entities($content,"\200-\377");
+ }
+
+ if(file_save($physical,\$content))
+ {
+  # Saving of the file was successfull - so unlock it!
+
+  return exec_unlock($data,$config);
+ }
+ else
+ {
+  return error("Saving of file '$virtual' failed'");
+ }
+}
+
+# exec_mkfile()
+#
+# Create a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_mkfile($$)
+{
+ 1;
+}
+
+# exec_mkdir()
+#
+# Create a directory and return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_mkdir($$)
+{
+ 1;
+}
+
+# exec_workwithfile()
+#
+# Display a form for renaming/copying/deleting/unlocking a file
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_workwithfile($$)
+{
+ my ($data,$config) = @_;
+ my $physical       = $data->{'physical'};
+ my $virtual        = $data->{'virtual'};
+ my $unused         = $data->{'uselist'}->unused($virtual);
+
+ my $output = htmlhead("Work with file $virtual");
+ $output   .= equal_url($config->{'httproot'},$virtual);
+ $output   .= dir_link($virtual);
+ $output   .= "<p><b>Note:</b> On UNIX systems, filenames are <b>case-sensitive</b>!</p>\n\n";
+
+ $output .= "<p>Someone else is currently editing this file. So not all features are available.</p>\n\n" unless($unused);
+
+ $output .= <<END;
+<hr>
+
+<h2>Copy</h2>
+
+<p>Copy file '$virtual' to: <input type="text" name="newfilename" size="50"> <input type="submit" value="Copy!"></p>
+
+<hr>
+
+END
+
+ if($unused)
+ {
+  $output .= <<END;
+<h2>Move/rename</h2>
+
+<p>Move/Rename file '$virtual' to: <input type="text" name="newfilename" size="50"> <input type="submit" value="Move/Rename!"></p>
+
+<hr>
+
+<h2>Delete</h2>
+
+<form action="$script" method="get">
+<input type="hidden" name="file" value="$virtual">
+<input type="hidden" name="command" value="remove">
+<p><input type="submit" value="Delete file '$virtual'!"></p>
+</form>
+END
+ }
+ else
+ {
+  $output .= <<END;
+<h2>Unlock file</h2>
+
+<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>
+
+<form action="$script" method="get">
+<input type="hidden" name="file" value="$virtual">
+<input type="hidden" name="command" value="unlock">
+<p><input type="submit" value="Unlock file '$virtual'"></p>
+</form>
+END
+ }
+
+ $output .= "\n<hr>";
+ $output .= htmlfoot;
+
+ return \$output;
+}
+
+# exec_copy()
+#
+# Copy a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_copy($$)
+{
+ 1;
+}
+
+# exec_rename()
+#
+# Rename/move a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_rename($$)
+{
+ 1;
+}
+
+# exec_remove()
+#
+# Remove a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_remove($$)
+{
+ my ($data,$config) = @_;
+ my $physical       = $data->{'physical'};
+ my $virtual        = $data->{'virtual'};
+
+ return error_in_use($virtual) if($data->{'uselist'}->in_use($virtual));
+
+ my $dir = upper_path($virtual);
+
+ unlink($physical);
+
+ my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
+ return \$output;
+}
+
+# exec_unlock()
+#
+# Remove a file from the list of used files and
+# return to directory view
+#
+# Params: 1. Reference to user input hash
+#         2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_unlock($$)
+{
+ my ($data,$config) = @_;
+ my $physical       = $data->{'physical'};
+ my $virtual        = $data->{'virtual'};
+ my $uselist        = $data->{'uselist'};
+
+ my $dir = upper_path($virtual);
+
+ $uselist->remove_file($virtual);
+ $uselist->save;
+
+ my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
+ return \$output;
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file

diff --git a/modules/File/Access.pm b/modules/File/Access.pm
new file mode 100644 (file)
index 0000000..81b6851
--- /dev/null
+++ b/modules/File/Access.pm
@@ -0,0 +1,146 @@
+package File::Access;
+
+#
+# Dev-Editor - Module File::Access
+#
+# Some simple routines for doing things with files
+# with only one command
+#
+# Author:        Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-20-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT);
+
+use Carp qw(croak);
+use File::Spec;
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(dir_read
+             file_create
+             file_read
+             file_save);
+
+# dir_read()
+#
+# Collect the files and directories in a directory
+#
+# Params: Directory
+#
+# Return: Hash reference: dirs  => directories
+#                         files => files
+
+sub dir_read($)
+{
+ my $dir = shift;
+ local *DIR;
+
+ return unless(-d $dir);
+
+ # Get all the entries in the directory
+
+ opendir(DIR,$dir) or return;
+ my @entries = readdir(DIR);
+ closedir(DIR) or return;
+
+ # Sort the entries
+
+ @entries = sort(@entries);
+
+ my @files;
+ my @dirs;
+
+ foreach my $entry(@entries)
+ {
+  next if($entry eq "." || $entry eq "..");
+
+  if(-d File::Spec->canonpath($dir."/".$entry))
+  {
+   push(@dirs,$entry);
+  }
+  else
+  {
+   push(@files,$entry);
+  }
+ }
+
+ return {dirs => \@dirs, files => \@files};
+}
+
+# file_create()
+#
+# Create a file
+#
+# Params: File to create
+#
+# Return: true on success;
+#         false on error or if the file already exists
+
+sub file_create($)
+{
+ my $file = shift;
+ local *FILE;
+
+ return if(-e $file);
+
+ open(FILE,">",$file) or return;
+ close(FILE)          or return;
+
+ return 1;
+}
+
+# file_read()
+#
+# Read out a file completely
+#
+# Params: File
+#
+# Return: Contents of the file (Scalar Reference)
+
+sub file_read($)
+{
+ my $file = shift;
+ local *FILE;
+
+ open(FILE,"<",$file);
+ read(FILE, my $content, -s $file);
+ close(FILE);
+
+ return \$content;
+}
+
+# file_save()
+#
+# Save a file
+#
+# Params: 1. File
+#         2. File content as Scalar Reference
+#
+# Return: Status Code (Boolean)
+
+sub file_save($$)
+{
+ my ($file,$content) = @_;
+ my $temp            = $file.".temp";
+ local *FILE;
+
+ open(FILE,">",$temp) or return;
+ print FILE $$content;
+ close(FILE) or return;
+
+ rename($temp,$file) or return;
+
+ return 1;
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file

diff --git a/modules/File/UseList.pm b/modules/File/UseList.pm
new file mode 100644 (file)
index 0000000..626bd90
--- /dev/null
+++ b/modules/File/UseList.pm
@@ -0,0 +1,247 @@
+package File::UseList;
+
+#
+# File::UseList
+#
+# Fuehren einer Liste mit Dateien, auf die zur Zeit zugegriffen wird
+# (basiert auf Filing::UseList von Roland Bluethgen <calocybe@web.de>)
+#
+# Autor:            Patrick Canterino <patshaping@gmx.net>
+# Letzte Aenderung: 20.9.2003
+#
+
+use strict;
+
+use Carp qw(croak);
+
+our $VERSION = '1.0';
+
+# new()
+#
+# Konstruktor
+#
+# Parameter: Hash: listfile => Datei mit der Liste der benutzten Dateien
+#                  lockfile => Lock-Datei
+#                  timeout  => Lock-Timeout in Sekunden (Standard: 10)
+#
+# Rueckgabe: File::UseList-Objekt
+
+sub new(%)
+{
+ my ($class,%args) = @_;
+
+ # Pruefen, ob wir alle Informationen erhalten haben
+
+ croak "Missing path of list file" unless($args{'listfile'});
+ croak "Missing path of lockfile"  unless($args{'lockfile'});
+ $args{'timeout'} = 10             unless($args{'timeout'});  # Standard-Timeout
+
+ my $self = \%args;
+ $self->{'files'} = [];
+
+ return bless($self,$class);
+}
+
+# lock()
+#
+# Datei mit Liste sperren
+# (Lock-Datei loeschen)
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub lock
+{
+ my $self     = shift;
+ my $lockfile = $self->{'lockfile'};
+ my $timeout  = $self->{'timeout'};
+
+ # Versuche, einmal pro Sekunde die Datei zu loeschen
+ # bis das Timeout erreicht ist
+
+ for(my $x=$timeout;$x>=0;$x--)
+ {
+  unlink($lockfile) and return 1;
+  sleep(1);
+ }
+
+ # Timeout
+
+ return;
+}
+
+# unlock()
+#
+# Datei mit Liste freigeben
+# (Lock-Datei anlegen)
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub unlock
+{
+ my $self     = shift;
+ my $lockfile = $self->{'lockfile'};
+ local *LOCKFILE;
+
+ return 1 if(-f $lockfile); # Hmmm...
+
+ open(LOCKFILE,">",$lockfile) or return;
+ close(LOCKFILE)              or return;
+
+ return 1;
+}
+
+# load()
+#
+# Liste mit Dateien laden
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub load
+{
+ my $self = shift;
+ my $file = $self->{'listfile'};
+ local *FILE;
+
+ # Datei auslesen und zeilenweise aufteilen
+
+ open(FILE,"<".$file) or return;
+ read(FILE, my $content, -s $file);
+ close(FILE)          or return;
+
+ my @files = split(/\015\012|\012|\015/,$content);
+
+ # Unbrauchbare Zeilen entfernen
+
+ for(my $x=0;$x<@files;$x++)
+ {
+  if($files[$x] eq "" || $files[$x] =~ /^\s+$/)
+  {
+   splice(@files,$x,1);
+   $x--; # <-- sehr wichtig!
+  }
+ }
+
+ $self->{'files'} = \@files;
+ return 1;
+}
+
+# save()
+#
+# Liste mit Dateien speichern
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub save
+{
+ my $self  = shift;
+ my $file  = $self->{'listfile'};
+ my $temp  = $file.".temp";
+ my $files = $self->{'files'};
+ local *FILE;
+
+ my $data = (@$files) ? join("\n",@$files)."\n" : '';
+
+ open(FILE,">",$temp) or return;
+ print FILE $data;
+ close(FILE)          or return;
+
+ rename($temp,$file) and return 1;
+
+ # Mist
+
+ return;
+}
+
+# add_file()
+#
+# Datei zur Liste hinzufuegen
+#
+# Parameter: Datei
+
+sub add_file($)
+{
+ my ($self,$file) = @_;
+ my $files = $self->{'files'};
+
+ # Pruefen, ob die Datei nicht schon in der Liste vorhanden ist
+
+ return if($self->in_use($file));
+
+ push(@$files,$file);
+}
+
+# remove_file()
+#
+# Datei aus der Liste entfernen
+#
+# Parameter: Datei
+
+sub remove_file($)
+{
+ my ($self,$file) = @_;
+ my $files = $self->{'files'};
+
+ # Pruefen, ob die Datei ueberhaupt in der Liste vorhanden ist
+
+ return if($self->unused($file));
+
+ # Datei entfernen
+
+ for(my $x=0;$x<@$files;$x++)
+ {
+  if($files->[$x] eq $file)
+  {
+   splice(@$files,$x,1);
+   last;
+  }
+ }
+}
+
+# in_use()
+#
+# Pruefen, ob eine Datei in der Liste vorhanden ist
+#
+# Parameter: Zu pruefende Datei
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub in_use($)
+{
+ my ($self,$file) = @_;
+ my $files = $self->{'files'};
+
+ foreach(@$files)
+ {
+  return 1 if($_ eq $file);
+ }
+
+ return;
+}
+
+# unused()
+#
+# Pruefen, ob eine Datei nicht in der Liste vorhanden ist
+#
+# Parameter: Zu pruefende Datei
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub unused($)
+{
+ return not shift->in_use(shift);
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### Ende ###
\ No newline at end of file

diff --git a/modules/Output.pm b/modules/Output.pm
new file mode 100644 (file)
index 0000000..e8d4bad
--- /dev/null
+++ b/modules/Output.pm
@@ -0,0 +1,174 @@
+package Output;
+
+#
+# Dev-Editor - Module Output
+#
+# HTML generating routines
+#
+# Author:        Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT);
+
+use CGI qw(header);
+use HTML::Entities;
+use Tool;
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(htmlhead
+             htmlfoot
+             error
+             abort
+             error_in_use
+             equal_url
+             dir_link);
+
+# htmlhead()
+#
+# Generate the head of a HTML document
+#
+# Params: Title and heading
+#
+# Return: Head for the HTML document
+
+sub htmlhead($)
+{
+ my $title = shift;
+
+ my $html = header(-type => "text/html");
+
+ $html .= <<END;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+"http://www.w3.org/TR/html4/loose.dtd">
+
+<html>
+<head>
+<title>$title</title>
+<meta http-equiv="content-type" content="text/html; charset=iso-8859-1">
+</head>
+<body bgcolor="#FFFFFF">
+
+<h1>$title</h1>
+
+END
+
+ return $html;
+}
+
+# htmlfoot()
+#
+# Generate the foot of a HTML document
+#
+# Params: -nothing-
+#
+# Return: Foot for the HTML document
+
+sub htmlfoot
+{
+ return "\n</body>\n</html>";
+}
+
+# error()
+#
+# Format an error message
+#
+# Params: Error message
+#
+# Return: Formatted message (Scalar Reference)
+
+sub error($)
+{
+ my $message = shift;
+
+ my $output = htmlhead("Error");
+ $output   .= "<p>$message</p>";
+ $output   .= htmlfoot;
+
+ return \$output;
+}
+
+# abort()
+#
+# Print and error message and exit script
+#
+# Params: Error message
+
+sub abort($)
+{
+ my $output = error(shift);
+ print $$output;
+ exit;
+}
+
+# error_in_use()
+#
+# Create a message, that a file is currently in use
+#
+# Params: File, which is in use
+#
+# Return: Formatted message (Scalar Reference)
+
+sub error_in_use($)
+{
+ my $file = encode_entities(shift);
+ my $dir  = upper_path($file);
+
+ my $message = htmlhead("File in use");
+ $message   .= "<p>The file '$file' is currently editet by someone else.</p>\n\n";
+ $message   .= "<a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\"><p>Back to $dir</a></p>";
+ $message   .= htmlfoot;
+
+ return \$message;
+}
+
+# equal_url()
+#
+# Create an "equals"-link and print it out
+#
+# Params: 1. HTTP root
+#         2. Relative path
+#
+# Return: Formatted link (String)
+
+sub equal_url($$)
+{
+ my ($root,$path) = @_;
+ my $url;
+
+ $root =~ s!/$!!;
+ $path =~ s!^/!!;
+ $url  =  $root."/".$path;
+ $url  =  encode_entities($url);
+
+ return "<p>(equals <a href=\"$url\" target=\"_blank\">$url</a>)</p>\n\n";
+}
+
+# dir_link()
+#
+# Create the link to the directory of a file and
+# print it out
+#
+# Params: File
+#
+# Return: Formatted link (String)
+
+sub dir_link($)
+{
+ my $dir = upper_path(shift);
+ $dir    = encode_entities($dir);
+
+ return "<p><a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\">Back to $dir</a></p>\n\n";
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file

diff --git a/modules/Tool.pm b/modules/Tool.pm
new file mode 100644 (file)
index 0000000..47b73e6
--- /dev/null
+++ b/modules/Tool.pm
@@ -0,0 +1,171 @@
+package Tool;
+
+#
+# Dev-Editor - Module Tool
+#
+# Some shared sub routines
+#
+# Author:        Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT);
+
+use Carp qw(croak);
+
+use Cwd qw(abs_path);
+use File::Basename;
+use File::Spec;
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(check_path
+             clean_path
+             filemode
+             upper_path);
+
+# check_path()
+#
+# Check, if a virtual path is above a virtual root directory
+# (currently no check if the path exists - check otherwise!)
+#
+# Params: 1. Virtual root directory
+#         2. Virtual path to check
+#
+# Return: Array with the physical and the cleaned virtual path;
+#         false, if the submitted path is above the root directory
+
+sub check_path($$)
+{
+ my ($root,$path) = @_;
+
+ # Clean root path
+
+ $root = abs_path($root);
+ $root = File::Spec->canonpath($root);
+
+ $path =~ s!^/{1}!!;
+ $path = $root."/".$path;
+
+ unless(-d $path)
+ {
+  # The path points to a file
+  # We have to extract the directory name and create the absolute path
+
+  my @pathinfo = fileparse($path);
+
+  # This is only to avoid errors
+
+  my $basename = $pathinfo[0] || '';
+  my $dir      = $pathinfo[1] || '';
+  my $ext      = $pathinfo[2] || '';
+
+  $dir = abs_path($dir);
+
+  $path = $dir."/".$basename.$ext;
+ }
+ else
+ {
+  $path = abs_path($path);
+ }
+
+ $path = File::Spec->canonpath($path);
+
+ # Check if the path is above the root directory
+
+ return if(index($path,$root) == -1);
+
+ # Create short path name
+
+ my $short_path = substr($path,length($root));
+ $short_path =~ tr!\\!\/!;
+ $short_path = "/".$short_path unless($short_path =~ m!^/!);
+ $short_path = $short_path."/" if($short_path !~ m!/$! && -d $path);
+
+ return ($path,$short_path);
+}
+
+# clean_path()
+#
+# Clean up a path logically and replace backslashes with
+# normal slashes
+#
+# Params: Path
+#
+# Return: Cleaned path
+
+sub clean_path($)
+{
+ my $path =  shift;
+ $path    =  File::Spec->canonpath($path);
+ $path    =~ tr!\\!/!;
+
+ return $path;
+}
+
+# filemode()
+#
+# Creates a readable string of a UNIX filemode number
+# (copied from Tool.pm of Dev-Editor 0.1.4)
+#
+# Params: Filemode as number
+#
+# Return: Filemode as readable string
+
+sub filemode($)
+{
+    my ($modestring, $ur, $uw, $ux, $gr, $gw, $gx, $or, $ow, $ox);
+    my $mode = shift;
+
+    $ur = ($mode & 0400) ? "r" : "-";       # User Read
+    $uw = ($mode & 0200) ? "w" : "-";       # User Write
+    $ux = ($mode & 0100) ? "x" : "-";       # User eXecute
+    $gr = ($mode & 0040) ? "r" : "-";       # Group Read
+    $gw = ($mode & 0020) ? "w" : "-";       # Group Write
+    $gx = ($mode & 0010) ? "x" : "-";       # Group eXecute
+    $or = ($mode & 0004) ? "r" : "-";       # Other Read
+    $ow = ($mode & 0002) ? "w" : "-";       # Other Write
+    $ox = ($mode & 0001) ? "x" : "-";       # Other eXecute
+
+    # build a readable mode string (rwxrwxrwx)
+    return $ur . $uw . $ux . $gr . $gw . $gx . $or . $ow . $ox;
+}
+
+# upper_path()
+#
+# Truncate a path in one of the following ways:
+#
+# - If the path points to a directory, the upper directory
+#   will be returned.
+# - If the path points to a file, the directory containing
+#   the file will be returned.
+#
+# Params: Path
+#
+# Return: Truncated path
+
+sub upper_path($)
+{
+ my $path =  shift;
+ $path    =~ tr!\\!/!;
+
+ unless($path eq "/")
+ {
+  $path = substr($path,0,-1) if($path =~ m!/$!);
+  $path = substr($path,0,rindex($path,"/"));
+  $path = $path."/";
+ }
+
+ return $path;
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file

diff --git a/uselist b/uselist
new file mode 100644 (file)
index 0000000..e69de29

diff --git a/uselist.lock b/uselist.lock
new file mode 100644 (file)
index 0000000..e69de29