saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
b6fc94ff0f
discourse-legacysite-perl/site/glist/lib/GList/Message.pm
dsainty aa25e9347f First pass at adding key files
2024-06-17 21:49:12 +10:00

1186 lines
41 KiB
Perl
Raw Blame History

# ==================================================================
# Gossamer List - enhanced mailing list management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info :
# Revision : $Id: Message.pm,v 1.63 2004/10/14 22:57:54 bao 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 GList::Message;
# ======================================================================
# The file will handle to add/update/delete the messages
#
use strict;
use GList qw/:objects :user_type/;
use GT::AutoLoader;
sub process {
#-------------------------------------------------------------------
#
my $do = shift;
$MN_SELECTED = 1;
my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
if ($tpl) {
my $hidden = GList::hidden(['msg_cat_id_fk']);
$results->{hidden_query} = $hidden->{hidden_query};
$results->{hidden_objects} = $hidden->{hidden_objects};
GList::display($tpl, $results);
}
}
$COMPILE{msg_spellcheck} = __LINE__ . <<'END_OF_SUB';
sub msg_spellcheck {
#--------------------------------------------------------------------
#
return ('spellcheck_inline.html') if $IN->param('load');
my $results = _spellcheck($IN->param('content'), $IN->param('compose_is_html'));
my $emode = $IN->param('emode');
if ($emode eq 'multi') {
my $results2 = _spellcheck($IN->param('content2'), 0);
$results->{text_words} = $results2->{words};
$results->{text_misspellings} = $results2->{misspellings};
}
return ('spellcheck_inline.html', { emode => $emode, %$results });
}
END_OF_SUB
$COMPILE{msg_addword} = __LINE__ . <<'END_OF_SUB';
sub msg_addword {
#--------------------------------------------------------------------
#
my $new_word = $IN->param('content');
return ('spellcheck_inline.html', { error => "Invalid word '$new_word'" }) unless $new_word =~ /^[a-zA-Z']+$/;
chomp $new_word; # Don't let there be a trailing \n!
my $db = $DB->table('CustomDict') or return ('spellcheck_inline.html', { error => $GT::SQL::error });
if (my $words = $db->select(custom_words => { username_fk => $USER->{usr_username} })->fetchrow) {
$words .= "\n$new_word";
$db->update({ custom_words => lc $words }, { username_fk => $USER->{usr_username} }) or return ('spellcheck_inline.html', { error => $GT::SQL::error });;
}
else {
$db->insert({ username_fk => $USER->{usr_username}, custom_words => $new_word }) or return ('spellcheck_inline.html', { error => $GT::SQL::error });
}
return ('spellcheck_inline.html', { word => $new_word });
}
END_OF_SUB
$COMPILE{msg_page} = <<'END_OF_SUB';
sub msg_page {
#--------------------------------------------------------------------
#
my $page = shift || $IN->param('pg');
return ($page);
}
END_OF_SUB
$COMPILE{msg_home} = <<'END_OF_SUB';
sub msg_home {
#--------------------------------------------------------------------
# Print home page
#
my $msg = shift;
my $cgi = $IN->get_hash;
if ( defined $cgi->{do} and $cgi->{do} =~ /msg_add|msg_modify|msg_delete/ ) {
foreach (keys % {$DB->table('Messages')->cols}) {
$cgi->{$_} = '' if $_ ne 'msg_cat_id_fk';
}
}
elsif (!$cgi->{msg_cat_id_fk} and $cgi->{do} !~ /msg_search/) { # Display message in home directory
$cgi->{msg_cat_id_fk} = 0;
}
my $query = '';
my $search_check = ($IN->param('do') eq 'msg_search') ? 1 : 0;
if ($cgi->{'msg_created-ge'} or $cgi->{'msg_created-le'}) {
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
my ($valid_from, $valid_to) = (1, 1);
require GT::Date;
if ($cgi->{'msg_created-ge'}) {
$query = "msg_created-ge=$cgi->{'msg_created-ge'};";
$valid_from = GList::date_to_time($cgi->{'msg_created-ge'}, $format);
$cgi->{'msg_created-ge'} = GT::Date::date_get($valid_from, $format) if ($valid_from);
}
if ($cgi->{'msg_created-le'}) {
$query = "msg_created-le=$cgi->{'msg_created-le'}";
$valid_to = GList::date_to_time($cgi->{'msg_created-le'}, $format);
$cgi->{'msg_created-le'} = GT::Date::date_get($valid_to, $format) if ($valid_to);
}
if ($search_check and (!$valid_from or !$valid_to)) {
$format =~ s/\%//g;
return msg_search_form(GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')));
}
}
my $results = GList::search(
cgi => $cgi,
db => $DB->table('Messages'),
prefix => 'msg',
sb => 'msg_created',
so => 'DESC',
search_check=> $search_check
);
my $nav = _load_navigator() || {};
if ( ref $results ne 'HASH' ) {
( $IN->param('do') eq 'msg_search' ) ? return ('msg_search_form.html', { msg => $msg || $results, %$nav})
: return ('msg_home.html', { msg => $msg || $results, %$nav });
}
elsif ( $results->{error} and $search_check ) {
return msg_search_form($results->{error});
}
if ($msg) {
$results->{msg} = $msg;
}
elsif ($cgi->{p}) {
$results->{msg} = '';
}
return ('msg_home.html', { %$results, %$nav, toolbar_query => $query });
}
END_OF_SUB
$COMPILE{msg_add_form} = <<'END_OF_SUB';
sub msg_add_form {
#--------------------------------------------------------------------
# Print Add Form
#
my $msg = shift;
my $attachments = _get_attachments();
my $navigator = _load_navigator() || {};
my $contents = _switch_editor_mode();
my $emode = $IN->param('emode') || $USER->{usr_compose_mode} || 'text';
my $editor_advanced;
if (!defined $IN->param('editor_advanced') and $USER->{usr_editor_advanced}) {
$editor_advanced = 1;
}
return ('msg_add_form.html', {
msg => $msg,
attachments => $attachments,
hits => $#$attachments + 1,
emode => $emode,
help => 'message_add.html', %$navigator, %$contents,
editor_advanced => $editor_advanced
});
}
END_OF_SUB
$COMPILE{msg_add} = <<'END_OF_SUB';
sub msg_add {
#--------------------------------------------------------------------
#
my $attachments;
if ($IN->param('add_attach')) { # add an attachment
$attachments = _add_attach();
return msg_add_form($attachments) if (ref $attachments ne 'ARRAY');
return ('msg_add_form.html', { attachments => $attachments, hits => $#$attachments + 1 });
}
if ($IN->param('del_attach')) { # Delete an attachment
$attachments = _del_attach();
return msg_add_form($attachments) if (ref $attachments ne 'ARRAY');
return ('msg_add_form.html', { attachments => $attachments, hits => $#$attachments + 1 });
}
$attachments = _get_attachments();
if ($IN->param('bswitch') or $IN->param('switch_editor')) {
return msg_add_form();
}
if ($attachments and _size_attachments() > $CFG->{max_attachments_size}) {
return msg_add_form(GList::language('MSG_OUTOF_LIMIT'));
}
# Add message into database
my $content_html = $IN->param('msg_content_html');
my $content_text = $IN->param('msg_content_text');
if ($content_html =~ /^\s*<html>\s*<BODY\s*class=object\s*\s*src="">\s*<\/BODY>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<body\s*src="">\s*<\/body>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<BODY\s*class=object\s*\s*src=""><p>\&nbsp;<\/p><\/BODY>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<BODY\s*src=""><P>\&nbsp;<\/P><\/BODY>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<br>\s*<\/html>\s*$/i) {
$content_html = "";
}
if (!$content_html and !$content_text) {
return msg_add_form(GList::language('MSG_EMPTY'));
}
my $cgi = $IN->get_hash();
if ($IN->param('msg_mode') =~ /html|multi/ and $content_html) {
$cgi->{msg_content_text} = _convert_to_text($content_html) if ($IN->param('msg_mode') eq 'html');
$cgi->{msg_track_open} = ($cgi->{msg_track_open}) ? 1 : 0;
$cgi->{msg_track_click} = ($cgi->{msg_track_click}) ? 1 : 0;
}
else {
$cgi->{msg_track_open} = 0;
$cgi->{msg_track_click}= 0;
}
# Add message into database
my $ret = GList::add('Messages', 'msg', $cgi);
return msg_add_form("<font color=red><b>$GList::error</b></font>") if ( $GList::error );
# Add attachments
if ($attachments) {
my $db = $DB->table('MessageAttachments');
my $path = "$CFG->{priv_path}/attachments/messages/" . ($ret % 10) . "/$ret";
mkdir($path, 0777) or return msg_home(GList::language('MSG_MKDIR_ERR', $!));
require GT::File::Tools;
foreach ( @$attachments ) {
my $attach_id = $db->add({
att_message_id_fk => $ret,
att_file_name => $_->{user_fname},
att_file_size => $_->{fsize}
}) or die $GT::SQL::error;
GT::File::Tools::move("$CFG->{priv_path}/tmp/$_->{fname}", "$path/$attach_id") or return msg_home(GList::language('MSG_ATTACH_ADD', $!));
}
}
return msg_home(GList::language('MSG_ADD_SUCCESS', $IN->param('msg_subject') || $ret)) if ($ret);
}
END_OF_SUB
$COMPILE{msg_modify_form} = <<'END_OF_SUB';
sub msg_modify_form {
#--------------------------------------------------------------------
# Print modify form
#
my $msg = shift;
my $id = $IN->param('msg_id');
return msg_home(GList::language('MSG_INVALID')) if (!$id or ref $id eq 'ARRAY');
my $info = GList::check_owner('Messages', 'msg', $id);
return msg_home($info) if (ref $info ne 'HASH');
my $navigator = _load_navigator() || {};
my $editor_advanced;
if (!defined $IN->param('editor_advanced') and $USER->{usr_editor_advanced}) {
$editor_advanced = 1;
}
if ($IN->param('do') eq 'msg_modify_form') {
my $attachments = _load_attachments($info->{msg_id});
$info->{msg_content_html} = $IN->html_escape($info->{msg_content_html});
return ('msg_modify_form.html', {
msg => $msg, %$info, %$navigator,
attachments => $attachments,
editor_advanced => $editor_advanced,
hits => $#$attachments + 1,
help => 'message_add.html',
emode => $info->{msg_mode}
});
}
else {
my $attachments = _get_attachments();
my $contents = _switch_editor_mode();
return ('msg_modify_form.html', {
msg => $msg,
attachments => $attachments,
editor_advanced => $editor_advanced,
hits => $#$attachments + 1,
help => 'message_add.html', %$navigator, %$contents
});
}
}
END_OF_SUB
$COMPILE{msg_modify} = <<'END_OF_SUB';
sub msg_modify {
#--------------------------------------------------------------------
# Modify a message
#
my $attachments;
if ($IN->param('bcancel')) { # Cancel to edit a record
$attachments = _get_attachments();
foreach (@$attachments) {
unlink "$CFG->{priv_path}/tmp/$_->{fname}";
}
return msg_home();
}
if ($IN->param('add_attach')) { # add an attachment
$attachments = _add_attach();
return msg_modify_form($attachments) if (ref $attachments ne 'ARRAY');
return ('msg_modify_form.html', { attachments => $attachments, hits => $#$attachments + 1 });
}
if ($IN->param('del_attach')) { # Delete an attachment
$attachments = _del_attach();
return msg_modify_form($attachments) if (ref $attachments ne 'ARRAY');
return ('msg_modify_form.html', { attachments => $attachments, hits => $#$attachments + 1 });
}
# Handle the attachments
$attachments = _get_attachments();
if ($IN->param('bswitch') or $IN->param('switch_editor')) {
return msg_modify_form();
}
my $content_html = $IN->param('msg_content_html');
my $content_text = $IN->param('msg_content_text');
if ($content_html =~ /^\s*<html>\s*<BODY\s*class=object\s*\s*src="">\s*<\/BODY>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<body\s*src="">\s*<\/body>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<BODY\s*class=object\s*\s*src=""><p>\&nbsp;<\/p><\/BODY>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<BODY\s*src=""><P>\&nbsp;<\/P><\/BODY>\s*<\/html>\s*$/i or
$content_html =~ /^\s*<html>\s*<br>\s*<\/html>\s*$/i) {
$content_html = "";
}
if (!$content_html and !$content_text) {
return msg_modify_form(GList::language('MSG_EMPTY'));
}
my $cgi = $IN->get_hash();
if ($IN->param('msg_mode') =~ /html|multi/ and $content_html) {
$cgi->{msg_content_text} = _convert_to_text($content_html) if ($IN->param('msg_mode') eq 'html');
$cgi->{msg_track_open} = ($cgi->{msg_track_open}) ? 1 : 0;
$cgi->{msg_track_click} = ($cgi->{msg_track_click}) ? 1 : 0;
}
else {
$cgi->{msg_track_open} = 0;
$cgi->{msg_track_click}= 0;
}
# Update a message
GList::modify('Messages', 'msg', $cgi);
return msg_modify_form($GList::error) if ($GList::error);
my $id = $IN->param('msg_id');
my $db = $DB->table('MessageAttachments');
my $sth = $db->select({ att_message_id_fk => $id }, ['att_id']);
my $path = "$CFG->{priv_path}/attachments/messages/" . ($id % 10) . "/$id";
while ( my $att = $sth->fetchrow_array ) {
unlink "$path/$att";
}
$db->delete({ att_message_id_fk => $id });
# Create a directory if it does not exist
require GT::File::Tools;
if ($#$attachments >= 0) {
if ( ! -e $path ) {
mkdir ($path, 0777) or return msg_home(GList::language('MSG_MKDIR_ERR', $!));
}
foreach ( @$attachments ) {
my $attach_id = $db->add({
att_message_id_fk => $id,
att_file_name => $_->{user_fname},
att_file_size => $_->{fsize}
});
GT::File::Tools::move("$CFG->{priv_path}/tmp/$_->{fname}", "$path/$attach_id") or return msg_home(GList::language('MSG_ATTACH_ADD', $!));
}
}
elsif (-e $path) {
GT::File::Tools::deldir($path);
}
msg_home(GList::language('MSG_MOD_SUCCESS', $IN->param('msg_subject') || $id));
}
END_OF_SUB
$COMPILE{msg_search_form} = <<'END_OF_SUB';
sub msg_search_form {
#-------------------------------------------------------------------
# Print search form
#
my $msg = shift;
my $db = $DB->table('CatMessages');
my $sth = $db->select({ cms_user_id_fk => $USER->{usr_username} });
my $output;
while ( my $rs = $sth->fetchrow_hashref ) {
push @$output, $rs;
}
my $navigator = _load_navigator() || {};
return ('msg_search_form.html', { msg => $msg, results => $output, hits => $#$output + 1, %$navigator });
}
END_OF_SUB
$COMPILE{msg_send_sample} = <<'END_OF_SUB';
sub msg_send_sample {
#--------------------------------------------------------------------
# Send a copy to an email address
#
my $msg_id = $IN->param('msg_id');
my $email = $IN->param('email');
my $name = $IN->param('name') || '';
#------------demo code-----------
# Check record's owner
my $info = GList::check_owner('Messages', 'msg', $msg_id);
return msg_home($info) if (ref $info ne 'HASH');
if ( $email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ ) { # check email address
return msg_home(GList::language('LST_IPT_INVALID_EMAIL'));
}
# Allows personalizing of messages using <%...%> tags
require GList::Template;
my $hash = $USER;
$hash->{sub_email} = $email;
$hash->{sub_name} = $name;
$info->{msg_content_text} = GList::Template->parse(
"string",
[$hash],
{
string => $info->{msg_content_text},
disable => { functions => 1 }
}
) if ( $info->{msg_content_text} );
$info->{msg_content_html} = GList::Template->parse(
"string",
[$hash],
{
string => $info->{msg_content_html},
disable => { functions => 1 }
}
) if ( $info->{msg_content_html} );
my %head;
$head{from} = ( $info->{msg_from_name} ) ? "$info->{msg_from_name} <$info->{msg_from_email}>" : $info->{msg_from_email};
$head{to} = ( $name ) ? "$name <$email>" : $email;
$head{subject} = $info->{msg_subject};
$head{'Reply-To'} = $info->{msg_reply_to};
$head{'Return-Path'}= $info->{msg_bounce_email};
# Load attachments
my $attachments = $DB->table('MessageAttachments')->select({ att_message_id_fk => $msg_id })->fetchall_hashref;
GList::send(\%head, { text => $info->{msg_content_text}, html => $info->{msg_content_html} }, $attachments, "$CFG->{priv_path}/attachments/messages/" . ($msg_id % 10) . "/$msg_id", $info->{msg_charset});
return msg_home(GList::language('MSG_EMAIL_SENT', $email));
}
END_OF_SUB
$COMPILE{msg_send_form} = __LINE__ . <<'END_OF_SUB';
sub msg_send_form {
#--------------------------------------------------------------------
# Send email - Step 1: select the lists
#
my $msg = shift;
my @messages;
my $cgi = $IN->get_hash();
my $query = '';
if ($cgi->{msg_id}) {
my $ids = (ref $cgi->{msg_id} eq 'ARRAY') ? $cgi->{msg_id} : [$cgi->{msg_id}];
foreach my $id (@$ids) {
my $info = GList::check_owner('Messages', 'msg', $id);
push @messages, { msg_id => $info->{msg_id}, msg_subject => $info->{msg_subject} } if ( ref $info eq 'HASH' );
$query .= "msg_id=$info->{msg_id};";
}
}
else {
my $modify = (ref $cgi->{modify} eq 'ARRAY') ? $cgi->{modify} : [$cgi->{modify}];
foreach my $i (@$modify) {
my $info = GList::check_owner('Messages', 'msg', $cgi->{"$i-msg_id"});
push @messages, { msg_id => $info->{msg_id}, msg_subject => $info->{msg_subject} } if ( ref $info eq 'HASH' );
$query .= "msg_id=$info->{msg_id};";
}
}
return msg_home(GList::language('MSG_SEND_INVALID')) if (!@messages);
# Get the Mailing Lists
my $results = GList::search(
cgi => $cgi,
db => $DB->table('Lists'),
prefix => 'lst',
sb => 'lst_title',
so => 'ASC',
show_user => $cgi->{show_user},
select_all => $cgi->{mh} == -1 ? 1 : 0
);
(ref $results eq 'HASH') or return msg_home(GList::language('MSG_LST_EMPTY'));
$results->{msg} = $msg;
my $subs = $DB->table('Subscribers');
my $output = $results->{results};
foreach my $rs (@$output) {
$rs->{subscribers} = $subs->count({ sub_list_id_fk => $rs->{lst_id} });
$rs->{val_subs} = $subs->count({ sub_list_id_fk => $rs->{lst_id}, sub_validated => 1 });
$rs->{bounced_emails} = $subs->count({ sub_list_id_fk => $rs->{lst_id}, sub_Bounced => 1 });
}
my $nav = _load_navigator() || {};
if ($#messages > 0) {
return ('msg_send_form.html', {
toolbar_query => $query,
mul_messages => 1,
loop_messages => \@messages,
help => 'message_send.html', %$results, %$nav
});
}
else {
my $info = $messages[0] || {};
return ('msg_send_form.html', {
toolbar_query => $query,
msg_id => $info->{msg_id},
loop_messages => \@messages,
help => 'message_send.html', %$results, %$nav
});
}
}
END_OF_SUB
$COMPILE{msg_send} = __LINE__ . <<'END_OF_SUB';
sub msg_send {
#--------------------------------------------------------------------
# Send email - step 2: Preview the content
#
return msg_send_form(GList::language('MSG_MLI_ERR')) unless($IN->param('modify'));
# Load database objects
my $db_msg = $DB->table('Messages');
my $db_mli = $DB->table('MailingIndex');
my $db_eml = $DB->table('EmailMailings');
my $db_sub = $DB->table('Subscribers');
my $db_mat = $DB->table('MailingAttachments');
my $mod = (ref $IN->param('modify') eq 'ARRAY') ? $IN->param('modify') : [$IN->param('modify')];
my (%emails, %lists, @subs, @lists, $sent);
foreach my $row_num (@$mod) {
my $id = $IN->param("$row_num-list_id_fk");
my $info = GList::check_owner('Lists', 'lst', $id);
next if (!$info);
push @lists, $id;
}
# If sending to multiple lists, ensure that duplicate address don't occur:
my $substh = $db_sub->select(
'sub_email', 'sub_name', 'sub_list_id_fk',
{ sub_validated => 1, sub_list_id_fk => \@lists }
);
while (my ($email, $name, $list) = $substh->fetchrow) {
$email = lc $email;
$emails{$email} ||= $name;
$lists{$email} ||= [];
push @{$lists{$email}}, $list;
}
foreach my $e (keys %emails) {
push @subs, [lc $e, $emails{$e}, join ',', @{$lists{$e}}];
}
my $messages = (ref $IN->param('msg_id') eq 'ARRAY') ? $IN->param('msg_id') : [$IN->param('msg_id')];
foreach my $id (@$messages) {
my $info = GList::check_owner('Messages', 'msg', $id);
next if ( ref $info ne 'HASH' );
# Get the attachments
my $attachs = $DB->table('MessageAttachments')->select({ att_message_id_fk => $info->{msg_id} })->fetchall_hashref;
# Create mailing index ID
my $mailing = $db_mli->insert(
mli_from => $info->{msg_from_email},
mli_name => $info->{msg_from_name},
mli_reply_to => $info->{msg_reply_to},
mli_bounce_email => $info->{msg_bounce_email},
mli_subject => $info->{msg_subject},
mli_charset => $info->{msg_charset} || 'us-ascii',
mli_message_html => $info->{msg_content_html},
mli_message_text => $info->{msg_content_text},
mli_track_open => $info->{msg_track_open},
mli_track_click => $info->{msg_track_click},
mli_user_id_fk => $USER->{usr_username},
)->insert_id;
$sent++;
$db_eml->insert_multiple(
[qw/eml_mailing_id_fk eml_code eml_email eml_name eml_lists/],
map [$mailing, 'N/A', @$_], @subs
) or die $GT::SQL::error;
# Update the attachments
if ( @$attachs ) {
require GT::File::Tools;
my $attach_path = "$CFG->{priv_path}/attachments";
mkdir("$attach_path/mailings/" . ($mailing % 10) . "/$mailing", 0777);
foreach (@$attachs) {
my $attach_id = $db_mat->insert(
mat_mailing_id_fk => $mailing,
mat_file_name => $_->{att_file_name},
mat_file_size => $_->{att_file_size}
)->insert_id;
GT::File::Tools::copy("$attach_path/messages/" . ($info->{msg_id} % 10) . "/$info->{msg_id}/$_->{att_id}", "$attach_path/mailings/" . ($mailing % 10) . "/$mailing/$attach_id");
}
}
$db_msg->update({ msg_status => '1' }, { msg_id => $info->{msg_id} });
}
require GList::Mailer;
$MN_SELECTED = 3;
GList::Mailer::mli_home(GList::language('MLI_CREATED_SUCCESS', $sent));
}
END_OF_SUB
$COMPILE{msg_move} = <<'END_OF_SUB';
sub msg_move {
#--------------------------------------------------------------------
# Moves the records to another category
#
return home(GList::language('SYS_MOVE_ERR')) unless ($IN->param('modify'));
return msg_home(GList::language('SYS_TARGET_ERR')) unless ($IN->param('move_to'));
# Check category ID
my $to = $IN->param('move_to');
if ($to ne 'root') { # Move to a sub-category
my $info = GList::check_owner('CatMessages', 'cms', $to);
return home($info) if (ref $info ne 'HASH');
}
# Need to know the number of records modified
my $rec_modified = 0;
my $rec_declined = 0;
my $mod = (ref $IN->param('modify') eq 'ARRAY') ? $IN->param('modify') : [$IN->param('modify')];
my $db = $DB->table('Messages');
# For through the record numbers. These are the values of the check boxes
foreach my $rec_num (@$mod) {
my $change = {};
$change->{msg_id} = $IN->param("$rec_num-msg_id") if ($IN->param("$rec_num-msg_id"));
# Check if users can modify only their own records
if ($USER->{usr_type} != ADMINISTRATOR) {
my $rs = $db->get($change);
next if (!$rs);
if ($rs->{'msg_user_id_fk'} ne $USER->{usr_username}) {
$rec_declined++; next;
}
}
next unless (keys %$change);
my $ret;
if ($to eq 'root') {
$ret = $db->update({ msg_cat_id_fk => 0 }, $change);
}
else {
$ret = $db->update({ msg_cat_id_fk => $to }, $change);
}
if (defined $ret and ($ret != 0)) {
$rec_modified++;
}
}
msg_home(($rec_declined) ? GList::language('SYS_MOVED2', $rec_modified, $rec_declined) : GList::language('SYS_MOVED', $rec_modified));
}
END_OF_SUB
$COMPILE{msg_delete} = <<'END_OF_SUB';
sub msg_delete {
#--------------------------------------------------------------------
# Delete messages
#
return msg_home(GList::delete('Messages', 'msg'));
}
END_OF_SUB
$COMPILE{msg_fview} = <<'END_OF_SUB';
sub msg_fview {
#----------------------------------------------------------------------
# View a attached file
#
return GList::view_file();
}
END_OF_SUB
$COMPILE{msg_fdownload} = <<'END_OF_SUB';
sub msg_fdownload {
#----------------------------------------------------------------------
# Download a attached file
#
return GList::download_file();
}
END_OF_SUB
$COMPILE{msg_cat_add} = <<'END_OF_SUB';
sub msg_cat_add {
#--------------------------------------------------------------------
# Add a category
#
my $name = $IN->param('cms_name');
return msg_home(GList::language('SYS_ADD_INVALID')) unless ($name);
my $ret = GList::add('CatMessages', 'cms', { cms_name => $name });
return msg_home($GList::error) if ( $GList::error );
return msg_home(GList::language('DIR_ADDED', $name)) if ( $ret );
}
END_OF_SUB
$COMPILE{msg_cat_modify} = <<'END_OF_SUB';
sub msg_cat_modify {
#-------------------------------------------------------------------
# Update a category
#
return msg_home(GList::language('SYS_ADD_INVALID')) unless ($IN->param('cms_id'));
GList::modify('CatMessages', 'cms');
return msg_home($GList::error) if ( $GList::error );
msg_home(GList::language('DIR_UPDATED', $IN->param('cms_name')));
}
END_OF_SUB
$COMPILE{msg_cat_delete} = <<'END_OF_SUB';
sub msg_cat_delete {
#--------------------------------------------------------------------
# Delete a category
#
my $cgi = $IN->get_hash();
return msg_home(GList::language('SYS_ADD_INVALID')) unless ($cgi->{cms_id});
$cgi->{modify} = '1';
$cgi->{'1-cms_id'} = $cgi->{cms_id};
return msg_home(GList::delete('CatMessages', 'cms', $cgi, GList::language('DIR_DELETED', $IN->param('cms_name'))));
}
END_OF_SUB
$COMPILE{_add_attach} = __LINE__ . <<'END_OF_SUB';
sub _add_attach {
#--------------------------------------------------------------------
# Adds an attachment for a message
#
return GList::language('MSG_ATTACH_ERR') unless ($IN->param('attachment'));
my $attachment = $IN->param('attachment');
(my $filename = $attachment) =~ s/.*[\/\\]//;
my $user_file = $filename;
my ($buffer, $count) = ('', 0);
# Check if file is existed
while (-e "$CFG->{priv_path}/tmp/$count$filename") {
$count++;
}
$filename = "$count$filename";
open (OUTFILE,">> $CFG->{priv_path}/tmp/$filename") or return GList::language('SYS_FILE_ERR', $!);
binmode($attachment);
binmode(OUTFILE);
while (my $bytesread = read($attachment, $buffer, 1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
return _get_attachments($user_file, $filename);
}
END_OF_SUB
$COMPILE{_del_attach} = __LINE__ . <<'END_OF_SUB';
sub _del_attach {
# ------------------------------------------------------------------
# Removes an attachment from the list of attachments for a message
#
my $in = $IN->get_hash();
my $dels = ( ref $IN->param('del_attach') eq 'ARRAY' ) ? $IN->param('del_attach') : [$IN->param('del_attach')];
my %exist;
require GT::File::Tools;
foreach my $del (@$dels) {
$exist{$del} = 1;
if (-d "$CFG->{priv_path}/tmp/$del") {
GT::File::Tools::deldir("$CFG->{priv_path}/tmp/$del");
}
else {
unlink ("$CFG->{priv_path}/tmp/$del");
}
}
my @attachments;
foreach my $file (grep (m/^attach-/, (keys %$in))) {
$file =~ /^attach-(.*)/;
next if $exist{$1};
my $fsize = _get_fsize("$CFG->{priv_path}/tmp/$1");
push (@attachments, { user_fname => $in->{$file}, fname => $1, fsize => $fsize});
}
return \@attachments;
}
END_OF_SUB
$COMPILE{_get_attachments} = __LINE__ . <<'END_OF_SUB';
sub _get_attachments {
# ------------------------------------------------------------------
# Generates the list of attachments
#
my ($user_file, $fname) = @_;
my (@attachments, $fsize);
my $in = $IN->get_hash();
foreach my $file (grep (m/^attach-/, (keys %$in))) {
$file =~ /^attach-(.*)/;
$fsize = _get_fsize("$CFG->{priv_path}/tmp/$1");
push @attachments, { user_fname => $in->{$file}, fname => $1, fsize => $fsize };
}
if ($user_file) {
$fsize = _get_fsize("$CFG->{priv_path}/tmp/$fname");
push @attachments, { user_fname => $user_file, fname => $fname, fsize => $fsize };
}
return if (!scalar(@attachments));
return \@attachments;
}
END_OF_SUB
$COMPILE{_get_fsize} = __LINE__ . <<'END_OF_SUB';
sub _get_fsize {
#-------------------------------------------------------------------
#
my $file = shift;
if (-d $file) {
opendir (DIR, $file) or return;
my @list = readdir(DIR);
closedir(DIR);
my $size = 0;
foreach (@list) {
($_ =~ /\.|\.\./) and next;
$size += -s "$file/$_";
}
return $size;
}
else {
return -s $file;
}
}
END_OF_SUB
$COMPILE{_size_attachments} = __LINE__ . <<'END_OF_SUB';
sub _size_attachments {
# ------------------------------------------------------------------
# Generates the total size of the attachments for a message
#
my $in = $IN->get_hash();
my $count;
foreach my $file (grep (m/^attach-/, (keys %$in))) {
$file =~ /^attach-(.*)/;
$count += -s "$CFG->{priv_path}/tmp/$1";
}
return $count / 1024;
}
END_OF_SUB
$COMPILE{_load_attachments} = __LINE__ . <<'END_OF_SUB';
sub _load_attachments {
# ------------------------------------------------------------------
# Generates the list of attachments from database
#
my $id = shift;
require GT::File::Tools;
my $sth = $DB->table('MessageAttachments')->select({ att_message_id_fk => $id });
my @attachments;
while (my $rs = $sth->fetchrow_hashref) {
my $filename = $rs->{att_file_name};
my $count = '';
while (-e "$CFG->{priv_path}/tmp/$count$filename") {
$count++;
}
$filename = "$count$filename";
GT::File::Tools::copy("$CFG->{priv_path}/attachments/messages/" . ($id % 10) . "/$id/$rs->{att_id}",
"$CFG->{priv_path}/tmp/$filename");
push @attachments, { user_fname => $rs->{att_file_name}, fname => $filename, fsize => $rs->{att_file_size} };
}
return \@attachments;
}
END_OF_SUB
$COMPILE{_load_navigator} = __LINE__ . <<'END_OF_SUB';
sub _load_navigator {
#---------------------------------------------------------------------
# Generates Category listings
#
my $user = GList::load_condition();
my $db = $DB->table('CatMessages', 'Messages');
my $cond = GT::SQL::Condition->new('cms_user_id_fk', $user->{opt} , $user->{id});
$db->select_options('GROUP BY cms_id, cms_name ORDER BY cms_name');
my $sth = $db->select('left_join', $cond, ['CatMessages.cms_id', 'CatMessages.cms_name', 'count(msg_id) as messages']) or die $GT::SQL::error;
my $output;
while (my $rs = $sth->fetchrow_hashref) {
push @$output, $rs;
}
my @items = ('cd', 'cs');
# Create the URL
my $url = '';
foreach (@items) {
$url .= "$_=".$IN->param($_).'&' if ( $IN->param($_) );
}
chop $url;
# Get category's information
my $info = {};
if ($IN->param('msg_cat_id_fk')) {
$info = GList::check_owner('CatMessages', 'cms', $IN->param('msg_cat_id_fk'));
if ( ref $info ne 'HASH' ) {
$info = {};
$info->{msg_cat_id_fk} = 0;
}
}
my $constraints = GT::SQL::Condition->new(
msg_user_id_fk => $user->{opt} => $user->{id},
msg_cat_id_fk => '=' => 0,
);
my $hit_root = $DB->table('Messages')->select( $constraints )->rows;
return { url => $url, results_cat => $output, hits_cat => $#$output + 1, hits_root => $hit_root, %$info };
}
END_OF_SUB
$COMPILE{_switch_editor_mode} = __LINE__ . <<'END_OF_SUB';
sub _switch_editor_mode {
my $html = $IN->param('msg_content_html') || '';
my $text = $IN->param('msg_content_text') || '';
my $mode = $IN->param('emode') || 'text';
if ($html =~ /^\s*<html>\s*<BODY\s*class=object\s*\s*src="">\s*<\/BODY>\s*<\/html>\s*$/mi or
$html =~ /^\s*<html>\s*<body\s*src="">\s*<\/body>\s*<\/html>\s*$/mi or
$html =~ /^\s*<html>\s*<BODY\s*class=object\s*\s*src=""><p>\&nbsp;<\/p><\/BODY>\s*<\/html>\s*$/mi or
$html =~ /^\s*<html>\s*<BODY\s*src=""><P>\&nbsp;<\/P><\/BODY>\s*<\/html>\s*$/mi) {
$html = "";
}
my %content;
if ($mode eq 'text') {
$content{msg_content_text} = _convert_to_text($html) if ($html);
}
elsif ($mode eq 'html') {
$content{msg_content_html} = _convert_to_html($text) if ($text);
}
else {
$content{msg_content_text} = _convert_to_text($html) if ($html);
$content{msg_content_html} = _convert_to_html($text) if ($text);
}
# $content{msg_content_html} = $IN->html_escape($html);
return \%content;
}
END_OF_SUB
$COMPILE{_convert_to_text} = __LINE__ . <<'END_OF_SUB';
sub _convert_to_text {
# Takes the text and checks it for html tags. If
# it contains html tags converts it to text. If it does not just
# returns it.
#
my $text = shift || '';
($text =~ /<\/?(?:br|p|html)>/i) or return $text;
_html_to_text(\$text);
$text =~ s/</&lt;/g;
$text =~ s/>/&gt;/g;
$text =~ s/"/&quot;/g;
return $text;
}
END_OF_SUB
$COMPILE{_convert_to_html} = __LINE__ . <<'END_OF_SUB';
sub _convert_to_html {
# ------------------------------------------------------------------
# Checks content for html tags, if it contains html this method
# will just return it. If it does not this method will convert the
# text to html. This means converting \n to <br> amoung other things.
#
my $text = shift || '';
#($text =~ /<\/?(?:br|p|html)>/i) and return;
#$text =~ s{\b((?:https?|ftp)://(?:[^@]*@)?[\w.-]+(?:/\S*)?)}{<a href="$1">$1</a>}gi;
$IN->html_escape(\$text);
_text_to_html(\$text);
return $text;
}
END_OF_SUB
$COMPILE{_text_to_html} = __LINE__ . <<'END_OF_SUB';
sub _text_to_html {
# ------------------------------------------------------------------
# Internal method to convert text to html
#
my $convert = shift;
$$convert =~ s/\r?\n/<br>\n/g;
}
END_OF_SUB
$COMPILE{_html_to_text} = __LINE__ . <<'END_OF_SUB';
sub _html_to_text {
# ------------------------------------------------------------------
# Internal method to convert html to text.
#
my $convert = shift;
my $dash = ('-' x 60);
# This will break <pre>'ed text, but it fixes a lot problems with regular conversions
$$convert =~ s/\r?\n//g;
$$convert =~ s/\r//g;
$$convert =~ s/ +/ /g;
$$convert =~ s/&nbsp;/ /ig;
$$convert =~ s/&quot;/"/ig;
$$convert =~ s/&amp;/&/ig;
$$convert =~ s/&copy;/(C)/ig;
$$convert =~ s/&reg;/(R)/ig;
$$convert =~ s/&trade;/^TM/ig;
$$convert =~ s/<!--.*?-->//sg;
$$convert =~ s/<li>\s*(.*?)\s*<\/li>/\n* $1\n/sig;
$$convert =~ s/<li>\s*([^<]*)/\n* $1/sig;
$$convert =~ s[</p[^>]*>][\n\n]ig;
$$convert =~ s/<br[^>]*>/\n/ig;
$$convert =~ s[</div[^>]*>][\n]ig;
# $$convert =~ s[<b>([^<]*)</b>][*$1*]ig;
# $$convert =~ s[<i>([^<]*)</i>][_$1_]ig;
$$convert =~ s[</blockquote[^>]*>][\n\n]ig;
$$convert =~ s/<hr[^>]*>/\n$dash\n/ig;
my @tokens = split /(<[^>"']*(?:(?:(?:"[^"]*"[^>"]*)|(?:'[^']*'[^>']*)))*>)/, $$convert;
$$convert = join '' => map { $tokens[$_] } grep { not $_ % 2 } 0 .. $#tokens;
$$convert =~ s/&lt;/</ig;
$$convert =~ s/&gt;/>/ig;
$$convert =~ s/^[ \t]+//gm;
$$convert =~ s/[ \t]+$//gm;
}
END_OF_SUB
$COMPILE{_spellcheck} = __LINE__ . <<'END_OF_SUB';
sub _spellcheck {
my ($content, $is_html) = @_;
my (@parts, @words, @non_words);
if ($is_html) {
@parts = split m{((?:<(?:[^>"']+|"[^"]*"|'[^']*')*>|[^a-zA-Z'<]+)+)}, $content;
}
else {
@parts = split m{([^a-zA-Z']+)}, $content;
}
for (@parts) {
next unless length;
if (/[^a-zA-Z']/) {
push @non_words, $_;
push @words, undef;
next;
}
if (s/^('+)//) {
push @non_words, $1;
push @words, undef;
}
my $end_apos;
if (s/('+)$//) {
$end_apos = $1;
}
if ($_ =~ /^(?:nbsp|amp|gt|lt)$/i ) {
push @words, undef;
push @non_words, $_;
}
elsif (/^[a-zA-Z']{2,}$/) {
push @words, $_;
push @non_words, undef;
}
else {
push @non_words, $_;
push @words, undef;
}
if ($end_apos) {
push @non_words, $end_apos;
push @words, undef;
}
}
require GT::SpellCheck;
my @check_words = map { (defined() ? (lc) : ()) } @words;
my $data = "$CFG->{priv_path}/lib/GT/SpellCheck";
my $sp = new GT::SpellCheck(
word_path => "$data/wordlist.ndx",
sndex_path => "$data/sndex.ndx",
acorrect_path => "$data/acorrect.ndx",
max_words => 10,
similarity_sort => 1
);
my $misspelled = $sp->check_words(\@check_words);
my $custom = $DB->table('CustomDict')->select(['custom_words'], { username_fk => $USER->{usr_username} });
$custom = $custom->fetchrow;
for ($custom ? split /\n/, $custom : ()) {
delete $misspelled->{lc $_};
}
my $corrections = [map +{ word => lc(), corrections => [ map +{ correction => $_ }, @{$misspelled->{$_}} ], num_corrections => scalar @{$misspelled->{$_}} }, keys %$misspelled];
my @loop;
for (0 .. $#words) {
if (defined $words[$_]) {
my $misspelled = exists $misspelled->{lc $words[$_]} ? 1 : 0;
if (@loop and not $loop[-1]->{misspelled} and not $misspelled) {
$loop[-1]->{word} .= $words[$_];
}
else {
push @loop, { word => $words[$_], misspelled => $misspelled };
}
}
else {
if (@loop and not $loop[-1]->{misspelled}) {
$loop[-1]->{word} .= $non_words[$_];
}
else {
push @loop, { word => $non_words[$_], misspelled => 0 };
}
}
}
my $misspellings = '';
$misspellings = join ",\n", map {
qq|"$_->{word}" : [| . join(",", map(qq: "$_->{correction}":, @{$_->{corrections}})) . "]"
} @$corrections;
return { words => \@loop, misspellings => \$misspellings };
}
END_OF_SUB
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
sub _determine_action {
#----------------------------------------------------------------------------
# Check valid action
my $action = shift || undef;
return if (!$action);
return 'msg_home' if ($action eq 'msg_search');
my %valid = (
map { $_ => 1 } qw(
msg_page
msg_home
msg_add_form
msg_add
msg_modify_form
msg_modify
msg_search_form
msg_send_sample
msg_send_form
msg_send
msg_move
msg_delete
msg_fview
msg_fdownload
msg_cat_add
msg_cat_modify
msg_cat_delete
msg_spellcheck
msg_addword
)
);
exists $valid{$action} and return $action;
return;
}
END_OF_SUB
1;
Reference in New Issue View Git Blame Copy Permalink