!;
+}
diff --git a/site/forum.slowtwitch.com/cgi-bin/ticker/admin/.htaccess b/site/forum.slowtwitch.com/cgi-bin/ticker/admin/.htaccess
new file mode 100644
index 0000000..2fb0232
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/ticker/admin/.htaccess
@@ -0,0 +1,6 @@
+AuthUserFile /home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin/.htpasswd
+AuthGroupFile /dev/null
+AuthType Basic
+AuthName "Gossamer Forum Administration"
+
+require valid-user
diff --git a/site/forum.slowtwitch.com/cgi-bin/ticker/admin/admin.cgi b/site/forum.slowtwitch.com/cgi-bin/ticker/admin/admin.cgi
new file mode 100755
index 0000000..ddea9f9
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/ticker/admin/admin.cgi
@@ -0,0 +1,160 @@
+#!/bin/env perl
+#
+# The ticker (client & admin) loosely follows an MVC architecture. The model
+# is over in Ticker.pm (it does all the DB work). ticker.cgi is the view for
+# the client, while this is the view+controller for the admin.
+#
+use strict;
+use warnings;
+use lib '/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin';
+use GForum qw($IN);
+GForum::init('/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin');
+use Ticker;
+use Error qw(:try);
+
+use constant {
+ STATE_NORMAL => 0,
+ STATE_UPDATE => 1,
+ STATE_REDIRECT => 2,
+ ADMIN_URL => "http://forum.slowtwitch.com/cgi-bin/ticker/admin/admin.cgi"
+};
+
+# prototypes.
+sub controller();
+sub view($);
+
+# And call the controller.
+controller();
+
+#
+# This is the controller. This is where work gets done.
+#
+sub controller() {
+ my %viewstate = (state => STATE_NORMAL);
+
+ # if we have an action parameter (that's non-empty), then do work:
+ if(defined $IN->param('action') && length($IN->param('action')) > 0) {
+ $viewstate{state} = STATE_REDIRECT;
+ try {
+ my $p = $IN->get_hash();
+ if($p->{action} =~ /create/) {
+ Ticker::create_ticker($p->{msg}, $p->{link});
+ } elsif($p->{action} =~ /show_update/) {
+ $viewstate{state} = STATE_UPDATE;
+ $viewstate{id} = $p->{'id'};
+ } elsif($p->{action} =~ /do_update/) {
+ Ticker::update_ticker($p->{'id'}, $p->{'msg'}, $p->{'link'});
+ } elsif($p->{action} =~ /delete/) {
+ Ticker::delete_ticker($p->{'id'});
+ }
+ } catch Ticker::TickerException with {
+ # oops. something bad happened.
+ $viewstate{error} = "Error: " . shift;
+ # reset the viewstate so that we display the error message.
+ $viewstate{state} = STATE_NORMAL;
+ };
+ }
+
+ return view(\%viewstate);
+}
+
+
+#
+# Build the view, which takes a single hashref describing how the view should
+# behave.
+#
+sub view($) {
+ my ($state) = @_;
+ my %s = %$state;
+
+ # If the state is redirect, we're done.
+ if($s{state} == STATE_REDIRECT) {
+ print $IN->redirect(ADMIN_URL);
+ return;
+ }
+
+ # Now let's actually build the view, depending on our current state:
+ print $IN->header();
+ print qq{Ticker Admin};
+
+ # Try to load all the tickers:
+ try {
+ $s{data} = Ticker::read_tickers();
+
+ # Are we also trying to update a record? Yeah, I know - we're
+ # hitting the db again. I wish that fetchall_hashref actually worked...
+ if(defined $s{id}) {
+ my $result = Ticker::read_ticker($s{id});
+ $s{msg} = $result->{ticker_text};
+ $s{link} = $result->{ticker_link};
+ }
+ } catch Ticker::TickerException with {
+ $s{error} .= " Could not read tickers from database!";
+ };
+
+ # Print an error message if we have one:
+ if(defined $s{error}) {
+ print "
" . $s{error} . "
";
+ }
+
+ # What should the top form look like?
+ if($s{state} == STATE_NORMAL) {
+ $s{title} = 'Create a ticker:';
+ $s{submit} = 'Create ticker';
+ $s{action} = 'create';
+ $s{id} = "";
+ $s{msg} = "";
+ $s{link} = "";
+ } elsif($s{state} == STATE_UPDATE) {
+ $s{title} = 'Update a ticker:';
+ $s{submit} = 'Update ticker';
+ $s{action} = 'do_update';
+ }
+
+ # print the form, which is configured for the type of action we're
+ # performing:
+ print qq{
} . $s{title} . qq{
+
+ };
+
+ # provide a way to get back to the create interface:
+ if($s{action} =~ /update/) {
+ print qq{Create a ticker instead.};
+ }
+
+ # Now print the entire list of all tickers.
+ print qq{
Current tickers:
};
+
+
+ # If there are no tickers, say so:
+ if(@{$s{data}} == 0) {
+ print "There are no tickers.";
+ } else {
+ # Print a table showing the ID, delete/edit links, messages, and links:
+ print "
";
+ print "
ID
Message
Link
";
+ foreach my $k (@{$s{data}}) {
+ my $id = $k->{ticker_id};
+ my $msg = $k->{ticker_text};
+ my $link = $k->{ticker_link};
+ print qq{
";
+ }
+ print qq{};
+}
+
diff --git a/site/forum.slowtwitch.com/cgi-bin/ticker/admin/sql.cgi b/site/forum.slowtwitch.com/cgi-bin/ticker/admin/sql.cgi
new file mode 100755
index 0000000..96398a7
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/ticker/admin/sql.cgi
@@ -0,0 +1,8 @@
+#!/bin/env perl
+
+use strict;
+use warnings;
+use lib '/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin';
+use Ticker;
+
+Ticker::create_table();
diff --git a/site/forum.slowtwitch.com/cgi-bin/ticker/coupons.cgi b/site/forum.slowtwitch.com/cgi-bin/ticker/coupons.cgi
new file mode 100755
index 0000000..5256555
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/ticker/coupons.cgi
@@ -0,0 +1,18 @@
+#!/bin/env perl
+#
+# Handle requests for the client-side view of the Ticker.
+#
+# Returns an xml document containing all the tickers currently present in
+# the database.
+#
+
+use strict;
+use warnings;
+use lib '/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin';
+use GForum qw($IN);
+GForum::init('/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin');
+use Ticker;
+
+print $IN->header();
+GForum::Template->parse_print('include_ticker_coupons.html');
+
diff --git a/site/forum.slowtwitch.com/cgi-bin/ticker/ticker.cgi b/site/forum.slowtwitch.com/cgi-bin/ticker/ticker.cgi
new file mode 100755
index 0000000..1a7c813
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/ticker/ticker.cgi
@@ -0,0 +1,17 @@
+#!/bin/env perl
+#
+# Handle requests for the client-side view of the Ticker.
+#
+# Returns an xml document containing all the tickers currently present in
+# the database.
+#
+
+use strict;
+use warnings;
+use lib '/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin';
+use GForum qw($IN);
+GForum::init('/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin');
+use Ticker;
+
+print $IN->header(-type => "text/xml");
+print Ticker::read_tickers_xml();
diff --git a/site/forum.slowtwitch.com/cgi-bin/tickerad/admin/.htaccess b/site/forum.slowtwitch.com/cgi-bin/tickerad/admin/.htaccess
new file mode 100644
index 0000000..2fb0232
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/tickerad/admin/.htaccess
@@ -0,0 +1,6 @@
+AuthUserFile /home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin/.htpasswd
+AuthGroupFile /dev/null
+AuthType Basic
+AuthName "Gossamer Forum Administration"
+
+require valid-user
diff --git a/site/forum.slowtwitch.com/cgi-bin/tickerad/admin/admin.cgi b/site/forum.slowtwitch.com/cgi-bin/tickerad/admin/admin.cgi
new file mode 100755
index 0000000..d8c8498
--- /dev/null
+++ b/site/forum.slowtwitch.com/cgi-bin/tickerad/admin/admin.cgi
@@ -0,0 +1,160 @@
+#!/bin/env perl
+#
+# The ticker (client & admin) loosely follows an MVC architecture. The model
+# is over in TickerAd.pm (it does all the DB work). ticker.cgi is the view for
+# the client, while this is the view+controller for the admin.
+#
+use strict;
+use warnings;
+use lib '/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin';
+use GForum qw($IN);
+GForum::init('/home/slowtwitch/forum.slowtwitch.com/cgi-bin/admin');
+use TickerAd;
+use Error qw(:try);
+
+use constant {
+ STATE_NORMAL => 0,
+ STATE_UPDATE => 1,
+ STATE_REDIRECT => 2,
+ ADMIN_URL => "http://forum.slowtwitch.com/cgi-bin/tickerad/admin/admin.cgi"
+};
+
+# prototypes.
+sub controller();
+sub view($);
+
+# And call the controller.
+controller();
+
+#
+# This is the controller. This is where work gets done.
+#
+sub controller() {
+ my %viewstate = (state => STATE_NORMAL);
+
+ # if we have an action parameter (that's non-empty), then do work:
+ if(defined $IN->param('action') && length($IN->param('action')) > 0) {
+ $viewstate{state} = STATE_REDIRECT;
+ try {
+ my $p = $IN->get_hash();
+ if($p->{action} =~ /create/) {
+ TickerAd::create_ticker($p->{msg}, $p->{link});
+ } elsif($p->{action} =~ /show_update/) {
+ $viewstate{state} = STATE_UPDATE;
+ $viewstate{id} = $p->{'id'};
+ } elsif($p->{action} =~ /do_update/) {
+ TickerAd::update_ticker($p->{'id'}, $p->{'msg'}, $p->{'link'});
+ } elsif($p->{action} =~ /delete/) {
+ TickerAd::delete_ticker($p->{'id'});
+ }
+ } catch TickerAd::TickerAdException with {
+ # oops. something bad happened.
+ $viewstate{error} = "Error: " . shift;
+ # reset the viewstate so that we display the error message.
+ $viewstate{state} = STATE_NORMAL;
+ };
+ }
+
+ return view(\%viewstate);
+}
+
+
+#
+# Build the view, which takes a single hashref describing how the view should
+# behave.
+#
+sub view($) {
+ my ($state) = @_;
+ my %s = %$state;
+
+ # If the state is redirect, we're done.
+ if($s{state} == STATE_REDIRECT) {
+ print $IN->redirect(ADMIN_URL);
+ return;
+ }
+
+ # Now let's actually build the view, depending on our current state:
+ print $IN->header();
+ print qq{TickerAd Admin};
+
+ # Try to load all the tickers:
+ try {
+ $s{data} = TickerAd::read_tickers();
+
+ # Are we also trying to update a record? Yeah, I know - we're
+ # hitting the db again. I wish that fetchall_hashref actually worked...
+ if(defined $s{id}) {
+ my $result = TickerAd::read_ticker($s{id});
+ $s{msg} = $result->{ticker_text};
+ $s{link} = $result->{ticker_link};
+ }
+ } catch TickerAd::TickerAdException with {
+ $s{error} .= " Could not read tickers from database!";
+ };
+
+ # Print an error message if we have one:
+ if(defined $s{error}) {
+ print "
" . $s{error} . "
";
+ }
+
+ # What should the top form look like?
+ if($s{state} == STATE_NORMAL) {
+ $s{title} = 'Create a ticker:';
+ $s{submit} = 'Create ticker';
+ $s{action} = 'create';
+ $s{id} = "";
+ $s{msg} = "";
+ $s{link} = "";
+ } elsif($s{state} == STATE_UPDATE) {
+ $s{title} = 'Update a ticker:';
+ $s{submit} = 'Update ticker';
+ $s{action} = 'do_update';
+ }
+
+ # print the form, which is configured for the type of action we're
+ # performing:
+ print qq{
} . $s{title} . qq{
+
+ };
+
+ # provide a way to get back to the create interface:
+ if($s{action} =~ /update/) {
+ print qq{Create a ticker instead.};
+ }
+
+ # Now print the entire list of all tickers.
+ print qq{
Current tickers:
};
+
+
+ # If there are no tickers, say so:
+ if(@{$s{data}} == 0) {
+ print "There are no tickers.";
+ } else {
+ # Print a table showing the ID, delete/edit links, messages, and links:
+ print "
";
+ print "
ID
Message
Link
";
+ foreach my $k (@{$s{data}}) {
+ my $id = $k->{ticker_id};
+ my $msg = $k->{ticker_text};
+ my $link = $k->{ticker_link};
+ print qq{
";
+
+ return $info;
+}
+
+sub display {
+# -----------------------------------------------------------------
+# Returns a specified template parsed.
+#
+ my ($template, $args) = @_;
+
+ my $template_set = $IN->param('t') || $CFG->{template_set};
+ my $template_dir = "$CFG->{priv_path}/templates/$template_set";
+ my $http = $IN->url(absolute => 0, query_string => 0);
+
+# Add config vars.
+ foreach my $key (keys %$CFG) {
+ $args->{$key} = $CFG->{$key} unless (exists $args->{$key});
+ }
+
+# Used for HTML editor
+ my %browser = $IN->browser_info;
+ delete $browser{is_ie} if $browser{is_ie} and $browser{ie_version} < 5.5;
+ @$args{keys %browser} = values %browser;
+
+ $args->{html}->{in} = $IN;
+ $args->{html}->{sql} = $DB;
+ $args->{html}->{cfg} = $CFG;
+ $args->{selected_menu} = $MN_SELECTED;
+
+# Loads template globals
+ load_globals();
+
+# Escapes HTML code
+ my $cgi = $IN->get_hash();
+ my $content = $cgi->{msg_content_html};
+ if ( $content ) {
+ $content =~ s,\r\n,\n,g;
+ $cgi->{msg_content_html} = $IN->html_escape($content);
+ }
+
+ unless (defined $args->{hidden_query}) {
+ my $hidden = hidden();
+ $args->{hidden_query} = $hidden->{hidden_query};
+ $args->{hidden_objects} = $hidden->{hidden_objects};
+ }
+ print $IN->header;
+ GT::Template->parse($template, [$args, $cgi, $GLOBALS, $USER || {}], { print => 1, root => $template_dir });
+}
+
+sub set_default_template {
+#-----------------------------------------------------------
+# Add default email template when adding a user
+#
+ my ($fname, $userid) = @_;
+ require GT::Mail::Editor;
+ my $email = GT::Mail::Editor->new(dir => "$CFG->{priv_path}/templates", template => $CFG->{template_set});
+ $email->load($fname);
+ my $hsh = {};
+ my $cgi = $IN->get_hash();
+
+ $fname =~ s/\.eml//;
+ $hsh->{tpl_user_id_fk} = $userid;
+ $hsh->{tpl_name} = $fname;
+ $hsh->{tpl_to} = $email->{headers}->{To};
+ $hsh->{tpl_from} = $email->{headers}->{From};
+ $hsh->{tpl_subject}= $email->{headers}->{Subject};
+ $hsh->{tpl_body} = $email->{body};
+
+ $DB->table('EmailTemplates')->insert($hsh);
+}
+
+sub add {
+#--------------------------------------------------------------------
+# Add a record
+#
+ my ($table, $prefix, $cgi) = @_;
+
+ my $db = $DB->table($table) or return $GT::SQL::error;
+
+# Turn arrays into delimited fields
+ $cgi ||= format_insert_cgi($db);
+
+# Save the current time
+ if ( $table eq 'Messages' ) {
+ $cgi->{msg_created} = time;
+ if ($cgi->{msg_content_html} =~ /^\s*\s*\s*<\/BODY>\s*<\/html>\s*$/mi or
+ $cgi->{msg_content_html} =~ /^\s*\s*\s*<\/body>\s*<\/html>\s*$/mi or
+ $cgi->{msg_content_html} =~ /^\s*\s*
\ <\/p><\/BODY>\s*<\/html>\s*$/mi or
+ $cgi->{msg_content_html} =~ /^\s*\s*
\ <\/P><\/BODY>\s*<\/html>\s*$/mi) {
+ $cgi->{msg_content_html} = "";
+ }
+ }
+ elsif ( $table eq 'Lists' ) {
+ $cgi->{lst_date_created} = time;
+ }
+
+# Add the record's owner
+ $cgi->{$prefix.'_user_id_fk'} = $USER->{usr_username};
+
+# Setup the language for GT::SQL.
+ local $GT::SQL::ERRORS->{ILLEGALVAL} = language('ADD_ILLEGALVAL') if ( language('ADD_ILLEGALVAL') );
+ local $GT::SQL::ERRORS->{UNIQUE} = language('ADD_UNIQUE') if ( language('ADD_UNIQUE') );
+ local $GT::SQL::ERRORS->{NOTNULL} = language('ADD_NOTNULL') if ( language('ADD_NOTNULL') );
+
+ my $cols = $db->cols;
+
+ foreach my $c ( keys % $cols ) {
+ my $regex = $cols->{$c}->{form_regex};
+ if ( $regex and $cgi->{$c} !~ /$regex/ ) {
+ $error .= language('SYS_REGEXFAIL', $cols->{$c}->{form_display});
+ }
+ }
+ return if ( $error );
+ if ( defined (my $ret = $db->add($cgi)) ) {
+ return $ret;
+ }
+ else {
+ local $^W;
+ $error = $GT::SQL::error;
+ }
+}
+
+sub modify {
+#--------------------------------------------------------------------
+# Modify a record
+#
+ my ($table, $prefix, $cgi) = @_;
+
+ my $db = $DB->table($table) or return $GT::SQL::error;
+
+# Format arrays for insertion
+ $cgi ||= format_insert_cgi($db, $cgi);
+
+# Check if users can modify only their own records except Administrator
+ if ( $USER->{usr_type} != ADMINISTRATOR ) {
+ my $lookup = {};
+ my $pk = $db->pk;
+ foreach (@$pk) { $lookup->{$_} = $IN->param($_); }
+ my $rs = $db->get($lookup);
+
+ if ( $rs->{$prefix.'_user_id_fk'} ne $USER->{usr_username} ) {
+ $error = language('SYS_PER_DENIED');
+ return;
+ }
+ }
+
+# Setup the language for GT::SQL.
+ local $GT::SQL::ERRORS->{ILLEGALVAL} = language('ADD_ILLEGALVAL') if ( language('ADD_ILLEGALVAL') );
+ local $GT::SQL::ERRORS->{UNIQUE} = language('ADD_UNIQUE') if ( language('ADD_UNIQUE') );
+ local $GT::SQL::ERRORS->{NOTNULL} = language('ADD_NOTNULL') if ( language('ADD_NOTNULL') );
+
+ if ( $table eq 'Messages' ) {
+ if ($cgi->{msg_content_html} =~ /^\s*\s*
\s*<\/BODY>\s*<\/html>\s*$/mi or
+ $cgi->{msg_content_html} =~ /^\s*\s*\s*<\/body>\s*<\/html>\s*$/mi or
+ $cgi->{msg_content_html} =~ /^\s*\s*
\ <\/p><\/BODY>\s*<\/html>\s*$/mi or
+ $cgi->{msg_content_html} =~ /^\s*\s*
\ <\/P><\/BODY>\s*<\/html>\s*$/mi) {
+ $cgi->{msg_content_html} = "";
+ }
+ if ($cgi->{msg_mode} eq 'text') {
+ $cgi->{msg_content_html} = '';
+ }
+ }
+ if ( $db->modify($cgi) ) {
+ return;
+ }
+ else {
+ local $^W;
+ $error = $GT::SQL::error;
+ }
+}
+
+sub delete {
+#--------------------------------------------------------------------
+# Delete records
+#
+ my ($table, $prefix, $cgi, $msg) = @_;
+
+ my $db = $DB->table($table);
+
+# Create a cgi object
+ $cgi ||= $IN->get_hash();
+
+# If they selected only one record to delete we still need an array ref
+ my $mod = ( ref $cgi->{modify} eq 'ARRAY' ) ? $cgi->{modify} : [$cgi->{modify}];
+
+# Need to know the names of the columns for this Table.
+ my @columns = keys %{$db->cols};
+
+# Need to know the number of records modified
+ my $rec_modified = 0;
+ my $rec_declined = 0;
+
+
+ if ( $table eq 'Messages' or $table eq 'MailingIndex' ) {
+ require GT::File::Tools;
+ }
+
+# For through the record numbers. These are the values of the
+# check boxes
+ foreach my $rec_num ( @{$mod} ) {
+ my $change = {};
+ foreach my $column ( @columns ) {
+ $change->{$column} = $cgi->{"$rec_num-$column"} if ( $cgi->{"$rec_num-$column"} );
+ }
+
+# Check for delete own record
+ if ( $USER->{usr_type} != ADMINISTRATOR ) { # As a user
+ my $rs = $db->get($change);
+ next if ( !$rs );
+ if ( $rs->{$prefix.'_user_id_fk'} ne $USER->{usr_username} ) {
+ $rec_declined++; next;
+ }
+ }
+ next unless ( keys %$change );
+ if ( $table eq 'MailingIndex' ) {
+ if ( int $cgi->{fd} and $cgi->{fd} == 3 ) { # Deletes records
+ my $info = $db->get($change) || {};
+ if ( $USER->{usr_type} == ADMINISTRATOR or !$info->{mli_Done} ) { # Admin user
+ my $ret = $db->delete($change);
+ if ( defined $ret and ($ret != 0) ) {
+ $rec_modified++;
+ }
+ }
+ else {
+ $db->update({ mli_delete => '2', mli_cat_id_fk => 0, mli_root => '0' }, $change);
+ $rec_modified++;
+ }
+ }
+ else { # Marks records
+ $db->update({ mli_delete => '1', mli_cat_id_fk => 0, mli_root => '0' }, $change);
+ $rec_modified++;
+ }
+ }
+ else {
+ my $ret = $db->delete($change) or die $GT::SQL::error;
+ if ( defined $ret and ($ret != 0) ) {
+ $rec_modified++;
+ }
+ }
+
+# Remove attachments
+ my $id = $IN->param("$rec_num-msg_id");
+ if ( $table eq 'Messages' and $id ) {
+ remove_attachments($id, 'messages');
+ }
+
+ $id = $IN->param("$rec_num-Mailing");
+ if ( $table eq 'MailingIndex' and $id and $cgi->{fd} == 3 ) {
+ remove_attachments($id, 'mailings');
+ }
+ }
+ $msg ||= ( $rec_declined ) ? GList::language('SYS_DELETED2', $rec_modified, $rec_declined) : GList::language('SYS_DELETED', $rec_modified);
+ return $msg;
+}
+
+sub send {
+#--------------------------------------------------------
+# Send a message by using GT::Mail
+#
+ my ($head, $content, $attachments, $attach_path, $charset) = @_;
+
+ $attachments ||= [];
+ $charset ||= 'us-ascii';
+ require GT::Mail;
+ $GT::Mail::error ||= ''; # Silence -w
+
+ my $m = GT::Mail->new(debug => $CFG->{debug_level}, header_charset => $charset);
+ my $parts;
+ if ( $content->{text} and $content->{html} ) {
+ $parts = $m->new_part('Content-Type' => "multipart/alternative; charset=\"$charset\"");
+ $parts->parts($m->new_part(
+ 'Content-Type' => "text/plain; charset=\"$charset\"",
+ body_data => $content->{text},
+ encoding => 'quoted-printable'
+ ));
+ $parts->parts($m->new_part(
+ 'Content-Type' => "text/html; charset=\"$charset\"",
+ body_data => $content->{html},
+ encoding => 'quoted-printable'
+ ));
+ }
+ elsif (@$attachments) {
+ my $msg = $content->{text} || $content->{html};
+ my $type = ( $msg =~ m/(|
)/i ? "text/html" : "text/plain" );
+ $type = "text/html" if ($content->{html});
+ $parts = $m->new_part(
+ 'Content-Type' => "$type; charset=\"$charset\"",
+ body_data => $msg,
+ encoding => 'quoted-printable'
+ );
+ }
+ else {
+ my $msg = $content->{text} || $content->{html};
+ my $type = ( $msg =~ m/(|)/i ? "text/html" : "text/plain" );
+ $type = "text/html" if ($content->{html});
+ $parts = $m->new_part(
+ 'Content-Type' => "$type; charset=\"$charset\"",
+ encoding => 'quoted-printable'
+ );
+ $head->{body_data} = $msg;
+ }
+
+# Handle the attachments
+ if (@$attachments) {
+ my $apart = $m->new_part('Content-Type' => 'multipart/mixed');
+ $apart->parts($parts);
+ for (@$attachments) {
+ my $id = $_->{att_id} || $_->{mat_id};
+ my $filename = $_->{mat_file_name} || $_->{att_file_name};
+ my $content_type = _load_mime("$attach_path/$id", $filename);
+ $apart->parts($m->new_part(
+ body_path => "$attach_path/$id",
+ encoding => '-guess',
+ filename => $filename,
+ 'Content-Type' => $content_type
+ ));
+ }
+ $parts = $apart;
+ }
+
+ $head->{'Content-Type'} = $parts->get('Content-Type');
+
+ my $mail = GT::Mail->new(
+ %$head,
+ debug => $CFG->{debug_level},
+ header_charset => $charset,
+ );
+ for ($parts->parts()) {
+ $mail->attach($_);
+ }
+
+ $mail->send(
+ smtp => $CFG->{smtp_server},
+ sendmail => $CFG->{mail_path},
+ ) or warn $GT::Mail::error;
+}
+
+sub hidden {
+#--------------------------------------------------------------------
+#
+ my $args = shift || [];
+
+ push @$args, 'users';
+ my $cgi = $IN->get_hash();
+ my ($hidden_query, $hidden_objects) = ('', '');
+ if ($CFG->{user_session} and ($cgi->{sid} or $USER->{session_id})) {
+ my $session_id = $cgi->{sid} || $USER->{session_id};
+ $hidden_query = ";sid=$session_id";
+ $hidden_objects = qq!!;
+ }
+ foreach (@$args) {
+ next unless $cgi->{$_};
+ $hidden_query .= ";$_=$cgi->{$_};$_-opt==";
+ $hidden_objects .= qq!
+
+ !;
+ }
+ return { hidden_query => $hidden_query, hidden_objects => $hidden_objects };
+}
+
+sub _search_check {
+#--------------------------------------------------------------------
+#
+ my ($cols, $cgi) = @_;
+ foreach (keys % $cols) {
+ my ($c) = $_ =~ /\.([^.]+)$/;
+ $c ||= $_;
+ if (exists $cgi->{$c} and $cgi->{$c}) {
+ return 1;
+ }
+ if ($cgi->{"$c-ge"} or $cgi->{"$c-le"} or $cgi->{"$c-gt"} or $cgi->{"$c-lt"}) {
+ return 1;
+ }
+ }
+ return;
+}
+
+sub search {
+#--------------------------------------------------------------------
+# Search engine
+#
+ my $opts = ref $_[0] eq 'HASH' ? shift : { @_ };
+ my $cgi = $opts->{cgi};
+ my $db = $opts->{db};
+ my $prefix = $opts->{prefix};
+ my $based_on = $opts->{based_on};
+ my $skip_user = $opts->{skip_user};
+ my $search_check= $opts->{search_check};
+ my $search_alpha= $opts->{search_alpha};
+ my $search_col = $opts->{search_col};
+ my $return_msg = $opts->{return_msg};
+ my $select_all = $opts->{select_all};
+ my $show_user = $opts->{show_user};
+ my $int_field = $opts->{int_field};
+ $return_msg ||= uc($prefix).'_RESULTS';
+
+ my $user_field = $prefix."_user_id_fk";
+ my $nh = $cgi->{nh} || 1;
+ my $mh = $cgi->{mh} || 25;
+ my $ma = $cgi->{ma} || '';
+ my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh;
+ my $sb = $cgi->{sb} || $opts->{sb};
+ my $so = $cgi->{so} || $opts->{so};
+ my $cols = $db->cols;
+ my $table_name = $db->name;
+ my $db_prefix = $DB->prefix;
+ $table_name =~ s/^$db_prefix//;
+
+ $sb ||= $opts->{sb};
+ $so ||= $opts->{so} || 'ASC';
+ if ($search_check and !$cgi->{keyword} and !_search_check($cols, $cgi)) {
+ return { error => GList::language('SYS_SEARCH_ERROR') };
+ }
+
+# Require GT's modules
+ require GT::SQL::Condition;
+ require GT::Date;
+
+ my ($cd, @words);
+ my $query = '';
+ if ( $cgi->{keyword} and $cgi->{keyword} ne '*' ) { # keyword search
+ $cd = new GT::SQL::Condition('OR');
+ if ( $ma ) { # match any
+ @words = split(/\s/, $cgi->{keyword});
+ }
+ else {
+ push @words, $cgi->{keyword};
+ }
+
+ foreach my $c ( keys % $cols ) {
+ if ( $cols->{$c}->{weight} ) { # search weight
+ foreach my $w ( @words ) {
+ $cd->add($c, 'like', "%$w%");
+ }
+ }
+ }
+ $query = "keyword=$cgi->{keyword};";
+ }
+ else {
+ my $bool = ( $ma ) ? 'OR' : 'AND';
+ $cd = new GT::SQL::Condition($bool);
+ if ($search_alpha) {
+ if ( $search_col and $search_alpha eq 'other') { # for Subscribers table only
+ my $tmp = GT::SQL::Condition->new('OR');
+ $tmp->add($search_col => '<' => '0');
+ $tmp->add(GT::SQL::Condition->new($search_col => '>=' => ':', $search_col => '<' => 'a'));
+ $tmp->add($search_col => '>=' => '[');
+ $cd->add($tmp);
+ $query .= 'alpha=other;';
+ }
+ elsif ( $search_col and $search_alpha eq 'number') { # for Subscribers table only
+ my $tmp = GT::SQL::Condition->new($search_col => '>=' => '0', $search_col => '<' => ':');
+ $cd->add($tmp);
+ $query .= 'alpha=number;';
+ }
+ else {
+ $cd->add($search_col, 'like', "$search_alpha%");
+ }
+ }
+
+ foreach my $c ( keys % $cols ) {
+ my $tc = $c;
+ if ( $based_on ) {
+ $tc =~ s/$based_on\.//;
+ }
+ next if ( $c and $cgi->{$tc} and ( $c eq $user_field or $cgi->{$tc} eq '*' ));
+ if ( $cols->{$c}->{type} =~ /date|datetime|timestamp/mi or !$cgi->{$tc} ) { # DATE fields
+ if ( defined $cgi->{$tc} and $cgi->{$tc} eq '0' ) {
+ $cd->add($c, $cgi->{"$tc-opt"} || '=', $cgi->{$tc} );
+ $query .= "$tc=0;";
+ }
+ else {
+ my $tmp = {'le' => '<=', 'ge' => '>=', 'lt' => '<', 'gt' => '>'};
+ my $format = $USER->{usr_date_format} || '%mm%-%dd%-%yyyy%';
+ foreach my $o (keys % {$tmp} ) {
+ next if ( !$cgi->{"$tc-$o"} );
+ my $v;
+ if ($int_field) {
+ $v = $cgi->{"$tc-$o"};
+ }
+ else {
+ $cgi->{"$tc-$o"} .= ( $o eq 'le' or $o eq 'lt' ) ? ' 23:59:58' : ' 00:00:01';
+ $v = GT::Date::timelocal(GT::Date::parse_format($cgi->{"$tc-$o"}, "$format %hh%:%MM%:%ss%"));
+ }
+ $cd->add($c, $tmp->{$o}, $v);
+ $query .= "$tc-$o=".$cgi->{"$tc-$o"}.';';
+ }
+ }
+ }
+ elsif ( $cgi->{"$tc-opt"} ) {
+ $cd->add($c, $cgi->{"$tc-opt"}, $cgi->{$tc});
+ $query .= "$tc=$cgi->{$tc};$c-opt=".$cgi->{"$tc-opt"}.";";
+ }
+ elsif ( $cols->{$c}->{type} =~ /char|varchar|text/mi ) { # TEXT fields
+ $cd->add($c, 'like', "%$cgi->{$tc}%");
+ $query .= "$tc=$cgi->{$tc};";
+ }
+ else {
+ $cd->add($c, '=', $cgi->{$tc});
+ $query .= "$tc=$cgi->{$tc};";
+ }
+ }
+ }
+ $query .= 'ma=1;' if ($ma);
+ my @extra = ('cs', 'mn_disable');
+ foreach (@extra) {
+ $query .= "$_=$cgi->{$_};" if ($cgi->{$_});
+ }
+ chop $query;
+
+# System users will view their own record only
+ my $cond = new GT::SQL::Condition($cd);
+ if ( !$skip_user ) {
+ if ( $USER->{usr_type} != ADMINISTRATOR ) {
+ $cond->add($user_field, '=', $USER->{usr_username});
+ }
+ elsif ( $cgi->{$user_field} ) {
+ my $o = $cgi->{"$user_field-opt"} || '=';
+ $cond->add($user_field, $o, $cgi->{$user_field});
+ }
+ else {
+ my $user = load_condition($show_user);
+ $cond->add($user_field, $user->{opt}, $user->{id});
+ }
+ }
+# Do the search and count the results.
+ if ( !$select_all ) {
+ $db->select_options("ORDER BY $sb $so LIMIT $bg, $mh ");
+ }
+ my $sth = $db->select($cond) or die $GT::SQL::error;
+ my $hits= $db->hits;
+
+ return language($return_msg, 0) if ( $hits == 0 );
+
+ if ( $#words == -1 and $cgi->{lu} ) {
+ @words = split(/\s/, $cgi->{lu});
+ }
+ my @output;
+ my @colors = ('#ff8888', '#88ff88', '#8888ff', '#ffff88', '#ff88ff', '#88ffff', '#ffcccc', '#cccc99', '#ffffcc', '#ffccff');
+ while ( my $rs = $sth->fetchrow_hashref ) {
+ if ( $CFG->{highlight_color} ) {
+ if ( $#words != -1 ) {
+ foreach my $c ( keys % $cols ) {
+ next if ( !$cols->{$c}->{weight} );
+ my $j = 0;
+ foreach my $i (0..$#words) {
+ $j = 0 if ( $j > $#colors );
+ $rs->{$c} =~ s/$words[$i]/$words[$i]<\/span>/gi;
+ $j++;
+ }
+ }
+ }
+ }
+ push @output, $rs;
+ }
+
+ return { hits => $hits,
+ results => \@output,
+ msg => language($return_msg, $hits),
+ query => $query,
+ mh => $mh,
+ nh => $nh,
+ lookup => $cgi->{keyword},
+ toolbar_table => $table_name
+ };
+}
+
+sub remove_attachments {
+#-----------------------------------------------------------------------
+#
+ my ($id, $dir) = @_;
+
+ my $path = "$CFG->{priv_path}/attachments/$dir/" . ($id % 10) . "/$id";
+ (-e $path) or return "Invalid path $path!";
+
+ opendir (DIR, $path) or return GList::language('DIR_OPEN_ERR', $path, $!);
+ my @list = readdir(DIR);
+ closedir (DIR);
+ foreach my $file (@list) {
+ ($file eq '.') and next;
+ ($file eq '..') and next;
+ unlink "$path/$file";
+ }
+ rmdir $path;
+ return;
+}
+
+sub load_condition {
+#-----------------------------------------------------------------------
+# Loads the user listings in a group for searching
+# It will be returned a hash
+#
+ my $show_user = shift;
+
+ my $cgi = $IN->get_hash();
+ $show_user ||= $cgi->{users};
+ if ( $show_user and $USER->{usr_type} == ADMINISTRATOR) { # For admin
+ return { id => $USER->{usr_username}, opt => '<>' };
+ }
+ else { # Check current user
+ return { id => $USER->{usr_username}, opt => '=' };
+ }
+}
+
+sub get_data {
+#--------------------------------------------------------------------
+# Get data of a record
+#
+ my $table = shift;
+
+ my $values;
+ my $mod = $IN->param('modify');
+
+ if ( $IN->param('modify') == 0 ) {
+ $values = $IN->get_hash;
+ }
+ else {
+ my $lookup = {};
+ my $db = $DB->table($table);
+ my $pk = $db->pk;
+ foreach ( @$pk ) { $lookup->{$_} = $IN->param("$mod-$_"); }
+ $values = $db->get($lookup, 'HASH');
+ }
+
+ return $values;
+}
+
+sub format_insert_cgi {
+#-----------------------------------------------------------------------------
+#
+ my ($db, $cgi) = @_;
+
+ $cgi ||= $IN->get_hash;
+ my $cols = $db->cols;
+ foreach ( keys % $cols ) {
+ if ( !exists $cgi->{$_} and uc($cols->{$_}->{form_type}) eq 'CHECKBOX' ) {
+ $cgi->{$_} = '';
+ }
+ next unless ( ref ($cgi->{$_}) eq 'ARRAY' );
+ $cgi->{$_} = join ($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort (@{$cgi->{$_}}));
+ }
+ return $cgi;
+}
+
+sub check_owner {
+#--------------------------------------------------------------------
+# User can only modify their own record, except admin
+#
+ my ($table, $pre_fix, $id) = @_;
+
+ my $info = $DB->table($table)->get($id);
+ ( $info ) or return "$id does not exist!";
+
+# Users can only modify their own records
+ if ( $USER->{usr_type} != ADMINISTRATOR and $info->{$pre_fix.'_user_id_fk'} ne $USER->{usr_username} ) {
+ return GList::language('SYS_PER_DENIED');
+ }
+
+ return $info;
+}
+
+sub check_limit {
+#------------------------------------------------------------------------------
+# Check account limits
+#
+ my ($type, $list_id) = @_;
+ return if ($USER->{usr_type} != LIMITED_USER);
+
+ $error = '';
+ if ($type eq 'list') { # limit number of list
+ if ($DB->table('Lists')->count({ lst_user_id_fk => $USER->{usr_username} }) >= $USER->{usr_limit_list}) {
+ $error = GList::language('SYS_OVERLIMIT_LIST');
+ return 1;
+ }
+ }
+ elsif ($type eq 'sublist') { # limit number of subscribers per list
+ if ($DB->table('Subscribers')->count(
+ { sub_user_id_fk => $USER->{usr_username}, sub_list_id_fk => $list_id }) >= $USER->{usr_limit_sublist} ) {
+ $error = GList::language('SYS_OVERLIMIT_SUBLIST');
+ return 1;
+ }
+ }
+ elsif ($type eq 'email30') { # limit number of email sending out in the last 30 days
+ require GT::Date;
+ require GT::SQL::Condition;
+ my $last30 = GT::Date::date_sub(GT::Date::date_get(), 30);
+ my $unix_time = date_to_time($last30);
+ my $num_sent = $DB->table('MailingIndex', 'EmailMailings')->count(
+ GT::SQL::Condition->new(
+ mli_user_id_fk => '=' => $USER->{usr_username},
+ eml_sent => '>=' => $unix_time
+ )
+ );
+ if ( $num_sent >= $USER->{usr_limit_email30} ) {
+ $error = GList::language('SYS_OVERLIMIT_EMAIL30');
+ return 1;
+ }
+ return $num_sent;
+ }
+ return;
+}
+
+sub load_language {
+# -----------------------------------------------------------------------------
+# Loads the language.txt file. You can either pass in a template set, or let
+# it auto-detect from t=, or fall back to the default.
+#
+ my $t = shift || scalar $IN->param('t') || $CFG->{template_set} || 'gossamer';
+ $LANGUAGE = undef if !$LANG_TPL or $LANG_TPL ne $t;
+ $LANGUAGE ||= GT::Config->load("$CFG->{priv_path}/templates/$t/language.txt", { create_ok => 1, inheritance => 1, local => 1, header => <load("$CFG->{priv_path}/templates/common/globals.txt", {
+ $no_subs ? () : (compile_subs => 'GList'),
+ inheritance => 1,
+ local => 1,
+ cache => 1,
+ header => <<'HEADER'
+# This file is auto generated and contains a perl hash of
+# your template globals.
+# Generated on: [localtime]
+
+HEADER
+ });
+ $GLOB_NO_SUBS = $no_subs;
+}
+
+sub language {
+# ------------------------------------------------------------------
+# Process a language request, it's only loaded once, and saved in
+# $LANGUAGE.
+#
+ require GT::Config;
+ my $code = shift || '';
+
+ load_language();
+
+ if (exists $LANGUAGE->{$code}) {
+ return @_ ? sprintf($LANGUAGE->{$code}, @_) : $LANGUAGE->{$code};
+ }
+ else {
+ return $code;
+ }
+}
+
+sub fatal {
+# --------------------------------------------------------------
+# Return a fatal error message to the browser.
+#
+ die @_ if (GT::Base->in_eval()); # Don't do anything if we are in eval.
+
+ my $msg = shift;
+ my $debug = defined $CFG->{debug_level} ? $CFG->{debug_level} : $DEBUG;
+
+ $IN ||= new GT::CGI;
+ if (defined $CFG and exists $CFG->{error_message} and $CFG->{error_message}) {
+ $CFG->{error_message} =~ s,<%error%>,$msg,g;
+ $CFG->{error_message} =~ s,<%environment%>,environment(),eg;
+ display('error_form.html', { msg => language('SYS_FATAL', $CFG->{error_message}) });
+ }
+ else {
+ display('error_form.html', { msg => language('SYS_FATAL', $msg) });
+ }
+ if ($debug) {
+ print environment();
+ }
+}
+
+sub view_file {
+#---------------------------------------------------------------
+# View a file
+#
+ my $fn = $IN->param('fn');
+ my $fd = $IN->param('fd');
+ my $type = $IN->param('ft');
+ $fn and $fd or return display('error_form.html', { msg => language('SYS_FILE_INVALID') });
+
+# Check file existing
+ my $file = $DB->table($type ? 'MessageAttachments' : 'MailingAttachments')->get($fn);
+ $file or return display('error_form.html', { msg => language('SYS_FILE_NOT_FOUND', $fn) });
+
+ my $full_file = "$CFG->{priv_path}/attachments/".(( $type ) ? 'messages' : 'mailings')."/".($fd % 10)."/$fd/$fn";
+ my $file_name = ( $type ) ? 'att_file_name' : 'mat_file_name';
+ my $content_type = _load_mime($file->{$file_name});
+ my ($ext) = $full_file =~ /\.([^.]+)$/;
+ my $file_size = -s $full_file;
+ if (open DATA, $full_file) {
+ if (($content_type =~ m/text/ or -T $full_file) and uc($ext) ne 'PDF') {
+ print $IN->header;
+ }
+ else {
+ warn "Content-type: $content_type, Content-Length: $file_size";
+ print $IN->header({
+ '-type' => $content_type,
+ '-Content-Length' => $file_size,
+ });
+ }
+ binmode STDOUT;
+ binmode DATA;
+ my $buffer;
+ print $buffer while (read(DATA, $buffer, READ_SIZE));
+ close DATA;
+ return;
+ }
+ else {
+ return ('error_form.html', { msg => language('SYS_FILE_ERR', $fn) });
+ }
+}
+
+sub download_file {
+#--------------------------------------------------------------
+# Download a file
+#
+ my $fn = $IN->param('fn');
+ my $fd = $IN->param('fd');
+ my $type = $IN->param('ft');
+ ( $fn and $fd ) or return display('error_form.html', { msg => language('SYS_FILE_INVALID') });
+
+# Check file existing
+ my $file = $DB->table(( $type ) ? 'MessageAttachments' : 'MailingAttachments')->get($fn);
+ $file or return display('error_form.html', { msg => language('SYS_FILE_NOT_FOUND', $fn) });
+
+ my $full_file = "$CFG->{priv_path}/attachments/".($type ? 'messages' : 'mailings')."/".($fd % 10)."/$fd/$fn";
+ my $file_name = $type ? 'att_File_Name' : 'mat_File_Name';
+ my $file_size = -s $full_file;
+ if (open DATA, $full_file) {
+ print $IN->header(
+ '-type' => 'application/download',
+ '-Content-Length' => $file_size,
+ '-Content-Transfer-Encoding' => 'binary',
+ '-Content-Disposition' => \"attachment; filename=$file->{$file_name}"
+ );
+ binmode STDOUT;
+ binmode DATA;
+ my $buffer;
+ print $buffer while (read(DATA, $buffer, READ_SIZE));
+ close DATA;
+ return;
+ }
+ else {
+ return ('error_form.html', { msg => language('SYS_FILE_ERR', $fn) } );
+ }
+}
+
+sub encrypt {
+# -------------------------------------------------------------------
+ my ($clear_pass, $salt) = @_;
+ defined $salt or ($salt = '');
+ require GT::MD5::Crypt;
+ if (! $salt) {
+ my @rand_salt = ('a' .. 'z', 'A' .. 'Z', 0 .. 9, '.', '/');
+ for (1 .. 8) { $salt .= $rand_salt[rand @rand_salt]; }
+ }
+ my $enc_pass = GT::MD5::Crypt::gt_md5_crypt($clear_pass, $salt);
+ return $enc_pass;
+}
+
+sub date_to_time {
+ my ($date, $date_format) = @_;
+ my $lt;
+ my @localtime;
+ require GT::Date;
+
+ $date_format ||= '%yyyy%-%mm%-%dd%';
+ DATE: {
+ # First, try the admin format:
+ ref($lt = GT::Date::_parse_format($date, $date_format)) eq 'ARRAY' and (@localtime = @$lt), last DATE;
+ # Okay, it wasn't simply them modifying what was displayed, so let's try some other common formats:
+ # just the date, no time:
+ # yyyy/mm/dd
+ $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2}$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d%")}), last DATE;
+ # 12 hour time:
+ # yyyy/mm/dd hh:MM [AP]M
+ $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2} [AaPp][Mm]$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %h%:%M% %tt%")}), last DATE;
+ # yyyy/mm/dd hh:MM:ss [AP]M
+ $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}:\d{1,2} [AaPp][Mm]$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %h%:%M%:%s% %tt%")}), last DATE;
+ # 24 hour time:
+ # yyyy/mm/dd HH:MM
+ $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %H%:%M%")}), last DATE;
+ # yyyy/mm/dd HH:MM:ss
+ $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %H%:%M%:%s%")}), last DATE;
+ # Common formats that can't be recognized:
+ # dd/mm/yyyy - These two are conflicting US/European formats and it would
+ # mm/dd/yyyy - be impossible to figure out which one you are trying to use.
+ }
+
+ return scalar @localtime ? GT::Date::timelocal(@localtime) : undef;
+}
+
+sub paging {
+# --------------------------------------------------------------
+# Returns paging variables for the templates.
+# Takes 4 arguments: number of hits, hits per page, the current page, and the number of pages to show.
+# Takes 1 additional optional argument - true or false, indicating whether or not a ... system will be
+# used. If set, one extra number will be returned if there is just one extra number needed, and a
+# 'dotdotdot' variable will be available as 1 if ... is needed.
+# Example: when displaying paging of 9 with 11 pages, you would get:
+# 1 2 3 4 5 6 7 8 9 and you would have the "dotdotdot" variable set, so you would put a ... and then 11.
+# Now, if you were displaying paging of 9 with 10 pages, you would actually get _10_ numbers:
+# 1 2 3 4 5 6 7 8 9 10 and the "dotdotdot" wouldn't be set, so you wouldn't put the ... 10, since
+# 1 2 3 4 5 6 7 8 9 ... 10 would look silly.
+# Returned is a hashref: { paging => LOOP, top_page => INTEGER }, and possibly dotdotdot => 1
+# Inside the loop you have: <%page_num%> and <%is_current_page%>.
+#
+ my ($num_hits, $max_hits, $current_page, $disp_pages, $want_dotdotdot) = @_;
+
+ $disp_pages ||= 20;
+ $max_hits ||= 25;
+ my $num_pages = int($num_hits / $max_hits);
+ $num_pages++ if $num_hits % $max_hits;
+ my ($start, $end);
+ if ($num_pages <= $disp_pages) {
+ $start = 1;
+ $end = $num_pages;
+ }
+ elsif ($current_page >= $num_pages - $disp_pages / 2) {
+ $end = $num_pages;
+ $start = $end - $disp_pages + 1;
+ }
+ elsif ($current_page <= $disp_pages / 2) {
+ $start = 1;
+ $end = $disp_pages;
+ }
+ else {
+ $start = $current_page - int($disp_pages / 2) + 1;
+ $start-- if $disp_pages % 2;
+ $end = $current_page + int($disp_pages / 2);
+ }
+ my $need_dotdotdot;
+ if ($want_dotdotdot) {
+ if ($num_pages == $end + 1) {
+ ++$end;
+ }
+ elsif ($num_pages > $end) {
+ $need_dotdotdot = 1;
+ }
+ }
+ my @pages = map +{ page_num => $_, (($_ == $current_page) ? (is_current_page => 1) : ()) }, $start .. $end;
+ return {
+ paging => \@pages,
+ top_page => $num_pages,
+ ($want_dotdotdot && $need_dotdotdot ? (dotdotdot => 1) : ())
+ };
+}
+sub wild_cards() {
+ require GT::SQL::Condition;
+ return $DB->table('StopLists')->select(GT::SQL::Condition->new(stl_email => LIKE => "%*%", stl_email => LIKE => "%?%", "OR"), ['stl_email'])->fetchall_arrayref;
+}
+
+sub _redirect_login_url {
+# --------------------------------------------------------------
+# Redirect the user to the login screen.
+#
+ my $url = $IN->url( query_string => 1 );
+ $url = $CFG->{cgi_url} . "/user.cgi?url=" . $IN->escape($url);
+ foreach my $preserve (@{$CFG->{dynamic_preserve}}) {
+ my $val = $IN->param($preserve);
+ defined $val or next;
+ $url .= ";$preserve=" . $IN->escape($val);
+ }
+ return $url;
+}
+
+sub _load_mime {
+# --------------------------------------------------------------------
+# Load the config file into a hash.
+#
+ my ($file, $name) = @_;
+ $name ||= $file;
+ require GT::MIMETypes;
+ my $guess = GT::MIMETypes->guess_type($name);
+ if (!$guess or $guess eq 'application/octet-stream') {
+ if (-e $file) {
+ $guess = -T _ ? 'text/plain' : 'application/octet-stream';
+ }
+ else {
+ $guess = 'application/octet-stream';
+ }
+ }
+ return $guess;
+}
+
+sub _load_global {
+ my $name = shift;
+ load_globals();
+ return if (!exists $GLOBALS->{$name});
+
+ my $value = $GLOBALS->{$name};
+ $value = $value->() if ref $value eq 'CODE';
+ return $value;
+}
+
+1;
diff --git a/site/glist/lib/GList/Admin.pm b/site/glist/lib/GList/Admin.pm
new file mode 100644
index 0000000..1b2e94a
--- /dev/null
+++ b/site/glist/lib/GList/Admin.pm
@@ -0,0 +1,1344 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: Admin.pm,v 1.59 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::Admin;
+
+use strict;
+use GList qw/:user_type :objects $DEBUG/;
+use GT::AutoLoader;
+
+sub process {
+#------------------------------------------------------------------
+# Setermine what to do
+#
+ my $do = shift;
+
+ my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
+ if ($action eq 'admin_gtdoc') {
+ return GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
+ }
+
+ my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
+ if ($tpl) {
+ $MN_SELECTED = 6 if ($tpl =~ /^admin_user/);
+ my $hidden = GList::hidden();
+ $results->{hidden_query} = $hidden->{hidden_query};
+ $results->{hidden_objects} = $hidden->{hidden_objects};
+ GList::display($tpl, $results);
+ }
+}
+
+$COMPILE{admin_gtdoc} = <<'END_OF_SUB';
+sub admin_gtdoc {
+#-------------------------------------------------------------------
+#
+ my $template = $IN->param('topic') || 'index.html';
+
+ my $help_path = "$CFG->{priv_path}/templates/help";
+ $template =~ s,^/|/$,,;
+
+# Check the topic file.
+ unless ( $template =~ /^[\w\/]+\.[\w]+$/ ) {
+ die "Invalid topic: $template";
+ }
+ if ( $template =~ /\.(gif|jpg)$/ and -e "$help_path/$template" ) {
+ print $IN->header("image/$1");
+ open IMG, "< $help_path/$template" or die "Unable to open image help: $help_path/$template ($!)";
+ binmode IMG;
+ local *BINSTDOUT;
+ open BINSTDOUT, ">&STDOUT";
+ binmode BINSTDOUT;
+ print BINSTDOUT while ;
+ close IMG;
+ }
+ else {
+ print $IN->header;
+ GT::Template->parse ($template, $USER, { print => 1, root => $help_path });
+ }
+}
+END_OF_SUB
+
+$COMPILE{admin_page} = <<'END_OF_SUB';
+sub admin_page {
+#--------------------------------------------------------------------
+#
+ my ($page, $vars) = @_;
+
+ $page ||= $IN->param('pg');
+ ( $page ) or return admin_user(GList::language('ADM_INVALID'));
+
+ if ( $page =~ /^admin_template_/ ) {
+ $MN_SELECTED = 7;
+ }
+ elsif ( $page =~ /plugin_|gt_doc/ ) {
+ $MN_SELECTED = 8;
+ }
+ elsif ( $page =~ /admin_setup_/ ) {
+ $MN_SELECTED = 9;
+ }
+
+ return ($page, $vars);
+}
+END_OF_SUB
+
+$COMPILE{admin_initial_sql} = <<'END_OF_SUB';
+sub admin_initial_sql {
+#-------------------------------------------------------------------
+#
+ my $sql = _sql_load_cfg();
+ unless ( $IN->param('setup_sql') ) {
+ return ('admin_initial_sql.html', { %$sql, msg => GList::language("ADM_CONNECTION_ERROR") });
+ }
+ my $do = $IN->param('action');
+ if ($do !~ /^create|overwrite|load$/) {
+ return ('admin_initial_sql.html', { msg => "Invalid action: '$do'", $sql });
+ }
+
+ my $ret = _sql_connect($IN->param('sql_host'), $IN->param('sql_driver'), $IN->param('sql_database'), $IN->param('sql_login'), $IN->param('sql_password'), $IN->param('sql_prefix'));
+ if (exists $ret->{error}) {
+ return ('admin_initial_sql.html', { msg => $ret->{error}, $sql });
+ }
+
+ my $output;
+ if ($do eq 'create') {
+ $output = GList::SQL::tables('check');
+ }
+ elsif ($do eq 'overwrite') {
+ $output = GList::SQL::tables('force');
+ }
+ elsif ($do eq 'load') {
+ $output = GList::SQL::load_from_sql();
+ }
+
+ if ( !$DB->table('Users')->count({ usr_Username => $USER->{username}}) ) {
+ my $user = $CFG->{admin}->{$USER->{username}};
+ my %hash;
+ $hash{usr_type} = ADMINISTRATOR;
+ $hash{usr_username} = $USER->{username};
+ $hash{usr_password} = $user->[0];
+ $hash{usr_email} = $user->[1];
+ $hash{pro_first_name} = $USER->{username};
+ $hash{pro_last_name} = $USER->{username};
+ $hash{usr_date_format} = '%yyyy%-%mm%-%dd%';
+ $DB->table('Users')->insert(%hash) or die $GT::SQL::error;
+ }
+
+ my $results = GList::Authenticate::auth('create_session', { username => $USER->{username} });
+ ( $results->{error} ) and return ('login_form.html', { msg => "$results->{error}" });
+
+# Delete session file if it has being used
+ GList::Authenticate::auth('admin_delete_session');
+
+# Administrator users need to be saved in Data.pm
+ _save_users();
+
+ return ('admin_initial_sql_results.html', { msg => $output });
+}
+END_OF_SUB
+
+$COMPILE{admin_initial_setup} = <<'END_OF_SUB';
+sub admin_initial_setup {
+# ------------------------------------------------------------------
+# Sets the mysql information.
+#
+ my ($host, $port, $overwrite);
+
+ unless ( $IN->param('initial_step') ) {
+ return admin_page('admin_initial_setup_first.html');
+ }
+ if ( $IN->param('initial_step') == 2 ) {
+ return admin_page('admin_initial_setup_second.html');
+ }
+
+# Test the ability to create a def file.
+ unless (open (TEST, "> $CFG->{priv_path}/defs/database.def")) {
+ return ('admin_initial_setup_second.html', { error => sprintf(GList::language('ADM_INITIAL_ERROR'), "$CFG->{priv_path}/defs/", $!) });
+ }
+ close TEST;
+ unlink "$CFG->{priv_path}/defs/database.def";
+
+# Set the connection info.
+ $overwrite = $IN->param('overwrite') ? 'force' : 'check';
+ $host = $IN->param('host');
+ ($host =~ s/\:(\d+)$//) and ($port = $1);
+
+ my $prefix = $IN->param('prefix');
+ $prefix =~ /^\w*$/ or return ('admin_initial_setup_second.html', { error => sprintf(GList::language('ADM_INITIAL_PREFIX_ERROR'), $prefix) });
+
+ $DB->prefix($prefix);
+ my $ret = $DB->set_connect ({
+ driver => scalar $IN->param('driver'),
+ host => $host,
+ port => $port,
+ database => scalar $IN->param('database'),
+ login => scalar $IN->param('login'),
+ password => scalar $IN->param('password'),
+ RaiseError => 0,
+ PrintError => 0,
+ AutoCommit => 1
+ });
+ if (! defined $ret) {
+ return ('admin_initial_setup_second.html', { error => $GT::SQL::error });
+ }
+# Now let's create the tables.
+ eval { local $SIG{__DIE__}; require GList::SQL; };
+ if ($@) { return ('admin_initial_setup_second.html', { error => sprintf(GList::language('ADM_INITIAL_LOAD_ERROR'), "$@\n") }); }
+ my $output = GList::SQL::tables($overwrite);
+
+# Remove admin users and Add an admin user
+
+ my $user;
+ foreach (keys % {$CFG->{admin}}) {
+ $user = $_;last;
+ }
+ if ($user) {
+ my $db = $DB->table('Users');
+ $db->delete({ usr_type => ADMINISTRATOR });
+ if ( !$db->insert({
+ usr_username => $user,
+ usr_email => $CFG->{admin}->{$user}->[1],
+ usr_password => $CFG->{admin}->{$user}->[0],
+ usr_type => ADMINISTRATOR,
+ usr_reply_email => $CFG->{admin}->{$user}->[1],
+ usr_bounce_email => $CFG->{admin}->{$user}->[1],
+ usr_date_format => '%yyyy%-%mm%-%dd%',
+ pro_first_name => $user,
+ pro_last_name => $user,
+ }) ) {
+ return ('admin_initial_setup_second.html', { error => $GT::SQL::error });
+ }
+ }
+
+# Set default email templates
+ GList::set_default_template('validation.eml', $IN->param('admin_user'));
+ GList::set_default_template('subscribe.eml', $IN->param('admin_user'));
+ GList::set_default_template('unsubscribe.eml', $IN->param('admin_user'));
+
+# And lets set sensible defaults for the rest of the config vars.
+ $CFG->create_defaults();
+
+# And save the config.
+ $CFG->save();
+
+ return ('admin_initial_setup_third.html', { message => sprintf(GList::language('ADM_INITIAL_SUCCESSFUL'), $output) } );
+}
+END_OF_SUB
+
+$COMPILE{admin_user} = <<'END_OF_SUB';
+sub admin_user {
+#--------------------------------------------------------------------
+# Print home page
+#
+ my $msg = shift;
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $cgi = $IN->get_hash;
+ my $search_check = ($IN->param('do') eq 'admin_user_search') ? 1 : 0;
+ my $results = GList::search(
+ cgi => $cgi,
+ db => $DB->table('Users'),
+ prefix => 'usr',
+ sb => 'usr_type',
+ so => 'ASC',
+ skip_user => '1',
+ search_check=> $search_check
+ );
+
+ if ( ref $results ne 'HASH' ) {
+ ( $IN->param('do') eq 'admin_user_search' ) ? return ('admin_user_search_form.html', { msg => $results })
+ : return ('admin_user_home.html', { msg => $results });
+ }
+ elsif ( $results->{error} and $search_check) {
+ return ('admin_user_search_form.html', { msg => $results->{error} })
+ }
+
+ my $output = $results->{results};
+ $results->{msg} = ($msg) ? $msg : GList::language('USR_RESULTS', $results->{hits});
+
+ return ('admin_user_home.html', $results);
+}
+END_OF_SUB
+
+$COMPILE{admin_user_add} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_add {
+#--------------------------------------------------------------------
+# Add a user
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $cols = $DB->table('Users')->cols;
+ my $cgi = {};
+
+ foreach ( keys % $cols) {
+ $cgi->{$_} = $IN->param("mod_$_") if ( $IN->param("mod_$_") );
+ }
+
+ ($cgi->{usr_username} and $cgi->{usr_username} =~ /^[\w\-\.]{3,}$/) or return ('admin_user_add_form.html', { msg => GList::language('USR_INVALID') });
+ ($cgi->{usr_password} and length $cgi->{usr_password} < 4 ) and return ('admin_user_add_form.html', { msg => GList::language('ADM_PWD_INVALID') });
+
+ $cgi->{usr_password} = GList::encrypt($cgi->{usr_password});
+ $cgi->{usr_date_format} = $IN->param('date_preview') if ($IN->param('date_preview'));
+ $cgi->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
+
+# Set account limits
+ $cgi = _account_limit($cgi);
+
+# Add a new record
+ GList::add('Users', 'usr', $cgi);
+
+ return ('admin_user_add_form.html', { msg => sprintf(GList::language('USR_ADD_ERR', $GList::error)) }) if ( $GList::error );
+
+# Add user info into Data.pm if user is a administrator
+ if ( $cgi->{usr_type} == ADMINISTRATOR and not exists $CFG->{admin}->{$cgi->{usr_username}}) {
+ $CFG->{admin}->{$cgi->{usr_username}} = [$cgi->{usr_password}, $cgi->{usr_email}];
+ $CFG->save();
+ }
+
+# Set default email templates
+ GList::set_default_template('validation.eml', $cgi->{usr_username});
+ GList::set_default_template('subscribe.eml', $cgi->{usr_username});
+ GList::set_default_template('unsubscribe.eml', $cgi->{usr_username});
+
+ admin_user(sprintf(GList::language('USR_ADDED'), $cgi->{usr_username}));
+}
+END_OF_SUB
+
+$COMPILE{admin_user_modify_form} = <<'END_OF_SUB';
+sub admin_user_modify_form {
+#-----------------------------------------------------------
+# Print modify a user form
+#
+ my $msg = shift;
+
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $id = $IN->param('uid');
+ my $db = $DB->table('Users');
+ my $user = $db->get($id);
+ ( $user ) or return admin_user(sprintf(GList::language('USR_NOT_FOUND'), $id));
+
+ my $cols = $db->cols;
+ my $hsh = {};
+ foreach ( keys % $cols ) {
+ $hsh->{"mod_$_"} = $user->{$_};
+ }
+ return ('admin_user_modify_form.html', { msg => $msg, modify => 1, %$hsh });
+}
+END_OF_SUB
+
+$COMPILE{admin_user_modify} = <<'END_OF_SUB';
+sub admin_user_modify {
+#-----------------------------------------------------------
+# Modify a user
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $db = $DB->table('Users');
+ my $cols = $db->cols;
+ my $hsh = {};
+ my $cgi = $IN->get_hash();
+
+ foreach ( keys % $cols) {
+ next if ( $USER->{usr_username} eq $cgi->{mod_usr_username} and $_ eq 'usr_type' );
+ $hsh->{$_} = $cgi->{"mod_$_"} if (exists $cgi->{"mod_$_"});
+ }
+
+# Setup the language for GT::SQL.
+ local $GT::SQL::ERRORS->{ILLEGALVAL} = GList::language('USR_ILLEGALVAL') if ( GList::language('USR_ILLEGALVAL') );
+ local $GT::SQL::ERRORS->{UNIQUE} = GList::language('USR_UNIQUE') if ( GList::language('USR_UNIQUE') );
+ local $GT::SQL::ERRORS->{NOTNULL} = GList::language('USR__NOTNULL') if ( GList::language('USR__NOTNULL') );
+
+ $hsh->{usr_cookie} = 0 if ( !defined $hsh->{usr_cookie} );
+ if ($hsh->{usr_type} == ADMINISTRATOR or $hsh->{usr_type} == UNLIMITED_USER) {
+ $hsh->{usr_validate_code} = '';
+ }
+
+ if ($hsh->{usr_password}) {
+ $hsh->{usr_password} = GList::encrypt($hsh->{usr_password});
+ }
+ else {
+ delete $hsh->{usr_password};
+ }
+
+ $hsh->{usr_date_format} = $IN->param('date_preview') if ($IN->param('date_preview'));
+ $hsh->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
+ my $old = $db->get($hsh->{usr_username});
+
+# Set account limits
+ $hsh = _account_limit($hsh);
+
+# Email validate this account
+ if ($CFG->{signup_admin_validate} and $cgi->{email_validate}) {
+ $hsh->{usr_validate_code} = '';
+ }
+
+ if ( $db->modify($hsh) ) {
+ my $pass = $hsh->{usr_password} || $old->{usr_password};
+ if ( $old->{usr_type} ne $hsh->{usr_type} ) { # Update Data.pm
+ if ( $hsh->{usr_type} == ADMINISTRATOR ) {
+ exists $CFG->{admin}->{$hsh->{usr_username}} or $CFG->{admin}->{$hsh->{usr_username}} = [$pass, $hsh->{usr_email}];
+ }
+ else {
+ exists $CFG->{admin}->{$hsh->{usr_username}} and delete $CFG->{admin}->{$hsh->{usr_username}};
+ }
+ $CFG->save();
+ }
+ elsif ($hsh->{usr_type}) {
+ $CFG->{admin}->{$hsh->{usr_username}} = [$pass, $hsh->{usr_email}];
+ $CFG->save();
+ }
+ return admin_user(sprintf(GList::language('USR_UPDATED'), $hsh->{usr_username}));
+ }
+ else {
+ local $^W;
+ return admin_user_modify_form("$GT::SQL::error");
+ }
+}
+END_OF_SUB
+
+$COMPILE{admin_user_delete} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_delete {
+#-------------------------------------------------------------------
+# Delete the glist users
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $cgi = $IN->get_hash();
+ my $dels = (ref $cgi->{modify} eq 'ARRAY') ? $cgi->{modify} : [$cgi->{modify}];
+ my (%hsh, @mods, @users);
+ foreach (@$dels) {
+ next if ($cgi->{"$_-usr_username"} eq $USER->{usr_username});
+ $hsh{"$_-usr_username"} = $cgi->{"$_-usr_username"};
+ push @mods, $_;
+ push @users, $cgi->{"$_-usr_username"};
+ }
+ $hsh{modify} = \@mods;
+
+ my $msg = GList::delete('Users', 'usr', \%hsh);
+
+# Delete users from Data.pm if they are administrator users
+ foreach my $u (@users) {
+ next if (not exists $CFG->{admin}->{$u});
+ delete $CFG->{admin}->{$u};
+ $CFG->save();
+ }
+ return admin_user($msg);
+}
+END_OF_SUB
+
+$COMPILE{admin_user_validate} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_validate {
+#-------------------------------------------------------
+# Validate users
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $cgi = $IN->get_hash();
+ my $mod = (ref $cgi->{modify} eq 'ARRAY') ? $cgi->{modify} : [$cgi->{modify}];
+
+ my $db_usr = $DB->table('Users');
+ my $count = 0;
+ foreach (@$mod) {
+ my $u = $cgi->{"$_-usr_username"};
+ next if (!$u or $u eq $USER->{usr_username});
+ if ($db_usr->count({ usr_username => $u })) {
+ $db_usr->update({
+ usr_type => LIMITED_USER,
+ usr_validate_code => '',
+ usr_limit_list => $CFG->{signup_limit_list} || 10,
+ usr_limit_sublist => $CFG->{signup_limit_sublist} || 10,
+ usr_limit_email30 => $CFG->{signup_limit_email30} || 100,
+ }, { usr_username => $u });
+ $count++;
+ }
+ }
+ return admin_user(GList::language('USR_VALIDATED', $count));
+}
+END_OF_SUB
+
+$COMPILE{admin_plugin} = <<'END_OF_SUB';
+sub admin_plugin {
+# ------------------------------------------------------------------
+# Run a plugin function.
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $plugin = $IN->param('plugin');
+ my $func = $IN->param('func');
+ {
+ local ($@, $!, $SIG{__DIE__});
+ eval { require "$CFG->{priv_path}/lib/GList/Plugins/$plugin.pm"; };
+ if ( $@ ) {
+ return ('error_form.html', { msg => "Unable to load plugin: $plugin ($@)" });
+ }
+ }
+ no strict 'refs';
+ my $code = ${"GList::Plugins::" . $plugin . "::"}{$func};
+ use strict 'refs';
+
+ if ( !defined $code ) {
+ return ('error_form.html', { msg => "Invalid plugin function: $func" });
+ }
+ $code->();
+}
+END_OF_SUB
+
+
+$COMPILE{admin_setup_sql_form} = <<'END_OF_SUB';
+sub admin_setup_sql_form {
+# ------------------------------------------------------------------
+# Print SQL Server Form
+#
+ my $msg = shift;
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $sql = _sql_load_cfg();
+ return ('admin_setup_sql_form.html', { msg => $msg, %$sql });
+}
+END_OF_SUB
+
+$COMPILE{admin_setup_sql} = <<'END_OF_SUB';
+sub admin_setup_sql {
+# ------------------------------------------------------------------
+# Change the sql server information.
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my ($host, $port, $output, $do, $ret);
+
+ $do = $IN->param('action');
+ if ($do !~ /^create|overwrite|load$/) {
+ return admin_setup_sql_form("Invalid action: '$do'");
+ }
+
+ $ret = _sql_connect($IN->param('sql_host'), $IN->param('sql_driver'), $IN->param('sql_database'), $IN->param('sql_login'), $IN->param('sql_password'), $IN->param('sql_prefix'));
+ if (exists $ret->{error}) {
+ return admin_setup_sql_form($ret->{error});
+ }
+
+ require GList::SQL;
+ if ($do eq 'create') {
+ $output = GList::SQL::tables('check');
+ }
+ elsif ($do eq 'overwrite') {
+ $output = GList::SQL::tables('force');
+ my $db = $DB->table('Users');
+ $db->insert($USER) or die $GT::SQL::error;
+
+ my $results = GList::Authenticate::auth('create_session', { username => $USER->{usr_username} });
+ ( $results->{error} ) and return ('login_form.html', { msg => "$results->{error}" });
+
+# Save username and password into Data.pm
+ $CFG->{admin} = { $USER->{usr_username} => [$USER->{usr_password}, $USER->{usr_email}] };
+ $CFG->save();
+ }
+ elsif ($do eq 'load') {
+ $output = GList::SQL::load_from_sql();
+ }
+
+ return admin_setup_sql_form("$output", 'is_set');
+}
+END_OF_SUB
+
+$COMPILE{admin_setup_form} = <<'END_OF_SUB';
+sub admin_setup_form {
+# ------------------------------------------------------------------
+# Print Setup form
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $msg = shift;
+ require GList::Config;
+ my $cfg = GList::Config::tpl_load();
+ my $pg = $IN->param('pg') || 'admin_setup_path.html';
+
+ return ($pg, { %$cfg, msg => $msg });
+}
+END_OF_SUB
+
+$COMPILE{admin_setup} = <<'END_OF_SUB';
+sub admin_setup {
+# ------------------------------------------------------------------
+# Set the configuration.
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $cgi = $IN->get_hash();
+
+ if ( $cgi->{pg} eq 'admin_setup_misc.html' and (($cgi->{mail_path} and $cgi->{smtp_server}) or (!$cgi->{smtp_server} and !$cgi->{mail_path})) ) {
+ return admin_setup_form(GList::language('SET_MISC_ERR'));
+ }
+
+ if ( !$cgi->{brestore} and exists $cgi->{cgi_url} and exists $cgi->{priv_path} and exists $cgi->{image_url} and
+ ( !$cgi->{cgi_url} or !$cgi->{priv_path} or !$cgi->{image_url} ) ) {
+ return admin_setup_form(GList::language('SET_PATH_ERR'));
+ }
+
+ if ($cgi->{brestore}) {
+ $CFG->default_path (1);
+ }
+ else {
+ _update_cfg();
+ }
+ $CFG->save();
+ return admin_setup_form(GList::language('SET_CFG_SUCCESS'));
+}
+END_OF_SUB
+
+$COMPILE{admin_template_diff} = <<'END_OF_SUB';
+sub admin_template_diff {
+# ------------------------------------------------------------------
+# Load fileman, but just for the purposes of displaying a diff.
+#
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ require GT::FileMan;
+ my $fileman = GT::FileMan->new(
+ cfg => {
+ template_root => "$CFG->{priv_path}/templates/common",
+ root_dir => "$CFG->{priv_path}/templates",
+ html_root_url => $CFG->{image_url}. '/fileman',
+ debug_level => 0,
+ winnt => $^O eq 'MSWin32' ? 1 : 0,
+ command_time_out => 20,
+ allowed_space => 0,
+ },
+ url_opts => 'do=fileman_diff'
+ );
+ $fileman->process();exit;
+}
+END_OF_SUB
+
+$COMPILE{init_setup} = __LINE__ . <<'END_OF_SUB';
+sub init_setup {
+# ------------------------------------------------------------------
+# Sets the mysql information.
+#
+ my ($host, $port, $overwrite);
+# Test the ability to create a def file.
+
+ unless (open (TEST, "> $CFG->{priv_path}/defs/database.def")) {
+ return GList::display('setup_second.html', {
+ error => "Unable to create our def file in $CFG->{priv_path}/defs/. \n
+ Please make sure this directory exists, and is writeable by the server. \n
+ If this is the wrong directory, you will need to manually set the directory \n
+ in GList::ConfigData. Error was: $!"
+ });
+ }
+ close TEST;
+ unlink "$CFG->{priv_path}/defs/database.def";
+
+# Set the connection info.
+ $overwrite = $IN->param('overwrite') ? 'force' : 'check';
+ $host = $IN->param('host');
+ ($host =~ s/\:(\d+)$//) and ($port = $1);
+
+ my $prefix = $IN->param('prefix');
+ $prefix =~ /^\w*$/ or return GList::display('setup_second.html', { error => "Invalid prefix: '$prefix'. Can only be letters, numbers and underscore." });
+
+ $DB->prefix($prefix);
+ my $ret = $DB->set_connect ({
+ driver => scalar $IN->param('driver'),
+ host => $host,
+ port => $port,
+ database => scalar $IN->param('database'),
+ login => scalar $IN->param('login'),
+ password => scalar $IN->param('password'),
+ RaiseError => 0,
+ PrintError => 0,
+ AutoCommit => 1
+ });
+ if (! defined $ret) {
+ return GList::display('setup_second.html', { error => $GT::SQL::error });
+ }
+# Now let's create the tables.
+ eval { local $SIG{__DIE__}; require GList::SQL; };
+ if ($@) { return GList::display('setup_second.html', { error => "Unable to load Dbsql::SQL module: $@\n" }); }
+
+ my $output = GList::SQL::tables($overwrite);
+
+# Add admin user
+ my $db = $DB->table('Users');
+ $db->insert({
+ usr_email => $IN->param('admin_user'),
+ usr_password => $IN->param('admin_pass'),
+ usr_type => ADMINISTRATOR,
+ usr_reply_email => $IN->param('admin_user'),
+ usr_bounce_Email => $IN->param('admin_user')
+ });
+ if ( $GT::SQL::error ) {
+ return GList::display('setup_second.html', { error => $GT::SQL::error });
+ }
+
+# And lets set sensible defaults for the rest of the config vars.
+ $CFG->create_defaults();
+
+# And save the config.
+ $CFG->save();
+
+ GList::display('setup_third.html', { message => "The data tables have been setup:
$output
" } );
+}
+END_OF_SUB
+
+$COMPILE{admin_user_table} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_table {
+#--------------------------------------------------------------------
+# Load Users table properties
+#
+ my $msg = shift;
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $db_usr = $DB->table('Users');
+ my $cols = $db_usr->cols;
+ my $pro_cols = [ grep(/^pro_/, $db_usr->ordered_columns) ];
+
+ my @output;
+ foreach my $c ( @$pro_cols ) {
+ $cols->{$c}->{name} = $c;
+ push @output, $cols->{$c};
+ }
+
+ return ('admin_user_table.html', { loop_fields => \@output, msg => $msg });
+}
+END_OF_SUB
+
+$COMPILE{admin_user_table_add} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_table_add {
+#-------------------------------------------------------------
+# Add a field
+#
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ return ('admin_user_table_add.html') if ($IN->param('form'));
+
+ my $db = $DB->table('Users');
+ my %cols = $db->cols;
+ my $attribs = _col_spec();
+ my $column = 'pro_'.$IN->param('column');
+
+# Error checking
+ my $errors = _field_check();
+ if ( exists $cols{$column} ) {
+ $errors .= sprintf(GList::language('TAB_COL_EXISTS'), $column);
+ }
+ if ( $IN->param('index') eq 'primary' ) {
+ $errors .= GList::language('TAB_PRIMARY_ERR');
+ }
+ return ('admin_user_table_add.html', { msg => "$errors" }) if ($errors);
+
+ $attribs->{pos} = keys(%cols) + 1;
+ $attribs->{edit} = 1;
+ $attribs->{default} ||= '';
+ my $editor = $DB->editor('Users');
+
+# Add the column.
+ delete $attribs->{column};
+ $editor->add_col($column, $attribs) or return ('admin_user_table_add.html', { msg => GList::language('TAB_ADD_COLUMN_ERR', $column, $GT::SQL::error) });
+
+# Add the indexes.
+ if ( $IN->param('index') eq 'regular' ) {
+ $editor->add_index($column . '_idx' => [$column]) or return ('admin_user_table_add.html', { msg => GList::language('TAB_ADD_INDEX_ERR', $GT::SQL::error) });
+ }
+ if ( $IN->param('index') eq 'unique' ) {
+ $editor->add_index($column . '_idx' => [$column]) or return ('admin_user_table_add.html', { msg => GList::language('TAB_ADD_UNIQUE_ERR', $GT::SQL::error) });
+ }
+ $db->reload;
+
+ return admin_user_table(GList::language('TAB_ADD_SUCCESS', $column));
+}
+END_OF_SUB
+
+$COMPILE{admin_user_table_modify} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_table_modify {
+#-------------------------------------------------------------
+# Modify a field
+#
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $col = $IN->param('column');
+ my $db = $DB->table('Users');
+ my $editor = $DB->editor('Users');
+ my $cols = $db->cols;
+ my $old_def = $cols->{$col};
+ return admin_user_table(GList::language('TAB_MOD_ERR', $col)) if (!exists $cols->{$col} or !$col);
+
+ my %attribs = %{$cols->{$col}};
+
+# Set up defaults for the fields
+ foreach my $col (qw/column type not_null file_save_in file_max_size file_save_scheme default form_display form_type form_size form_names form_values regex weight values size/) {
+ $attribs{$col} = $IN->param($col) if ( defined $IN->param($col) );
+ }
+
+ $attribs{column} ||= $col;
+ $attribs{form_type} ||= 'TEXT';
+ $attribs{form_size} ||= ($attribs{form_type} eq 'SELECT') ? 0 : '';
+ ref $attribs{form_size} and ($attribs{form_size} = join(",", @{$attribs{form_size}}));
+ ref $attribs{form_names} and ($attribs{form_names} = join("\n", @{$attribs{form_names}}));
+ ref $attribs{form_values} and ($attribs{form_values} = join("\n", @{$attribs{form_values}}));
+ ref $attribs{values} and ($attribs{values} = join("\n", @{$attribs{values}}));
+ return ('admin_user_table_modify.html', \%attribs) if ($IN->param('form'));
+
+# Keep any values that where there before
+ my $attribs = _col_spec();
+ for my $val ( keys %$old_def ) {
+ $attribs->{$val} = $old_def->{$val} unless exists $attribs->{$val};
+ }
+
+# Error checking
+ my $errors = _field_check();
+ if ( $IN->param('index') eq 'primary' and ( $col ne $db->{schema}->{pk}) ) {
+ $errors .= GList::language('TAB_PRIMARY_ERR');
+ }
+ return ('admin_user_table_modify.html', { msg => "$errors", %attribs }) if($errors);
+
+# Add/Drop indexes.
+ my $index_type = _index_type($col);
+ if ( $index_type ne $IN->param('index') ) {
+ if ($index_type eq 'none') {
+ if ( $IN->param('index') eq 'regular' ) {
+ $editor->add_index( $col . "_idx" => [$col] );
+ }
+ else {
+ $editor->add_unique( $col . "_idx" => [$col] );
+ }
+ }
+ elsif ( $IN->param('index') eq 'none' ) {
+ if ( $index_type eq 'regular' ) {
+ my $index = $db->index;
+ INDEX: foreach my $index_name (keys %$index) {
+ foreach my $col_name ( @{$index->{$index_name}} ) {
+ next unless ($col_name eq $col);
+ $editor->drop_index($index_name) or return ('admin_user_table_modify.html', { msg => "$GT::SQL::error", %attribs });
+ last INDEX;
+ }
+ }
+ }
+ else {
+ my $unique = $db->unique;
+ INDEX: foreach my $unique_name (keys %$unique) {
+ foreach my $col_name (@{$unique->{$unique_name}}) {
+ next unless ($col_name eq $col);
+ $editor->drop_unique($unique_name) or return ('admin_user_table_modify.html', { msg => "$GT::SQL::error", %attribs });
+ last INDEX;
+ }
+ }
+ }
+ }
+ }
+
+# Make the changes
+ delete $attribs->{column};
+
+ $editor->alter_col($col, $attribs) or return ('admin_user_table_modify.html', { msg => ''.$editor->error.'', %attribs });
+ return admin_user_table(GList::language('TAB_MOD_SUCCESS', $col));
+}
+END_OF_SUB
+
+$COMPILE{admin_user_table_delete} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_table_delete {
+#--------------------------------------------------------------
+# Delete a field of User Table
+#
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+#------------demo code-----------
+
+ my $column = $IN->param('column');
+ return admin_user_table(GList::language('TAB_MOD_INVALID')) if (!$column);
+ return admin_user_table(GList::language('TAB_MOD_PERMIT_ERR', 'pro_first_name, pro_last_name')) if ($column =~ /pro_first_name|pro_last_name/);
+
+# Keep any values that where there before
+ my $db = $DB->table('Users');
+ my $editor = $DB->editor('Users');
+ my $old_def = $db->cols->{$column};
+
+# Drop the column from the database.
+ $editor->drop_col($column) or return admin_user_table("$GT::SQL::error");
+
+ return admin_user_table(GList::language('TAB_DEL_SUCCESS', $column));
+}
+END_OF_SUB
+
+$COMPILE{admin_user_table_resync} = __LINE__ . <<'END_OF_SUB';
+sub admin_user_table_resync {
+#--------------------------------------------------------------------
+# Resync database
+#
+ my $name = $IN->param('db') || 'Users';
+ $USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+# We need a creator for this.
+ my $c = $DB->creator($name);
+ my $db = $DB->table($name);
+ $c->load_table or return admin_user_table($GT::SQL::error);
+
+# Re Load our table object.
+ $db->reload;
+
+ return admin_user_table(GList::language('TAB_RESYNC'));
+}
+END_OF_SUB
+
+$COMPILE{admin_stoplist} = __LINE__ . <<'END_OF_SUB';
+sub admin_stoplist {
+#-------------------------------------------------------------------
+# Update the stop lists
+#
+ my $msg = shift;
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ $MN_SELECTED = 9;
+ return ('admin_stoplist_form.html') if ($IN->param('form'));
+
+ my $alpha = 0;
+ my $cgi = $IN->get_hash;
+ my $query= '';
+ if ($IN->param('alpha') and $IN->param('alpha') ne 'all') { # from the quick search bar
+ $alpha = $IN->param('alpha');
+ $query = "alpha=$alpha";
+ }
+ my $db = $DB->table('StopLists');
+ $db->select_options('ORDER BY letter');
+
+ require GT::SQL::Condition;
+ my $cd = GT::SQL::Condition->new();
+ my $url = 'glist.cgi?do=admin_stoplist';
+ if ($cgi->{stl_email}) {
+ $cd->add('stl_email' => 'like' => "%$cgi->{stl_email}%");
+ $url .= ";stl_email=$cgi->{stl_email}";
+ }
+
+ my $sth = $db->select($cd, ['DISTINCT SUBSTRING(stl_email, 1, 1) as letter']);
+ my $results = GList::search(
+ cgi => $cgi,
+ db => $DB->table('StopLists'),
+ based_on => $DB->prefix.'StopLists',
+ prefix => 'stl',
+ sb => 'stl_email',
+ so => 'ASC',
+ search_alpha=> $alpha,
+ search_col => 'stl_email',
+ return_msg => 'ADM_STOPLIST',
+ skip_user => 1,
+ );
+
+ require GList::List;
+ if ( ref $results ne 'HASH' ) {
+ return ('admin_stoplist.html', { search_bar => GList::List::_search_bar($sth, $url), msg => $results });
+ }
+ $results->{msg} = $msg if ($msg);
+ return ('admin_stoplist.html', { search_bar => GList::List::_search_bar($sth, $url), toolbar_query => $query, toolbar_table => 'StopLists', %$results })
+}
+END_OF_SUB
+
+$COMPILE{admin_stoplist_confirm} = __LINE__ . <<'END_OF_SUB';
+sub admin_stoplist_confirm {
+#--------------------------------------------------------------------
+# Confirmation about remove all emails that match the addition stoplist
+# from all list
+#
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ $MN_SELECTED = 9;
+ my $emails = $IN->param('emails') || '';
+ return ('lst_stoplist_form.html', { msg => GList::language('ADM_STOPLIST_ERROR') }) if (!$emails);
+
+ require GT::SQL::Condition;
+ my $db_sub = $DB->table('Subscribers');
+ my @emails = split(/\r?\n/, $emails);
+
+ my (@results, %found);
+ foreach my $e (@emails) {
+ $e =~ s/^\s+//;
+ $e =~ s/\s+$//;
+ next unless $e and $e =~ /.@./;
+ my $cond;
+ if ($e =~ /[*?]/) {
+ my $tmp = $e;
+ $tmp =~ y/*/%/;
+ $tmp =~ y/?/_/;
+ $cond = GT::SQL::Condition->new(sub_email => LIKE => $tmp);
+ }
+ else {
+ $cond = { sub_email => $e };
+ }
+ my $pre = keys %found;
+ my @found = $db_sub->select(sub_id => $cond)->fetchall_list;
+ for (@found) { $found{$_}++ }
+ my $added = keys(%found) - $pre;
+ push @results, { email => $e, found => $added };
+ }
+
+ my $found_emails = scalar keys %found;
+ return admin_stoplist_add() if (!$found_emails);
+
+ return ('admin_stoplist_form.html', {
+ loop_results => \@results,
+ loop_hits => $#results + 1,
+ found_emails => $found_emails,
+ data => $emails,
+ confirmation => 1
+ });
+}
+END_OF_SUB
+
+$COMPILE{admin_stoplist_add} = __LINE__ . <<'END_OF_SUB';
+sub admin_stoplist_add {
+#--------------------------------------------------------------------
+# Add email to stop list
+#
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ $MN_SELECTED = 9;
+ my $emails = $IN->param('emails') || '';
+ return ('lst_stoplist_form.html', { msg => GList::language('ADM_STOPLIST_ERROR') }) if (!$emails);
+
+ my ($invalid, $duplicate) = (0, 0);
+ my @emails = split(/\r?\n/, $emails);
+ my $db_stl = $DB->table('StopLists');
+ my $db_sub = $DB->table('Subscribers');
+
+ require GT::SQL::Condition;
+ my @results;
+ my $cond = GT::SQL::Condition->new('OR');
+ foreach my $e (@emails) {
+ $e =~ s/^\s+//;
+ $e =~ s/\s+$//;
+ next if !$e;
+ if ( $e !~ /.@./ ) { # check email address
+ push @results, { email => $e, status => GList::language('SYS_INVALID_EMAIL') };
+ $invalid++;
+ }
+ else {
+ if ($e =~ /[*?]/) {
+ my $tmp = $e;
+ $tmp =~ y/*/%/;
+ $tmp =~ y/?/_/;
+ $cond->add(sub_email => LIKE => $tmp);
+ }
+ else {
+ $cond->add(sub_email => '=' => $e);
+ }
+
+ push @results, { email => $e, status => '' };
+ if ($db_stl->count({ stl_email => $e })) {
+ $results[-1]->{status} = GList::language('SYS_DUPLICATE');
+ $duplicate++;
+ }
+ else {
+ $db_stl->insert({ stl_email => $e });
+ }
+ }
+ }
+ $db_sub->delete($cond) if (@{$cond->{cond}});
+
+ return ('admin_stoplist_success.html', {
+ results => \@results,
+ duplicate => $duplicate,
+ invalid => $invalid,
+ hits => scalar @results,
+ successful => scalar @results - $invalid - $duplicate,
+ });
+}
+END_OF_SUB
+
+$COMPILE{admin_stoplist_delete} = __LINE__ . <<'END_OF_SUB';
+sub admin_stoplist_delete {
+#---------------------------------------------------------------------
+# Delete email from stop list
+#
+ $USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
+
+ my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
+ my $db = $DB->table('StopLists');
+ my $cgi = $IN->get_hash();
+
+ foreach my $rec_num ( @{$mod} ) {
+ $db->delete({ stl_id => $cgi->{"$rec_num-stl_id"} });
+ }
+ return admin_stoplist(GList::language('ADM_STOPLIST_DELETED', $#$mod + 1));
+}
+END_OF_SUB
+
+$COMPILE{_update_cfg} = __LINE__ . <<'END_OF_SUB';
+sub _update_cfg {
+# ------------------------------------------------------------------
+# Updates the config based on the form input.
+#
+ foreach my $param ($IN->param) {
+ if (exists $CFG->{$param}) {
+ if (ref $CFG->{$param} eq ref []) {
+ my @val = split /\s*,\s*/, $IN->param($param);
+ $CFG->{$param} = \@val;
+ }
+ elsif (ref $CFG->{$param} eq ref {}) {
+ my $h = {};
+ my @pairs = split /\s*,\s*/, $IN->param($param);
+ foreach my $pair (@pairs) {
+ my ($k, $v) = split /\s*=\s*/, $pair;
+ $h->{$k} = $v;
+ }
+ $CFG->{$param} = $h;
+ }
+ else {
+ $CFG->{$param} = $IN->param($param);
+ }
+ }
+ }
+}
+END_OF_SUB
+
+$COMPILE{_field_check} = __LINE__ . <<'END_OF_SUB';
+sub _field_check {
+# ----------------------------------------------------------
+# Checks to see if the input field name is a valid one,
+# the function checks the following:
+# 1. Column name
+# 2. Check column exist
+# 3. Check field size
+ my $cgi = $IN->get_hash;
+ my $col_name = $cgi->{column} || $cgi->{mod};
+ my $form_type = uc($cgi->{form_type});
+ my $type = uc($cgi->{type});
+
+ return GList::language('TAB_COL_NAME') if ( $col_name !~ /^(\w+)$/ );
+
+# Max lengths
+ if (( $type eq 'CHAR' ) and ( $cgi->{size} > 255 ) ) {
+ return GList::language('TAB_COL_SIZE');
+ }
+
+ if ( ( $type eq 'INT' ) and ( $cgi->{size} > 0 ) ) {
+ return GList::language('TAB_COL_SIZE_INT');
+ }
+
+ if ( ( $type eq 'ENUM' ) and ( !$cgi->{values} ) ) {
+ return GList::language('TAB_COL_VALUES');
+ }
+
+ if ( ( $cgi->{index} eq 'primary' or $cgi->{index} eq 'index' or $cgi->{index} eq 'unique' ) and ( ! $cgi->{not_null} ) ) {
+ return sprintf(GList::language('TAB_COL_NOTNULL'), $col_name);
+ }
+
+ if ( ( $form_type eq 'FILE' ) and ( $type ne 'CHAR' ) and ( $type ne 'VARCHAR' ) ) {
+ return GList::language('TAB_COL_FILE_TYPE');
+ }
+
+ my $location = $cgi->{file_save_in};
+ if ( ( $form_type eq 'FILE' ) and ( !$location ) ) {
+ return GList::language('TAB_COL_FILE_IN');
+ }
+
+ if ( ( $form_type eq 'FILE' ) and ( !-w $location ) ) {
+ return sprintf(GList::language('TAB_COL_FILE_ERR'), $location);
+ }
+}
+END_OF_SUB
+
+$COMPILE{_col_spec} = __LINE__ . <<'END_OF_SUB';
+sub _col_spec {
+# ----------------------------------------------------------
+# Reconstruct the input variables into a string in the form
+# "field_name(type(length_set) attribute DEFAULT default_value extra)"
+
+ my $cgi = $IN->get_hash;
+ my $col_spec;
+
+ # add field properties into a hash
+ $col_spec->{'type'} = $cgi->{type};
+ if ( $cgi->{type} eq 'ENUM' ) {
+ $col_spec->{'values'} = [split /(?:\n|\r)+/, $cgi->{values}];
+ }
+ else {
+ $col_spec->{'size'} = $cgi->{size};
+ }
+ $col_spec->{'default'} = $cgi->{default};
+ $col_spec->{'not_null'} = ($cgi->{not_null}) ? '1' : '';
+ $col_spec->{'form_display'} = ($cgi->{form_display})? $cgi->{form_display} : $cgi->{column};
+ $col_spec->{'form_type'} = ($cgi->{form_type}) ? $cgi->{form_type} : 'TEXT';
+ $col_spec->{'form_size'} = ($cgi->{form_size}) ? $cgi->{form_size} : '';
+ $col_spec->{'form_names'} = ($cgi->{form_names}) ? [split /(?:\n|\r)+/, $cgi->{form_names}] : [];
+ $col_spec->{'form_values'} = ($cgi->{form_values}) ? [split /(?:\n|\r)+/, $cgi->{form_values}]: [];
+ $col_spec->{'regex'} = ($cgi->{regex}) ? $cgi->{regex} : '';
+
+ if ( $cgi->{file_save_in} ) {
+ $col_spec->{'file_save_in'} = $cgi->{file_save_in};
+ $col_spec->{'file_save_scheme'} = $cgi->{file_save_scheme};
+ $col_spec->{'file_max_size'} = $cgi->{file_max_size};
+ }
+
+ return $col_spec;
+}
+END_OF_SUB
+
+$COMPILE{_index_type} = __LINE__ . <<'END_OF_SUB';
+sub _index_type {
+#-----------------------------------------------------------------
+ my $column = shift;
+ my $db = $DB->table('Users');
+ my $indexed = 'none';
+ if ($column) {
+ $db->_is_indexed($column) and ($indexed = 'regular');
+ $db->_is_unique($column) and ($indexed = 'unique');
+ $db->_is_pk($column) and ($indexed = 'primary');
+ }
+ return $indexed;
+}
+END_OF_SUB
+
+$COMPILE{_save_users} = __LINE__ . <<'END_OF_SUB';
+sub _save_users {
+#-------------------------------------------------------------------
+#
+ my $users = $DB->table('Users')->select({ usr_type => ADMINISTRATOR }, ['usr_username', 'usr_password', 'usr_email'])->fetchall_hashref;
+ my %hash;
+ foreach (@$users) {
+ $hash{$_->{usr_username}} = [$_->{usr_password}, $_->{usr_email}];
+ }
+ $CFG->{admin} = \%hash;
+ $CFG->save;
+}
+END_OF_SUB
+
+$COMPILE{_sql_load_cfg} = __LINE__ . <<'END_OF_SUB';
+sub _sql_load_cfg {
+#-------------------------------------------------------------------
+# Load current sql information
+#
+ require GList::SQL;
+ my $cfg = GList::SQL::load();
+ foreach (keys % $cfg) {
+ $cfg->{"sql_$_"} = $cfg->{$_};
+ delete $cfg->{$_};
+ }
+ return $cfg;
+}
+END_OF_SUB
+
+$COMPILE{_sql_connect} = __LINE__ . <<'END_OF_SUB';
+sub _sql_connect {
+#----------------------------------------------------------
+#
+ my ($host, $driver, $database, $login, $password, $prefix) = @_;
+
+ my ($port, $ret);
+ ($host =~ s/\:(\d+)$//) and ($port = $1);
+
+ $prefix =~ /^\w*$/ or return { error => "Invalid prefix: '$prefix'. Can only be letters, numbers and underscore." };
+
+ GT::SQL->reset_env();
+ $DB->prefix($prefix);
+ $ret = $DB->set_connect({
+ driver => $driver,
+ host => $host,
+ port => $port,
+ database => $database,
+ login => $login,
+ password => $password,
+ RaiseError => 0,
+ PrintError => 0,
+ AutoCommit => 1
+ });
+
+ if (! defined $ret) {
+ return { error => "$GT::SQL::error" };
+ }
+
+ return $ret;
+}
+END_OF_SUB
+
+$COMPILE{_account_limit} = __LINE__ . <<'END_OF_SUB';
+sub _account_limit {
+#-----------------------------------------------------------
+#
+ my $data = shift;
+ if ($data->{usr_type} == ADMINISTRATOR or $data->{usr_type} == UNLIMITED_USER ) {
+ $data->{usr_limit_list} = 0;
+ $data->{usr_limit_sublist} = 0;
+ $data->{usr_limit_email30} = 0;
+ }
+ else {
+ $data->{usr_limit_list} ||= $CFG->{signup_limit_list} || 10;
+ $data->{usr_limit_sublist} ||= $CFG->{signup_limit_sublist} || 10;
+ $data->{usr_limit_email30} ||= $CFG->{signup_limit_email30} || 100;
+ }
+ return $data;
+}
+END_OF_SUB
+
+$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
+sub _determine_action {
+#----------------------------------------------------------------------------
+# Check valid action
+#
+ my $action = shift || undef;
+
+ if ( $action =~ /admin_setup_sql_form|admin_setup_sql|admin_setup_form|admin_setup/ ) {
+ $MN_SELECTED = 9;
+ }
+ ($action eq 'admin_user_search') and return 'admin_user';
+ return if ( !$action );
+
+ my %valid = (
+ map { $_ => 1 } qw(
+ admin_gtdoc
+ admin_page
+ admin_initial_sql
+ admin_initial_setup
+ admin_user
+ admin_user_add
+ admin_user_modify_form
+ admin_user_modify
+ admin_user_delete
+ admin_user_validate
+ admin_user_table
+ admin_user_table_add
+ admin_user_table_modify
+ admin_user_table_delete
+ admin_user_table_resync
+ admin_plugin
+ admin_setup_sql_form
+ admin_setup_sql
+ admin_setup_form
+ admin_setup
+ admin_template_diff
+ admin_stoplist
+ admin_stoplist_add
+ admin_stoplist_confirm
+ admin_stoplist_delete
+ )
+ );
+ exists $valid{$action} and return $action;
+ return;
+}
+END_OF_SUB
+
+1;
diff --git a/site/glist/lib/GList/Authenticate.pm b/site/glist/lib/GList/Authenticate.pm
new file mode 100644
index 0000000..971a1d7
--- /dev/null
+++ b/site/glist/lib/GList/Authenticate.pm
@@ -0,0 +1,246 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: Authenticate.pm,v 1.15 2004/04/15 19:46:36 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::Authenticate;
+# ==================================================================
+
+use strict;
+use GList qw/:objects/;
+use GT::Session::SQL;
+
+sub auth {
+# -------------------------------------------------------------------
+# Runs the request auth function through the plugin system.
+#
+ ($_[0] eq 'GList::Authenticate') and shift;
+
+ my ($auth, $args) = @_;
+ my $code = exists $GList::Authenticate::{"auth_$auth"} ? $GList::Authenticate::{"auth_$auth"} : die "Invalid Authenticate method: auth_$auth called.";
+ GT::Plugins->dispatch("$CFG->{priv_path}/lib/GList/Plugins", "auth_$auth", $code, $args);
+}
+
+sub auth_init {
+# -------------------------------------------------------------------
+# This function is guaranteed to be called before any other authentication
+# function, but may be called multiple times during one request.
+#
+ return 1;
+}
+
+sub auth_get_user {
+# -------------------------------------------------------------------
+# This function returns user information for a given user, auto
+# creating if it doesn't exist.
+#
+ my $args = shift;
+ return $DB->table ('Users')->get({ usr_username => $args->{username}, usr_status => '1' });
+}
+
+sub auth_valid_user {
+# -------------------------------------------------------------------
+# This function returns 1 if the user/pass combo is valid, 0/undef
+# otherwise.
+#
+ my $args = shift;
+ my $user = $DB->table('Users')->get($args->{username});
+ return if ( !$user );
+
+ return ($user->{usr_password} eq GList::encrypt($args->{password}, $user->{usr_password})) ? 1 : 0;
+}
+
+sub auth_create_session {
+# -------------------------------------------------------------------
+# This function creates a session, and prints the header and returns a
+# hash with session => $id, and redirect => 0/1.
+#
+ my $args = shift;
+
+ my $uid = $args->{username};
+ my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
+ my $session = GT::Session::SQL->new ({
+ _debug => $CFG->{debug},
+ tb => $DB->table('Users_Sessions'),
+ session_user_id => $uid,
+ session_data => { cookie => $use_cookie, do => scalar($IN->param('do')) },
+ expires => $CFG->{session_exp},
+ }
+ );
+
+ if ( $GT::Session::SQL::error ) {
+ return { error => $GT::Session::SQL::error };
+ }
+# Delete all old sessions.
+ $session->cleanup;
+ if ($use_cookie) {
+ print $IN->cookie(
+ -name => 'sid',
+ -value => $session->{info}->{session_id},
+ )->cookie_header() . "\n";
+ }
+ return { session_id => $session->{info}->{session_id}, use_cookie => $use_cookie };
+}
+
+sub auth_valid_session {
+# -------------------------------------------------------------------
+# This functions checks to see if the session is valid, and returns the
+# username.
+ my $args = shift;
+ my ($sid, $cookie);
+ if ($IN->param ('sid')) {
+ $sid = $IN->param ('sid');
+ }
+ elsif ( !$CFG->{user_session} and $IN->cookie ('sid') ) {
+ $cookie = 1;
+ $sid = $IN->cookie ('sid');
+ }
+ else { return }
+ my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
+
+# Cookie authentication
+ my $session = new GT::Session::SQL ({
+ _debug => $CFG->{debug},
+ tb => $DB->table('Users_Sessions'),
+ session_id => $sid,
+ expires => $CFG->{session_exp},
+ session_data => { cookie => $use_cookie, do => scalar($IN->param('do')) },
+ }) or return;
+
+# Delete any of the user's expired sessions
+ $sid = '' if ($session->{data}->{cookie});
+
+# Must return the session id and the userid
+ return { session_id => $session->{info}->{session_id}, use_cookie => $use_cookie, user_name => $session->{info}->{session_user_id} };
+}
+
+sub auth_delete_session {
+# -------------------------------------------------------------------
+# This function removes a session, returns 1 on success, undef on
+# failure.
+#
+ my $args = shift;
+ my $sid;
+ if ( $IN->param('sid') ) {
+ $sid = $IN->param ('sid');
+ }
+ elsif ( !$CFG->{user_session} and $IN->cookie('sid') ) {
+ $sid = $IN->cookie ('sid');
+ }
+ else { return }
+
+ my $session = new GT::Session::SQL (
+ {
+ _debug => $CFG->{debug},
+ tb => $DB->table ('Users_Sessions'),
+ session_id => $sid
+ }
+ ) or return;
+
+# Delete the cookie
+ $session->delete or return;
+
+# Print the cookie header
+ if (!$CFG->{user_session}) {
+ print $IN->cookie(
+ -name => 'sid',
+ -value => $sid,
+ -expires => '-1h'
+ )->cookie_header() . "\n";
+ }
+ return 1;
+}
+
+sub auth_admin_valid_user {
+#---------------------------------------------------------
+#
+ my $args = shift;
+
+ my $admins = $CFG->{admin};
+ foreach my $u (keys % $admins) {
+ my $pass = $admins->{$u}->[0];
+ if ($u eq $args->{username} and GList::encrypt($args->{password}, $pass) eq $pass ) {
+ return $args->{username};
+ }
+ }
+ return;
+}
+
+sub auth_admin_create_session {
+#---------------------------------------------------------
+#
+ my $args = shift;
+
+# Clear out old sessions.
+ require GT::Session::File;
+ GT::Session::File->cleanup(1800, "$CFG->{priv_path}/tmp");
+
+# Create a new session and save the information.
+ my $session = new GT::Session::File ( directory => "$CFG->{priv_path}/tmp" );
+ $session->{data}->{username} = $args->{username};
+ my $session_id = $session->{id};
+ $session->save;
+
+# Now redirect to another URL and set cookies, or set URL string.
+ my $redirect = 0;
+ my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
+ if ($use_cookie) {
+ print $IN->cookie (
+ -name => 'session_id',
+ -value => $session_id,
+ -path => '/'
+ )->cookie_header() . "\n";
+ }
+ return { session_id => $session_id, use_cookie => $use_cookie };
+}
+
+sub auth_admin_valid_session {
+# -------------------------------------------------------------------
+# This functions checks to see if the session is valid, and returns the
+# username.
+#
+ my $args = shift;
+
+# Clear out old sessions.
+ require GT::Session::File;
+ GT::Session::File->cleanup(1800, "$CFG->{priv_path}/tmp");
+
+ my $session_id = $IN->param('session_id') || $IN->cookie('session_id') || return;
+ my $session = new GT::Session::File (
+ directory => "$CFG->{priv_path}/tmp",
+ id => $session_id
+ ) || return;
+
+ my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
+ return { username => $session->{data}->{username}, session_id => $session_id, use_cookie => $use_cookie };
+}
+
+sub auth_admin_delete_session {
+#--------------------------------------------------------
+#
+ require GT::Session::File;
+ my $session_id = $IN->cookie('session_id') || $IN->param('session_id') || return;
+ my $session = new GT::Session::File(
+ directory => "$CFG->{priv_path}/tmp",
+ id => $session_id
+ ) || return;
+
+ print $IN->cookie(
+ -name => 'session_id',
+ -value => '',
+ -path => '/'
+ )->cookie_header() . "\n";
+
+ return $session->delete();
+}
+
+1;
diff --git a/site/glist/lib/GList/Config.pm b/site/glist/lib/GList/Config.pm
new file mode 100644
index 0000000..63dbd75
--- /dev/null
+++ b/site/glist/lib/GList/Config.pm
@@ -0,0 +1,196 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: Config.pm,v 1.7 2004/10/05 22:02:27 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::Config;
+# =============================================================================
+# Sets up our config variables -- if you are looking to hand edit variables the
+# data is in GList/Config/Data.pm, but you shouldn't have to do this, really!
+#
+use GT::Config();
+use vars qw/@ISA/;
+@ISA = 'GT::Config';
+
+use strict;
+
+sub new {
+# -----------------------------------------------------------------------------
+ my $class = ref $_[0] ? ref shift : shift;
+ my $path = shift || '.';
+
+ my $file = "$path/GList/Config/Data.pm";
+
+ my $self = $class->load($file => {
+ debug => $GList::DEBUG,
+ header => <<'HEADER'
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website: http://gossamer-threads.com/
+# Support: http://gossamer-threads.com/scripts/support/
+# Updated: [localtime]
+#
+# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
+# Redistribution in part or in whole strictly prohibited. Please
+# see LICENSE file for full details.
+# ==================================================================
+
+HEADER
+ });
+
+ $self->debug_level($self->{debug});
+
+ return $self;
+
+ $self->{priv_path} ||= '.';
+ $self->{version} ||= $GList::VERSION;
+ $self->{setup} ||= 0;
+
+ return $self;
+}
+
+sub tpl_load {
+# ------------------------------------------------------------------
+# Returns a hash of config variables for use in tempaltes.
+#
+ my $t = {};
+ while (my ($key, $val) = each %{$GList::CFG}) {
+ (ref $val eq 'ARRAY') and ($val = join ",", @$val);
+ (ref $val eq 'HASH') and do { my $tmp = ''; foreach (sort keys %$val) { $tmp .= "$_ = $val->{$_}, "; } chop $tmp; chop $tmp; $val = $tmp; };
+ $t->{"cfg_$key"} = $GList::IN->html_escape($val);
+ }
+ return $t;
+}
+
+sub defaults {
+# ------------------------------------------------------------------
+# Set sensible defaults for the config values, overwriting old values.
+#
+ my $self = shift;
+ $self->{setup} = 1;
+ $self->default_path(1);
+ $self->default_misc(1);
+}
+
+sub create_defaults {
+# ------------------------------------------------------------------
+# Create defaults, does not overwrite old values.
+#
+ my $self = shift;
+ $self->{setup} = 1;
+ $self->default_path(0);
+ $self->default_misc(0);
+}
+
+sub set {
+# ------------------------------------------------------------------
+# Sets a value.
+#
+ my ($self, $key, $val, $overwrite) = @_;
+ if ($overwrite or ! exists $self->{$key}) { $self->{$key} = $val }
+}
+
+sub default_path {
+# ------------------------------------------------------------------
+# Set the path settings to default values.
+#
+ my ($self, $overwrite) = @_;
+ $self->set('cgi_url', _find_cgi_url(), $overwrite);
+ $self->set('image_url', _find_image_url(), $overwrite);
+ $self->set('path_to_perl', _find_perl(), $overwrite);
+ $self->set('path_fileman', $self->{priv_path}, $overwrite);
+}
+
+sub default_misc {
+# ------------------------------------------------------------------
+# Set the misc settings to default values.
+#
+ my ($self, $overwrite) = @_;
+ $self->set('reg_number', '', $overwrite);
+ $self->set('debug_level', 0, $overwrite);
+ $self->set('user_session', '', $overwrite);
+ $self->set('session_exp', 3, $overwrite);
+ $self->set('scheduled_mailing_minute', 5, $overwrite);
+ $self->set('admin_email', '', $overwrite);
+ $self->set('smtp_server', '', $overwrite);
+ $self->set('mail_path', _find_sendmail(), $overwrite);
+ $self->set('highlight_color', 1, $overwrite);
+
+# for attachments
+ $self->set('max_attachments_size', 1024, $overwrite);
+
+# for templates
+ my $html_code = <<'HTML';
+
+
+
+HTML
+
+ $self->set('html_code', $html_code, $overwrite);
+}
+
+sub _find_cgi_url {
+# -----------------------------------------------------------------------------
+# Returns basedir of current url.
+#
+ my $url = GT::CGI->url({ absolute => 1, query_string => 0 });
+ $url =~ s,/[^/]*$,,;
+ return $url;
+}
+
+sub _find_image_url {
+# -----------------------------------------------------------------------------
+# Returns image directory basedir from cgi basedir, replacing cgi with images
+#
+ my $url = _find_cgi_url();
+ $url =~ s,/cgi$,,;
+ $url .= '/images';
+ return $url;
+}
+
+sub _find_perl {
+# -----------------------------------------------------------------------------
+# Returns path to perl.
+#
+ my @poss_perls = qw(
+ /usr/local/bin/perl /usr/bin/perl /bin/perl
+ /usr/local/bin/perl5 /usr/bin/perl5 /bin/perl5
+ /perl/bin/perl.exe c:/perl/bin/perl.exe d:/perl/bin/perl.exe
+ );
+ foreach my $perl_path (@poss_perls) {
+ return $perl_path if -f $perl_path and -x _;
+ }
+ return '';
+}
+
+sub _find_sendmail {
+# ------------------------------------------------------------------
+# Looks for sendmail.
+#
+ for (qw(/usr/sbin/sendmail /usr/lib/sendmail /usr/bin/sendmail /sbin/sendmail /bin/sendmail)) {
+ return $_ if -f and -x _;
+ }
+ return '';
+}
+
+1;
+
diff --git a/site/glist/lib/GList/Config/Data.pm b/site/glist/lib/GList/Config/Data.pm
new file mode 100644
index 0000000..a8acd49
--- /dev/null
+++ b/site/glist/lib/GList/Config/Data.pm
@@ -0,0 +1,73 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website: http://gossamer-threads.com/
+# Support: http://gossamer-threads.com/scripts/support/
+# Updated: Sat Feb 12 12:02:26 2022
+#
+# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
+# Redistribution in part or in whole strictly prohibited. Please
+# see LICENSE file for full details.
+# ==================================================================
+
+{
+ 'admin' => {
+ 'admin' => [
+ '$GT$YJ4E9RP4$khwtQz/NC7ErNdHmPNOAE0',
+ 'slowman@slowtwitch.com'
+ ],
+ 'rappstar' => [
+ '$GT$HQRmVMKU$qsarcJtu/9LHJtzyZBTJt.',
+ 'rappstar@slowtwitch.com'
+ ]
+ },
+ 'admin_email' => '',
+ 'allowed_space' => '100000',
+ 'cgi_url' => 'https://secure.slowtwitch.com/cgi-bin',
+ 'command_time_out' => '10',
+ 'debug_level' => '0',
+ 'highlight_color' => '1',
+ 'html_code' => '
+
+
+ ',
+ 'iframe_tracking' => '1',
+ 'image_path' => '/home/slowtwitch/secure.slowtwitch.com/secure-www/glist',
+ 'image_url' => 'https://secure.slowtwitch.com/glist',
+ 'mail_path' => '/usr/sbin/sendmail',
+ 'max_attachments_size' => '1024',
+ 'max_bounced_emails' => '10000',
+ 'path_fileman' => '/home/slowtwitch/site/glist',
+ 'path_to_perl' => '/usr/bin/perl',
+ 'priv_path' => '/home/slowtwitch/site/glist',
+ 'reg_number' => '',
+ 'scheduled_mailing_minute' => '5',
+ 'session_exp' => '3',
+ 'setup' => '1',
+ 'signup_admin_validate' => '0',
+ 'signup_email_validate' => '1',
+ 'signup_enable' => '0',
+ 'signup_limit_email30' => '100',
+ 'signup_limit_list' => '10',
+ 'signup_limit_sublist' => '10',
+ 'signup_restricted_email' => [],
+ 'signup_username_regex' => '^[\w\-\.]{3,}$',
+ 'smtp_server' => '',
+ 'static_url' => 'https://secure.slowtwitch.com/glist',
+ 'template_backups' => '1',
+ 'template_set' => 'gossamer',
+ 'user_session' => '0',
+ 'version' => '1.1.1'
+};
+
+# vim:syn=perl:ts=4:noet
diff --git a/site/glist/lib/GList/Custom.pm b/site/glist/lib/GList/Custom.pm
new file mode 100644
index 0000000..1dafc01
--- /dev/null
+++ b/site/glist/lib/GList/Custom.pm
@@ -0,0 +1,30 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: Custom.pm,v 1.1 2004/01/13 01:19:23 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.
+# ==================================================================
+#
+# Description:
+# By default, this file is empty, however it is here to allow installations
+# to perform special operations required to make Gossamer Mail load.
+# For example, some installations might need a 'use lib' line to work
+# properly.
+#
+# This file will NOT be overwritten when upgrading your installation, so you
+# do not need to worry about additions made here being overwritten. This is
+# generally loaded after GMail.pm has started loading, but before any other
+# modules are loaded.
+#
+
+
+
+
+
+1; # This must remain at the bottom of the file
diff --git a/site/glist/lib/GList/GUI.pm b/site/glist/lib/GList/GUI.pm
new file mode 100644
index 0000000..3049a82
--- /dev/null
+++ b/site/glist/lib/GList/GUI.pm
@@ -0,0 +1,249 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: GUI.pm,v 1.5 2004/08/24 19:28:37 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::GUI;
+# ==================================================================
+
+use strict;
+use GList qw/:objects/;
+
+sub gui_profile_form {
+# -------------------------------------------------------------------
+ require GT::SQL::Display::HTML;
+ require GT::SQL::Display::HTML::Table;
+
+ my $opts = {@_};
+ my $user_tb = $DB->table('Users');
+
+ $opts->{cols} ||= [ grep(/^pro_/, $user_tb->ordered_columns) ];
+ $opts->{tr} ||= 'class="body"';
+ $opts->{td_l} ||= 'class="body" width="40%" align="right"';
+ $opts->{td_r} ||= 'class="body" align="left"';
+ $opts->{cols} ||= [];
+ $opts->{mode} ||= 'edit';
+ $opts->{required} ||= ($opts->{mode} eq 'search') ? '' : '*';
+
+ my $tags = GT::Template->tags;
+ my $cols = $user_tb->cols;
+ my $disp = $DB->html($user_tb, GT::Template->tags);
+ my $html = '';
+ my $prefix = $opts->{prefix} || '';
+
+ if ( $opts->{mode} eq 'hidden' ) {
+
+# Preserve all columns that relate to the Users database
+ my $cols = $user_tb->cols;
+ my $hidden_html = '';
+ foreach my $col ( keys %$cols ) {
+ foreach my $name ( map { "$col$_" } ( '', qw( -opt -gt -lt -le -ge -ne )) ) {
+ my $v = $tags->{$name};
+ next unless defined $v;
+ my $input_html = gui_form_control({
+ form_type => 'hidden',
+ value => $v,
+ name => $name
+ });
+ $html .= $$input_html;
+ }
+ }
+ return \$html;
+ }
+
+ my %search_defs = (
+ string => { names => [qw( LIKE <> = )] },
+ number => { names => [qw( = <> < <= > >= )] },
+ date => { names => [ '', qw( = <> < <= > >= )] },
+ radio => { names => [qw( = <> )] },
+ minimal => { names => [qw( = )] }
+ );
+
+ foreach my $col (@{$opts->{cols}}) {
+ my $control_opts = {%{$cols->{$col}||{}}};
+ $control_opts->{name} = $col;
+ $control_opts->{value} = $tags->{$col};
+ my $title = GList::language( $cols->{$col}{form_display} );
+ my $input_html = gui_form_control({
+ name => "$prefix$col",
+ value=> ($opts->{mode} eq 'search') ? '' : $tags->{"$prefix$col"},
+ def => $control_opts
+ });
+ $html .= ( $cols->{$col}->{not_null} ) ?
+ "
{tr}>
{td_l}>
$title
{td_r}>$$input_html $opts->{required}
" :
+ "
{tr}>
{td_l}>
$title
{td_r}>$$input_html
";
+ }
+ return \$html;
+}
+
+sub gui_form_control {
+# -------------------------------------------------------------------
+ require GT::SQL::Display::HTML;
+ require GT::SQL::Display::HTML::Table;
+ require GT::Template;
+
+ my $opts = ref $_[0] eq 'HASH' ? shift : {@_};
+
+ my $user_tb = $DB->table('Users');
+ my $tags = GT::Template->tags || {};
+ my $disp = $DB->html($user_tb, $tags);
+
+ my $form_type = lc $opts->{def}->{form_type};
+ exists $opts->{blank} or $opts->{blank} = $form_type eq 'select' ? 1 : 0;
+
+ $opts->{def}->{class} = 'object' if ($form_type !~ /radio|checkbox/);
+ my $input_html = 'radio' eq $form_type ? $disp->radio( $opts ) :
+ 'checkbox' eq $form_type ? $disp->checkbox( $opts ) :
+ 'select' eq $form_type ? $disp->select( $opts ) :
+ 'hidden' eq $form_type ? $disp->hidden( $opts ) :
+ 'multiple' eq $form_type ? $disp->multiple( $opts ) :
+ 'textarea' eq $form_type ? $disp->textarea( $opts ) :
+ 'file' eq $form_type ? "File type not supported." :
+ 'date' eq $form_type ? do {
+ require GT::Date;
+ my ($sel_year, $sel_mon, $sel_day) = split /\-/, GT::CGI::html_escape($opts->{value});
+ $sel_year ||= 1970;
+ $sel_mon ||= 1;
+ $sel_day ||= 1;
+ my $month_sel = $disp->select({
+ name => "$opts->{name}-mon",
+ value => $sel_mon,
+ values => { map { sprintf("%02d", $_) => $GT::Date::LANGUAGE->{short_month_names}->[$_ - 1] } (1 .. 12) },
+ sort => [ map { sprintf("%02d", $_) } (1 .. 12) ],
+ blank => 0
+ });
+ my $day_sel = $disp->select({
+ name => "$opts->{name}-day",
+ value => $sel_day,
+ values => { map { sprintf("%02d", $_) => $_ } (1 .. 31) },
+ sort => [ map { sprintf("%02d", $_) } (1 .. 31) ],
+ blank => 0
+ });
+ qq~
+ $day_sel /
+ $month_sel /
+
+ ~;
+ } :
+ $disp->text($opts);
+
+ return \$input_html;
+}
+
+sub gui_toolbar {
+ my %input = @_;
+ my $tags = GT::Template->tags;
+ $input{first} ||= q||;
+ $input{first_grey} ||= q||;
+ $input{prev} ||= q||;
+ $input{prev_grey} ||= q||;
+ $input{next} ||= q||;
+ $input{next_grey} ||= q||;
+ $input{last} ||= q||;
+ $input{last_grey} ||= q||;
+ $input{view_all} ||= q|View All|;
+ $input{pages} ||= 9;
+ $input{'...'} ||= '...';
+ $input{'first_...'} ||= 1;
+ $input{'last_...'} ||= 1;
+ $input{before_page} ||= q||;
+ $input{after_page} ||= q||;
+ $input{before_current} ||= q||;
+ $input{after_current} ||= q||;
+ $input{'glist.cgi'} ||= 'glist.cgi';
+
+ for (keys %input) {
+ $input{$_} =~ s/\$image_url/$tags->{image_url}/g;
+ }
+
+ my $hidden_query = ${$tags->{hidden_query} || \''};
+
+ my $num_page_items = ref $tags->{num_page_items} eq 'SCALAR' ? ${$tags->{num_page_items}} : $tags->{num_page_items};
+ my $paging = GList::paging($num_page_items, @$tags{qw/mh nh/}, @input{qw/pages last_.../});
+ ($paging, my ($top_page, $ddd)) = @$paging{'paging', 'top_page', 'dotdotdot'};
+ my $return = '';
+ my $search = '';
+ if ($tags->{toolbar_table}) {
+ my $cols = $DB->table($tags->{toolbar_table})->cols;
+ foreach my $c (keys %{$cols}) {
+ next unless $tags->{$c};
+ $search .= qq|$c=$tags->{$c};|;
+ if ($tags->{"$c-opt"}) { $search .= qq|$c-opt=$tags->{"$c-opt"};|; }
+ }
+ }
+
+ my $link = sub {
+ my ($page, $disp) = @_;
+ $return .= qq|$disp\n|;
+ };
+
+ unless ($top_page == 1) {
+ if ($tags->{nh} == 1) {
+ $return .= $input{first_grey} . "\n";
+ $return .= $input{prev_grey} . "\n";
+ }
+ else {
+ my $prev = ($tags->{nh} == -1) ? 1 : ($tags->{nh} - 1);
+ $link->(1, $input{first});
+ $link->($prev, $input{prev});
+ }
+
+ if (@$paging and $paging->[0]->{page_num} > 1 and $input{'first_...'}) {
+ $link->(1, qq|$input{before_page}1$input{after_page}|);
+ $return .= "$input{before_page}$input{'...'}" . ($input{after_page} || " ") if $paging->[0]->{page_num} > 2;
+ }
+ for (@$paging) {
+ if ($_->{is_current_page}) {
+ $return .= qq|$input{before_current}$_->{page_num}$input{after_current}\n|;
+ }
+ else {
+ $link->($_->{page_num}, qq|$input{before_page}$_->{page_num}$input{after_page}|);
+ }
+ }
+ if ($ddd) {
+ $return .= "$input{before_page}$input{'...'}" . ($input{after_page} || " ");
+ $link->($top_page, "$input{before_page}$top_page$input{after_page}");
+ }
+
+ if ($tags->{nh} >= $top_page) {
+ $return .= $input{next_grey} . "\n";
+ $return .= $input{last_grey} . "\n";
+ }
+ else {
+ my $next = ($tags->{nh} == -1) ? 1 : ($tags->{nh} + 1);
+ $link->($next, $input{next});
+ $link->($top_page, $input{last});
+ }
+ }
+ return \$return;
+}
+1;
diff --git a/site/glist/lib/GList/HTML.pm b/site/glist/lib/GList/HTML.pm
new file mode 100644
index 0000000..f1bece3
--- /dev/null
+++ b/site/glist/lib/GList/HTML.pm
@@ -0,0 +1,88 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: HTML.pm,v 1.10 2004/03/01 21:38:38 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::HTML;
+
+use strict;
+use GList q/:objects/;
+
+sub date_get {
+#----------------------------------------------------------------------
+#
+ my ($fld_name, $type) = @_;
+
+ my $tags = GT::Template->tags;
+ my $format = $tags->{usr_date_format};
+ $format =~ s/\#/\%/g;
+ $format ||= '%mm%-%dd%-%yyyy%';
+ $format .= ' %hh%:%MM%:%ss%' if ( $type );
+
+ require GT::Date;
+ ( $fld_name ) or return GT::Date::date_get(time, $format);
+
+ my $record = $tags->{results}[$tags->{row_num} - 1];
+ return GT::Date::date_get($record->{$fld_name} || $tags->{$fld_name}, $format);
+}
+
+sub html_unescape {
+#--------------------------------------------------------------------
+#
+ my $content = shift;
+ $content =~ s/\n/ /g;
+ return $content;
+}
+
+sub generate_attachments {
+#---------------------------------------------------------------------
+#
+ my $col = shift || 'msg_id';
+
+ my $tags = GT::Template->tags;
+ my $val = $tags->{results}[$tags->{row_num} - 1]->{$col};
+ ( $val ) or return;
+
+ my $sth;
+ if ( $col eq 'msg_id' ) {
+ $sth = $tags->{html}->{sql}->table('MessageAttachments')->select({ att_message_id_fk => $val });
+ }
+ else {
+ $sth = $tags->{html}->{sql}->table('MailingAttachments')->select({ mat_mailing_id_fk => $val });
+ }
+ my $attachments;
+ while ( my $rs = $sth->fetchrow_hashref ) {
+ push @$attachments, $rs;
+ }
+
+ return { attachments => ( !$attachments ) ? 0 : $attachments };
+}
+
+sub generate_years {
+#-------------------------------------------------------------------
+#
+ my $tags = GT::Template->tags;
+ my $min = $tags->{html}->{sql}->table('MailingIndex')->select(['MIN(mli_done)'])->fetchrow_array || time;
+
+ require GT::Date;
+ my $yy_min = GT::Date::date_get($min, '%yyyy%');
+ my $yy_max = GT::Date::date_get(time, '%yyyy%');
+ my @output;
+ for my $i ( $yy_min .. $yy_max ) {
+ push @output, { y => $i };
+ }
+ return { loop_years => \@output };
+}
+
+1;
+
+
diff --git a/site/glist/lib/GList/List.pm b/site/glist/lib/GList/List.pm
new file mode 100644
index 0000000..6a8135f
--- /dev/null
+++ b/site/glist/lib/GList/List.pm
@@ -0,0 +1,833 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: List.pm,v 1.50 2004/11/04 17:54:05 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::List;
+# ==================================================================
+
+use strict;
+use GList qw/:objects :user_type $DEBUG/;
+use GT::AutoLoader;
+
+sub process {
+#-------------------------------------------------------------------
+# Setermine what to do
+#
+ my $do = shift;
+
+ 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);
+
+ $tpl ||= 'lst_home.html';
+ $MN_SELECTED = 2;
+
+ my $hidden = GList::hidden();
+ $results->{hidden_query} = $hidden->{hidden_query};
+ $results->{hidden_objects} = $hidden->{hidden_objects};
+ GList::display($tpl, $results);
+}
+
+$COMPILE{lst_home} = __LINE__ . <<'END_OF_SUB';
+sub lst_home {
+#--------------------------------------------------------------------
+# Print home page
+#
+ my $msg = shift;
+ my $cgi = $IN->get_hash;
+ if (defined $cgi->{do} and $cgi->{do} =~ /^lst_add|lst_modify|lst_html/) {
+ foreach ( $DB->table('Lists')->cols ) { $cgi->{$_} = ''; }
+ }
+ my $search_check = ($IN->param('do') eq 'lst_search') ? 1 : 0;
+ my $query = '';
+ if ($cgi->{'lst_date_created-ge'} or $cgi->{'lst_date_created-le'}) {
+ my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
+ my ($valid_from, $valid_to) = (1, 1);
+ require GT::Date;
+ if ($cgi->{'lst_date_created-ge'}) {
+ $query .= "lst_date_created-ge=$cgi->{'lst_date_created-ge'};";
+ $valid_from = GList::date_to_time($cgi->{'lst_date_created-ge'}, $format);
+ $cgi->{'lst_date_created-ge'} = GT::Date::date_get($valid_from, $format);
+ }
+ if ($cgi->{'lst_date_created-le'}) {
+ $query .= "lst_date_created-le=$cgi->{'lst_date_created-le'};";
+ $valid_to = GList::date_to_time($cgi->{'lst_date_created-le'}, $format);
+ $cgi->{'lst_date_created-le'} = GT::Date::date_get($valid_to, $format);
+ }
+
+ if ($search_check and (!$valid_from or !$valid_to)) {
+ $format =~ s/\%//g;
+ return lst_search_form(GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')));
+ }
+ }
+ my $results = GList::search(
+ cgi => $cgi,
+ db => $DB->table('Lists'),
+ prefix => 'lst',
+ sb => 'lst_title',
+ so => 'ASC',
+ search_check=> $search_check,
+ select_all => $cgi->{select_all}
+ );
+
+ if (ref $results ne 'HASH') {
+ ($IN->param('do') eq 'lst_search') ? return (lst_search_form($results))
+ : return ('lst_home.html', { msg => $results });
+ }
+ elsif ($results->{error} and $search_check) {
+ return lst_search_form($results->{error});
+ }
+
+ require GT::SQL::Condition;
+ my $subs = $DB->table('Subscribers');
+ my $output = $results->{results};
+ my @lists = map $_->{lst_id}, @$output;
+
+ $subs->select_options("GROUP BY sub_list_id_fk");
+ my %subscribers = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists })->fetchall_list;
+
+ $subs->select_options("GROUP BY sub_list_id_fk");
+ my %validateds = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists, sub_validated => 1 })->fetchall_list;
+
+ $subs->select_options("GROUP BY sub_list_id_fk");
+ my %bounceds = $subs->select(sub_list_id_fk => 'COUNT(*)', GT::SQL::Condition->new(sub_list_id_fk => 'IN' => \@lists, sub_bounced => '>=' => 1))->fetchall_list;
+
+ foreach my $rs (@$output) {
+ $rs->{subscribers} = $subscribers{$rs->{lst_id}};
+ $rs->{validateds} = $validateds{$rs->{lst_id}};
+ $rs->{bounceds} = $bounceds{$rs->{lst_id}};
+ }
+
+ if ($cgi->{select_all}) {
+ my $sorted = _qsort($results->{results}, $cgi->{sb}, ($cgi->{so} eq 'ASC') ? 1 : 0);
+ my @sorted;
+ my $mh = $results->{mh};
+ my $nh = $results->{nh} || 1;
+ my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh;
+ my $count = 0;
+ if ( $bg < $results->{hits} ) {
+ foreach my $i (0..($results->{hits} - 1)) {
+ if ($i >= $bg) {
+ push @sorted, $sorted->[$i];
+ last if ($#sorted == $mh - 1);
+ }
+ }
+ $results->{results} = \@sorted;
+ }
+ else {
+ $results->{results} = [];
+ }
+ }
+ $results->{msg} = $msg if ($msg);
+ return ('lst_home.html', { %$results, toolbar_query => $query });
+}
+END_OF_SUB
+
+$COMPILE{lst_add} = __LINE__ . <<'END_OF_SUB';
+sub lst_add {
+#--------------------------------------------------------------------
+#
+ return ('lst_add_form.html') if ($IN->param('form'));
+
+# Check account limit if it's a limited user
+ if ($USER->{usr_type} == LIMITED_USER and GList::check_limit('list')) {
+ return lst_home($GList::error);
+ }
+
+ my $ret = GList::add('Lists', 'lst');
+ return ('lst_add_form.html', { msg => "$GList::error", help => 'lists_add.html' }) if ( $GList::error );
+
+ my $name = $IN->param('lst_title');
+ return lst_home(GList::language('LST_ADD_SUCCESS', $name));
+}
+END_OF_SUB
+
+$COMPILE{lst_modify_form} = __LINE__ . <<'END_OF_SUB';
+sub lst_modify_form {
+#--------------------------------------------------------------------
+# Print modify form
+#
+ my $msg = shift;
+
+ return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));
+
+ my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
+ return home($info) if (ref $info ne 'HASH');
+
+ return ('lst_modify_form.html', { msg => $msg, %$info, help => 'lists_add.html' });
+}
+END_OF_SUB
+
+$COMPILE{lst_modify} = __LINE__ . <<'END_OF_SUB';
+sub lst_modify {
+#--------------------------------------------------------------------
+#
+ GList::modify('Lists', 'lst');
+ return lst_modify_form("$GList::error") if ( $GList::error );
+
+ my $title = $IN->param('lst_title');
+ lst_home(GList::language('LST_MOD_SUCCESS', $title));
+}
+END_OF_SUB
+
+$COMPILE{lst_search_form} = __LINE__ . <<'END_OF_SUB';
+sub lst_search_form {
+#--------------------------------------------------------------------
+# Print add form
+#
+ my $msg = shift;
+ return ('lst_search_form.html', { msg => $msg });
+}
+END_OF_SUB
+
+$COMPILE{lst_delete} = __LINE__ . <<'END_OF_SUB';
+sub lst_delete {
+#--------------------------------------------------------------------
+# Delete lists
+#
+ return lst_home(GList::delete('Lists', 'lst'));
+}
+END_OF_SUB
+
+$COMPILE{lst_html} = __LINE__ . <<'END_OF_SUB';
+sub lst_html {
+#-----------------------------------------------------------------
+#
+ return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));
+
+ my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
+ return lst_home($info) if (ref $info ne 'HASH');
+
+ my $msg = $CFG->{html_code};
+ $msg =~ s/<%name%>/$info->{lst_title}/;
+ $msg =~ s/<%id%>/$info->{lst_id}/;
+ $msg =~ s/<%url%>/$CFG->{cgi_url}\/glist.cgi/;
+ return ('lst_html.html', { msg => $msg, lst_title => $info->{lst_title} });
+}
+END_OF_SUB
+
+$COMPILE{lst_import} = __LINE__ . <<'END_OF_SUB';
+sub lst_import {
+#-----------------------------------------------------------------
+# Import data into subcribers table
+#
+ return ('lst_import_form.html', { help => 'lists_import.html' }) if ($IN->param('form'));
+
+ my $data = $IN->param('sub_file') || $IN->param('sub_data');
+ return ('lst_import_form.html', { msg => GList::language('LST_IPT_INVALID'), help => 'lists_import.html' }) unless ($data);
+ return ('lst_import_form.html', { msg => GList::language('LST_IPT_LIST_EMPTY'), help => 'lists_import.html' }) unless ($IN->param('import_to'));
+
+ my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
+ my $fd = $IN->param('fd') || ',';
+ my $fe = $IN->param('fe') || '\\';
+ my $rd = $IN->param('rd') || '\n';
+ my $rl = $IN->param('rl') || 0;
+
+# Setup the language for GT::SQL.
+ local $GT::SQL::ERRORS->{UNIQUE} = GList::language('LST_IPT_DUPLICATE_EMAIL');
+ local $GT::SQL::ERRORS->{NOTNULL} = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
+ local $GT::SQL::ERRORS->{ILLEGALVAL} = '';
+
+ my (@data, @results);
+ if ($IN->param('sub_file')) { # from a text file
+ my $file_name = $data;
+ $file_name =~ s/.*?([^\\\/:]+)$/$1/;
+ $file_name =~ s/[\[\]\s\$\#\%'"]/\_/g;
+ $file_name = "$CFG->{priv_path}/tmp/$file_name";
+ open (OUTFILE, "> $file_name") ;
+ binmode(OUTFILE);
+ my ($bytesread, $buffer, $count);
+ while ($bytesread = read($data, $buffer, 1024)) {
+ $buffer =~ s,\r\n,\n,g;
+ print OUTFILE $buffer;
+ }
+ close OUTFILE;
+
+ if (!-T $file_name) {
+ unlink $file_name;
+ return lst_import_form(GList::language('LST_IPT_INVALID_FILE'));
+ }
+
+ open (DATA, "< $file_name");
+ my @lines = ;
+ close DATA;
+ unlink $file_name;
+
+ LINE: foreach (@lines) {
+ $count++;
+ ( /^#/ ) and next LINE;
+ ( /^\s*$/ ) and next LINE;
+ ( $count eq $rl ) and next LINE;
+ push @data, $_;
+ }
+ }
+ else { # from listings
+ @data = split(/$rd/, $data);
+ }
+ foreach my $id (@$import_to) {
+ my $results = _import_subscriber($id, \@data);
+ if (ref $results eq 'HASH') {
+ push @results, $results;
+ }
+ else {
+ push @results, { lst_id => $id, error => $results };
+ }
+ }
+ return ('lst_import_success.html', { import_results => \@results });
+}
+END_OF_SUB
+
+$COMPILE{_import_subscriber} = __LINE__ . <<'END_OF_SUB';
+sub _import_subscriber {
+#-----------------------------------------------------------------
+#
+ my ($list_id, $data) = @_;
+
+# Verify data before importing
+ return GList::language('LST_INVALID') if (!$list_id or !$data);
+
+ my $info = GList::check_owner('Lists', 'lst', $list_id);
+ return $info if (ref $info ne 'HASH');
+
+ if (GList::check_limit('sublist', $list_id)) {
+ return { list_name => $info->{lst_title}, overlimit => 1 };
+ }
+ my $db = $DB->table('Subscribers');
+ my $fd = $IN->param('fd') || ',';
+ my $fe = $IN->param('fe') || '\\';
+ my $rd = $IN->param('rd') || '\n';
+ my $rl = $IN->param('rl') || 0;
+
+# Create stoplist database and load wild cards
+ my $db_stl = $DB->table('StopLists');
+ my $wild_cards = GList::wild_cards();
+
+ my @results;
+ my ($invalid, $duplicate) = (0, 0);
+ foreach my $row ( @$data ) {
+ $row =~ s/[\r\n\"]//g; # Remove Windows linefeed character.
+ if ($IN->param('cname')) {
+ my ($n, $e) = split(/$fd/, $row);
+ $e = $1 if ($e =~ /<([^> ]+)>/);
+ $e = lc $e;
+ my $error = _check_subscriber($e, $list_id, $db_stl, $wild_cards);
+ if ($error) {
+ push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => $error };
+ $invalid++;
+ }
+ else {
+ push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => '' };
+ if ($db->count({ sub_email => $e, sub_list_id_fk => $list_id })) {
+ $db->update({ sub_name => $n }, { sub_email => $e, sub_list_id_fk => $list_id }) if $n;
+ $results[-1]->{status} = GList::language('SYS_DUPLICATE');
+ $duplicate++;
+ }
+ else {
+ $db->insert({ sub_email => $e, sub_name => $n, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
+ }
+ }
+ }
+ else {
+ $row = $1 if ($row =~ /<([^> ]+)>/);
+ $row = lc $row;
+ my $error = _check_subscriber($row, $list_id, $db_stl, $wild_cards);
+ if ($error) {
+ push @results, { list_name => $info->{lst_title}, sub_email => $row, status => $error };
+ $invalid++;
+ }
+ else {
+ push @results, { list_name => $info->{lst_title}, sub_email => $row, status => '' };
+ if ($db->count({ sub_email => $row, sub_list_id_fk => $list_id })) {
+ $results[-1]->{status} = GList::language('SYS_DUPLICATE');
+ $duplicate++;
+ }
+ else {
+ $db->insert({ sub_email => $row, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
+ }
+ }
+ }
+ }
+
+ return {
+ list_name => $info->{lst_title},
+ results => \@results,
+ invalid => $invalid,
+ duplicate => $duplicate,
+ hits => scalar @results,
+ successful => scalar @results - $invalid - $duplicate,
+ declined => $invalid + $duplicate
+ };
+}
+END_OF_SUB
+
+$COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB';
+sub _check_subscriber {
+#-----------------------------------------------------------------
+#
+ my ($email, $lst_id, $db_stl, $wild_cards) = @_;
+ return GList::language('LST_IPT_OVERLIMIT') if (GList::check_limit('sublist', $lst_id));
+ return GList::language('LST_IPT_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ );
+ return GList::language('LST_IPT_ON_STOPLIST') if ($db_stl->count({ stl_email => $email }));
+ foreach (@$wild_cards) {
+ my $e = $_->[0];
+ my $re = quotemeta $e;
+ $re =~ s/\\\*/.*/;
+ $re =~ s/\\\?/./;
+ return GList::language('LST_IPT_ON_STOPLIST') if ($email =~ /$re/i);
+ }
+}
+END_OF_SUB
+
+$COMPILE{lst_subscribers} = __LINE__ . <<'END_OF_SUB';
+sub lst_subscribers {
+#--------------------------------------------------------------------
+# Print add form
+#
+ my $do = shift || 0;
+
+ my $msg = ($do and $do =~ /^\d+$/) ? _sub_modify($do) : $do;
+ if ($do =~ /^\d+$/ and ($do =~ /3|4/ or ($do == 1 and $IN->param('unbounced_form')))) { # Reset bounced emails
+ return lst_unsub_bounced($msg);
+ }
+ return ('lst_subscriber_form.html') if ($IN->param('form'));
+
+ my $alpha;
+ my $cgi = $IN->get_hash();
+ my $hidden = GList::hidden;
+
+# Create condition for subscriber's quick search bar
+ require GT::SQL::Condition;
+ my $cd = GT::SQL::Condition->new(lst_user_id_fk => '=' => $USER->{usr_username});
+ my $cols = $DB->table('Subscribers')->cols;
+ my $url = "glist.cgi?do=lst_subscribers$hidden->{hidden_query}";
+ my $query= '';
+ foreach my $c (keys % $cols) {
+ next if (!$cgi->{$c});
+ if ($c eq 'sub_list_id_fk') {
+ $cd->add($c => '=' => $cgi->{$c});
+ }
+ else {
+ $cd->add($c => 'like' => "%$cgi->{$c}%");
+ }
+ $url .= ";$c=$cgi->{$c}";
+ }
+
+# Do a search from the main page
+ if ($IN->param('sub_search') and $IN->param('search_val')) {
+ $cgi->{$cgi->{search_col}} = $cgi->{search_val};
+ $url .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
+ $query .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
+ }
+# And from quick search bar
+ if ($IN->param('alpha') and $IN->param('alpha') ne 'all') {
+ $alpha = $IN->param('alpha');
+ $query .= ";alpha=$alpha";
+ }
+
+# Search on date fields
+ my $search_check = ($IN->param('search_form')) ? 1 : 0;
+ if ($cgi->{'sub_created-ge'} or $cgi->{'sub_created-le'}) {
+ my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
+ my ($valid_from, $valid_to) = (1, 1);
+
+ require GT::Date;
+ if ($cgi->{'sub_created-ge'}) {
+ $valid_from = GList::date_to_time($cgi->{'sub_created-ge'}, $format);
+ $cgi->{'sub_created-ge'} = GT::Date::date_get($valid_from, $format) if ($valid_from);
+ }
+ if ($cgi->{'sub_created-le'}) {
+ $valid_to = GList::date_to_time($cgi->{'sub_created-le'}, $format);
+ $cgi->{'sub_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 ('lst_subscriber_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
+ }
+ }
+ if ($cgi->{sub_bounced}) {
+ $cgi->{'sub_bounced-opt'} = '>=';
+ }
+ my $results = GList::search(
+ cgi => $cgi,
+ db => $DB->table('Subscribers'),
+ prefix => 'sub',
+ sb => 'sub_email',
+ so => 'ASC',
+ search_alpha=> $alpha,
+ search_col => 'sub_email',
+ search_check=> $search_check,
+ show_user => $cgi->{show_user},
+ return_msg => 'LST_SUB_RESULTS',
+ );
+
+ my $page = ($IN->param('mn_disable')) ? 'lst_subscribers_preview.html' : 'lst_subscribers.html';
+ my $subs_db = $DB->table('Lists', 'Subscribers');
+ $subs_db->select_options('ORDER BY letter');
+
+ my $sth = $subs_db->select($cd, ['DISTINCT SUBSTRING(sub_email, 1, 1) as letter']);
+ if (ref $results ne 'HASH') {
+ $page = 'lst_subscriber_form.html' if ($search_check);
+ return ($page, { msg => $msg || $results, search_bar => _search_bar($sth, $url) });
+ }
+ elsif ($results->{error} and $search_check) {
+ return ('lst_subscriber_form.html', { msg => $results->{error} });
+ }
+
+ if ($IN->param('mn_disable')) {
+ $results->{msg} = '';
+ }
+ else {
+ $results->{msg} = $msg if ($msg);
+ }
+ return ($page, { search_bar => _search_bar($sth, $url), toolbar_query => $query, %$results });
+}
+END_OF_SUB
+
+$COMPILE{_sub_modify} = __LINE__ . <<'END_OF_SUB';
+sub _sub_modify {
+#--------------------------------------------------------------------
+# Validate/delete subscribers user
+#
+ my $do = shift;
+
+# If they selected only one record to search we still need an array ref
+ my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
+ my $db = $DB->table('Subscribers');
+ my $cgi = $IN->get_hash;
+
+ my ($msg, $rec_modified) = ('', 0);
+ if ($do == 1) { # Delete subscribers
+ foreach my $rec_num ( @{$mod} ) {
+ my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
+ next if (!$info);
+
+ my $ret = $db->delete({ sub_id => $info->{sub_id} });
+ if (defined $ret and $ret != 0) {
+ $rec_modified++;
+ }
+ }
+ $msg = GList::language('LST_SUB_DELETED', $rec_modified);
+ }
+ elsif ($do == 2) { # Validate subscribers
+ foreach my $rec_num ( @{$mod} ) {
+ my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
+ next if (!$info);
+
+ if ($db->count({ sub_id => $info->{sub_id}, sub_validated => 0 })) {
+ $db->update({ sub_validated => 1 }, { sub_id => $info->{sub_id} });
+ $rec_modified++;
+ }
+ }
+ $msg = GList::language('LST_SUB_VALIDATED', $rec_modified);
+ }
+ elsif ($do == 3) { # Unbounced subscribers
+ require GT::SQL::Condition;
+ foreach my $rec_num ( @{$mod} ) {
+ my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
+ next if (!$info);
+
+ if ($db->count(GT::SQL::Condition->new(sub_id => '=' => $info->{sub_id}, sub_bounced => '>=' => 1))) {
+ $db->update({ sub_bounced => '0' }, { sub_id => $info->{sub_id} });
+ $rec_modified++;
+ }
+ }
+ $msg = GList::language('LST_SUB_UNBOUNCED', $rec_modified);
+ }
+ elsif ($do == 4) { # Remove all unbounced subscribers
+ require GT::SQL::Condition;
+ my $cond = new GT::SQL::Condition;
+ $cond->add(sub_bounced => '>=' => 1, sub_user_id_fk => '=' => $USER->{usr_username});
+ $cond->add(sub_list_id_fk => '=', $cgi->{list_id}) if $cgi->{list_id};
+ if ($cgi->{sub_bounced} and $cgi->{sub_bounced} ne '*') {
+ my $opt = $cgi->{'sub_bounced-opt'} || '=';
+ $cond->add(sub_bounced => $opt => $cgi->{sub_bounced});
+ }
+ my $rec = $db->delete($cond);
+ $msg = GList::language('LST_BOUNCED_REMOVED', $rec);
+ }
+}
+END_OF_SUB
+
+$COMPILE{lst_unsub_bounced} = __LINE__ . <<'END_OF_SUB';
+sub lst_unsub_bounced {
+#--------------------------------------------------------------------
+# Let you to unsubscribe all bounced users
+#
+ my $msg = shift;
+
+ my $cgi = $IN->get_hash();
+ my %hash;
+ my $conditions = '';
+ $hash{sub_list_id_fk} = $cgi->{sub_list_id_fk} || '';
+ $conditions .= ";list_id=$cgi->{sub_list_id_fk}" if $cgi->{sub_list_id_fk};
+
+ if ($cgi->{sub_bounced} and $cgi->{sub_bounced} eq '*') {
+ $conditions .= ';sub_bounced=*';
+ $hash{sub_bounced} = 1;
+ $hash{'sub_bounced-opt'} = '>=';
+ }
+ else {
+ $conditions .= ";sub_bounced=$cgi->{sub_bounced}";
+ $conditions .= ";sub_bounced-opt=$cgi->{'sub_bounced-opt'}";
+ if ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<') {
+ $hash{'sub_bounced-lt'} = $cgi->{sub_bounced};
+ $hash{'sub_bounced-ge'} = 1;
+ }
+ elsif ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<=') {
+ $hash{'sub_bounced-le'} = $cgi->{sub_bounced};
+ $hash{'sub_bounced-ge'} = 1;
+ }
+ else {
+ $hash{sub_bounced} = $cgi->{sub_bounced} || 1;
+ $hash{'sub_bounced-opt'} = $cgi->{'sub_bounced-opt'} || '>=';
+ }
+ }
+ my $results = GList::search(
+ cgi => \%hash,
+ db => $DB->table('Subscribers'),
+ prefix => 'sub',
+ sb => 'sub_email',
+ so => 'ASC',
+ return_msg => 'LST_BOUNCED_RESULTS',
+ int_field => 1,
+ );
+ if (ref $results ne 'HASH') {
+ return ('lst_unsub_bounced.html', { msg => $msg || $results });
+ }
+
+ $results->{msg} = $msg if ($msg);
+ return ('lst_unsub_bounced.html', { %$results, conditions => $conditions });
+}
+END_OF_SUB
+
+$COMPILE{lst_sub_add} = <<'END_OF_SUB';
+sub lst_sub_add {
+#-------------------------------------------------------------------
+# Add a subscriber
+#
+ return ('lst_sub_add.html') if ($IN->param('form'));
+ return ('lst_sub_add.html', { msg => GList::language('LST_IPT_LIST_EMPTY') }) if (!$IN->param('import_to'));
+
+ my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
+ my $email = $IN->param('new_email');
+ my $name = $IN->param('new_name');
+ if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/) { # check email address
+ return ('lst_sub_add.html', { msg => GList::language('LST_IPT_INVALID_EMAIL') });
+ }
+ $email = lc $email;
+
+# Create stoplist database and load wild cards
+ my $db = $DB->table('Subscribers');
+ my $db_stl = $DB->table('StopLists');
+ my $wild_cards = GList::wild_cards();
+
+# Setup the language for GT::SQL.
+ local $GT::SQL::ERRORS->{UNIQUE} = GList::language('SYS_DUPLICATE');
+ local $GT::SQL::ERRORS->{NOTNULL} = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
+ local $GT::SQL::ERRORS->{ILLEGALVAL} = '';
+
+ my @results;
+ foreach my $id (@$import_to) {
+ my $info = GList::check_owner('Lists', 'lst', $id);
+ push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => lst_subscribers($info) } if ( ref $info ne 'HASH' );
+
+ push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => '' };
+ my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
+ if ($error) {
+ $results[-1]->{status} = $error;
+ }
+ elsif ($db->count({ sub_email => $email, sub_list_id_fk => $id })) {
+ $results[-1]->{status} = GList::language('SYS_DUPLICATE');
+ }
+ else {
+ $db->insert({ sub_email => $email, sub_name => $name, sub_list_id_fk => $id, sub_user_id_fk => $info->{lst_user_id_fk} });
+ }
+ }
+ return ('lst_sub_success.html', { results => \@results, msg => GList::language('LST_SUB_ADDED', $email) });
+}
+END_OF_SUB
+
+$COMPILE{lst_sub_modify} = <<'END_OF_SUB';
+sub lst_sub_modify {
+#-------------------------------------------------------------------
+# Modify a subscriber
+#
+ my $sub_id = $IN->param('subid');
+ my $old_data = $DB->table('Lists', 'Subscribers')->select({ sub_id => $sub_id }, [ 'lst_title', 'sub_email as new_email', 'sub_name as new_name', 'sub_validated as new_validated', 'sub_bounced as new_bounced', 'sub_list_id_fk'])->fetchrow_hashref;
+ return lst_subscribers(GList::language('LST_INVALID')) if (!$old_data);
+
+ my $info = GList::check_owner('Lists', 'lst', $old_data->{sub_list_id_fk});
+ return lst_subscribers($info) if (ref $info ne 'HASH');
+
+ return ('lst_sub_modify.html', $old_data) if ($IN->param('form'));
+
+ my $new_email = $IN->param('new_email');
+ my $name = $IN->param('new_name');
+ my $validated = ($IN->param('new_validated')) ? '1' : '0';
+ my $bounced = $IN->param('new_bounced') || 0;
+
+ if ($new_email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $new_email =~ /\s/) { # check email address
+ return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_INVALID_EMAIL'), %$info });
+ }
+
+ require GT::SQL::Condition;
+ if ($DB->table('Subscribers')->count( GT::SQL::Condition->new(
+ sub_email => '=' => $new_email,
+ sub_list_id_fk => '=' => $old_data->{sub_list_id_fk},
+ sub_id => '<>'=> $sub_id,
+ )) == 1 ) {
+ return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_DUPLICATE_EMAIL'), %$info });
+ }
+ else {
+ $DB->table('Subscribers')->update({
+ sub_email => $new_email,
+ sub_name => $name,
+ sub_validated => $validated,
+ sub_bounced => $bounced,
+ }, { sub_id => $sub_id });
+ }
+ return lst_subscribers(GList::language('LST_SUB_MODIFIED', $old_data->{new_email}));
+}
+END_OF_SUB
+
+
+$COMPILE{lst_sub_delete} = <<'END_OF_SUB';
+sub lst_sub_delete {
+#-------------------------------------------------------------------
+# Delete the subscribers
+#
+ return lst_subscribers(1);
+}
+END_OF_SUB
+
+$COMPILE{lst_sub_validate} = <<'END_OF_SUB';
+sub lst_sub_validate {
+#-------------------------------------------------------------------
+# Validate the subscribers
+#
+ return lst_subscribers(2);
+}
+END_OF_SUB
+
+$COMPILE{lst_sub_unbounced} = <<'END_OF_SUB';
+sub lst_sub_unbounced {
+#-------------------------------------------------------------------
+# Validate the subscribers
+#
+ my $action = $IN->param('all') ? 4 : 3;
+ return lst_subscribers($action);
+}
+END_OF_SUB
+
+$COMPILE{_qsort} = __LINE__ . <<'END_OF_SUB';
+sub _qsort {
+#------------------------------------------------------------------
+ my ($list_file, $orderby, $sortdown) = @_;
+ my $sorted;
+ @$sorted =
+ sort {
+ my $da = lc $a->{$orderby}; #lower case
+ my $db = lc $b->{$orderby};
+ my $res;
+ if ($orderby eq 'size' or $orderby eq 'date') {
+ $res = $db <=> $da;
+ }
+ else {
+ $res = $db cmp $da;
+ }
+ if ($res == 0 and $orderby ne 'name') {
+ lc $b->{name} cmp lc $a->{name};
+ }
+ else {
+ $res;
+ }
+ } @$list_file;
+ ($sortdown) and @$sorted = reverse @$sorted;
+ return $sorted;
+}
+END_OF_SUB
+
+$COMPILE{_search_bar} = __LINE__ . <<'END_OF_SUB';
+sub _search_bar {
+#---------------------------------------------------------------------
+# create quick search bar
+#
+ my ($sth, $url) = @_;
+ my $current = $IN->param('alpha') || '';
+ my @alpha = ('All', 'A'..'Z', '0..9', 'Other');
+
+ my ($search_bar, $items);
+ $items->{All} = 'all';
+ while (my ($letter) = $sth->fetchrow_array) {
+ $letter = uc $letter;
+ if ($letter =~ /\d/) {
+ exists $items->{'0..9'} or $items->{'0..9'} = 'number';
+ }
+ elsif ($letter =~ /[\W_]/) {
+ exists $items->{Other} or $items->{Other} = 'other';
+ }
+ else {
+ exists $items->{$letter} or $items->{$letter} = $letter;
+ }
+ }
+ foreach (@alpha) {
+ if ($_ eq 'All') {
+ $search_bar .= ( (!$current or $current eq 'all') and !$IN->param('bsearch') ) ? "$_ " : "$_ ";
+ }
+ elsif ($items->{$_}) {
+ my $l = ($_ eq '0..9') ? 'number' : lc $_;
+ $search_bar .= ( lc $current eq lc $l ) ? "$_ " : "$_ ";
+ }
+ else {
+ $search_bar .= "$_ ";
+ }
+ }
+ return $search_bar;
+}
+END_OF_SUB
+
+$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
+sub _determine_action {
+#----------------------------------------------------------------------------
+# Check valid action
+#
+ my $action = shift || undef;
+ return if (!$action);
+ return 'lst_home' if ($action eq 'lst_search' );
+
+ my %valid = (
+ map { $_ => 1 } qw(
+ lst_home
+ lst_add
+ lst_modify_form
+ lst_modify
+ lst_search_form
+ lst_delete
+ lst_html
+ lst_import
+ lst_subscribers
+ lst_sub_add
+ lst_sub_modify
+ lst_sub_delete
+ lst_sub_validate
+ lst_sub_unbounced
+ lst_unsub_bounced
+ )
+ );
+ exists $valid{$action} and return $action;
+ return;
+}
+END_OF_SUB
+
+1;
+
+
diff --git a/site/glist/lib/GList/Mailer.pm b/site/glist/lib/GList/Mailer.pm
new file mode 100644
index 0000000..b584712
--- /dev/null
+++ b/site/glist/lib/GList/Mailer.pm
@@ -0,0 +1,1076 @@
+# ==================================================================
+# Gossamer List - enhanced mailing list management system
+#
+# Website : http://gossamer-threads.com/
+# Support : http://gossamer-threads.com/scripts/support/
+# CVS Info :
+# Revision : $Id: Mailer.pm,v 1.79 2005/04/06 23:17:03 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::Mailer;
+
+use strict;
+use GList qw/:user_type :objects :tracks $DEBUG/;
+use GT::AutoLoader;
+
+sub process {
+#---------------------------------------------------------------------
+# Setermine what to do
+#
+ my $do = shift;
+
+ 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);
+
+ $MN_SELECTED = 3;
+ if ($tpl) {
+ my $hidden = GList::hidden();
+ $results->{hidden_query} = $hidden->{hidden_query};
+ $results->{hidden_objects} = $hidden->{hidden_objects};
+ GList::display($tpl, $results);
+ }
+}
+
+sub mli_print {
+#--------------------------------------------------------------------
+#
+ my ($page, $args) = @_;
+
+# Get category's information
+ my $nav = _load_navigator() || {};
+ my ($info, $url);
+ if ($IN->param('id')) {
+ $info = ( $USER->{usr_type} == ADMINISTRATOR ) ? $DB->table('CatMailing')->get({ cm_id => $IN->param('id') })
+ : $DB->table('CatMailing')->get({ cm_id => $IN->param('id'), cm_user_id_fk => $USER->{usr_username} });
+ }
+ $info ||= {};
+
+# Create the URL
+ my @items = ('cd', 'cs', 'ca');
+ foreach (@items) {
+ $url .= "$_=".$IN->param($_).'&' if ($IN->param($_));
+ }
+ return ($page, { %$info, %$nav, %$args, url => $url });
+}
+
+$COMPILE{mli_home} = <<'END_OF_SUB';
+sub mli_home {
+#--------------------------------------------------------------------
+# Print home page
+#
+ my ($msg, $cgi) = @_;
+
+ $cgi ||= $IN->get_hash;
+ $msg ||= GList::language('MLI_SUCCESS', $cgi->{sent}) if ($cgi->{sent});
+ $msg = GList::language('MLI_BOUNCED_EMAILS', $cgi->{bounced}) if ($cgi->{bounced});
+ if ($cgi->{do} =~ /msg_send|mli_bounced/) {
+ $cgi->{fd} = 1;
+ }
+
+#------------demo code-----------
+
+ if (!$cgi->{d}) {
+ if ( $cgi->{fd} and $cgi->{fd} =~ /^1|2/ ) { # Queue & Sent Items
+ $cgi->{mli_delete} = 1;
+ $cgi->{'mli_delete-opt'}= '<';
+ $cgi->{mli_done} = 1;
+ $cgi->{'mli_done-opt'} = ( $cgi->{fd} == 2 ) ? '>' : '<';
+ $cgi->{mli_scheduled} = 0;
+ if ( $cgi->{fd} == 2 and $cgi->{do} ne 'mli_search' ) {
+ $cgi->{mli_cat_id_fk} = ( $cgi->{id} ) ? $cgi->{id} : 0;
+ }
+ }
+ elsif ( $cgi->{fd} == 3 ) { # Delete Items
+ $cgi->{mli_delete} = 1;
+ }
+ elsif ($cgi->{fd} == 4) { # Scheduled mailings
+ $cgi->{mli_scheduled} = 1;
+ $cgi->{mli_delete} = 0;
+ }
+ }
+ my $search_check = ($IN->param('do') eq 'mli_search') ? 1 : 0;
+ if ($cgi->{'mli_done-ge'} or $cgi->{'mli_done-le'}) {
+ my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
+ my ($valid_from, $valid_to) = (1, 1);
+
+ require GT::Date;
+ if ($cgi->{'mli_done-ge'}) {
+ $valid_from = GList::date_to_time($cgi->{'mli_done-ge'}, $format);
+ $cgi->{'mli_done-ge'} = GT::Date::date_get($valid_from, $format);
+ }
+ if ($cgi->{'mli_done-le'}) {
+ $valid_to = GList::date_to_time($cgi->{'mli_done-le'}, $format);
+ $cgi->{'mli_done-le'} = GT::Date::date_get($valid_to, $format);
+ }
+
+ if ($search_check and (!$valid_from or !$valid_to)) {
+ $format =~ s/\%//g;
+ return ('mli_search_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
+ }
+ }
+ if ($IN->param('do') eq 'mli_search' and $IN->param('fd') and $IN->param('fd') !~ /^1|2|3/) {
+ my @cat = split(/\-/, $IN->param('fd'));
+ $cgi->{mli_cat_id_fk} = $cat[1];
+ }
+ my $results = GList::search(
+ cgi => $cgi,
+ db => $DB->table('MailingIndex'),
+ prefix => 'mli',
+ sb => 'mli_id',
+ so => 'DESC',
+ search_check=> $search_check
+ );
+# Get category's information
+ my $info = {};
+ if ($IN->param('id')) {
+ $info = ( $USER->{usr_type} == ADMINISTRATOR ) ? $DB->table('CatMailing')->get({ cm_id => $IN->param('id') })
+ : $DB->table('CatMailing')->get({ cm_id => $IN->param('id'), cm_user_id_fk => $USER->{usr_username} });
+ $info ||= {};
+ }
+
+ my $nav = _load_navigator() || {};
+
+# Create the URL
+ my $url;
+ my @items = ('cd', 'cs', 'ca');
+ foreach ( @items ) {
+ $url .= "$_=".$cgi->{$_}.'&' if ( $cgi->{$_} );
+ }
+ chop $url if ($url);
+
+ if ( ref $results ne 'HASH' ) {
+ ( $IN->param('do') eq 'mli_search' ) ? return ('mli_search_form.html', { msg => $msg || $results, %$nav, %$info, url => $url })
+ : return ('mli_home.html', { msg => $msg || $results, %$nav, %$info, url => $url });
+ }
+ elsif ( $results->{error} and $search_check ) {
+ return ('mli_search_form.html', { msg => $results->{error} });
+ }
+
+ my $eml = $DB->table('EmailMailings');
+ my $output = $results->{results};
+
+ require GT::SQL::Condition;
+ foreach my $rs ( @$output ) {
+ my $cd_sent = GT::SQL::Condition->new(
+ eml_mailing_id_fk => '=' => $rs->{mli_id},
+ eml_sent => '<>' => 0
+ );
+ $rs->{total} = $eml->count({ eml_mailing_id_fk => $rs->{mli_id} });
+ $rs->{bounced_emails} = $eml->count({ eml_mailing_id_fk => $rs->{mli_id}, eml_bounced => 1 });
+ $rs->{done} = $eml->count($cd_sent);
+ }
+ $results->{msg} = $msg if ($msg);
+ return ('mli_home.html', { %$results, %$nav, %$info, url => $url });
+}
+END_OF_SUB
+
+$COMPILE{mli_search_form} = <<'END_OF_SUB';
+sub mli_search_form {
+#--------------------------------------------------------------------
+# Print the search form
+#
+ my $msg = shift;
+ return mli_print('mli_search_form.html', { msg => $msg });
+}
+END_OF_SUB
+
+$COMPILE{mli_empty} = <<'END_OF_SUB';
+sub mli_empty {
+#--------------------------------------------------------------------
+# Delete all of deleted items
+#
+ require GT::SQL::Condition;
+ my $db = $DB->table('MailingIndex');
+ my $cd = new GT::SQL::Condition;
+ $cd->add('mli_delete', '=', 1);
+
+ if ($USER->{usr_type} == ADMINISTRATOR and $IN->param('users')) { # As a admin user
+ $cd->add('mli_user_id_fk', '<>', $USER->{usr_username});
+ }
+ else {
+ $cd->add('mli_user_id_fk', '=', $USER->{usr_username});
+ }
+ $db->delete($cd);
+
+ mli_home(GList::language('MLI_EMPTY'));
+}
+END_OF_SUB
+
+$COMPILE{mli_delete} = <<'END_OF_SUB';
+sub mli_delete {
+#--------------------------------------------------------------------
+# Delete the mailings
+#
+ return mli_home(GList::delete('MailingIndex', 'mli'));
+}
+END_OF_SUB
+
+$COMPILE{mli_move} = <<'END_OF_SUB';
+sub mli_move {
+#--------------------------------------------------------------------
+# Moves the records to another category
+#
+ ( $IN->param('modify') ) or return mli_home(GList::language('SYS_MOVE_ERR'));
+
+# Check category ID
+ my $to = $IN->param('move_to');
+ ( $to) or return mli_home(GList::language('SYS_TARGET_ERR'));
+
+ if ( $to ne 'root' and $to ne 'draft' and $to ne 'sent') { # Move to a sub-category
+ my $info = GList::check_owner('CatMailing', 'cm', $to);
+ ( ref $info eq 'HASH' ) or return mli_home($info);
+ }
+
+# 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('MailingIndex');
+# For through the record numbers. These are the values of the check boxes
+ foreach my $rec_num ( @$mod ) {
+ my $change = {};
+ $change->{mli_id} = $IN->param("$rec_num-mli_id") if ($IN->param("$rec_num-mli_id"));
+
+# Check if users can modify only their own records except Administrator
+ my $rs = $db->get($change);
+ if ( $USER->{usr_type} != ADMINISTRATOR ) {
+ next if ( !$rs );
+ if ( $rs->{'mli_user_id_fk'} ne $USER->{usr_username} ) {
+ $rec_declined++; next;
+ }
+ }
+ next unless ( keys %$change );
+ next if ($to eq 'draft' and $rs->{mli_done});
+ next if ($to eq 'sent' and !$rs->{mli_done});
+
+ my $ret;
+ if ( $to =~ /^root|draft|sent/mi ) {
+ $ret = ( $IN->param('fd') == 3 ) ? $db->update({ mli_cat_id_fk => 0, mli_delete => '0' }, $change)
+ : $db->update({ mli_cat_id_fk => 0 }, $change);
+ }
+ else {
+ $ret = $db->update({ mli_cat_id_fk => $to }, $change);
+ }
+ $rec_modified++ if (defined $ret and $ret != 0);
+ }
+ mli_home(($rec_declined) ? GList::language('SYS_MOVED2', $rec_modified, $rec_declined) : GList::language('SYS_MOVED', $rec_modified));
+}
+END_OF_SUB
+
+
+$COMPILE{mli_send} = __LINE__ . <<'END_OF_SUB';
+sub mli_send {
+#--------------------------------------------------------------------
+# Send Email - Send email to subcribers
+#
+ return mli_home(GList::language('MLI_INVALID')) if (!$IN->param('modify'));
+
+ $MN_SELECTED = 3;
+
+# Check account limits
+ my $num_sent = GList::check_limit('email30') || 0;
+ return mli_home(GList::language('SYS_OVERLIMIT_EMAIL30')) if ($num_sent == 1);
+
+ my $mod = (ref $IN->param('modify') eq 'ARRAY') ? $IN->param('modify') : [$IN->param('modify')];
+ my @ids = map $IN->param("$_-mli_id"), @{$mod};
+
+ my $total_size = _size_mailings(\@ids, 'web');
+ return mli_home(GList::language('MLI_MSG_EMPTY')) if (!$total_size);
+
+ _send('web', \@ids, $total_size);
+ return;
+}
+END_OF_SUB
+
+$COMPILE{mli_fview} = <<'END_OF_SUB';
+sub mli_fview {
+#--------------------------------------------------------------------
+# Print a attached file
+#
+ return GList::view_file();
+}
+END_OF_SUB
+
+$COMPILE{mli_fdownload} = <<'END_OF_SUB';
+sub mli_fdownload {
+#--------------------------------------------------------------------
+# Print a attached file
+#
+ return GList::download_file();
+}
+END_OF_SUB
+
+$COMPILE{mli_bounced_form} = <<'END_OF_SUB';
+sub mli_bounced_form {
+#--------------------------------------------------------------------
+#
+ my ($msg, $page) = @_;
+ $page ||= 'mli_check_bounced_form.html';
+ $page = 'mli_check_bounced_results.html' if ($IN->param('results'));
+
+ return mli_print($page, { msg => $msg });
+}
+END_OF_SUB
+
+$COMPILE{mli_bounced} = <<'END_OF_SUB';
+sub mli_bounced {
+#--------------------------------------------------------------------
+# To check a pop account and delete bounced emails
+#
+
+#------------demo code-----------
+
+ return mli_bounced_form(GList::language('MLI_BOUNCED_NO_SERVER')) unless ($IN->param('mail_host'));
+ return mli_bounced_form(GList::language('MLI_BOUNCED_NO_USER')) unless ($IN->param('mail_user'));
+ return mli_bounced_form(GList::language('MLI_BOUNCED_NO_PASS')) unless ($IN->param('mail_pass'));
+
+ _bounced('web', {
+ host => $IN->param('mail_host'),
+ port => $IN->param('mail_port') || 110,
+ user => $IN->param('mail_user'),
+ pass => $IN->param('mail_pass'),
+ auth_mode => 'PASS',
+ debug => $CFG->{debug_level}
+ }, { delete => $IN->param('del_bounced'), save => $IN->param('save_info') });
+}
+END_OF_SUB
+
+$COMPILE{mli_recipients} = <<'END_OF_SUB';
+sub mli_recipients {
+#-------------------------------------------------------------------
+# View recipients
+#
+ my $id = $IN->param('eml_mailing_id_fk');
+ return mli_home(GList::language('MLI_INVALID')) if (!$id);
+
+# Check the record's onwer
+ my $mli = $DB->table('MailingIndex')->get($id);
+ return mli_home(GList::language('MLI_NOT_FOUND', $id)) if (!$mli);
+
+ if ( $USER->{usr_type} != ADMINISTRATOR ) { # As a user
+ my $cond = new GT::SQL::Condition('OR');
+
+ $cond->add('usr_username', '=', $mli->{mli_user_id_fk});
+ my $u = $DB->table('Users')->select($cond)->rows;
+ return mli_home(GList::language('SYS_PER_DENIED')) if (!$u);
+ }
+
+ my $cgi = $IN->get_hash;
+ $cgi->{eml_mailing_id_fk} = $id;
+ my $results = GList::search(
+ cgi => $cgi,
+ db => $DB->table('EmailMailings'),
+ skip_user => 1,
+ prefix => 'eml',
+ sb => 'eml_email',
+ so => 'ASC',
+ );
+
+ if ( ref $results ne 'HASH' ) {
+ return ('mli_recipients.html', %$results);
+ }
+ return ('mli_recipients.html', $results);
+}
+END_OF_SUB
+
+$COMPILE{mli_cat_add} = <<'END_OF_SUB';
+sub mli_cat_add {
+#--------------------------------------------------------------------
+# Add a category
+#
+ my $name = $IN->param('cm_name');
+ ( $name ) or return mli_home(GList::language('SYS_ADD_INVALID'));
+
+ my $ret = GList::add('CatMailing', 'cm', { cm_name => $name, cm_type => 2 });
+ return mli_home($GList::error) if ($GList::error);
+
+ return mli_home(GList::language('DIR_ADDED', $name)) if ( $ret );
+}
+END_OF_SUB
+
+$COMPILE{mli_cat_modify} = <<'END_OF_SUB';
+sub mli_cat_modify {
+#-------------------------------------------------------------------
+# Update a category
+#
+ my $id = $IN->param('cm_id');
+ ( $id ) or return mli_home(GList::languag('SYS_ADD_INVALID'));
+
+ GList::modify('CatMailing', 'cm');
+
+ return mli_home($GList::error) if ($GList::error);
+ mli_home(GList::language('DIR_UPDATED', $IN->param('cm_name')));
+}
+END_OF_SUB
+
+$COMPILE{mli_cat_delete} = <<'END_OF_SUB';
+sub mli_cat_delete {
+#--------------------------------------------------------------------
+# Delete a category
+#
+ my $cgi = $IN->get_hash();
+
+ ( $cgi->{cm_id}) or return mli_home(GList::languag('SYS_ADD_INVALID'));
+
+ $cgi->{modify} = '1';
+ $cgi->{'1-cm_id'} = $cgi->{cm_id};
+ if ( $USER->{usr_type} != ADMINISTRATOR ) {
+ my $owner = $DB->table('CatMailing')->select({ cm_user_id_fk => $USER->{usr_username} }, ['cm_user_id_fk'])->fetchrow_array;
+ ( !$owner or $owner ne $USER->{usr_username} ) and return mli_home(GList::language('SYS_PER_DENIED'));
+ }
+
+ $DB->table('MailingIndex')->update({ mli_cat_id_fk => 0, mli_delete => '1' }, { mli_cat_id_fk => $cgi->{cm_id} });
+
+ return mli_home(GList::delete('CatMailing', 'cm', $cgi, GList::language('DIR_DELETED', $IN->param('cm_name'))));
+}
+END_OF_SUB
+
+$COMPILE{mli_schedule} = __LINE__ . <<'END_OF_SUB';
+sub mli_schedule {
+#--------------------------------------------------------------------
+#
+ return mli_home() if $IN->param('bcancel');
+
+ my $mod = ref $IN->param('modify') eq 'ARRAY' ? $IN->param('modify') : [$IN->param('modify')];
+ my @ids = map $IN->param("$_-mli_id"), @{$mod};
+
+ require GT::SQL::Condition;
+ my $results = $DB->table('MailingIndex')->select(['mli_id', 'mli_subject'], GT::SQL::Condition->new(mli_id => 'IN' => \@ids))->fetchall_hashref;
+ return mli_home('0 mailing was scheduled') unless $results;
+
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MSG'), selected_mailings => $results }) unless $IN->param('bschedule');
+
+ my $scm_type = $IN->param('scm_type');
+ my $minute = $IN->param('scm_minute') || 0;
+ my $hour = $IN->param('scm_hour') || 0;
+ my $text_url = $IN->param('scm_text_url') || '';
+ my $html_url = $IN->param('scm_html_url') || '';
+ my $option = '';
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_TYPE'), selected_mailings => $results }) unless $scm_type;
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), selected_mailings => $results }) if ($text_url and $text_url !~ /^http/);
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), selected_mailings => $results }) if ($html_url and $html_url !~ /^http/);
+
+ if ($scm_type == 1) {
+ my $opt_date = $IN->param('opt_date');
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), selected_mailings => $results }) unless $opt_date;
+
+ my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
+ my $valid = GList::date_to_time($opt_date, $format);
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')), selected_mailings => $results }) unless $valid;
+
+ $option = $valid;
+ }
+ elsif ($scm_type == 3) {
+ my $opt_weekly = $IN->param('opt_weekly');
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), selected_mailings => $results }) unless $opt_weekly;
+ $option = $opt_weekly;
+ }
+ elsif ($scm_type == 4) {
+ my $opt_monthly = $IN->param('opt_monthly');
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), selected_mailings => $results }) unless $opt_monthly;
+ $option = $opt_monthly;
+ }
+
+ my @scheduleds;
+ my $db = $DB->table('ScheduledMailings');
+ foreach my $m (@$results) {
+ $db->insert({ scm_mailing_id_fk => $m->{mli_id}, scm_hour => $hour, scm_minute => $minute, scm_type => $scm_type, scm_option => $option, scm_text_url => $text_url, scm_html_url => $html_url }) or next;
+ push @scheduleds, $m->{mli_id};
+ }
+ $DB->table('MailingIndex')->update({ mli_done => 0, mli_scheduled => 1}, GT::SQL::Condition->new( mli_id => 'IN' => \@scheduleds ));
+ mli_home(GList::language('MLI_SCHEDULES_CREATED', $#scheduleds + 1));
+}
+END_OF_SUB
+
+$COMPILE{mli_schedule_modify} = __LINE__ . <<'END_OF_SUB';
+sub mli_schedule_modify {
+#--------------------------------------------------------------------
+#
+ my $msg = '';
+ my $mli_id = $IN->param('mli_id');
+ my $cgi = $IN->get_hash();
+ delete $cgi->{mli_id};
+
+ return mli_home(GList::language('MLI_MISSING_ID')) unless $mli_id;
+ return mli_home($msg, $cgi) if $IN->param('bcancel');
+
+ my $schedule = $DB->table('ScheduledMailings', 'MailingIndex')->select(['ScheduledMailings.*', 'MailingIndex.mli_subject'], { scm_mailing_id_fk => $mli_id })->fetchrow_hashref;
+ return mli_home("$mli_id not found!") unless $schedule;
+
+ if ($IN->param('mod_action') and $IN->param('mod_action') eq 'delete') {
+ return mli_schedule_delete($mli_id);
+ }
+ elsif ($IN->param('bmodify')) {
+ my $scm_type = $IN->param('scm_type');
+ my $minute = $IN->param('scm_minute') || 0;
+ my $hour = $IN->param('scm_hour') || 0;
+ my $text_url = $IN->param('scm_text_url') || '';
+ my $html_url = $IN->param('scm_html_url') || '';
+ my $option = '';
+
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), %$schedule }) if ($text_url and $text_url !~ /^http/);
+ return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), %$schedule }) if ($html_url and $html_url !~ /^http/);
+
+ if ($scm_type == 1) {
+ my $opt_date = $IN->param('opt_date');
+ return mli_print('mli_modify_schedule.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), scm_type => 1, %$schedule }) unless $opt_date;
+
+ my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
+ my $valid = GList::date_to_time($opt_date, $format);
+ return mli_print('mli_modify_schedule.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')), %$schedule }) unless $valid;
+
+ $option = $valid;
+ }
+ elsif ($scm_type == 3) {
+ my $opt_weekly = $IN->param('opt_weekly');
+ return mli_print('mli_modify_schedule.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), scm_type => 3, %$schedule }) unless $opt_weekly;
+ $option = $opt_weekly;
+ }
+ elsif ($scm_type == 4) {
+ my $opt_monthly = $IN->param('opt_monthly');
+ return mli_print('mli_modify_schedule.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), scm_type => 4, %$schedule }) unless $opt_monthly;
+ $option = $opt_monthly;
+ }
+ $DB->table('ScheduledMailings')->update({ scm_hour => $hour, scm_minute => $minute, scm_type => $scm_type, scm_inprocess => 0, scm_sent => 0, scm_option => $option, scm_text_url => $text_url, scm_html_url => $html_url }, { scm_mailing_id_fk => $mli_id });
+ return mli_home(GList::language('MLI_SCHEDULE_UPDATED', $mli_id), $cgi);
+ }
+
+ my ($opt_monthly, $opt_weekly, $opt_date);
+ if ($schedule->{scm_type} == 1) {
+ require GT::Date;
+ my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
+ $opt_date = GT::Date::date_get($schedule->{scm_option}, $format);
+ }
+ elsif ($schedule->{scm_type} == 3) {
+ $opt_weekly = $schedule->{scm_option};
+ }
+ elsif ($schedule->{scm_type} == 4) {
+ $opt_monthly = $schedule->{scm_option};
+ }
+ return mli_print('mli_modify_schedule.html', { msg => $msg, opt_date => $opt_date, opt_weekly => $opt_weekly, opt_monthly => $opt_monthly, %$schedule });
+}
+END_OF_SUB
+
+$COMPILE{mli_schedule_delete} = __LINE__ . <<'END_OF_SUB';
+sub mli_schedule_delete {
+#--------------------------------------------------------------------
+#
+ my $mli_id = shift;
+
+ my @ids;
+ my $cgi = $IN->get_hash();
+ delete $cgi->{mli_id};
+ if ($mli_id) {
+ push @ids, $mli_id;
+ }
+ else {
+ my $mod = ref $IN->param('modify') eq 'ARRAY' ? $IN->param('modify') : [$IN->param('modify')];
+ @ids = map $IN->param("$_-mli_id"), @{$mod};
+ }
+ foreach my $id (@ids) {
+ $DB->table('ScheduledMailings')->delete({ scm_mailing_id_fk => $id });
+ $DB->table('MailingIndex')->update({ mli_scheduled => 0 }, { mli_id => $id });
+ }
+ my $msg = $mli_id ? GList::language('MLI_SCHEDULE_DELETED', $mli_id) : GList::language('MLI_SCHEDULES_DELETED', $#ids + 1);
+ return mli_home($msg, $cgi);
+}
+END_OF_SUB
+
+$COMPILE{_print_results} = __LINE__ . <<'END_OF_SUB';
+sub _print_results {
+ my ($call_from, $checkeds, $bounceds, $deleteds) = @_;
+ if ($call_from eq 'web') {
+ mli_bounced_form(undef, 'mli_check_bounced_results.html');
+ }
+ else {
+ print qq!\n
+ - Total checked email(s): $checkeds
+ - Total bounced email(s): $bounceds
+ - Total deleted email(s): $deleteds
+!;
+ }
+}
+END_OF_SUB
+
+$COMPILE{_bounced} = __LINE__ . <<'END_OF_SUB';
+sub _bounced {
+#-------------------------------------------------------------------
+#
+ my ($call_from, $connection, $opts) = @_;
+
+ require GT::Mail::POP3;
+ my $pop = new GT::Mail::POP3 ($connection);
+ my $num_emails = $pop->connect;
+ if ($GT::Mail::POP3::error) {
+ ($call_from eq 'web') ? return mli_bounced_form("$GT::Mail::POP3::error")
+ : die "$GT::Mail::POP3::error";
+ }
+ if ($call_from eq 'web' and $opts->{save}) { # Save connection to users' profile
+ $DB->table('Users')->update({
+ usr_mail_host => $connection->{host},
+ usr_mail_port => $connection->{port} || 110,
+ usr_mail_account => $connection->{user},
+ usr_mail_password => $connection->{pass},
+ }, { usr_username => $USER->{usr_username} }
+ );
+ }
+ if ($num_emails == 0) {
+ $pop->quit;
+ return _print_results($call_from, 0, 0);
+ }
+ elsif ($call_from eq 'web' and $num_emails > $CFG->{max_bounced_emails}) {
+ $pop->quit;
+ return mli_bounced_form(GList::language('MLI_OVERLIMIT_BOUNCEDS'));
+ }
+
+ my $db_sub = $DB->table('Subscribers');
+ my $db_eml = $DB->table('EmailMailings');
+
+# handle the progress bar
+ my ($last_width, $checked, $bounced, $deleted) = (0, 0, 0, 0);
+ my ($prog_header, $prog_footer) = '';
+ my $max_width = ($call_from eq 'web') ? 420 : 50;
+ if ($call_from eq 'web') {
+ GList::display('mli_progress_bar.html');
+ $prog_header = "";
+ }
+ else {
+ $prog_header = "";
+ $prog_footer = "Done";
+ }
+
+ print $prog_header;
+ foreach ( 1..$num_emails ) {
+ $checked++;
+ my $content = $pop->retr($_);
+ if ($$content =~ /x-glist:\s+(\w+)/i) {
+ my $code = $1;
+ my $info = $db_eml->get({ eml_code => $code });
+ if ($info) {
+ $db_sub->update({ sub_bounced => \'sub_bounced + 1' }, { sub_email => $info->{eml_email} });
+ $db_eml->update({ eml_bounced => 1 }, { eml_email => $info->{eml_email}, eml_code => $code });
+ $bounced++;
+ if ($opts->{delete} =~ /1|2/) {
+ if ($pop->dele($_)) {
+ $deleted++;
+ }
+ else {
+ warn "Can't delete email $_: $GT::Mail::POP3::error";
+ }
+ }
+ }
+ }
+ elsif ($opts->{delete} == 2) { # delete all option is set.
+ if ($pop->dele($_)) {
+ $deleted++;
+ }
+ else {
+ warn "Can't delete email $_: $GT::Mail::POP3::error";
+ }
+ }
+ my $wpercent = 1 - ($num_emails - $checked) / $num_emails;
+ my $img_width= int($max_width * $wpercent);
+ if ($img_width != $last_width) {
+ if ($call_from eq 'web') {
+ printf "\n", 100 * $wpercent;
+ }
+ else {
+ _print_dot($img_width - $last_width);
+ }
+ $last_width = $img_width;
+ }
+ }
+ $pop->quit;
+
+ if ($call_from eq 'web') {
+ my $url = ($USER->{use_cookie}) ? "$CFG->{cgi_url}/glist.cgi?do=mli_bounced_form;parsed=$num_emails;bounced=$bounced;deleted=$deleted;results=1"
+ : "$CFG->{cgi_url}/glist.cgi?do=mli_bounced_form;parsed=$num_emails;bounced=$bounced;deleted=$deleted;results=1;sid=$USER->{session_id}";
+ print "";
+ }
+ else {
+ print $prog_footer;
+ _print_results($call_from, $num_emails, $bounced, $deleted);
+ }
+}
+END_OF_SUB
+
+$COMPILE{_send} = __LINE__ . <<'END_OF_SUB';
+sub _send {
+#---------------------------------------------------------------------
+# This subsroutine will be called from either web or shell mode
+#
+ my ($call_from, $ids, $total_size) = @_;
+
+ require GList::Template;
+ require GT::TempFile;
+
+ my $demo = 0;
+#------------demo code-----------
+
+ if ($call_from eq 'web') {
+ GList::display('mli_progress_bar.html');
+ print "";
+ }
+
+ my $start = time();
+ my $started = scalar localtime;
+ my $db_mli = $DB->table('MailingIndex');
+ my $db_eml = $DB->table('EmailMailings');
+ my $db_mat = $DB->table('MailingAttachments');
+ my $db_sub = $DB->table('Subscribers');
+ my $db_usr = $DB->table('Users');
+ my $sub_cols = $DB->table('Subscribers')->cols;
+ my $usr_cols = $DB->table('Users')->cols;
+ my $num_sent = ($call_from eq 'web') ? (GList::check_limit('email30') || 0) : 0;
+ my $data = $USER || {};
+ $data->{cgi_url} = $CFG->{cgi_url};
+ $data->{image_url} = $CFG->{image_url};
+
+
+# Load StopLists
+ my $stoplist = $DB->table('StopLists')->select(['stl_email'])->fetchall_arrayref;
+ my %stoplist;
+ foreach (@$stoplist) {
+ next if (!$_->[0]);
+ exists $stoplist{$_->[0]} or $stoplist{$_->[0]} = 1;
+ }
+
+ $|++;
+ my ($count, $sent_size, $last_width) = (0, 0, -1);
+ my ($html_header, $html_footer, $text_header, $text_footer, $prog_header, $prog_footer);
+ my $max_width = ($call_from eq 'web') ? 420 : 50;
+ my $temp_text = new GT::TempFile;
+ my $temp_html = new GT::TempFile;
+ if ($call_from eq 'web') {
+ $prog_header = "";
+ my $url = ($USER->{use_cookie}) ? "$CFG->{cgi_url}/glist.cgi?do=mli_home;fd=2;sent=$count;demo=$demo"
+ : "$CFG->{cgi_url}/glist.cgi?do=mli_home;fd=2;sent=$count;sid=$USER->{session_id};demo=$demo";
+ $prog_footer = "";
+
+# Set header and footer if they are specified
+ $html_header = ($CFG->{header_html}) ? "$CFG->{header_html} $USER->{usr_header_html}" : $USER->{usr_header_html};
+ $html_footer = ($CFG->{footer_html}) ? "$USER->{usr_footer_html} $CFG->{footer_html}" : $USER->{usr_footer_html};
+ $text_header = ($CFG->{header_text}) ? "$CFG->{header_text}\n$USER->{usr_header_text}" : $USER->{usr_header_text};
+ $text_footer = ($CFG->{footer_text}) ? "$USER->{usr_footer_text}\n$CFG->{footer_text}" : $USER->{usr_footer_text};
+ }
+ else {
+ $prog_header = "\nSending messages\n";
+ $prog_footer = "Done\n";
+ }
+
+ print $prog_header;
+ foreach my $mailing (@$ids) {
+ my ($msg_size, $att_size, $info) = (0, 0, {});
+
+ if ($call_from eq 'web') {
+ last if ($USER->{usr_type} == LIMITED_USER and $num_sent >= $USER->{usr_limit_email30});
+ $info = GList::check_owner('MailingIndex', 'mli', $mailing);
+ }
+ else {
+ $info = $db_mli->get($mailing);
+ my $user = $db_usr->get({ usr_username => $info->{mli_user_id_fk}});
+ if ($user) {
+ $data = $user;
+ $html_header = ($CFG->{header_html}) ? "$CFG->{header_html} $user->{usr_header_html}" : $user->{usr_header_html};
+ $html_footer = ($CFG->{footer_html}) ? "$user->{usr_footer_html} $CFG->{footer_html}" : $user->{usr_footer_html};
+ $text_header = ($CFG->{header_text}) ? "$CFG->{header_text}\n$user->{usr_header_text}" : $user->{usr_header_text};
+ $text_footer = ($CFG->{footer_text}) ? "$user->{usr_footer_text}\n$CFG->{footer_text}" : $user->{usr_footer_text};
+ }
+ }
+ next if (!$info or ref $info ne 'HASH');
+ next if ($info->{mli_done}); # Skip if it has already been sent
+
+ $count++;
+ my $mailings = $db_eml->select({ eml_mailing_id_fk => $mailing, eml_sent => 0 })->fetchall_hashref;
+ my $attachs = $db_mat->select({ mat_mailing_id_fk => $mailing })->fetchall_hashref;
+
+# Figure out the attachments size
+ foreach (@$attachs) {
+ $att_size += -s "$CFG->{priv_path}/attachments/mailings/" . ($mailing % 10) . "/$mailing/$_->{mat_id}";
+ }
+
+# Figure out the message size
+ my $content_text = $info->{mli_message_text};
+ my $content_html = $info->{mli_message_html};
+ $msg_size = length $content_html if ($content_html);
+ $msg_size += length $content_text if ($content_text);
+
+# Add header and footer if they are available
+ $content_text = "$text_header\n$content_text" if ($content_text and $text_header);
+ $content_text .= "\n$text_footer" if ($content_text and $text_footer);
+ $content_html = "$html_header $content_html" if ($content_html and $html_header);
+ $content_html .= " $html_footer" if ($content_html and $html_footer);
+
+ open (TEXT, "> $$temp_text");
+ print TEXT $content_text;
+ close TEXT;
+
+ if ($info->{mli_message_html}) {
+ $content_html =~ s/<%/<%/g;
+ $content_html =~ s/%>/%>/g;
+ if ($info->{mli_track_open}) { # Insert track openning code
+ $content_html.= ($CFG->{iframe_tracking}) ? TRACK_OPEN_HTML : TRACK_OPEN_HTML_NOIFRAME;
+ }
+ $content_html = _replace_url($content_html, TRACK_CLICK_URL) if ($info->{mli_track_click});
+ open (HTML, "> $$temp_html");
+ print HTML $content_html;
+ close HTML;
+ }
+ foreach my $m (@$mailings) {
+ last if ($call_from eq 'web' and $USER->{usr_type} == LIMITED_USER and $num_sent >= $USER->{usr_limit_email30});
+ next unless $db_eml->count( eml_id => $m->{eml_id}, eml_sent => '0' );
+
+ if ( exists $stoplist{$m->{eml_email}} ) { # skip email if it's in stoplist
+ $db_eml->update({ eml_skipped => '1', eml_sent => time }, { eml_id => $m->{eml_id} });
+ next;
+ }
+
+ my $bounce_code = _generate_bounce_code();
+ my $sth = $db_eml->update({ eml_sent => time, eml_code => $bounce_code }, { eml_id => $m->{eml_id}, eml_sent => 0 })
+ or next;
+ my $rows = $sth->rows;
+ next unless $rows;
+
+# Allows personalizing of messages using <%...%> tags
+ my $lists = join ';', map "lid=$_", split ',', $m->{eml_lists};
+ $data->{mailing} = $info->{mli_id};
+ $data->{eml_code}= $bounce_code;
+ $data->{unsubscribe_url} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists")
+ : "$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists";
+
+ #--------------------------
+ # LJM: Parse out arbitrary lists - keys will replace these
+ #--------------------------
+ $lists = "lid=";
+ $data->{unsubscribe_list} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists")
+ : "$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists";
+ $data->{subscribe_list} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_subscribe;eml_code=$bounce_code;$lists")
+ : "$CFG->{cgi_url}/glist.cgi?do=user_subscribe;eml_code=$bounce_code;$lists";
+ $lists = "from_to_lid=";
+ $data->{move_list} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_move;eml_code=$bounce_code;$lists")
+ : "$CFG->{cgi_url}/glist.cgi?do=user_move;eml_code=$bounce_code;$lists";
+ #--------------------------
+
+ foreach ( keys %$sub_cols ) { # Subscriber's information
+ (my $c = $_) =~ s/sub/eml/;
+ $data->{$_} = $m->{$c};
+ }
+
+ my $text = $content_text;
+ my $html = $content_html;
+ my $key = join '|', map quotemeta, keys %$data;
+
+ $text =~ s/<%($key)%>/$data->{$1}/g;
+ $html =~ s/<%($key)%>/$data->{$1}/g;
+
+ $text = GList::Template->parse($$temp_text, $data, { disable => { functions => 1 } }) if ($text =~ /<%/);
+ $html = GList::Template->parse($$temp_html, $data, { disable => { functions => 1 } }) if ($html and $html =~ /<%/);
+
+ my %head;
+ my $to_quoted = "$m->{eml_name} ";
+ my $from_quoted = "$info->{mli_name} ";
+ if ($to_quoted =~ /[^\w\s]/) {
+ $to_quoted =~ s/([\\"])/\\$1/g;
+ $to_quoted = '"' . substr($to_quoted, 0, -1) . '" ';
+ }
+ if ($from_quoted =~ /[^\w\s]/) {
+ $from_quoted =~ s/([\\"])/\\$1/g;
+ $from_quoted = '"' . substr($from_quoted, 0, -1) . '" ';
+ }
+ $head{from} = $info->{mli_name} ? $from_quoted . "<$info->{mli_from}>" : $info->{mli_from};
+ $head{to} = $m->{eml_name} ? $to_quoted . "<$m->{eml_email}>" : $m->{eml_email};
+ $head{subject} = $info->{mli_subject};
+ $head{'Reply-To'} = $info->{mli_reply_to};
+ $head{'Return-Path'}= $info->{mli_bounce_email};
+ $head{'X-GList'} = $bounce_code;
+
+# Handle the progress bar
+ $sent_size += $msg_size + $att_size;
+ my $wpercent = 1 - ($total_size - $sent_size) / $total_size;
+ my $img_width = int($max_width * $wpercent);
+
+ if (!$demo) {
+ GList::send(\%head, { text => $text, html => $html }, $attachs, "$CFG->{priv_path}/attachments/mailings/" . ($mailing % 10) . "/$mailing", $info->{mli_charset});
+ }
+ $num_sent++;
+
+ if ( $img_width != $last_width ) {
+ if ($call_from eq 'web') {
+ printf "\n", 100 * $wpercent;
+ }
+ else {
+ _print_dot($img_width - $last_width);
+ }
+ $last_width = $img_width;
+ }
+ }
+ if (!$db_eml->count({ eml_mailing_id_fk => $mailing, eml_sent => 0 })) {
+ $db_mli->update({ mli_done => time, mli_cat_id_fk => 0 }, { mli_id => $mailing });
+ }
+ }
+ print $prog_footer;
+}
+END_OF_SUB
+
+$COMPILE{_size_mailings} = __LINE__ . <<'END_OF_SUB';
+sub _size_mailings {
+#--------------------------------------------------------------------
+# Get the size of mailings
+#
+ my ($ids, $call_from) = @_;
+
+ my $db_attach = $DB->table('MailingAttachments');
+ my $db_email = $DB->table('EmailMailings');
+ my $db_mailing= $DB->table('MailingIndex');
+ my $size = 0;
+ foreach my $mailing ( @$ids ) {
+ my $length = 0;
+ my $info;
+
+# Check who owns it
+ if ($call_from eq 'web') {
+ $info = GList::check_owner('MailingIndex', 'mli', $mailing);
+ next if (ref $info ne 'HASH');
+ }
+ else {
+ $info = $db_mailing->get($mailing);
+ next if (!$info);
+ }
+
+# Skip if it's been completed
+ next if ( $info->{mli_done} );
+
+# Of Text and HTML message
+ $length += length $info->{mli_message_text} if ($info->{mli_message_text});
+ $length += length $info->{mli_message_html} if ($info->{mli_message_html});
+
+# Get the size of attachments
+ my $attach = $db_attach->select({ mat_mailing_id_fk => $mailing });
+
+ while ( my $rs = $attach->fetchrow_hashref ) {
+ $length += -s "$CFG->{priv_path}/attachments/mailings/" . ($mailing % 10) . "/$mailing/$rs->{mat_id}";
+ }
+
+ my $emails = $db_email->count({ eml_mailing_id_fk => $mailing, eml_sent => '0' });
+ $length *= $emails if ( $emails );
+ $size += $length;
+ }
+ return $size;
+}
+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('CatMailing', 'MailingIndex');
+ my $cond = GT::SQL::Condition->new('cm_user_id_fk', $user->{opt}, $user->{id});
+ $db->select_options('GROUP BY cm_type,cm_id, cm_name ORDER BY cm_name');
+
+ my $sth = $db->select('left_join', $cond, ['CatMailing.cm_id', 'CatMailing.cm_type', 'CatMailing.cm_name', 'count(mli_id) as mailing']) or die "$GT::SQL::error";
+ my ($draft, $sent);
+ while ( my $rs = $sth->fetchrow_hashref ) {
+ if ( $rs->{cm_type} eq '1' ) {
+ push @$draft, $rs;
+ }
+ else {
+ push @$sent, $rs;
+ }
+ }
+
+ my $db_mli = $DB->table('MailingIndex');
+ my $cd = GT::SQL::Condition->new(
+ mli_user_id_fk => $user->{opt} => $user->{id},
+ mli_delete => '=' => 0,
+ mli_done => '=' => 0,
+ mli_scheduled => '=' => 0,
+ mli_cat_id_fk => '=' => 0,
+ );
+ my $drafts = $db_mli->select($cd)->rows;
+ my $scheduled = $db_mli->select({ mli_scheduled => 1, mli_delete => 0 })->rows;
+
+ return { results_draft => $draft, results_sent => $sent, scheduled_hits => $scheduled,
+ hits_draft => $#$draft + 1, hits_sent => $#$sent + 1, drafts => $drafts,
+ };
+}
+END_OF_SUB
+
+$COMPILE{_generate_bounce_code} = __LINE__ . <<'END_OF_SUB';
+sub _generate_bounce_code {
+# -------------------------------------------------------------------
+ my $code;
+ my $i;
+ while ($i++ < 10) {
+ $code = '';
+ my @chars = ('a' .. 'z', 'A' .. 'Z', 0 .. 9);
+ for (1 .. 20) {
+ $code .= $chars[rand @chars];
+ }
+ last unless ($DB->table('EmailMailings')->count( { eml_code => $code } ));
+ }
+ return $code;
+}
+END_OF_SUB
+
+$COMPILE{_print_dot} = __LINE__ . <<'END_OF_SUB';
+sub _print_dot {
+ my $num = shift;
+ foreach my $i(1..$num) {
+ print ".";
+ }
+}
+END_OF_SUB
+
+$COMPILE{_replace_url} = __LINE__ . <<'END_OF_SUB';
+sub _replace_url {
+ my ($content, $url) = @_;
+ $url ||= '';
+ $content =~ s/href\s*=\s*(["'])\s*((?:https?|ftp):\/\/.*?)\1/my $link = $IN->escape($IN->html_unescape($2)); "href=$1$url;url=$link$1"/gise;
+ return $content;
+}
+END_OF_SUB
+
+$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
+sub _determine_action {
+#----------------------------------------------------------------------------
+# Check valid action
+#
+ my $action = shift || undef;
+ return if ( !$action );
+ return 'mli_home' if ( $action eq 'mli_search' );
+
+ my %valid = (
+ map { $_ => 1 } qw(
+ mli_home
+ mli_search_form
+ mli_empty
+ mli_delete
+ mli_move
+ mli_schedule
+ mli_schedule_modify
+ mli_schedule_delete
+ mli_send
+ mli_fview
+ mli_fdownload
+ mli_bounced_form
+ mli_bounced
+ mli_recipients
+ mli_cat_add
+ mli_cat_modify
+ mli_cat_delete
+ )
+ );
+ exists $valid{$action} and return $action;
+ return;
+}
+END_OF_SUB
+1;
diff --git a/site/glist/lib/GList/Message.pm b/site/glist/lib/GList/Message.pm
new file mode 100644
index 0000000..a4ab26f
--- /dev/null
+++ b/site/glist/lib/GList/Message.pm
@@ -0,0 +1,1185 @@
+# ==================================================================
+# 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;
+ $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