This code is for reaching my admin page of autoresdonder, The script is responder.cgi. My installation goes fine until this last page code I keep getting this error Invalid header value contains a newline not followed by whitespace: iso-8859-1 at (eval 36) line 34. I am running Ubuntu 14.04, apache2, php5, mysql. I have tried a couple of things, use strict; use warnings; use CGI; None of this works. Any suggesttions would really help. Sorry for the long code.
#!/usr/bin/perl -w use lib('lib'); require 'conf.cgi'; ### %CONF=(); %PAR=();%ACCOUNT=(); ### &par_prepare; &db_prepare; unless(keys %LNG){ &printheader; print $q->start_html("Error"); print $q->h1("Language keys was not loaded"); print $q->p("Can not find file <B>shabl/$CONF{langnow}.txt"); print $q->end_html; exit; } $dparser::lang=\%LNG; #map{$LNG{$_}="|$LNG{$_}|"}keys %LNG; local %ACT= ( "" =>\&print_frameset, account =>\&print_account, signatures=>\&print_manage_signatures, manageaccount=>\&print_manage_account, openhtmleditor=>\&openXinha, lngset =>\&print_set_leng, mainbody =>\&print_main, 'stat'=> =>\&print_stat, settings =>\&print_settings, getfile =>\&print_getfile, delfile =>\&print_delfile, doimess =>\&print_doimess, subscrmess=>\&print_subsmess, unsubscrmess=>\&print_unsubsmess, showmess=>\&print_show_mess, showrfcmess=>\&print_show_rfc_mess, changehtmleditor=>\&print_change_editor, testsend=>\&print_test_send, statdaily=>\&print_statdaily, logout=>\&print_logout ); local @ACCOUNTMENU=( {name=>$LNG{ACCOUNTMENU_MAIN}, params=>{act2=>""}}, {name=>$LNG{ACCOUNTMENU_OPTIONS},params=>{act2=>"config"}, description=>$LNG{ACCOUNTMENU_OPTIONS_DESCR}, nextlevel=>[ { name=>$LNG{ACCOUNTMENU_OPTIONS}, params=>{act3=>""}, description=>'' }, { name=>$LNG{ACCOUNTMENU_HTML_RSS}, params=>{act3=>"rss"}, description=>'' } ] }, {name=>$LNG{ACCOUNTMENU_HTML_FORM}, params=>{act2=>"columns +"}, description=>$LNG{ACCOUNTMENU_HTML_FORM_DESCR}, nextlevel=>[ { name=>$LNG{ACCOUNTMENU_HTML_FORM}, params=>{act3=>""}, description=>'' }, { name=>$LNG{HTML_FORM_FIELDS}, params=>{act3=>"fields"}, description=>'' }, { name=>$LNG{HTML_FORM_OPTIONS}, params=>{act3=>"settings"}, description=>'' }, { name=>$LNG{HTML_FORM_INTEGRATION}, params=>{act3=>"integration"}, description=>'' } ] }, # {name=>$LNG{ACCOUNTMENU_HTML_RSS}, params=>{act2=>"rss"}, # description=>$LNG{ACCOUNTMENU_HTML_RSS_DESCR}}, {name=>$LNG{ACCOUNTMENU_SUBSCR_MAN}, params=>{act2=>"users_new"}, description=>$LNG{ACCOUNTMENU_SUBSCR_MAN_DESCR}, nextlevel=>[ { name=>$LNG{ACCOUNTMENU_SUBSCR_MAN}, params=>{act3=>""}, description=>'' }, { name=>(($PAR{reckey} and ($PAR{act3}eq"userform"))?"$L +NG{ACCOUNT_MENU_EDIT_CURRENT_PROSPECT}":$LNG{PROSPMENU_ADD_PROSP}), params=>{act3=>"userform"}, description=>'' }, { name=>$LNG{PROSPMENU_IMPORT}, params=>{act3=>"import"}, description=>'', nextlevel=>[ { name=>$LNG{IMPORT_FROM_TEXT}, params=>{act4=>""}, description=>'' }, { name=>$LNG{IMPORT_FROM_TAB_DELMITTED}, params=>{act4=>"tab"}, description=>'' } ] }, { name=>$LNG{PROSPMENU_EXPORT}, params=>{act3=>"export"}, description=>'', nextlevel=>[ { name=>$LNG{PROSPMENU_EXPORT}, params=>{act4=>""}, description=>'' }, { name=>$LNG{EXPORT_TO_TAB_DELMITTED}, params=>{act4=>"tab"}, description=>'' } ] }, { name=>$LNG{PROSPMENU_COPY}, params=>{act3=>'copy'}, description=>'', }, { name=>$LNG{PROSPMENU_BULK_REMOVE}, params=>{act3=>'bulk'}, description=>'', } ] }, {name=>$LNG{ACCOUNTMENU_EDIT_MESS}, params=>{act2=>"mess"}, description=>$LNG{ACCOUNTMENU_EDIT_MESS_DESCR}}, {name=>$LNG{ACCOUNTMENU_LINKS}, params=>{act2=>"links"}, description=>$LNG{ACCOUNTMENU_LINKS_DESCR}, nextlevel=>[ { name=>$LNG{ACCOUNTMENU_LINKS}, params=>{modelog=>""}, description=>'', add_params=>[qw(datefilter)] }, { name=>$LNG{ACCOUNTMENU_LINKS_MESS_STAT}, params=>{modelog=>"mess"}, description=>'', add_params=>[qw(datefilter)] }, { name=>$LNG{ACCOUNTMENU_LINKS_ACT_PROSP}, params=>{modelog=>"prospects"}, description=>'', add_params=>[qw(datefilter)], }, { name=>$LNG{ACCOUNTMENU_LINKS_CLICKS}, params=>{modelog=>"clicks"}, description=>'', add_params=>[qw(datefilter)], }, ] } ); local @SETTINGSMENU=( {name=>$LNG{SETTINGSMENU_MAIN}, params=>{act2=>""}}, {name=>$LNG{SETTINGSMENU_PERSONAL},params=>{act2=>"personal"}, description=>$LNG{SETTINGSMENU_PERSONAL_DESCR}}, {name=>$LNG{SETTINGSMENU_SENDING_OPTIONS}, params=>{act2=>" +smtp"}, description=>$LNG{SETTINGSMENU_SENDING_OPTIONS_DESCR}}, {name=>$LNG{SETTINGSMENU_ACCESS}, params=>{act2=>"pass"}, description=>$LNG{SETTINGSMENU_ACCESS_DESCR}}, {name=>$LNG{SETTINGSMENU_TIME_SYNC}, params=>{act2=>"timecorr"} +, description=>$LNG{SETTINGSMENU_TIME_SYNC_DESCR}}, {name=>$LNG{SETTINGSMENU_PERFOM}, params=>{act2=>"test"}, description=>$LNG{SETTINGSMENU_PERFOM_DESCR}}, {name=>$LNG{SETTINGSMENU_BACUP_RESTORE}, params=>{act2=>"backup +"}, description=>$LNG{SETTINGSMENU_BACUP_RESTORE_DESCR}} ); local @STATMENU=( {name=>$LNG{STATMENU_MAIN}, params=>{act2=>""}}, {name=>$LNG{STATMENU_ACT_LOGS}, params=>{act2=>"log"}, description=>$LNG{STATMENU_ACT_LOGS_DESCR}}, {name=>$LNG{STATMENU_CURRENT_BROADCAST}, params=>{act2=>"curl +og"}, description=>$LNG{STATMENU_CURRENT_BROADCAST_DESCR}}, {name=>$LNG{STATMENU_TOTALS}, params=>{act2=>"total"}, description=>$LNG{STATMENU_TOTALS_DESCR}, nextlevel=>[ { name=>$LNG{STATMENU_TOTALS_SENT_MESS}, params=>{modelog=>""}, description=>'', add_params=>[qw(day1 day2 month1 month2 year1 year2)] }, { name=>$LNG{STATMENU_TOTALS_SUBSCRIBERS}, params=>{modelog=>"subscribers"}, description=>'', add_params=>[qw(day1 day2 month1 month2 year1 year2)] }, { name=>$LNG{STATMENU_TOTALS_PROSPECTS}, params=>{modelog=>"account"}, description=>'', add_params=>[qw(day1 day2 month1 month2 year1 year2)], }, ] }, ); my $address=$ENV{HTTP_HOST}; my $scriptdir=$ENV{SCRIPT_NAME}; (my $src=$scriptdir)=~s#[^/]*$##; save_config(0,"serverurl","http://$address${src}"); &sessiya; &process_all; sub ReorderAccounts{ my $count; my $sql="SELECT * from ${PREF}account ORDER by position asc , name + asc"; my $out=$db->prepare($sql); $out->execute(); my $count=0; while (my $output=$out->fetchrow_hashref){ $count++; update_db("${PREF}account", {position=>$count},{pk_account=>$o +utput->{pk_account}}) if($output->{position}!=$count); } return $count; } sub print_accountreport{ my $account_count=ReorderAccounts(); if($PAR{modify} eq 'chstatus'){ #die $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}&re +load=1"); $db->do("UPDATE ${PREF}account SET isact = IF(isact=1,0,1) WHE +RE pk_account=? LIMIT 1",undef,$PAR{id}); &Error; print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}&r +eload=1"); exit; } if($PAR{modify} eq 'delete'){ DeleteAccount($PAR{id}); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}&r +eload=1"); exit; } if($PAR{modify} eq 'moveup'){ my $hr=select_one_db("SELECT * FROM ${PREF}account WHERE pk_ac +count=?",$PAR{id}); #die $hr->{position}; update_db("${PREF}account",{position=>$hr->{position}},{positi +on=>$hr->{position}-1}); update_db("${PREF}account",{position=>$hr->{position}-1},{pk_a +ccount=>$PAR{id}}); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}&r +eload=1"); exit; } if($PAR{modify} eq 'movedown'){ my $hr=select_one_db("SELECT * FROM ${PREF}account WHERE pk_ac +count=?",$PAR{id}); update_db("${PREF}account",{position=>$hr->{position}},{positi +on=>$hr->{position}+1}); update_db("${PREF}account",{position=>$hr->{position}+1},{pk_a +ccount=>$PAR{id}}); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}&r +eload=1"); exit; } my $page=new repparser DATA=>"$SHABL_DIR/manage_accounts.html",TO => "#end_report",FROM=> +"#start_report"; map{$page->add_regesp("{".$_."}",$PAR{$_})}keys %PAR; $page->Hide('<!--IFRELOAD-->') unless ($PAR{reload}); my $sql="SELECT * from ${PREF}account ORDER by position asc , name + asc"; my $out=$db->prepare($sql); $out->execute(); while (my $output=$out->fetchrow_hashref){ $output->{img} = "content.cgi?get=image&mode=gif&f="; $output->{img}.=$output->{isact}?'active':'inact'; $output->{confirm_activation}=$output->{isact}?$LNG{CONFIRM_DI +SABLING_ACCOUNT}:$LNG{CONFIRM_ENABLING_ACCOUNT}; $output->{status}=$output->{isact}?$LNG{MESS_ACTIVE}:$LNG{MESS +_INACTIVE}; $output->{statustitle}=$output->{isact}?$LNG{ACCOUNT_STATUS_AC +TIV_DESCR}:$LNG{ACCOUNT_STATUS_INACTIV_DESCR}; if($output->{position}==1){ $output->{moveup}=qq|<img src="img/sp.gif" width="16" heig +ht="16" border="0">|; }else{ $output->{moveup}=qq|<a href="$SCRIPT_NAME?ses=$PAR{ses}&a +ct=$PAR{act}&modify=moveup&id=$output->{pk_account}"><img src="conten +t.cgi?get=image&mode=gif&f=move_task_up" width="16" height="16" borde +r="0"></a>|; } if($output->{position}==$account_count){ $output->{movedown}=qq|<img src="img/sp.gif" width="16" he +ight="16" border="0">|; }else{ $output->{movedown}=qq|<a href="$SCRIPT_NAME?ses=$PAR{ses} +&act=$PAR{act}&modify=movedown&id=$output->{pk_account}"><img src="co +ntent.cgi?get=image&mode=gif&f=move_task_down" width="16" height="16" + border="0"></a>|; } $page->AddRow($output); } $page->ParseData; return $page->as_string; } sub print_account_pref{ my $page=new hfparser DATA=>"$SHABL_DIR/manage_accounts.html",TO => "#end_account_pref", +FROM=>"#start_account_pref"; if($PAR{issubmit}){ $PAR{name}=~s/^\s+//; $PAR{name}=~s/\s+$//; $page->set_error('name',"$LNG{ERROR_REQUIRED}") unless length( +$PAR{name}); if($PAR{id}){ $page->set_error('name',ucfirst("$LNG{ERROR_IS_ALREADY_EXI +STS}")) if GetSQLCount("SELECT * FROM ${PREF}account WHERE name=? AND + pk_account<>?",$PAR{name},$PAR{id}); }else{ $page->set_error('name',ucfirst("$LNG{ERROR_IS_ALREADY_EXI +STS}")) if GetSQLCount("SELECT * FROM ${PREF}account WHERE name=?",$P +AR{name}); } unless($page->is_error){ if($PAR{id}){ update_db("${PREF}account",{name=>sequre($PAR{name}),d +escr=>sequre($PAR{descr})},{pk_account=>$PAR{id}}); }else{ my $count=insert_db("${PREF}account",{name=>sequre($PA +R{name}),isact=>1,descr=>sequre($PAR{descr})}); if ($PAR{clone}){ DublicateAccountTable("${PREF}conf",$PAR{clone},$c +ount,undef,"fk_account"); DublicateAccountTable("${PREF}fields",$PAR{clone}, +$count,"pk_fields","fk_account"); DublicateAccountTable("${PREF}mess",$PAR{clone},$c +ount,"pk_mess","fk_account"); $db->do("UPDATE ${PREF}mess SET sent=0 WHERE fk_ac +count=?",undef,$count); $keymap=DublicateAccountTable("${PREF}links",$PAR{ +clone},$count,"pk_link","fk_account"); my $sql="SELECT * from ${PREF}mess WHERE fk_accoun +t=?"; my $out=$db->prepare($sql); $out->execute($count); #print $q->header; while (my $output=$out->fetchrow_hashref){ my $subject=$output->{subject}; my $mess=$output->{mess}; my $messhtml=$output->{messhtml}; map{ my $oldkey=$_; my $newkey=$keymap->{$_}; #print "$oldkey = $newkey\n<BR>\n"; $subject=~s/\[LINK$oldkey\]/[LINK$newkey]/ +gs; $mess=~s/\[LINK$oldkey\]/[LINK$newkey]/gs; $messhtml=~s/\[LINK$oldkey\]/[LINK$newkey] +/gs; }keys %$keymap; #print "<HR>"; update_db("${PREF}mess",{subject=>$subject,mes +s=>$mess,messhtml=>$messhtml},{pk_mess=>$output->{pk_mess}}); } } } print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{ac +t}&reload=1"); exit; } } unless($PAR{id}){ unless($PAR{clone}){ $page->add_regesp('{ACTION_VALUE}',$LNG{ACCOUNT_NEW}); }else{ my $hr=select_one_db("SELECT * FROM ${PREF}account WHERE p +k_account=?",$PAR{clone}); $page->add_regesp('{ACTION_VALUE}',"$LNG{ACCOUNT_CLONE} $h +r->{name}"); } }else{ $page->add_regesp('{ACTION_VALUE}',$LNG{ACCOUNT_EDIT}); } if($PAR{id}){ my $hr=select_one_db("SELECT * FROM ${PREF}account WHERE pk_ac +count=?",$PAR{id}); map{$page->set_def($_,$hr->{$_})}keys %$hr; } $page->ParseData; return $page->as_string; } sub print_manage_account{ my %map; %map=( "" =>\&print_accountreport, accountpref =>\&print_account_pref ); $main_page=new dparser( DATA=>"$SHABL_DIR/main-settings.html" ); #$main_page->add_regesp('{main_menu}',get_account_menu(\@SETTINGSM +ENU)); $main_page->add_regesp('{main_menu}',""); my $func_ref; if ($map{$PAR{act2}}) { $func_ref=$map{$PAR{act2}}; }else{ $func_ref=sub{return $q->h1($LNG{INCORRECT_URL})} } $main_page->add_regesp('###TITLE###',$LNG{MANAGE_ACCOUNTS}); $main_page->add_regesp('{body}',&$func_ref); $main_page->ParseData; &printheader; $main_page->print; } sub print_signatures_report{ if($PAR{modify} eq 'delete'){ $db->do("DELETE FROM ${PREF}signatures WHERE pk_signature=?",u +ndef,$PAR{id}); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}") +; exit; } my $page=new repparser DATA=>"$SHABL_DIR/manage_signatures.html",TO => "#end_report",FROM +=>"#start_report"; map{$page->add_regesp("{".$_."}",$PAR{$_})}keys %PAR; my $sql="SELECT * from ${PREF}signatures ORDER by name asc"; my $out=$db->prepare($sql); $out->execute(); while (my $output=$out->fetchrow_hashref){ my $sql2="SELECT * FROM ${PREF}mess WHERE mess LIKE ".$db->quo +te('%[SIGNATURE_'.$output->{name}.']%')." OR messhtml LIKE ".$db->quo +te('%[SIGNATURE_'.$output->{name}.']%')." ORDER by fk_account"; my $out2=$db->prepare($sql2); $out2->execute(); my @mess; while (my $mess=$out2->fetchrow_hashref){ push(@mess,qq|<a href="$SCRIPT_NAME?ses=$PAR{ses}&reckey=$ +mess->{pk_mess}&act=mainbody&act2=newmess&account=$mess->{fk_account} +">$mess->{subject}</a>|); } $output->{descr}=join "<BR>\n",@mess; if(@mess){ $output->{delete_signature}=qq|<img src="content.cgi?get=i +mage&mode=gif&f=sp" width="16" height="16" border="0">|; }else{ $output->{delete_signature}=qq|<a href="$SCRIPT_NAME?ses=$ +PAR{ses}&act=signatures&modify=delete&id=$output->{pk_signature}" onC +lick="return confirm('$LNG{SIGNATURE_DELETE_CONFIRM}')"><img src="con +tent.cgi?get=image&mode=png&f=b_drop" width="16" height="16" border=" +0"></a>|; } $page->AddRow($output); } $page->ParseData; return $page->as_string; } sub print_signatures_pref{ my $page=new hfparser DATA=>"$SHABL_DIR/manage_signatures.html",TO => "#end_account_pref +",FROM=>"#start_account_pref"; if($PAR{issubmit}){ $PAR{name}=~s/^\s+//; $PAR{name}=~s/\s+$//; $page->set_error('name',"$LNG{ERROR_REQUIRED}") unless length( +$PAR{name}); $page->set_error('name',"$LNG{SIGNATURE_INCORRECT_NAME}") if($ +PAR{name}=~/[^a-zA-Z0-9_]/); if($PAR{id}){ $page->set_error('name',ucfirst("$LNG{ERROR_IS_ALREADY_EXI +STS}")) if GetSQLCount("SELECT * FROM ${PREF}signatures WHERE name=? +AND pk_signature<>?",$PAR{name},$PAR{id}); }else{ $page->set_error('name',ucfirst("$LNG{ERROR_IS_ALREADY_EXI +STS}")) if GetSQLCount("SELECT * FROM ${PREF}signatures WHERE name=?" +,$PAR{name}); } unless($page->is_error){ if($PAR{id}){ update_db("${PREF}signatures",{name=>$PAR{name},sig_te +xt=>$PAR{sig_text},sig_html=>$PAR{sig_html}},{pk_signature=>$PAR{id}} +); }else{ insert_db("${PREF}signatures",{name=>$PAR{name},sig_te +xt=>$PAR{sig_text},sig_html=>$PAR{sig_html}}); } print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{ac +t}"); exit; } } unless($PAR{id}){ $page->add_regesp('{ACTION_VALUE}',$LNG{SIGNATURE_NEW}); }else{ $page->add_regesp('{ACTION_VALUE}',$LNG{SIGNATURE_EDIT}); } if($PAR{id}){ my $hr=select_one_db("SELECT * FROM ${PREF}signatures WHERE pk +_signature=?",$PAR{id}); map{$page->set_def($_,$hr->{$_})}keys %$hr; my $sql2="SELECT * FROM ${PREF}mess WHERE mess LIKE ".$db->quo +te('%[SIGNATURE_'.$hr->{name}.']%')." OR messhtml LIKE ".$db->quote(' +%[SIGNATURE_'.$hr->{name}.']%')." ORDER by fk_account"; if(GetSQLCount($sql2)){ $page->Hide('<!--SHOW_IF_NEW-->'); $page->add_regesp('{name}',$hr->{name}); }else{ $page->Hide('<!--SHOW_IF_EDIT-->'); } }else{ $page->Hide('<!--SHOW_IF_EDIT-->'); } if($PAR{clone}){ my $hr=select_one_db("SELECT * FROM ${PREF}signatures WHERE pk +_signature=?",$PAR{clone}); map{$page->set_def($_,$hr->{$_}) unless /name/}keys %$hr; } $page->ParseData; return $page->as_string; } sub print_manage_signatures{ my %map; %map=( "" =>\&print_signatures_report, pref =>\&print_signatures_pref ); $main_page=new dparser( DATA=>"$SHABL_DIR/main-settings.html" ); #$main_page->add_regesp('{main_menu}',get_account_menu(\@SETTINGSM +ENU)); $main_page->add_regesp('{main_menu}',""); my $func_ref; if ($map{$PAR{act2}}) { $func_ref=$map{$PAR{act2}}; }else{ $func_ref=sub{return $q->h1($LNG{INCORRECT_URL})} } $main_page->add_regesp('###TITLE###',$LNG{MANAGE_SIGNATURES}); $main_page->add_regesp('{body}',&$func_ref); $main_page->ParseData; &printheader; $main_page->print; } ################## sub add_menu_prospects{ my $page_ref=shift; #my $menu; #$menu=<<ALL__; #<table width="100%" border="0" cellspacing="3" cellpadding="1"> # <tr align="center" class="data"> # <td><a href="$SCRIPT_NAME?ses=$PAR{ses}&act=mainbody&act2=use +rform&account=$PAR{account}"><NOBR>$LNG{PROSPMENU_ADD_PROSP}</NOBR></ +a></td> # <td><a href="$SCRIPT_NAME?ses=$PAR{ses}&act=mainbody&act2=imp +ort&account=$PAR{account}"><NOBR>$LNG{PROSPMENU_IMPORT}</NOBR></a></t +d> # <td><a href="$SCRIPT_NAME?ses=$PAR{ses}&act=mainbody&act2=exp +ort&account=$PAR{account}"><NOBR>$LNG{PROSPMENU_EXPORT}</NOBR></a></t +d> # <td><a href="$SCRIPT_NAME?ses=$PAR{ses}&act=mainbody&act2=loa +dfrom&account=$PAR{account}"><NOBR>$LNG{PROSPMENU_COPY}</NOBR></a></t +d> # <td><a href="$SCRIPT_NAME?ses=$PAR{ses}&act=mainbody&act2=bul +k&account=$PAR{account}"><NOBR>$LNG{PROSPMENU_BULK_REMOVE}</NOBR></a> +</td> # </tr> #</table> #ALL__ $page_ref->add_regesp('{prospects_menu}',""); } ################## sub process_all{ if ($ACT{$PAR{act}}){ my $sub_ref=$ACT{$PAR{act}}; &$sub_ref if $sub_ref; }else{ printheader(); print $q->start_html($LNG{ERROR}); print $q->h1($LNG{ERROR_NOT_CHANGE_URL}); print $q->end_html; exit; } } ################### sub get_account_menu{ my $ref_menu=shift; my @MENU=@{$ref_menu}; my $out; $out=$q->start_table({-border=>0,-align=>"center",width=>"100%"}). +"<TR>"; my $count=@MENU; my $width=100/$count."%" if $count; my $menu; my $acct=""; $acct='&account='.$PAR{account} if $PAR{account}; my @menu=map{$q->td({-align=>center, -width=>$width}, $q->a({-href=>"$SCRIPT_NAME?act=$PAR{act}&act2=".$_->{ +params}{act2}."&ses=$PAR{ses}".$acct, -target=>'_self', -class=>($PAR{act2} eq $_->{ +params}{act2}) ? 'menuACT' : 'menu'},"<NOBR>$_->{name}</NOBR>") ) }@MENU; $out.=join "\n", @menu; $out.="</TR>".$q->end_table() ; return $out; } ######################################## sub get_full_menu{ my $ref_menu=shift; my @MENU=@{$ref_menu}; my $out; $out=<<ALL__; <table cellspacing="1" cellpadding="5" border="0" align="center" wid +th ="100%"> ALL__ my $acct=""; $acct='&account='.$PAR{account} if $PAR{account}; foreach(@MENU){ next unless ($_->{description}); my $href=$q->a({-href=>"$SCRIPT_NAME?act=$PAR{act}&act2=".$_-> +{params}{act2}."&ses=$PAR{ses}".$acct,-target=>'_self'},qq|<img src=" +content.cgi?get=image&mode=gif&f=go" border="0" width="16" height="16 +">|); $out.=<<ALL__; <TR class="data"> <td>$href</td> <td><STRONG>$_->{name}: </STRONG>$_->{description}</td +> </tr> ALL__ } $out.=$q->end_table() ; return $out; } ################## sub get_full_url{ my $pars=shift; my %pars=%$pars; my $qq = new CGI; foreach (keys %pars){ $qq->param($_,$pars{$_}) } #-path_info=>1 #-query=>1 return $qq->url(-absolute=>1,-query=>1); } #################### #begin mapping functions #################### #SETTINGS sub print_settings_main{ my $page = new hfparser( DATA=>$settings_shabl ); $page->SplitData("#begin#main","#end#main"); $page->deleteBEFORE_AFTER(); $page->add_regesp('{main_menu_body}',get_full_menu(\@SETTINGSMENU) +); $page->ParseData; return $page->as_string; } ################### sub print_settings_personal{ my $page = new hfparser( DATA=>$settings_shabl ); my @set=qw(statbyemail adminname adminemail splashsettings); if ($PAR{issubmit}){ $page->set_error("adminname",$LNG{ERROR_YOUR_NAME_REQUIRED}) u +nless $PAR{adminname}; if ($PAR{adminemail}){ $page->set_error("adminemail",$LNG{ERROR_EMAIL_INCORRECT}) + unless checkemail($PAR{adminemail}); }else{ $page->set_error("adminemail",$LNG{ERROR_EMAIL_REQUIRED}); } } if ($PAR{issubmit} && !$page->is_error){ map{save_config(0,"$_",$PAR{$_})}@set; $page->add_regesp('{error}',"<h1 class=\"mess\">$LNG{MESS_SETT +INGS_UPDATED}</h1>"); } my @splval=qw(news daily_stats activity curbroadcast totalstat bou +nced bounced_total); map{$page->add_element('splashsettings',$_,$LNG{"SPLASH_PAGE_SETTI +NGS_".uc($_)})}@splval; my $sql="select * from ${PREF}account WHERE isact=1 ORDER by name" +; my $out=$db->prepare($sql); $out->execute(); my %output; while ($output=$out->fetchrow_hashref){ $page->add_element('splashsettings','account_'.$output->{pk_ac +count},$LNG{ACCOUNT_BIG}." -> ".$output->{name}); } map{$page->set_def("$_",$CONF{$_});}@set; $page->SplitData("#begin#personal","#end#personal"); $page->deleteBEFORE_AFTER(); $page->ParseData; return $page->as_string; } ########################### sub print_settings_smtp{ my $page = new hfparser( DATA=>$settings_shabl ); my @settings=qw(sendmail modsend smtp COUNT_PROC sendingdelay OLD_ +ALGORITHM_PROC smtpauth smtpusername smtppassword errorsto smtpuseadm +inemail smtpfromemail returnpath issendmailf sendmailaddress smtpport + smtpssl ); if ($PAR{issubmit}){ if ($PAR{modsend} eq ""){ $page->set_error("modsend",$LNG{ERROR_NOT_SELECTED}) }else{ if ($PAR{modsend} eq 'sendmail'){ unless ($PAR{sendmail}){ $page->set_error("sendmail",$LNG{ERROR_REQUIRED_SE +NDMAIL}) }else{ if($PAR{sendmail}=~/[ ><;&]/){ $page->set_error("sendmail",$LNG{ERROR_INCORRE +CT_SENDMAIL_PATH}) }elsif(! -f $PAR{sendmail}){ $page->set_error("sendmail",$LNG{ERROR_INCORRE +CT_SENDMAIL_NOT_EXISTS}) } unless($page->is_error){ if(length($PAR{errorsto})){ $page->set_error("errorsto",$LNG{ERROR_EMA +IL_INCORRECT}) unless (checkemail($PAR{errorsto})); } if(length($PAR{returnpath})){ $page->set_error("returnpath",$LNG{ERROR_E +MAIL_INCORRECT}) unless (checkemail($PAR{returnpath})); + } if(length($PAR{issendmailf})){ $page->set_error("sendmailaddress",$LNG{ER +ROR_EMAIL_INCORRECT}) unless (checkemail($PAR{sendmailaddress})); + } } } }elsif($PAR{modsend} eq 'SMTP'){ $page->set_error("smtp",$LNG{ERROR_REQUIRED_SMTP}) unl +ess $PAR{smtp}; if($PAR{smtpauth}){ $page->set_error("smtpusername",$LNG{ERROR_REQUIRE +D}) unless length($PAR{smtpusername}); $page->set_error("smtppassword",$LNG{ERROR_REQUIRE +D}) unless length($PAR{smtppassword}); } if($PAR{smtpuseadminemail}){ $page->set_error("smtpfromemail",$LNG{ERROR_EMAIL_ +INCORRECT}) unless (checkemail($PAR{smtpfromemail})); } } } if ($PAR{smtpport}){ if ($PAR{smtpport}=~/[^0-9]/){ $page->set_error('smtpport',$LNG{ERROR_NUMBER_REQUIRED +}); } } } if ($PAR{issubmit} && !$page->is_error){ map{save_config(0,$_,$PAR{$_})}@settings; $page->add_regesp('{error}',"<h1 class=\"mess\">$LNG{MESS_SETT +INGS_UPDATED}</h1>"); } if($CONF{modsend} eq 'SMTP'){ $page->Hide('<!--HIDEIFSMTP-->'); }else{ $page->Hide('<!--HIDEIFSENDMAIL-->'); } map{$page->add_element("COUNT_PROC",$_)}(1..10); map{$page->add_element("sendingdelay",$_)}(0..999); $page->set_def("sendingdelay",0); $page->add_element("modsend","","--select--"); $page->add_element("modsend","sendmail"); $page->add_element("modsend","SMTP"); map{$page->set_def("$_",$CONF{$_})}@settings; $page->set_def("sendmailaddress",$CONF{adminemail}) unless length( +$CONF{sendmailaddress}); $page->set_def("smtpfromemail",$CONF{adminemail}) unless length($C +ONF{smtpfromemail}); $page->set_input("smtpport",{size=>4, MAXLENGTH=>5}); $page->SplitData("#begin#smtp","#end#smtp"); $page->deleteBEFORE_AFTER(); $page->ParseData; return $page->as_string; } ################# sub print_settings_timecorr{ my $page = new hfparser( DATA=>$settings_shabl ); if ($PAR{issubmit}){ if ($PAR{timecorr} ne ""){ unless ($PAR{timecorr}=~m#^(\+|-)\d\d:\d\d$#){ $page->set_error("timecorr",$LNG{ERROR_INCORRECT_FORMA +T}); } } } if ($PAR{issubmit} && !$page->is_error){ save_config(0,"timecorr",$PAR{timecorr}); save_config(0,'date_format',$PAR{date_format}); $page->add_regesp('{error}',"<h1 class=\"mess\">$LNG{MESS_SETT +INGS_UPDATED}</h1>"); $CONF{timecorr}=$PAR{timecorr}; $MY_TIME=time+TimeToSec($CONF{timecorr}); $NOW=GetNow($PAR{timecorr}); $db->do("UPDATE ${PREF}ses SET date=$NOW WHERE ran=?", undef, +$PAR{ses}); } $page->add_regesp('{time}',scalar(localtime())); $page->add_regesp('{mytime}',scalar(localtime($MY_TIME))); unless($CONF{date_format}){ $CONF{date_format}='%m/%d/%Y'; } eval{ $page->add_regesp('{testdate}',strftime($CONF{date_format},loc +altime($MY_TIME))); }; $page->add_regesp('{testdate}',qq|<FONT color=red>Error parsing fo +rmat: $@</FONT>|) if $@; $page->set_def("date_format",$CONF{date_format}); $page->set_def("timecorr",$CONF{timecorr}); $page->SplitData("#begin#time","#end#time"); $page->deleteBEFORE_AFTER(); $page->ParseData; return $page->as_string; } ######################## sub print_settings_pass{ my $page = new hfparser( DATA=>$settings_shabl ); if ($PAR{issubmit}){ $page->set_error("oldpass",$LNG{ERROR_INCORRECT}) if ($PAR{old +pass} ne $CONF{adminpwd}); if ($PAR{newpass1} && $PAR{newpass2}){ $page->set_error("newpass1",$LNG{ERROR_NOT_EQUAL}) if ($PA +R{newpass1} ne $PAR{newpass2}); $page->set_error("newpass2",$LNG{ERROR_NOT_EQUAL}) if ($PA +R{newpass1} ne $PAR{newpass2}); }else{ $page->set_error("newpass1",$LNG{ERROR_REQUIRED}) unless $ +PAR{newpass1}; $page->set_error("newpass2",$LNG{ERROR_REQUIRED}) unless $ +PAR{newpass2}; } } if ($PAR{issubmit} && !$page->is_error){ save_config(0,"adminpwd",$PAR{newpass1}); $page->add_regesp('{error}',"<h1 class=\"mess\">$LNG{MESS_SETT +INGS_UPDATED}</h1>"."<A href=\"$SCRIPT_NAME\" target=\"parent\">$LNG{ +MESS_LOGOUT_TO_CHECK}</a>"); } $page->SplitData("#begin#pass","#end#pass"); $page->deleteBEFORE_AFTER(); $page->ParseData; return $page->as_string; } #############Backup sub get_dir_size{ my $dir=shift; my $dirsize=0; if (-d "$dir"){ my @files; opendir(DIR,$dir) || die $LNG{ERROR_CANT_OPEN_DIR}; while (my $file=readdir(DIR)){ next if ($file=~/^\.+$/); push (@files,$file); } closedir(DIR); foreach my $file(@files){ if(-d "$dir/$file"){ $dirsize += get_dir_size("$dir/$file"); }else{ $dirsize += (stat("$dir/$file"))[7]; } } }elsif(-f $dir){ return (stat("$dir"))[7]; } return $dirsize; } ################### sub remove_dir{ my $dir=shift; if (-d "$dir"){ opendir(DIR,$dir) || die $LNG{ERROR_CANT_OPEN_DIR}; my @files; while (my $file=readdir(DIR)){ next if ($file=~/^\.+$/); push (@files,$file); } closedir(DIR); foreach my $file(@files){ if(-d "$dir/$file"){ remove_dir("$dir/$file"); }else{ unlink("$dir/$file") || die "$LNG{ERROR_CANT_UNLINK_FILE} +$dir/$file"; } } } rmdir($dir); } sub create_backup{ my $name=shift; unless (-d $glbackupdir){ mkdir($glbackupdir,0777) || die "${ERROR_CANT_CREATE_DIR} $glb +ackupdir : $!"; } my @tables=map{"${PREF}$_"}@backup_tables; return if ($name=~/[^a-zA-Z0-9_-]/); my $dirstore="$glbackupdir/$name"; remove_dir($dirstore) if (-d $dirstore); mkdir($dirstore,0777) || die "${ERROR_CANT_CREATE_DIR} $dirstore : + $!"; my $path; if($ENV{PATH_TRANSLATED}){ $path="$ENV{PATH_TRANSLATED}"; }elsif($ENV{SCRIPT_FILENAME}){ $path="$ENV{SCRIPT_FILENAME}"; } my $delm; $delm='/' if $path=~/\//; $delm='\\' if $path=~/\\/; my @path=split(/\/|\\/,$path); $path=join($delm, @path[0..@path-2]); foreach $table(@tables){ my $filename="$path${delm}$glbackupdir${delm}$name${delm}$tabl +e.dmp"; open (FILE,">$filename") || die "$LNG{ERROR_CANT_OPEN_FILE} $f +ilename $LNG{ERROR_CANT_WRITE}"; my $sql="SHOW fields FROM $table"; my $out=$db->prepare($sql); $out->execute(); my @cols; while (my @output=@{$out->fetchrow_arrayref}){ push (@cols,$output[0]); } print FILE join("\t",@cols)."\n"; my $sql="SELECT * from $table"; my $out=$db->prepare($sql); $out->execute(); while (my %output=%{$out->fetchrow_hashref}){ @output=map{$db->quote($output{$_})}@cols; #map{s/\t/\\t/g}@output; print FILE join(", ",@output)."\n"; } close(FILE); } unless ($^O=~/win/i){ #Linux chdir($glbackupdir); `tar -cf $name.tar $name`; `gzip $name.tar`; chdir(".."); remove_dir("$glbackupdir/$name"); }else{ } } sub LoadTableFromFile{ my($table,$file)=@_; unless(open (FILE,$file)){ die ("$LNG{ERROR_CANT_OPEN_FILE} : $! "); return; } $db->do("DELETE FROM $table"); unless($file=~/attach/){ # local $/="\n"; my $cols=<FILE>; chomp($cols); my @cols=split(/\t/,$cols); $cols=join(", ",@cols); while (<FILE>){ chomp; $sql="INSERT INTO $table ($cols) VALUES ($_)"; $db->do($sql); } }else{ binmode(FILE); my $buff,$data; while (read(FILE,$buff,8*2**10)){ $data.=$buff; } my @lines=split(/\n/,$data); $data=""; $buff=""; my @cols=split(/\t/,shift(@lines)); foreach(@lines){ $sql="INSERT INTO $table ($cols) VALUES ($_)"; $db->do($sql); } } close(FILE); } sub print_settings_backup{ my $page = new hfparser( DATA=>$settings_shabl, ERROR_AFTER_INPUT=>0 ); my @tables=map{"${PREF}$_"}@backup_tables; if ($PAR{issubmit}=1){ if ($PAR{backup}){ if($PAR{filename}=~/[^a-zA-Z0-9_-]/){ $page->set_error('filename', $LNG{ERROR_FILENAME_INCOR +RECT}); } if(length($PAR{filename})<4){ $page->set_error('filename', $LNG{ERROR_SHORTER_THEN_3 +}); } unless ($page->is_error()){ create_backup($PAR{filename}); } } if ($PAR{'unlink'}){ my @files=$q->param("unlinkcheck"); foreach my $file(@files){ next if($file=~/[^a-zA-Z0-9_-]/); my $filename="$glbackupdir/$file"; remove_dir($filename) if (-d $filename); unless ($^O=~/win/i){ $filename=$filename.'.tar.gz'; unlink($filename) || die ("$LNG{ERROR_CANT_UNLINK_ +FILE} $filename $!"); } } } if ($PAR{'restore'}){ if($PAR{rest}){ chdir($glbackupdir); my $backup=$PAR{rest}; unless($^O=~/win/i){ `gunzip < $backup.tar.gz | tar xvf -` if (-f "$bac +kup.tar.gz"); unless (-d $backup){ $page->set_error('none',"Files was not unpacke +d from $backup.tar.gz"); } } foreach my $table(@tables){ $page->set_error($table, "The file $table.dmp is n +ot exist on backup directory $backup probably table prefix was change +d.") unless (-f "$backup/$table.dmp"); } unless ($page->is_error()){ $page->add_regesp("{error}",qq{<h1 class="mess">Da +tabase was restored from backup - $backup</h1>}); my $path; if($ENV{PATH_TRANSLATED}){ $path="$ENV{PATH_TRANSLATED}"; }elsif($ENV{SCRIPT_FILENAME}){ $path="$ENV{SCRIPT_FILENAME}"; } my $delm; $delm='/' if $path=~/\//; $delm='\\' if $path=~/\\/; my @path=split(/\/|\\/,$path); $path=join($delm, @path[0..@path-2]); #my $path=$ENV{SCRIPT_FILENAME}; #my @path=split(/\//,$path); #$path=join("\/", @path[0..@path-2]); foreach $table(@tables){ #next unless (-f "$backup/$table.dmp"); my $filename="$path${delm}$glbackupdir${delm}$ +backup${delm}$table.dmp"; LoadTableFromFile($table,$filename); } save_config(0,"adminpwd",$CONF{adminpwd}); unless ($^O=~/win/i){ remove_dir("$backup"); } } chdir('..'); } } } opendir(DIR,$glbackupdir); my @backups; while(my $file=readdir(DIR)){ next if ($file=~/^\.+$/); unless ($^O=~/win/i){ if ($file=~/(.*)\.tar\.gz/){ push(@backups,$1); } }else{ if (-d "$glbackupdir/$file"){ push(@backups,$file); } } } my $BACKUP=""; foreach my $name(@backups){ my $filename="$glbackupdir/$name"; $filename=$filename.'.tar.gz' unless ($^O=~/win/i); my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime +,$ctime,$blksize,$blocks)= stat $filename; my $time=localtime($ctime); if ($^O=~/win/i){ $size=get_dir_size("$glbackupdir/$name"); } $BACKUP.=<<ALL__; <tr class="data"> <td width="7%" align="center"><INPUT type="che +ckbox" name="unlinkcheck" value="$name"></td> <td width="30%" align="center">$name</td> <td width="6%" align="center"><INPUT type="rad +io" name="rest" value="$name"></td> <td width="24%" align="center"><NOBR>$time</NO +BR></td> <td width="33%" align="center">$size</td> </tr> ALL__ } $page->add_regesp('{BACKUP}',$BACKUP); $page->SplitData("#begin#backup","#end#backup"); $page->deleteBEFORE_AFTER(); unless($BACKUP){ $page->SplitData("<!--HIDE_START-->","<!--HIDE_END-->"); $page->replaceINSIDE(""); } #$page->add_regesp("{mess_hour}",sprintf("%4d",$PAR{messcount}/$sec*60 +*60)); $page->ParseData; return $page->as_string; } #############Backup ################ sub print_settings_test{ my $page = new hfparser( DATA=>$settings_shabl ); $page->add_regesp("{conf_mail}",$CONF{modsend}); if ($PAR{issubmit}){ unless($PAR{emailtest}){ $page->set_error("emailtest",$LNG{ERROR_REQUIRED}); }else{ unless(checkemail($PAR{emailtest})){ $page->set_error("emailtest",$LNG{ERROR_EMAIL_INCORREC +T}); } } unless($PAR{messcount}){ $page->set_error("messcount",$LNG{ERROR_REQUIRED}); }else{ if ($PAR{messcount}=~/[^0-9]/){ $page->set_error("messcount","digits only"); }elsif($PAR{messcount}>300){ $page->set_error("messcount","300 is maximum"); }elsif($PAR{messcount}<30){ $page->set_error("messcount","30 is minimum"); } } } if ($PAR{issubmit} && !$page->is_error()){ my $starttime=time(); my $DATA=<<ALL__; This is a performance test message. $ENV{SERVER_ADMIN} $ENV{HTTP_HOST} $ENV{REMOTE_ADDR} ALL__ $msg = new MIME::Lite From =>"$CONF{adminname} <$CONF{adminemail}>", To =>" <$PAR{emailtest}>", Subject =>"Performance test message", Data =>$DATA; foreach(1..$PAR{messcount}){ MIMEsendto($PAR{emailtest},$msg); } my $endtime=time(); my $sec=$endtime-$starttime; $sec=1 unless $sec; $page->SplitData("#begin#testresult","#end#testresult"); $page->deleteBEFORE_AFTER(); $page->add_regesp("{messcount}",$PAR{messcount}); $page->add_regesp("{emailtest}",$PAR{emailtest}); $page->add_regesp("{seconds}",$sec); $page->add_regesp("{mess_sec}",sprintf("%4d",$PAR{messcount}/$ +sec)); $page->add_regesp("{mess_min}",sprintf("%4d",$PAR{messcount}/$ +sec*60)); $page->add_regesp("{mess_hour}",sprintf("%4d",$PAR{messcount}/ +$sec*60*60)); $page->ParseData; return $page->as_string; }else{ $page->SplitData("#begin#test","#end#test"); $page->deleteBEFORE_AFTER(); $page->set_def("emailtest",$CONF{adminemail}); $page->set_input("messcount",{size=>3,maxlength=>3}); $page->set_def("messcount",50); $page->ParseData; return $page->as_string; } } ################ sub print_settings_log{ my $page = new hfparser( DATA=>$settings_shabl ); $page->SplitData("#begin#log","#end#log"); $page->deleteBEFORE_AFTER(); if ($PAR{issubmit}){ save_config(0,"enablelog",$PAR{enablelog}); if($PAR{cleanall}){ $db->do("DELETE FROM ${PREF}log"); &Error; } if($PAR{cleandate}){ my $WHERE="WHERE date BETWEEN ".$db->quote("$PAR{year1}-$P +AR{month1}-$PAR{day1}")." AND DATE_ADD(".$db->quote("$PAR{year2}-$PAR +{month2}-$PAR{day2}").", INTERVAL 1 DAY)"; $db->do("DELETE FROM ${PREF}log $WHERE"); &Error; } } #DATE my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtim +e($MY_TIME); $year+=1900;$mon++; foreach (1..31){ my $dd=sprintf("%02d",$_); $page->add_element("day1",$_,$dd); $page->add_element("day2",$_,$dd) } $page->set_def("day1",$mday); $page->set_def("day2",$mday); my @month=($LNG{MONTH_1},$LNG{MONTH_2},$LNG{MONTH_3},$LNG{MONTH_4} +,$LNG{MONTH_5},$LNG{MONTH_6},$LNG{MONTH_7},$LNG{MONTH_8},$LNG{MONTH_9 +},$LNG{MONTH_10},$LNG{MONTH_11},$LNG{MONTH_12}); foreach (1..12){ $page->add_element("month1",$_,$month[$_-1]);$page->add_elemen +t("month2",$_,$month[$_-1]); } $page->set_def("month1",$mon); $page->set_def("month2",$mon); foreach (2002..$year){ $page->add_element("year1",$_); $page->add_element("year2",$_); } $page->set_def("year1",$year); $page->set_def("year2",$year); #END DATE $page->set_def("enablelog",$CONF{enablelog}); my @WHERE=(); if ($PAR{issubmit}){ if ($PAR{usedate}){ push(@WHERE,"date BETWEEN ".$db->quote("$PAR{year1}-$PAR{m +onth1}-$PAR{day1}")." AND DATE_ADD(".$db->quote("$PAR{year2}-$PAR{mon +th2}-$PAR{day2}").", INTERVAL 1 DAY)"); } }else{ push(@WHERE,"date BETWEEN '$year-$mon-$mday' AND DATE_ADD('$ye +ar-$mon-$mday', INTERVAL 1 DAY)"); } my $WHERE=join(" AND ",@WHERE); $WHERE="WHERE ".$WHERE if $WHERE; my $logdata; my $sql="SELECT * FROM ${PREF}log $WHERE ORDER by pk_log ASC"; my $out=$db->prepare($sql); $out->execute(); &Error($sql); unless ($out->rows()){ $logdata.=<<ALL__; <tr class="data"> <td align="center" class="data" colspan=2><b>No logs + found</b></td> </tr> ALL__ } while (my %output=%{$out->fetchrow_hashref}){ $logdata.=<<ALL__; <tr class="data"> <td width="15%" align="right" class="data"><b><NOBR> +$output{date}</NOBR></b></td> <td width="54%" align="left">${\&sequre($output{log} +)}</td> </tr> ALL__ } $page->add_regesp('{allcountlog}',GetSQLCount("SELECT * FROM ${PRE +F}log")); $page->add_regesp('{logdata}',$logdata); $page->ParseData; return $page->as_string; } ################ sub print_settings{ my %map; %map=( "" =>\&print_settings_main, personal =>\&print_settings_personal, smtp =>\&print_settings_smtp, pass =>\&print_settings_pass, timecorr =>\&print_settings_timecorr, test =>\&print_settings_test, backup =>\&print_settings_backup ); $main_page=new dparser( DATA=>"$SHABL_DIR/main-settings.html" ); $main_page->add_regesp('{main_menu}',get_account_menu(\@SETTINGSME +NU)); my $func_ref; if ($map{$PAR{act2}}) { $func_ref=$map{$PAR{act2}}; }else{ $func_ref=sub{return $q->h1($LNG{INCORRECT_URL})} } $main_page->add_regesp('###TITLE###',$LNG{GLOBAL_SETTS}); $main_page->add_regesp('{body}',&$func_ref); $main_page->ParseData; &printheader; $main_page->print; } ################ ##STAT ############## sub print_stat_main{ my $page = new hfparser( DATA=>$settings_shabl ); $page->SplitData("#begin#main","#end#main"); $page->deleteBEFORE_AFTER(); $page->add_regesp('{main_menu_body}',get_full_menu(\@STATMENU)); $page->ParseData; return $page->as_string; } sub print_stat_curlog{ my $page = new hfparser( DATA=>$settings_shabl ); $page->SplitData("#begin#broadcastlog","#end#broadcastlog"); $page->deleteBEFORE_AFTER(); $page->add_regesp('{mess}',""); $page->add_regesp('{broadcast_file}',$BroadcastLogFile); $page->add_regesp('{count_rows}',GetSQLCount("SELECT * FROM ${PREF +}brodcastlog")); if($PAR{issubmit}){ if($PAR{save_broadcast_log}){ if(open(FILE,">>$BroadcastLogFile")){ unless ($^O=~/win/i){ unless(flock(FILE, LOCK_EX())){ $page->set_error("save_broadcast_log", "$LNG{E +RROR_CANT_LOCK_FILE} ".LOCK_EX()." $!\n"); close(FILE); }else{ print FILE "Broadcast logging starts at ".GetD +ate()."\n"; print FILE "TIME\tPROCESS NUMBER\tPID\tSTATUS +MESSAGE\n"; close(FILE); } }else{ print FILE "Broadcast logging starts at ".GetD +ate()."\n"; print FILE "TIME\tPROCESS NUMBER\tPID\tSTATUS +MESSAGE\n"; close(FILE); } }else{ $page->set_error("save_broadcast_log", "$LNG{ERROR_CAN +T_OPEN_FILE} $BroadcastLogFile $LNG{ERROR_CANT_WRITE} ($!) <BR> $LNG{ +ERROR_NEED_TO_CREATE} $BroadcastLogFile $LNG{ERROR_NEED_TO_CREATE2}") +; } } unless($page->is_error){ $page->add_regesp('{mess}',"<H1 class=mess>$LNG{MESS_SETTI +NGS_UPDATED}</H1>"); save_config(0,"save_broadcast_log",$PAR{save_broadcast_log +}); } } $page->set_def("save_broadcast_log",$CONF{save_broadcast_log}); + my $mess = ""; my $sql="SELECT DATE_FORMAT(date, '%Y-%b-%d %H:%i:%S' + ) as datelog, pid,log,procnomber FROM `${PREF}brodcastlog` ORDER by + `date` ASC"; my $out=$db->prepare($sql); $out->execute; &Error; unless($out->rows()){ $mess.=qq|<h1 class="mess"> $LNG{MESS_NO_BROADCAST_LOG}</h1>|; }else{ my $count=$out->rows(); $mess.=<<ALL__; <table border="0" align="center" width="70%" cellspacing="1" cellpaddi +ng="2"> <tr class="dataheader"> <td width="5%"><NOBR>$LNG{BROADCAST_LOG_PROC}</NOBR></td> <td width="10%"><NOBR>PID</NOBR></td> <td width="20%"><NOBR>$LNG{BROADCAST_LOG_TIME}</NOBR></td> <td width="65%"><NOBR>$LNG{BROADCAST_LOG_STATUS}</NOBR></td> </tr> ALL__ while (my $output=$out->fetchrow_hashref){ $output->{procnomber}="<B>$LNG{BROADCAST_LOG_MAIN}</B>" un +less $output->{procnomber}; $mess.=<<ALL__; <tr class="data"> <td width="5%" align=center>$output->{procnomber}</td> <td width="10%" align=center><B>$output->{pid}</B></td> <td width="20%"><NOBR>$output->{datelog}</NOBR></td> <td width="65%">$output->{log}</td> </tr> ALL__ } $mess.="</table>"; } $page->add_regesp('{broadcast_mess}',$mess); $page->ParseData; return $page->as_string; } sub set_leng{ my $out=<<ALL__; <table width="100%" border="0" cellspacing="0" cellpadding="0" height= +"80%"> <tr> <td valign="middle"> <form name="form1" method="POST" action="{ME}" target="_top"> {error}{fm_hidden_ses}{fm_hidden_act} <input type="hidden" name="issubmit" value="1"> <table width="50%" border="0" cellspacing="3" cellpadding="4" align= +"center"> <tr class="dataheader"> <td colspan="2"><b>[LNG_LANG_SELECT_LANG_TABHEADER]</b></td> </tr> <tr class="data"> <td width="48%" align="right" class="data"><b>[LNG_LANG_LANG]:</ +b></td> <td width="52%"><div align="left">{fm_select_langnow}</div></td> </tr> <tr class="data" align="center"> <td colspan="2"> <input type="submit" value="Save lang" class="BUTTONmy" name="su +bmit"> </td> </tr> </table> </form></td></tr></table> ALL__ if($PAR{issubmit} and $PAR{langnow}){ save_config(0,'langnow',$PAR{langnow}); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}"); exit; } my $page=new hfparser( IS_CRIPT=>0, SOURCE=>'string', DATA=>$out ); # my @files=<"shabl/lang/*.txt">; my $lang_dir='shabl/lang'; opendir(DIR,$lang_dir); my @backups; while(my $file=readdir(DIR)){ next unless $file=~/\.txt$/; $file=~s/\.txt$//; open(FILE,"$lang_dir/$file.txt"); my $fline=<FILE>; close(FILE); chomp($fline); my ($lang_name,$lengencod)=split(/\t/,$fline); $page->add_element('langnow',$file,"$lang_name ($lengencod)"); } closedir(DIR); $page->set_def('langnow',$CONF{langnow}); $page->ParseData; return $page->as_string; } ################# sub print_set_leng{ $main_page=new dparser( DATA=>"$SHABL_DIR/main-settings.html" ); $main_page->add_regesp('###TITLE###',$LNG{LANG_SELECT_LANG}); $main_page->add_regesp('{body}',set_leng()); $main_page->add_regesp('{main_menu}',""); $main_page->ParseData; &printheader; $main_page->print; } ################# sub print_stat{ my %map; %map=( "" =>\&print_stat_main, curlog =>\&print_stat_curlog, 'log' =>\&print_settings_log, total =>\&print_stat_total, ); $main_page=new dparser( DATA=>"$SHABL_DIR/main-settings.html" ); my $func_ref; if ($map{$PAR{act2}}) { $func_ref=$map{$PAR{act2}}; }else{ $func_ref=sub{return $q->h1($LNG{ERROR_NOT_CHANGE_URL})} } $main_page->add_regesp('###TITLE###',$LNG{STAT_STATISTICS}); $main_page->add_regesp('{body}',&$func_ref); $main_page->add_regesp('{main_menu}', get_hor_menu(\@STATMENU,{ses=>$PAR{ses},act=>$PAR{act}},[['men +u','menuACT'],['menu2','menu2ACT']]) ); $main_page->ParseData; &printheader; $main_page->print; } sub print_stat_account{ my $page=shift; $page->add_regesp('{log_header}',$LNG{STAT_TOTAL_PROSP}); $page->Hide("<!--HIDE_PERIOD-->"); my $sql="select * from ${PREF}account"; my $out=$db->prepare($sql); $out->execute(); my %accountname; while (my %output=%{$out->fetchrow_hashref}){ $accountname{$output{pk_account}}=$output{name}; } my $Total_act,$Total_inact; my $logdata.=<<ALL__; <table border="0" align="center" width="60%" cellspacing="1" cellpaddi +ng="2"> <tr class="dataheader"> <td >$LNG{STAT_ACCOUNT}</td> <td >$LNG{STAT_ACT_PROSP}</td> <td >$LNG{STAT_INACT_PROSP}</td> <td >$LNG{STAT_TOTAL}</td> </tr> ALL__ foreach my $account_id(sort {$accountname{$a} cmp $accountname{$b} +}keys %accountname){ my $total_activ = GetSQLCount("Select * from ${PREF}user WHE +RE fk_account=? AND isact=1",$account_id); my $total_inactiv = GetSQLCount("Select * from ${PREF}user WHE +RE fk_account=? AND isact<>1",$account_id); my $total=$total_activ+$total_inactiv; $Total_act+=$total_activ; $Total_inact+=$total_inactiv; $logdata.=<<ALL__; <tr class="data" align="right"> <td align="left"><a href="$SCRIPT_NAME?act=mainbody&account=$account_ +id&ses=$PAR{ses}">$accountname{$account_id}</a></td> <td >$total_activ</td> <td >$total_inactiv</td> <td >$total</td> </tr> ALL__ } my $tot=$Total_inact+$Total_act; $logdata.=<<ALL__; <tr class="data" align="right"> <td align="left"><b>$LNG{STAT_TOTAL}:</b></td> <td ><b>$Total_act</b></td> <td ><b>$Total_inact</b></td> <td ><b>$tot</b></td> </tr> </table> ALL__ $logdata.=get_gif_link(); $page->add_regesp('{logdata}',$logdata); $page->ParseData; return $page->as_string; } sub get_gif_link{ my $script=$SCRIPT_NAME; my @chars=('a'..'z','A'..'Z',0..9,'_'); my $ran=join("", @chars[map{rand @chars}(1..8)]); $script=~s/responder\.cgi/logpng.cgi/; $script.="?rn=$ran&".join("&",map{"$_=$PAR{$_}"}keys %PAR); return qq|<DIV align="center"><IMG src="$script" hspace="5" vspace +="5" alt="Diagram"></DIV>|; } sub print_stat_total{ my $page = new hfparser( DATA=>$settings_shabl ); $page->SplitData("#begin#total","#end#total"); $page->deleteBEFORE_AFTER(); if ($PAR{modelog} eq 'account'){ return print_stat_account($page); } #DATE my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtim +e($MY_TIME); $year+=1900;$mon++; $PAR{year1}=$year unless $PAR{year1}; $PAR{year2}=$year unless $PAR{year2}; $PAR{month1}=$mon unless $PAR{month1}; $PAR{month2}=$mon unless $PAR{month2}; $PAR{day1}=$mday unless $PAR{day1}; $PAR{day2}=$mday unless $PAR{day2}; foreach (1..31){ my $dd=sprintf("%02d",$_); $page->add_element("day1",$_,$dd); $page->add_element("day2",$_,$dd) } $page->set_def("day1",$PAR{day1}); $page->set_def("day2",$PAR{day2}); my @month=($LNG{MONTH_1},$LNG{MONTH_2},$LNG{MONTH_3},$LNG{MONTH_4} +,$LNG{MONTH_5},$LNG{MONTH_6},$LNG{MONTH_7},$LNG{MONTH_8},$LNG{MONTH_9 +},$LNG{MONTH_10},$LNG{MONTH_11},$LNG{MONTH_12}); foreach (1..12){ $page->add_element("month1",$_,$month[$_-1]);$page->add_elemen +t("month2",$_,$month[$_-1]); } $page->set_def("month1",$PAR{month1}); $page->set_def("month2",$PAR{month2}); foreach (2002..$year){ $page->add_element("year1",$_); $page->add_element("year2",$_); } $page->set_def("year1",$PAR{year1}); $page->set_def("year2",$PAR{year2}); #END DATE $page->set_def("enablelog",$CONF{enablelog}); my @WHERE=(); push @WHERE, "`date` >=".$db->quote("$PAR{year1}-$PAR{month1}-$PAR +{day1}"); push @WHERE, "`date` <=".$db->quote("$PAR{year2}-$PAR{month2}-$PAR +{day2}"); my $WHERE=join(" AND ",@WHERE); $WHERE="WHERE ".$WHERE if $WHERE; my $logdata; my $sql=<<ALL__; SELECT `name`,`pk_account` , SUM(`subscribers`) as subscribers , SUM(`unsubscribers`) as unsubscribers, SUM(`sent_manual`) as `sent_manual`, SUM(`sent_sheduled`) as `sent_sheduled`, SUM(`sent_sequential`) as `sent_sequential` , SUM(`sent_subscribe`) as `sent_subscribe`, SUM(`sent_unsubscribe`) as `sent_unsubscribe` , SUM(`sent_doubleoptin`) as `sent_doubleoptin` , SUM(`sent_manual`)+SUM(`sent_sheduled`)+SUM(`sent_sequential`)+SUM(`se +nt_subscribe`)+SUM(`sent_unsubscribe`) as total_sent, SUM(`subscribers`)-SUM(`unsubscribers`) as total_subscribers FROM `${PREF}stat_account_dayly` RIGHT JOIN ${PREF}account ON pk_account=fk_account $WHERE GROUP BY fk_account ALL__ unless($PAR{modelog}){ $sql.=" HAVING total_sent<>0 ORDER by total_sent DESC "; }else{ $sql.=" HAVING subscribers<>0 OR unsubscribers<>0 ORDER by total_subsc +ribers DESC"; } my $out=$db->prepare($sql); $out->execute(); &Error($sql); unless ($out->rows()){ $logdata.=<<ALL__; <H1 class=mess>$LNG{STAT_NO_LOGS_FOUND}</H1> ALL__ }else{ unless($PAR{modelog}){ $logdata.=<<ALL__; <table border="0" align="center" width="100%" cellspacing="1" cellpadd +ing="2"> <tr class="dataheader"> <td ><NOBR>$LNG{STAT_ACCOUNT}</NOBR></td> <td >$LNG{STAT_SEQUNTIAL}</td> <td >$LNG{STAT_SHEDULED}</td> <td >$LNG{STAT_MANUAL}</td> <td ><NOBR>$LNG{STAT_DOI}</NOBR></td> <td >$LNG{STAT_SUBSCRIBE}</td> <td >$LNG{STAT_UNSUBSCRIBE}</td> <td >$LNG{STAT_TOTAL}</td> </tr> ALL__ }else{ $logdata.=<<ALL__; <table border="0" align="center" width="50%" cellspacing="1" cellpaddi +ng="2"> <tr class="dataheader"> <td >$LNG{STAT_ACCOUNT}</td> <td >$LNG{STAT_SUBSCRIBERS}</td> <td >$LNG{STAT_UNSUBSCRIBERS}</td> <td >$LNG{STAT_TOTAL}</td> </tr> ALL__ } my %itog; while (my $output=$out->fetchrow_hashref){ map{$itog{$_}=$itog{$_}+$output->{$_} unless(/account|name +/)}keys %{$output}; unless($PAR{modelog}){ $logdata.=<<ALL__; <tr class="data" align="right"> <td align="left"><a href="$SCRIPT_NAME?act=mainbody&account=$output-> +{pk_account}&ses=$PAR{ses}">$output->{name}</a></td> <td >$output->{sent_sequential}</td> <td >$output->{sent_sheduled}</td> <td >$output->{sent_manual}</td> <td >$output->{sent_doubleoptin}</td> <td >$output->{sent_subscribe}</td> <td >$output->{sent_unsubscribe}</td> <td >$output->{total_sent}</td> </tr> ALL__ }else{ $logdata.=<<ALL__; <tr class="data" align="right"> <td align="left"><a href="$SCRIPT_NAME?act=mainbody&account=$output-> +{pk_account}&ses=$PAR{ses}">$output->{name}</a></td> <td >$output->{subscribers}</td> <td >$output->{unsubscribers}</td> <td >$output->{total_subscribers}</td> </tr> ALL__ } } unless($PAR{modelog}){ $logdata.=<<ALL__; <tr class="data" align="right"> <td align="left"><b>$LNG{STAT_TOTAL}</b></td> <td ><b>$itog{sent_sequential}</b></td> <td ><b>$itog{sent_sheduled}</b></td> <td ><b>$itog{sent_manual}</b></td> <td ><b>$itog{sent_doubleoptin}</b></td> <td ><b>$itog{sent_subscribe}</b></td> <td ><b>$itog{sent_unsubscribe}</b></td> <td ><b>$itog{total_sent}</b></td> </tr> </table> ALL__ }else{ $logdata.=<<ALL__; <tr class="data" align="right"> <td align="left"><b>$LNG{STAT_TOTAL}</b></td> <td ><b>$itog{subscribers}</b></td> <td ><b>$itog{unsubscribers}</b></td> <td ><b>$itog{total_subscribers}</b></td> </tr> </table> ALL__ } $logdata.=get_gif_link(); } my $header; my $m1=$month[$PAR{month1}-1]; my $m2=$month[$PAR{month2}-1]; my $period; if ($m1 eq $m2 && $PAR{day1} == $PAR{day2} && $PAR{year1}==$PAR{ye +ar2}){ $period = "$LNG{STAT_PERIOD_FOR} $PAR{day1} $m1 $PAR{year1}"; }else{ $period = "$LNG{STAT_PERIOD_FROM} $PAR{day1} $m1 $PAR{year1} $ +LNG{STAT_PERIOD_TILL} $PAR{day2} $m2 $PAR{year2}"; } unless($PAR{modelog}){ $header="$LNG{STAT_SENT_MESS_STAT} $period"; }else{ $header="$LNG{STAT_SUBSCRIBERS_STAT} $period"; } $page->add_regesp('{log_header}',"$header"); $page->add_regesp('{logdata}',$logdata); $page->ParseData; return $page->as_string; } ################# ################# ##ACCOUNT ################# ################# #USERS ################# sub print_user_form{ local @FIELDS; @FIELDS=load_account_fields($PAR{account}); my $page = new hfparser( DATA=>$main_shabl, FROM=>'#begin#user_form',TO=>'#end#user_form' ); if ($PAR{issubmit}){ #SET ERROR $page->set_error("email",$LNG{ERROR_EMAIL_INCORRECT}) unless c +heckemail($PAR{email}); $page->set_error("email","$LNG{TXT_EMAIL_ADDRESS} <B>$PAR{ +email}</b> $LNG{ERROR_IS_ALREADY_EXISTS}") if GetSQLCount("SELECT * from ${PREF}user where fk_account=? + AND email=? AND pk_user<>?",$PAR{account},$PAR{email},$PAR{reckey}); if($PAR{fk_affiliate}){ $page->set_error("fk_affiliate", $LNG{PROSPECT_NOT_FOUND}) + unless GetSQLCount("SELECT * FROM ${PREF}user WHERE pk_user=? and fk +_account=?",$PAR{fk_affiliate},$PAR{account}); } unless($page->is_error){ if($CONF{useblacklist}){ $page->set_error("email",$CONF{blacklist_error}) if Ge +tSQLCount("SELECT * FROM ${PREF}bounce_banemails WHERE email=?",$PAR{ +email}); } } if(length($PAR{fromemail})){ $page->set_error('fromemail',$LNG{ERROR_EMAIL_INCORRECT}) +unless checkemail($PAR{fromemail}); } map{ if(length($PAR{$_})){ unless($PAR{$_}=~/\d\d\d\d-\d\d-\d\d/){ $page->set_error("$_",$LNG{ERROR_INCORRECT}) } } }qw(datereg datelastsend); unless($page->is_error){ my $last; my $datelastsend; if($PAR{datelastsend}=~/\d\d\d\d-\d\d-\d\d/){ $datelastsend=$PAR{datelastsend}; } my ($days,$messlastsend); if($PAR{sequence}==-1){ #sequense disabled $days=-1; $messlastsend=0; }elsif($PAR{sequence}==0){ #sequense started $days=0; $messlastsend=0; }else{ $messlastsend=$PAR{sequence}; map{$days=$_->{days} if ($_->{pk_mess}==$PAR{sequence} +)}LoadAccountSequence($PAR{account}); } unless($PAR{reckey}){ #$last=GetLastInsert("${PREF}user"); #$db->do("INSERT INTO ${PREF}user (fk_account,name,ema +il,days,datereg) VALUES (?,?,?,?,$NOW)",undef,$PAR{account},$PAR{name +},$PAR{email},$days); my $params={ messageformat=>$PAR{messageformat}, fk_account=>$PAR{account}, name=>$PAR{name}, email=>$PAR{email}, days=>$days, datelastsend=>$datelastsend, messlastsend=>$messlastsend, fk_affiliate=>$PAR{fk_affiliate}, fromname=>$PAR{fromname}, fromemail=>$PAR{fromemail}, datereg=>$PAR{datereg} }; $last=insert_db("${PREF}user",$params,{datereg=>"$NOW" +}); &Error; }else{ #update user update_db("${PREF}user",{datereg=>$PAR{datereg},fromna +me=>$PAR{fromname},fromemail=>$PAR{fromemail},fk_affiliate=>$PAR{fk_a +ffiliate},datelastsend=>$datelastsend,messlastsend=>$messlastsend,mes +sageformat=>$PAR{messageformat},fk_account=>$PAR{account},name =>$PAR +{name},email=>$PAR{email},days=>$days},{pk_user=>$PAR{reckey}}); $last=$PAR{reckey}; } foreach(@FIELDS){ my $param="dp".$_->{key}; save_user_parametr($_->{key},$last,$PAR{$param}); } if (length($PAR{referer}) and $PAR{referer}=~/^http:\/\/.+ +$SCRIPT_NAME/){ print $q->redirect($PAR{referer}); }else{ print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PA +R{act}&act2=$PAR{act2}&account=$PAR{account}"); } exit(1); } } #set defaults if ($PAR{reckey}){ $page->add_regesp('{mode}', $LNG{TXT_MODE_EDIT}); $val=select_one_db("SELECT * from ${PREF}user WHERE pk_user=? +and fk_account=?",$PAR{reckey},$PAR{account}) || die $LNG{ERROR_USER_NOT_FOUND}; $page->set_def('email',$val->{email}); $page->set_def('name',$val->{name}); $page->set_def('messageformat',$val->{messageformat}); $page->set_def('datelastsend',$val->{datelastsend}); $page->set_def('fk_affiliate',$val->{fk_affiliate}); $page->set_def('fromname',$val->{fromname}); $page->set_def('fromemail',$val->{fromemail}); $page->set_def('datereg',$val->{datereg}); if($val->{fk_affiliate}){ my $aff=select_one_db("SELECT * from ${PREF}user WHERE pk_ +user=? and fk_account=?",$val->{fk_affiliate},$PAR{account}); $page->add_regesp('{AFFINFO}',"<BR>$LNG{CURRENT_AFFILIATE_ +EMAIL} $aff->{email} \n<BR>$LNG{CURRENT_AFFILIATE_NAME} $aff->{name}" +); }else{ $page->add_regesp('{AFFINFO}',""); } if($val->{days}==-1){ $page->set_def('sequence',-1); }elsif($val->{messlastsend}){ $page->set_def('sequence',$val->{messlastsend}); }else{ $page->set_def('sequence',0); } foreach (@FIELDS){ $page->set_def('dp'.$_->{key},get_user_parametr($_->{key}, +$PAR{reckey})); } }else{ $page->add_regesp("{CHECKED_yes_seq}",' CHECKED '); $page->set_def('days',0); $page->add_regesp('{mode}', $LNG{TXT_MODE_NEW}); } my $add; foreach (@FIELDS){ $add.=<<ALL__; <TR class="data"> <td align="right"><b>$_->{name}:</b></td> <TD>{fm_$_->{type}_dp$_->{key}}</TD></TR> ALL__ } #return join("<BR>",map{"<B>$_</B> = $ENV{$_}"}sort keys %ENV); $page->set_def("referer", $ENV{HTTP_REFERER}); add_menu_prospects($page); $page->add_element("sequence",0,$LNG{SEQUENCE_STATUS_STARTED}); my @seq=LoadAccountSequence($PAR{account}); my $i=0; map{ $i++; $page->add_element("sequence",$_->{pk_mess},"$LNG{USR_SENT_MES +SAGE} ".$i." of ".scalar(@seq)." ($LNG{SEQUENCE_DAY_SMALL} $_->{days} +) $LNG{SEQUENCE_WAS_SENT}") unless ($i eq scalar(@seq)); $page->add_element("sequence",$_->{pk_mess},uc($LNG{USR_BROWSE +R_FINISHED}) ." $LNG{USR_SENT_MESSAGE} ".$i." of ".scalar(@seq)." ($L +NG{SEQUENCE_DAY_SMALL} $_->{days}) $LNG{SEQUENCE_WAS_SENT}") if ($i e +q scalar(@seq)); }@seq; $page->add_element("sequence",-1,$LNG{SEQUENCE_STATUS_DISABLED}); $page->add_element('messageformat','0',$LNG{USR_BROWSER_DEFAULT_FO +RMAT}); $page->add_element('messageformat','1',$LNG{USR_BROWSER_TEXT_USER_ +FORMAT}); $page->add_element('messageformat','2',$LNG{USR_BROWSER_HTML_USER_ +FORMAT}); $page->add_regesp("{LOGMESS}",&GetUserMessLog($PAR{reckey})); $page->ChangeData('{additional_fields}',$add); $page->set_default_input("text","size",35); $page->set_default_input("textarea","rows",4); $page->set_default_input("textarea","columns",35); $page->set_input("days",{size=>3,maxlength=>3}); $page->ParseData; return $page->as_string; } ############# sub GetUserMessLog{ my $user=shift; return unless ($user); my $data=""; #return unless $CONF{messlogging}; my $sql="SELECT * FROM ${PREF}senthistory WHERE fk_user=? ORDER BY + date ASC"; my $out=$db->prepare($sql); $out->execute($user); &Error($sql); return unless ($out->rows()); my $rows=$out->rows; $data.=<<ALL__; <h2>$LNG{USR_SENT_MESS}: $rows $LNG{USR_SENT_RECORDS_IN_LOGS}</h2> <table width="70%" border="0" cellspacing="3" cellpadding="4" align="c +enter"> <tr class="dataheader"> <td width="5%"> </td> <td width="70%"> $LNG{USR_SENT_MESSAGE} </td> <td width="25%"> $LNG{USR_SENT_DATE} </td> </tr> ALL__ my $i; while (my %output=%{$out->fetchrow_hashref}){ $i++; my $mess=select_one_db("SELECT * FROM ${PREF}mess WHERE pk_mes +s=?",$output{fk_mess}); my $subj=sequre($mess->{subject}); $data.=<<ALL__; <tr class="data"> <td width="5%">$i</td> <td width="70%">$subj</td> <td width="25%"><NOBR>$output{date}</NOBR></td> </tr> ALL__ } $data.=<<ALL__; </TABLE> ALL__ return $data; } sub print_select_fields{ if($PAR{issubmit}){ my @params=$q->param('selectedlist'); my $level_changed=""; $level_changed="mode=selectfields&" if($CONF{affiliate_level} +ne $PAR{affiliate_level}); save_config($PAR{account},"REPORT_SHOW_FIELDS",join("\t",@para +ms)); save_config($PAR{account},"affiliate_level","$PAR{affiliate_le +vel}"); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&${level_changed +}account=$PAR{account}&act=$PAR{act}&act2=$PAR{act2}"); exit; } my $page=new hfparser ( DATA=>$main_shabl, FROM=>'#begin#reportselectfields',TO=>'#end#reportselectfields +', ERROR_AFTER_INPUT=>0, ); my $info=GetAllAccountFields($PAR{account},$CONF{affiliate_level}| +|0,$CONF{REPORT_SHOW_FIELDS}); my $avalible_fields="\n"; my $selected_fields="\n"; map{ my $descr=$info->{names}->{$_}; $avalible_fields.=qq|\t<OPTION value="$_">$descr</OPTION>\n|; }@{$info->{avalible_fields}}; $page->add_regesp('{avalible_list_options}',$avalible_fields); map{$page->add_element('affiliate_level',$_)}(0..10); $page->set_def('affiliate_level',$CONF{affiliate_level}); map{ my $descr=$info->{names}->{$_}; $selected_fields.=qq|\t<OPTION value="$_">$descr</OPTION>\n|; }@{$info->{selected_fields}}; $page->add_regesp('{selected_list_options}',$selected_fields); $page->ParseData; return $page->as_string; } sub GetOrderLink{ my $field=shift; my $direction=$PAR{direction}; if($PAR{orderfield} eq $field){ if($PAR{direction} eq 'asc'){ $direction="desc" }else{ $direction="asc" } }else{ $direction="asc" } $q->param('direction',$direction); $q->param('orderfield',$field); my $url=$q->url(-absolute=>1,-query=>1); if($PAR{direction}){ $q->param('direction',$PAR{direction}); }else{ $q->delete('direction'); } if($PAR{orderfield}){ $q->param('orderfield',$PAR{orderfield}); }else{ $q->delete('orderfield'); } return $url; } sub print_users_report{ if($PAR{mode} eq 'selectfields'){ return print_select_fields(); } if($PAR{bnAction}){ my @USERS=$q->param('sel'); if(@USERS){ my $IN="(". join(',',map{$db->quote($_)}@USERS).")"; if($PAR{action} eq 'remove'){ map{DeleteUser($_)}@USERS; }elsif($PAR{action} eq 'activate'){ $db->do("UPDATE ${PREF}user set isact =1 WHERE pk_user + IN$IN"); }elsif($PAR{action} eq 'deactivate'){ $db->do("UPDATE ${PREF}user set isact =0 WHERE pk_user + IN$IN"); }elsif($PAR{action} eq 'restart_sequence'){ $db->do("UPDATE ${PREF}user set days =0, datelastsend= +NULL, messlastsend=NULL WHERE pk_user IN$IN"); }elsif($PAR{action} eq 'deactivate_sequence'){ $db->do("UPDATE ${PREF}user set days =-1, datelastsend +=NULL, messlastsend=NULL WHERE pk_user IN$IN"); } } print $q->redirect($ENV{HTTP_REFERER}) if($ENV{HTTP_REFERER}=~ +/account=/); print $q->redirect("$SCRIPT_NAME?ses=$PAR{ses}&act=$PAR{act}&a +ct2=$PAR{act2}&act3=$PAR{act3}&account=$PAR{account}") unless ($ENV{H +TTP_REFERER}=~/account=/); exit; } if($PAR{actsingle}){ $db->do("UPDATE ${PREF}user SET isact=1 WHERE pk_user=?",undef +,$PAR{actsingle}); $q->delete('actsingle'); print $q->redirect($q->url(-absolute=>1,-query=>1)); exit; } if($PAR{inactsingle}){ $db->do("UPDATE ${PREF}user SET isact=0 WHERE pk_user=?",undef +,$PAR{inactsingle}); $q->delete('inactsingle'); print $q->redirect($q->url(-absolute=>1,-query=>1)); exit; } if($PAR{removesingle}){ DeleteUser($PAR{removesingle}); $q->delete('removesingle'); print $q->redirect($q->url(-absolute=>1,-query=>1)); exit; } ...
In reply to Trouble with Autoresponder Perl Script by autoresponder
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |