First pass at adding key files
This commit is contained in:
dsainty
2383
site/slowtwitch.com/cgi-bin/articles/GT/FileMan/Commands.pm
Normal file
2383
site/slowtwitch.com/cgi-bin/articles/GT/FileMan/Commands.pm
Normal file
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,145 @@
|
||||
# ====================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::FileMan::Commands::Language
|
||||
# Author: Jason Rhinelander
|
||||
# CVS Info : 087,068,085,094,083
|
||||
# $Id: Language.pm,v 1.4 2006/02/11 04:54:51 jagerman Exp $
|
||||
#
|
||||
# Copyright (c) 2006 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ====================================================================
|
||||
#
|
||||
# Description:
|
||||
# Language variables for GT::FileMan::Commands
|
||||
#
|
||||
|
||||
package GT::FileMan::Commands::Language;
|
||||
use strict;
|
||||
use Exporter();
|
||||
use vars qw/@EXPORT @ISA %LANGUAGE/;
|
||||
@EXPORT = qw/%LANGUAGE/;
|
||||
@ISA = qw/Exporter/;
|
||||
|
||||
my $download_suffix = '<b>%s</b> (%s bytes) - </font><a href=\"javascript:top.js_download(\\\'%s\\\')\">Download</a>';
|
||||
|
||||
%LANGUAGE = (
|
||||
UPLOAD_MODE => "<font color=green>File <b>%s</b> was successfully uploaded in <b>%s</b> mode.</font>",
|
||||
MSG_LOG_OFF => "<font color=green>Please enter username and password to login.</font>",
|
||||
MSG_MULTI_UPLOAD => "<font color=green><b>%s</b> files have been successfully uploaded.</font>",
|
||||
MSG_CHMOD_CHANGED => "<font color=green>Permissions on <b>%s</b> file(s) have been updated successfully.</font>",
|
||||
MSG_SEACH_FOUND => "<font color=green>Your search found <b>%s</b> results.</font>",
|
||||
MSG_REPLA_FOUND => "<font color=green>Your search and replace updated <b>%s</b> files in %s</font>",
|
||||
MSG_SEACH_NOTFOUND => "<font color=red>Your search did not produce any results.</font>",
|
||||
MSG_FILE_EDITING => "<font color=green>Editing $download_suffix",
|
||||
MSG_FILE_VIEWING => "<font color=green>Viewing $download_suffix",
|
||||
MSG_FILE_CONTENTS => "<font color=green>Viewing contents of $download_suffix",
|
||||
MSG_FILE_CREATED => "<font color=green><b>%s</b> has been created.</font>",
|
||||
MSG_FILE_EDITED => "<font color=green>Changes to <b>%s</b> have been saved.</font>",
|
||||
MSG_DIR_CREATED => "<font color=green><b>%s</b> directory has been created.</font>",
|
||||
MSG_PREFERENCES => "<font color=green>Your options have been saved.</font>",
|
||||
MSG_UNCOMPRESS => "<font color=green><b>%s</b> file has been unarchived.</font>",
|
||||
MSG_TAR_CANCEL => "<font color=red>Creation of tar file has been cancelled.</font>",
|
||||
MSG_TAR_CREATED => "<font color=green>Tar file <b>%s</b> has been created.</font>",
|
||||
MSG_COPIED => "<font color=green> %s selected file/directory(s) have been copied (%s can not be copied).</font>",
|
||||
MSG_MOVED => "<font color=green> %s selected file/directory(s) have been moved (%s can not be moved).</font>",
|
||||
MSG_DEL_SUCC => "<font color=green><b>%s</b> files and <b>%s</b> directories have been removed.</font>",
|
||||
MSG_DEL_CURR => "<font color=green>You've removed the directory: %s</font>",
|
||||
MSG_DEL_ALL => "<font color=green>You've removed the directory, and all contents recursively.</font>",
|
||||
MSG_DEL_SKIP => "<font color=green>You've skipped the directory: %s</font>",
|
||||
MSG_DEL_CANC => "<font color=green>You've cancelled deleting the directory</font>",
|
||||
MSG_DEL_ALL_SUCC => "<font color=green>All child dirs and files on the selected directorys has been removed. </font>",
|
||||
MSG_CONTINUE => "<body bgcolor='#E9E9E9' text='#000066' leftmargin=5 topmargin=5><font color=red face=arial size=2> <b><a href='%s?fdo=cmd_show_passwd&work_path=%s&%s'>click here</a> to continue.</font></body>",
|
||||
MSG_PWD_CHANGED => "<font color=green>Your password was changed. </font>",
|
||||
MSG_DEMO => "<font color=red>Disabled in Demo.</font>",
|
||||
MSG_USER_ADDED => "%s was added successfully.",
|
||||
MSG_USER_DELETED => "%s was deleted successfully.",
|
||||
MSG_USER_RMALL => "Users were deleted sucessfully.",
|
||||
ERR_DEL => "<font color=red>Can not remove file(s)</font>",
|
||||
ERR_CHMOD => "<font color=red>Can not change mode </font>",
|
||||
ERR_FILE_OPEN => "<font color=red>Can not open file: %s</font>",
|
||||
ERR_FILE_EMPTY => "<font color=red>File <b>%s</b> is empty.</font>",
|
||||
ERR_FILE_EXISTS => "<font color=red>File <b>%s</b> exists.</font>",
|
||||
ERR_FILE_NOT_EXISTS => "<font color=red>File <b>%s</b> does not exist.</font>",
|
||||
ERR_FILE_PERM => "<body bgcolor='#E9E9E9' text='#000066' leftmargin=5 topmargin=5><font color=red face=arial size=2> <b>Sorry, but we don't have write access to the htaccess files: '%s' and '%s'</font></BODY>",
|
||||
ERR_FILE_PEM => "<font color=red>The <b>%s</b> directory is not writeable.</font>",
|
||||
ERR_NOT_TEXT_FILE => "<font color=red>File <b>%s</b> is not a text file.</font>",
|
||||
ERR_DIR_NOT_EXISTS => "<font color=red>Directory <b>%s</b> does not exist.</font>",
|
||||
ERR_DIR_PEM => "<font color=red>The <b>%s</b> is not writeable.</font>",
|
||||
ERR_DIR_PERM => "<font color=red>Please check permission.</font>",
|
||||
ERR_NOT_ISFILE => "<font color=red><b>%s</b> is a directory.</font>",
|
||||
ERR_TMP_FILE => "<font color=red>Can not open temp file.</font>",
|
||||
ERR_FREE_SPC => "<font color=red>Upload: Not enough free space to upload that file.</font>",
|
||||
ERR_RM_FILE => "<font color=red>Unable to remove file: %s. Reason: %s</font>",
|
||||
ERR_UPLOAD => "<font color=red>Unable to upload file: %s. Reason: %s.</font>",
|
||||
ERR_FILE_SAVE => "<font color=red>Cannot save file %s. Check permissions.</font>",
|
||||
ERR_DIR_EXISTS => "<font color=red>Directory %s already exists.</font>",
|
||||
ERR_NAME => "<font color=red>Illegal Characters in Directory. Please use letters, numbers, - and _ only.</font>",
|
||||
ERR_FILE_NAME1 => "No double .. allowed in file names.",
|
||||
ERR_FILE_NAME2 => "No leading . in file names.",
|
||||
ERR_READ_DIR => "<font color=red>Can not open dir: %s. Reason: %s</font>",
|
||||
ERR_DIR_DEEP => "Directory level too deep.",
|
||||
ERR_DISK_SPACE => "<font color=red>Not enough space to save it (free space is %s kb)</font>",
|
||||
ERR_UNCOMPRESS => "<font color=red>Select files or directories before to uncompress.</font>",
|
||||
ERR_TAR => "<font color=red>Error: %s.</font>",
|
||||
ERR_TAR_NOT_EXISTS => "<font color=red>Can not create a tar file: %s</font>",
|
||||
ERR_TAR_PEM => "<font color=red>Can not create a tar file <b>%s</b>. Check permission.</font>",
|
||||
ERR_DOWNLOAD => "<font color=red>You selected a directory !</font>",
|
||||
ERR_LOGIN => "<font color=red>Invalid Username and Password.</font>",
|
||||
ERR_INVALID => "<font color=red>Input value has invalid characters : <b>%s</b></font> ",
|
||||
ERR_NOT_FILE => "<font color=red>The %s is not a file</font>",
|
||||
ERR_OLD_PASSWORD => "<font color=red>Invalid Old password</font>",
|
||||
ERR_NEW_PASSWORD => "<font color=red>New password must be more than 3 character</font>",
|
||||
ERR_OPEN_FILE => "<font color=red>Can not open %s file, reason: %s</font>",
|
||||
ERR_WRITEABLE => "<font color=red>Can not save %s file, reason: %s</font>",
|
||||
ERR_NO_AZIP => "<font color=red>Please install the Archive::Zip library which is required.</font>",
|
||||
ERR_NO_GZIP => "<font color=red>Please install the Compress::Zlib library which is required.</font>",
|
||||
COBALT_NOREMOTE => "FileMan is not currently running under server authentication!",
|
||||
ERR_VERSION => "<font color=red>This action does not support for your current version!</font>",
|
||||
ERR_PRINT => "Please select the files which are required text or image files",
|
||||
PRINT_NEXT => "<a href='%s'><font face='Verdana, Arial, Helvetica, sans-serif' size=2>Print Next</font></a>",
|
||||
COBALT_NOUSER => "Unable to lookup user '%s'",
|
||||
COBALT_BADUID => "Invalid user '%s' (%s)",
|
||||
COBALT_CANTSU => "Can't switch to user '%s' (%s,%s). Reason: '%s'",
|
||||
COBALT_BADDIR => "Invalid home directory '%s'. It does not look like a standard Raq director.",
|
||||
COBALT_BADGROUP => "This program is restricted to site administrators only. You must be in the site administer group in order to use this.",
|
||||
FILETYPE_IMAGE => 'Image file',
|
||||
FILETYPE_TEXT => 'Text file',
|
||||
FILETYPE_SCRIPT => 'Script file',
|
||||
FILETYPE_COMPRESSED => 'Compressed file',
|
||||
FILETYPE_HTML => 'HTML file',
|
||||
FILETYPE_SOUND => 'Audio file',
|
||||
FILETYPE_BINARY => 'Binary file',
|
||||
FILETYPE_DOC => 'MS Word',
|
||||
FILETYPE_XLS => 'MS Excel',
|
||||
FILETYPE_PDF => 'PDF file',
|
||||
FILETYPE_FOLDER => 'File Folder',
|
||||
FILETYPE_UNKNOWN => 'Unknown file',
|
||||
FILETYPE_EXT => '%s file',
|
||||
FILECOL_NAME => 'Name',
|
||||
FILECOL_SIZE => 'Size',
|
||||
FILECOL_DATE => 'Modified',
|
||||
FILECOL_PERM => 'Permissions',
|
||||
FILECOL_USER => 'Owner',
|
||||
FILECOL_TYPE => 'File Type',
|
||||
FILECOL_VIEW => 'View',
|
||||
DATE_SHORT_JAN => 'Jan',
|
||||
DATE_SHORT_FEB => 'Feb',
|
||||
DATE_SHORT_MAR => 'Mar',
|
||||
DATE_SHORT_APR => 'Apr',
|
||||
DATE_SHORT_MAY => 'May',
|
||||
DATE_SHORT_JUN => 'Jun',
|
||||
DATE_SHORT_JUL => 'Jul',
|
||||
DATE_SHORT_AUG => 'Aug',
|
||||
DATE_SHORT_SEP => 'Sep',
|
||||
DATE_SHORT_OCT => 'Oct',
|
||||
DATE_SHORT_NOV => 'Nov',
|
||||
DATE_SHORT_DEC => 'Dec',
|
||||
DIR_PARENT => 'Parent Directory',
|
||||
README => 'Readme File',
|
||||
COMMAND_TIMEOUT => 'Command timed out',
|
||||
COMMAND_KILLFAIL => 'Unable to kill process (%s): %s',
|
||||
EXTRACT_FILE_OK => '%s... okay',
|
||||
EXTRACT_FILE_SKIP => '%s... skipped',
|
||||
);
|
||||
|
||||
1;
|
||||
442
site/slowtwitch.com/cgi-bin/articles/GT/FileMan/Diff.pm
Normal file
442
site/slowtwitch.com/cgi-bin/articles/GT/FileMan/Diff.pm
Normal file
@ -0,0 +1,442 @@
|
||||
# ==================================================================
|
||||
# File manager - enhanced web based file management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# Revision : $Id: Diff.pm,v 1.9 2004/02/17 01:33:07 jagerman Exp $
|
||||
#
|
||||
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
# Redistribution in part or in whole strictly prohibited. Please
|
||||
# see LICENSE file for full details.
|
||||
# ==================================================================
|
||||
|
||||
package GT::FileMan::Diff;
|
||||
# ==================================================================
|
||||
# This module is based off the example scripts distributed with Algorthim::Diff
|
||||
#
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION %HTML_ESCAPE);
|
||||
use GT::File::Diff;
|
||||
|
||||
$VERSION = sprintf "%d.%03d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
|
||||
%HTML_ESCAPE = (
|
||||
'&' => '&',
|
||||
'<' => '<',
|
||||
'>' => '>',
|
||||
'"' => '"'
|
||||
);
|
||||
|
||||
my $File_Length_Difference = 0;
|
||||
|
||||
sub diff {
|
||||
# -----------------------------------------------------------------------------
|
||||
# Takes two filenames, or two array refs, and returns a text diff. See also
|
||||
# html_diff. Optionally takes an additional number - if provided, you'll get
|
||||
# a unified context diff with however many lines of context as you passed in for
|
||||
# this value, otherwise you'll get a boring old <, >-type diff.
|
||||
# Returns 1 if the first file couldn't be opened, 2 if the second couldn't be
|
||||
# opened, and a scalar reference containing the diff otherwise.
|
||||
#
|
||||
my ($file1, $file2, $context_lines) = @_;
|
||||
my ($f1_mod, $f2_mod, $filename1, $filename2);
|
||||
|
||||
if (!ref $file1) {
|
||||
my $fh = \do { local *FH; *FH };
|
||||
open $fh, "<$file1" or return 1;
|
||||
chomp(my @f1 = <$fh>);
|
||||
$f1_mod = (stat $fh)[9];
|
||||
($filename1, $file1) = ($file1, \@f1);
|
||||
}
|
||||
if (!ref $file2) {
|
||||
my $fh = \do { local *FH; *FH };
|
||||
open $fh, "<$file2" or return 2;
|
||||
chomp(my @f2 = <$fh>);
|
||||
$f2_mod = (stat $fh)[9];
|
||||
($filename2, $file2) = ($file2, \@f2);
|
||||
}
|
||||
|
||||
my $ret = "";
|
||||
my $diff = GT::File::Diff::diff($file1, $file2, \&_hash);
|
||||
return \($ret = "Files are identical") if not @$diff;
|
||||
|
||||
if ($context_lines and $f1_mod and $f2_mod) {
|
||||
$ret .= "--- $filename1\t" . gmtime($f1_mod) . " -0000\n";
|
||||
$ret .= "+++ $filename2\t" . gmtime($f2_mod) . " -0000\n";
|
||||
}
|
||||
|
||||
$File_Length_Difference = 0;
|
||||
|
||||
my ($hunk, $oldhunk);
|
||||
for my $piece (@$diff) {
|
||||
$hunk = GT::FileMan::Diff::Hunk->new($file1, $file2, $piece, $context_lines);
|
||||
next unless $oldhunk;
|
||||
|
||||
if ($context_lines and $hunk->does_overlap($oldhunk)) {
|
||||
$hunk->prepend_hunk($oldhunk);
|
||||
}
|
||||
else {
|
||||
$ret .= $oldhunk->output_diff($file1, $file2, $context_lines);
|
||||
}
|
||||
} continue { $oldhunk = $hunk }
|
||||
|
||||
$ret .= $oldhunk->output_diff($file1, $file2, $context_lines);
|
||||
\$ret;
|
||||
}
|
||||
|
||||
# This generates a unique key for the line; we simply take the line and convert
|
||||
# all multiple spaces into a single space to effectively perform a "diff -b".
|
||||
sub _hash {
|
||||
my $str = shift;
|
||||
$str =~ s/^\s+//;
|
||||
$str =~ s/\s+$//;
|
||||
$str =~ s/\s{2,}/ /g;
|
||||
$str;
|
||||
}
|
||||
|
||||
sub html_diff {
|
||||
# -----------------------------------------------------------------------------
|
||||
# Works exactly as the above, but also HTML escapes and colorizes the diff.
|
||||
# The first two or three arguments are the same as above, and the last argument
|
||||
# is a hash ref of (ID => html_color) pairs. The ID's available, and defaults,
|
||||
# are as follows (scalar refs make the text also bold):
|
||||
# { file => \"#2e8b57", linenum => \"#a52a2a", sep => "#6a5acd", removed => "#6a5acd", added => "#008b8b" }
|
||||
# - file is used only in unified context diffs to show the filename & last modified time
|
||||
# - linenum is used to indicate the line numbers the change applies to
|
||||
# - sep is used only in non-unified diffs to separate the removed/added lines
|
||||
# - removed is the colour for removed lines
|
||||
# - added is the colour for added lines
|
||||
# The return is the same scalar reference or error number as that of diff(),
|
||||
# but formatted for HTML with escaped HTML where necessary and the whole thing
|
||||
# wrapped in <pre>...</pre>. Note that no checking or HTML escaping is
|
||||
# performed on the colors passed in; it is your responsibility to make sure the
|
||||
# values of the colors hash are safe.
|
||||
#
|
||||
my (@args) = @_;
|
||||
my %colors;
|
||||
%colors = %{pop @args} if ref $args[-1];
|
||||
|
||||
$colors{file} ||= \"#2e8b57";
|
||||
$colors{linenum} ||= \"#a52a2a";
|
||||
$colors{added} ||= "#008b8b";
|
||||
$colors{removed} ||= "#6a5acd";
|
||||
$colors{sep} ||= "#6a5acd";
|
||||
|
||||
for (keys %colors) {
|
||||
if (ref $colors{$_}) {
|
||||
$colors{$_} = qq|<font color="${$colors{$_}}"><b>|;
|
||||
$colors{"${_}_close"} = qq|</b></font>|;
|
||||
}
|
||||
else {
|
||||
$colors{$_} = qq|<font color="$colors{$_}">|;
|
||||
$colors{"${_}_close"} = qq|</font>|;
|
||||
}
|
||||
}
|
||||
|
||||
my $ret = diff(@args);
|
||||
return $ret unless ref $ret;
|
||||
|
||||
$$ret =~ s/(["&<>])/$HTML_ESCAPE{$1}/g;
|
||||
$$ret =~ s{^([^ ].*)}{
|
||||
my $line = $1;
|
||||
if ($line eq '---') {
|
||||
qq{$colors{sep}$line$colors{sep_close}}
|
||||
}
|
||||
elsif (substr($line, 0, 3) eq '---' or substr($line, 0, 3) eq '+++') {
|
||||
qq{$colors{file}$line$colors{file_close}}
|
||||
}
|
||||
elsif (substr($line, 0, 2) eq '@@' or $line =~ /^[0-9]/) {
|
||||
qq{$colors{linenum}$line$colors{linenum_close}}
|
||||
}
|
||||
elsif (substr($line, 0, 1) eq '+' or substr($line, 0, 4) eq '>') {
|
||||
qq{$colors{added}$line$colors{added_close}}
|
||||
}
|
||||
elsif (substr($line, 0, 1) eq '-' or substr($line, 0, 4) eq '<') {
|
||||
qq{$colors{removed}$line$colors{removed_close}}
|
||||
}
|
||||
else {
|
||||
# A mistake? We should never get here, but silently ignore if we do
|
||||
$line
|
||||
}
|
||||
}egm;
|
||||
|
||||
substr($$ret, 0, 0) = '<pre>';
|
||||
$$ret .= '</pre>';
|
||||
|
||||
$ret;
|
||||
}
|
||||
|
||||
|
||||
# Package Hunk. A Hunk is a group of Blocks which overlap because of the
|
||||
# context surrounding each block. (So if we're not using context, every
|
||||
# hunk will contain one block.)
|
||||
package GT::FileMan::Diff::Hunk;
|
||||
|
||||
sub new {
|
||||
# Arg1 is output from &LCS::diff (which corresponds to one Block)
|
||||
# Arg2 is the number of items (lines, e.g.,) of context around each block
|
||||
#
|
||||
# This subroutine changes $File_Length_Difference
|
||||
#
|
||||
# Fields in a Hunk:
|
||||
# blocks - a list of Block objects
|
||||
# start - index in file 1 where first block of the hunk starts
|
||||
# end - index in file 1 where last block of the hunk ends
|
||||
#
|
||||
# Variables:
|
||||
# before_diff - how much longer file 2 is than file 1 due to all hunks
|
||||
# until but NOT including this one
|
||||
# after_diff - difference due to all hunks including this one
|
||||
my ($class, $f1, $f2, $piece, $context_items) = @_;
|
||||
|
||||
my $block = new GT::FileMan::Diff::Block ($piece); # this modifies $FLD!
|
||||
|
||||
my $before_diff = $File_Length_Difference; # BEFORE this hunk
|
||||
my $after_diff = $before_diff + $block->{"length_diff"};
|
||||
$File_Length_Difference += $block->{"length_diff"};
|
||||
|
||||
# @remove_array and @insert_array hold the items to insert and remove
|
||||
# Save the start & beginning of each array. If the array doesn't exist
|
||||
# though (e.g., we're only adding items in this block), then figure
|
||||
# out the line number based on the line number of the other file and
|
||||
# the current difference in file lenghts
|
||||
my @remove_array = $block->remove;
|
||||
my @insert_array = $block->insert;
|
||||
my ($a1, $a2, $b1, $b2, $start1, $start2, $end1, $end2);
|
||||
$a1 = @remove_array ? $remove_array[0 ]->{"item_no"} : -1;
|
||||
$a2 = @remove_array ? $remove_array[-1]->{"item_no"} : -1;
|
||||
$b1 = @insert_array ? $insert_array[0 ]->{"item_no"} : -1;
|
||||
$b2 = @insert_array ? $insert_array[-1]->{"item_no"} : -1;
|
||||
|
||||
$start1 = $a1 == -1 ? $b1 - $before_diff : $a1;
|
||||
$end1 = $a2 == -1 ? $b2 - $after_diff : $a2;
|
||||
$start2 = $b1 == -1 ? $a1 + $before_diff : $b1;
|
||||
$end2 = $b2 == -1 ? $a2 + $after_diff : $b2;
|
||||
|
||||
# At first, a hunk will have just one Block in it
|
||||
my $hunk = {
|
||||
"start1" => $start1,
|
||||
"start2" => $start2,
|
||||
"end1" => $end1,
|
||||
"end2" => $end2,
|
||||
"blocks" => [$block],
|
||||
"f1" => $f1,
|
||||
"f2" => $f2
|
||||
};
|
||||
bless $hunk, $class;
|
||||
|
||||
$hunk->flag_context($context_items);
|
||||
|
||||
return $hunk;
|
||||
}
|
||||
|
||||
# Change the "start" and "end" fields to note that context should be added
|
||||
# to this hunk
|
||||
sub flag_context {
|
||||
my ($hunk, $context_items) = @_;
|
||||
return unless $context_items; # no context
|
||||
|
||||
# add context before
|
||||
my $start1 = $hunk->{"start1"};
|
||||
my $num_added = $context_items > $start1 ? $start1 : $context_items;
|
||||
$hunk->{"start1"} -= $num_added;
|
||||
$hunk->{"start2"} -= $num_added;
|
||||
|
||||
# context after
|
||||
my $end1 = $hunk->{"end1"};
|
||||
$num_added = ($end1+$context_items > $#{$hunk->{f1}}) ?
|
||||
$#{$hunk->{f1}} - $end1 :
|
||||
$context_items;
|
||||
$hunk->{"end1"} += $num_added;
|
||||
$hunk->{"end2"} += $num_added;
|
||||
}
|
||||
|
||||
# Is there an overlap between hunk arg0 and old hunk arg1?
|
||||
# Note: if end of old hunk is one less than beginning of second, they overlap
|
||||
sub does_overlap {
|
||||
my ($hunk, $oldhunk) = @_;
|
||||
return "" unless $oldhunk; # first time through, $oldhunk is empty
|
||||
|
||||
# Do I actually need to test both?
|
||||
return ($hunk->{"start1"} - $oldhunk->{"end1"} <= 1 ||
|
||||
$hunk->{"start2"} - $oldhunk->{"end2"} <= 1);
|
||||
}
|
||||
|
||||
# Prepend hunk arg1 to hunk arg0
|
||||
# Note that arg1 isn't updated! Only arg0 is.
|
||||
sub prepend_hunk {
|
||||
my ($hunk, $oldhunk) = @_;
|
||||
|
||||
$hunk->{"start1"} = $oldhunk->{"start1"};
|
||||
$hunk->{"start2"} = $oldhunk->{"start2"};
|
||||
|
||||
unshift (@{$hunk->{"blocks"}}, @{$oldhunk->{"blocks"}});
|
||||
}
|
||||
|
||||
|
||||
# DIFF OUTPUT ROUTINES. THESE ROUTINES CONTAIN DIFF FORMATTING INFO...
|
||||
sub output_diff {
|
||||
my $context_diff = $_[3];
|
||||
if ($context_diff) { return &output_unified_diff }
|
||||
else { return &output_boring_diff }
|
||||
}
|
||||
|
||||
sub output_unified_diff {
|
||||
my ($hunk, $fileref1, $fileref2) = @_;
|
||||
my @blocklist;
|
||||
my $ret = "";
|
||||
|
||||
# Calculate item number range.
|
||||
my $range1 = $hunk->unified_range(1);
|
||||
my $range2 = $hunk->unified_range(2);
|
||||
$ret .= "@@ -$range1 +$range2 @@\n";
|
||||
|
||||
# Outlist starts containing the hunk of file 1.
|
||||
# Removing an item just means putting a '-' in front of it.
|
||||
# Inserting an item requires getting it from file2 and splicing it in.
|
||||
# We splice in $num_added items. Remove blocks use $num_added because
|
||||
# splicing changed the length of outlist.
|
||||
# We remove $num_removed items. Insert blocks use $num_removed because
|
||||
# their item numbers---corresponding to positions in file *2*--- don't take
|
||||
# removed items into account.
|
||||
my $low = $hunk->{"start1"};
|
||||
my $hi = $hunk->{"end1"};
|
||||
my ($num_added, $num_removed) = (0,0);
|
||||
my @outlist = @$fileref1[$low..$hi];
|
||||
for (@outlist) { s/^/ / } # assume it's just context
|
||||
|
||||
foreach my $block (@{$hunk->{"blocks"}}) {
|
||||
foreach my $item ($block->remove) {
|
||||
my $op = $item->{"sign"}; # -
|
||||
my $offset = $item->{"item_no"} - $low + $num_added;
|
||||
$outlist[$offset] =~ s/^ /$op/;
|
||||
$num_removed++;
|
||||
}
|
||||
foreach my $item ($block->insert) {
|
||||
my $op = $item->{"sign"}; # +
|
||||
my $i = $item->{"item_no"};
|
||||
my $offset = $i - $hunk->{"start2"} + $num_removed;
|
||||
splice(@outlist,$offset,0,"$op$$fileref2[$i]");
|
||||
$num_added++;
|
||||
}
|
||||
}
|
||||
|
||||
for (@outlist) { $ret .= "$_\n" } # add \n's
|
||||
$ret;
|
||||
}
|
||||
|
||||
sub output_boring_diff {
|
||||
# Note that an old diff can't have any context. Therefore, we know that
|
||||
# there's only one block in the hunk.
|
||||
my ($hunk, $fileref1, $fileref2) = @_;
|
||||
my %op_hash = ('+' => 'a', '-' => 'd', '!' => 'c');
|
||||
|
||||
my $ret = '';
|
||||
my @blocklist = @{$hunk->{"blocks"}};
|
||||
warn ("Expecting one block in an old diff hunk!") if scalar @blocklist != 1;
|
||||
my $block = $blocklist[0];
|
||||
my $op = $block->op; # +, -, or !
|
||||
|
||||
# Calculate item number range.
|
||||
# old diff range is just like a context diff range, except the ranges
|
||||
# are on one line with the action between them.
|
||||
my $range1 = $hunk->context_range(1);
|
||||
my $range2 = $hunk->context_range(2);
|
||||
my $action = $op_hash{$op} || warn "unknown op $op";
|
||||
$ret .= "$range1$action$range2\n";
|
||||
|
||||
# If removing anything, just print out all the remove lines in the hunk
|
||||
# which is just all the remove lines in the block
|
||||
if (my @foo = $block->remove) {
|
||||
my @outlist = @$fileref1[$hunk->{"start1"}..$hunk->{"end1"}];
|
||||
map {$_ = "< $_\n"} @outlist; # all lines will be '< text\n'
|
||||
$ret .= join '', @outlist;
|
||||
}
|
||||
|
||||
$ret .= "---\n" if $op eq '!'; # only if inserting and removing
|
||||
if ($block->insert) {
|
||||
my @outlist = @$fileref2[$hunk->{"start2"}..$hunk->{"end2"}];
|
||||
map {$_ = "> $_\n"} @outlist; # all lines will be '> text\n'
|
||||
$ret .= join "", @outlist;
|
||||
}
|
||||
}
|
||||
|
||||
sub context_range {
|
||||
# Generate a range of item numbers to print. Only print 1 number if the range
|
||||
# has only one item in it. Otherwise, it's 'start,end'
|
||||
my ($hunk, $flag) = @_;
|
||||
my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
|
||||
$start++; $end++; # index from 1, not zero
|
||||
my $range = ($start < $end) ? "$start,$end" : $end;
|
||||
return $range;
|
||||
}
|
||||
|
||||
sub unified_range {
|
||||
# Generate a range of item numbers to print for unified diff
|
||||
# Print number where block starts, followed by number of lines in the block
|
||||
# (don't print number of lines if it's 1)
|
||||
my ($hunk, $flag) = @_;
|
||||
my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
|
||||
$start++; $end++; # index from 1, not zero
|
||||
my $length = $end - $start + 1;
|
||||
my $first = $length < 2 ? $end : $start; # strange, but correct...
|
||||
my $range = $length== 1 ? $first : "$first,$length";
|
||||
return $range;
|
||||
}
|
||||
|
||||
package GT::FileMan::Diff::Block;
|
||||
# Package Block. A block is an operation removing, adding, or changing
|
||||
# a group of items. Basically, this is just a list of changes, where each
|
||||
# change adds or deletes a single item.
|
||||
# (Change could be a separate class, but it didn't seem worth it)
|
||||
|
||||
sub new {
|
||||
# Input is a chunk from &Algorithm::LCS::diff
|
||||
# Fields in a block:
|
||||
# length_diff - how much longer file 2 is than file 1 due to this block
|
||||
# Each change has:
|
||||
# sign - '+' for insert, '-' for remove
|
||||
# item_no - number of the item in the file (e.g., line number)
|
||||
# We don't bother storing the text of the item
|
||||
#
|
||||
my ($class,$chunk) = @_;
|
||||
my @changes = ();
|
||||
|
||||
# This just turns each change into a hash.
|
||||
foreach my $item (@$chunk) {
|
||||
my ($sign, $item_no, $text) = @$item;
|
||||
my $hashref = {"sign" => $sign, "item_no" => $item_no};
|
||||
push @changes, $hashref;
|
||||
}
|
||||
|
||||
my $block = { "changes" => \@changes };
|
||||
bless $block, $class;
|
||||
|
||||
$block->{"length_diff"} = $block->insert - $block->remove;
|
||||
return $block;
|
||||
}
|
||||
|
||||
|
||||
# LOW LEVEL FUNCTIONS
|
||||
sub op {
|
||||
# what kind of block is this?
|
||||
my $block = shift;
|
||||
my $insert = $block->insert;
|
||||
my $remove = $block->remove;
|
||||
|
||||
$remove && $insert and return '!';
|
||||
$remove and return '-';
|
||||
$insert and return '+';
|
||||
warn "unknown block type";
|
||||
return '^'; # context block
|
||||
}
|
||||
|
||||
# Returns a list of the changes in this block that remove items
|
||||
# (or the number of removals if called in scalar context)
|
||||
sub remove { return grep {$_->{"sign"} eq '-'} @{shift->{"changes"}}; }
|
||||
|
||||
# Returns a list of the changes in this block that insert items
|
||||
sub insert { return grep {$_->{"sign"} eq '+'} @{shift->{"changes"}}; }
|
||||
|
||||
1;
|
||||
103
site/slowtwitch.com/cgi-bin/articles/GT/FileMan/Session.pm
Normal file
103
site/slowtwitch.com/cgi-bin/articles/GT/FileMan/Session.pm
Normal file
@ -0,0 +1,103 @@
|
||||
# ==================================================================
|
||||
# File manager - enhanced web based file management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# Revision : $Id: Session.pm,v 1.1 2007/12/19 23:32:47 bao Exp $
|
||||
#
|
||||
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
|
||||
# Redistribution in part or in whole strictly prohibited. Please
|
||||
# see LICENSE file for full details.
|
||||
# ==================================================================
|
||||
package GT::FileMan::Session;
|
||||
|
||||
use strict;
|
||||
use GT::Session::File;
|
||||
|
||||
sub session_valid {
|
||||
# This function checks to see if the session is valid, and returns a
|
||||
# hash of session information
|
||||
#
|
||||
my $self = shift;
|
||||
|
||||
my $session_path = "$self->{cfg}->{private_path}/sessions";
|
||||
|
||||
# Clear out old sessions.
|
||||
GT::Session::File->cleanup($self->{cfg}->{session}->{expiry} * 3600, $session_path);
|
||||
|
||||
# Validate the session
|
||||
my $session_id = $self->{in}->param('sid') || $self->{in}->cookie($self->{cfg}->{session}->{cookie}) || return;
|
||||
my $session = new GT::Session::File (
|
||||
directory => $session_path,
|
||||
id => $session_id
|
||||
) || return;
|
||||
|
||||
# Update the session
|
||||
$session->save;
|
||||
|
||||
return { id => $session_id, data => $session->{data} };
|
||||
}
|
||||
|
||||
sub session_create {
|
||||
my ($self, $user, $use_cookie) = @_;
|
||||
|
||||
my $session_path = "$self->{cfg}->{private_path}/sessions";
|
||||
|
||||
# Clear out old sessions.
|
||||
GT::Session::File->cleanup($self->{cfg}->{session}->{expiry} * 3600, $session_path);
|
||||
|
||||
# Create a new session and save the information.
|
||||
my $session = new GT::Session::File (directory => $session_path);
|
||||
$session->{data}->{user} = $user->{username};
|
||||
$session->save;
|
||||
|
||||
# Now redirect to another URL and set cookies, or set URL string.
|
||||
if ($use_cookie) {
|
||||
print $self->{in}->cookie(
|
||||
-name => $self->{cfg}->{session}->{cookie},
|
||||
-value => $session->{id},
|
||||
-path => '/'
|
||||
)->cookie_header() . "\n";
|
||||
}
|
||||
else {
|
||||
$self->{cgi}->{sid} = $session->{id};
|
||||
}
|
||||
return { id => $session->{id}, data => $session->{data} };
|
||||
}
|
||||
|
||||
sub session_delete {
|
||||
my $self = shift;
|
||||
|
||||
print $self->{in}->cookie(
|
||||
-name => $self->{cfg}->{session}->{cookie},
|
||||
-value => '',
|
||||
-path => '/'
|
||||
)->cookie_header() . "\n";
|
||||
|
||||
my $session_id = $self->{in}->cookie($self->{cfg}->{session}->{cookie}) || $self->{in}->param('sid') || return;
|
||||
my $session = new GT::Session::File (
|
||||
directory => "$self->{cfg}->{private_path}/sessions",
|
||||
id => $session_id
|
||||
) || return;
|
||||
return $session->delete();
|
||||
}
|
||||
|
||||
sub session_save {
|
||||
my ($self, $id, $args) = @_;
|
||||
|
||||
return unless $id and $args;
|
||||
|
||||
my $session_path = "$self->{cfg}->{private_path}/sessions";
|
||||
my $session = new GT::Session::File (
|
||||
directory => $session_path,
|
||||
id => $id
|
||||
);
|
||||
|
||||
foreach (keys %$args) {
|
||||
next unless $args->{$_};
|
||||
$session->{data}->{$_} = $args->{$_};
|
||||
}
|
||||
$session->save();
|
||||
}
|
||||
1;
|
||||
Reference in New Issue
Block a user