# ================================================================== # 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*\s*\s*<\/BODY>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*\s*<\/body>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*

\ <\/p><\/BODY>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*

\ <\/P><\/BODY>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*
\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("$GList::error") 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*\s*\s*<\/BODY>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*\s*<\/body>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*

\ <\/p><\/BODY>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*

\ <\/P><\/BODY>\s*<\/html>\s*$/i or $content_html =~ /^\s*\s*
\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*\s*\s*<\/BODY>\s*<\/html>\s*$/mi or $html =~ /^\s*\s*\s*<\/body>\s*<\/html>\s*$/mi or $html =~ /^\s*\s*

\ <\/p><\/BODY>\s*<\/html>\s*$/mi or $html =~ /^\s*\s*

\ <\/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//>/g; $text =~ s/"/"/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
amoung other things. # my $text = shift || ''; #($text =~ /<\/?(?:br|p|html)>/i) and return; #$text =~ s{\b((?:https?|ftp)://(?:[^@]*@)?[\w.-]+(?:/\S*)?)}{$1}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/
\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

'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/ / /ig;
    $$convert =~ s/"/"/ig;
    $$convert =~ s/&/&/ig;
    $$convert =~ s/©/(C)/ig;
    $$convert =~ s/®/(R)/ig;
    $$convert =~ s/™/^TM/ig;

    $$convert =~ s///sg;
    $$convert =~ s/
  • \s*(.*?)\s*<\/li>/\n* $1\n/sig; $$convert =~ s/
  • \s*([^<]*)/\n* $1/sig; $$convert =~ s[]*>][\n\n]ig; $$convert =~ s/]*>/\n/ig; $$convert =~ s[]*>][\n]ig; # $$convert =~ s[([^<]*)][*$1*]ig; # $$convert =~ s[([^<]*)][_$1_]ig; $$convert =~ s[]*>][\n\n]ig; $$convert =~ s/]*>/\n$dash\n/ig; my @tokens = split /(<[^>"']*(?:(?:(?:"[^"]*"[^>"]*)|(?:'[^']*'[^>']*)))*>)/, $$convert; $$convert = join '' => map { $tokens[$_] } grep { not $_ % 2 } 0 .. $#tokens; $$convert =~ s/<//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;