damfer21 has asked for the wisdom of the Perl Monks concerning the following question:

I tried to add a parameter to the following code and it does not work. If you see the "$last240_flag" in the code, that one is the one that doesn't work. The others do as expected. Is there somewhere that I can find the definitions of the "_flag"? I am extremely new at this, and my admin retired so I cannot get any help. Apologies if this is a silly question. 

 

# ********************************************************************
+*********************
# camp_schedule.cgi
#

# ********************************************************************
+*********************

# include Perl Modules

use strict;
use CGI;
use empire;

# get some objects to use later

my $pms = empire->new;
my $query = CGI->new;
my $sth;
my $sth2;
my $sql;
my $dbh;
my $campaign_id = $query->param('campaign_id');
my $list_id;
my $status;
my $cname;
my $schedule_date;
my $shour;
my $smin;
my $max_emails;
my $old_mid;
my $old_dname;
my $clast60;
my $openflag;
my $aolflag;
my $yahoo_flag;
my $yahoo_only_flag;
my $yahoo_no_flag;
my $yes_flag;
my $no_flag;
my $seven_flag;
my $last90_flag;
my $last120_flag;
my $last240_flag;
my $yes_open_flag;
my $no_open_flag;
my $aol_yes_flag;
my $aol_no_flag;
my $both_flag;
my $light_table_bg = $pms->get_light_table_bg;
my $images = $pms->get_images_url;
my $list_members = 1;
my $counter;

# connect to the pms database

$pms->db_connect();
$dbh = $pms->get_dbh;

# check for login

my $user_id = empire::check_security();
if ($user_id == 0)
{
    print "Location: notloggedin.cgi\n\n";
    $pms->clean_up();
    exit(0);
}

# make sure this campaign has some valid member list or lists assigned
+ to it before 
# allowing the user to schedule it to be sent.

$sql = "select list_id from campaign_list where campaign_id = $campaig
+n_id";
$sth = $dbh->prepare($sql);
$sth->execute();
while (($list_id) = $sth->fetchrow_array())
{
    $sql = "select member_cnt from list where list_id = $list_id and s
+tatus = 'A'";
    $sth2 = $dbh->prepare($sql);
    $sth2->execute();
    ($counter) = $sth2->fetchrow_array();
    $sth2->finish();

    $list_members = $list_members + $counter;
}
$sth->finish();

if ($list_members == 0)
{
    empire::logerror("Error, the campaign you selected does not have a
+ny email member lists <br>
                    assigned to it.  You must assign at least one emai
+l list that contains <br>
                    some active members to this campaign before it can
+ be scheduled.");
    $pms->clean_up();
    exit(0);
}    

# print out the html page

my $cdate;
$sql = "select now()";
$sth = $dbh->prepare($sql);
$sth->execute();
($cdate)=$sth->fetchrow_array();
$sth->finish();
empire::header("Campaign Schedule");

$sql = "select status,curdate(),max_emails,last60_flag,aol_flag,open_f
+lag,yahoo_flag,hour(schedule_time),minute(schedule_time),mid,redirect
+_domain,campaign_name from campaign where campaign_id=$campaign_id"; 
$sth = $dbh->prepare($sql);
$sth->execute();
($status,$schedule_date,$max_emails,$clast60,$aolflag,$openflag,$yahoo
+_flag,$shour,$smin,$old_mid,$old_dname,$cname) = $sth->fetchrow_array
+();
print << "end_of_html";
</TD>
</TR>
<TR>
<TD vAlign=top align=left bgColor=#999999>

    <TABLE cellSpacing=0 cellPadding=10 bgColor=#999999 border=0 width
+="100%">
    <TBODY>
    <TR>
    <TD vAlign=top align=left bgColor=#ffffff colSpan=10><!-- doing ct
+-table-open -->

        <TABLE cellSpacing=0 cellPadding=0 width=660 bgColor=#ffffff b
+order=0>
        <TBODY>
        <TR>
            <TD vAlign=center align=left><font face="verdana,arial,hel
+vetica,sans serif" 
                color="#509C10" size="3"><b>Schedule Your Campaign</b>
+</font></TD>
        </TR>
        <TR>
        <TD><IMG height=3 src="$images/spacer.gif"></TD>
        </TR>
        </TBODY>
        </TABLE>

        <TABLE cellSpacing=0 cellPadding=0 width=660 bgColor=#ffffff b
+order=0>
        <TBODY>
        <TR>
        <TD><FONT face="verdana,arial,helvetica,sans serif" color=#509
+C10 size=2>
            Set your Campaign status to either Draft or Scheduled. You
+r Campaign
            will remain in Draft mode until you move it to Scheduled. 
+If you schedule your 
            Campaign, it will be sent on the date specified beginning 
+around midnight.
            If you schedule your Campaign for today, it will begin goi
+ng out
            in the next 5 minutes.<BR></FONT></TD>
        </TR>
        <TR>
        <TD><IMG height=5 src="$images/spacer.gif"></TD>
        </TR>
        </TBODY>
        </TABLE>

        <FORM action="camp_copy_schedule_save.cgi" method=post name="b
+date">
        <INPUT type=hidden name="campaign_id" value="$campaign_id">

        <TABLE cellSpacing=0 cellPadding=0 width=760 bgColor=#ffffff b
+order=0>
        <TBODY>
        <TR>
        <TD>

            <TABLE cellSpacing=0 cellPadding=5 width="100%" border=0>
            <TBODY>
            <TR>
            <TD align=middle>

                <TABLE cellSpacing=0 cellPadding=0 width=500 bgColor=$
+light_table_bg border=0>
                <TBODY>
                <TR align=top bgColor=#509C10 height=18>
                <TD vAlign=top align=left height=15><IMG src="$images/
+blue_tl.gif" border=0 
                    width="7" height="7"></TD>
                <TD height=15><IMG height=1 src="$images/spacer.gif" w
+idth=3 border=0></TD>
                <TD align=middle height=15>

                    <TABLE cellSpacing=0 cellPadding=0 width="100%" bo
+rder=0>
                    <TBODY>
                    <TR bgColor=#509C10 height=15>
                    <TD align=middle width="100%" height=15>
                        <FONT face=Verdana,Arial,Helvetica,sans-serif 
+color=white size=2>
                        <B>Campaign Status</B>&nbsp;&nbsp;Current Date
+time: $cdate </FONT> </TD>
                    </TR>
                    </TBODY>
                    </TABLE>

                </TD>
                <TD height=15><IMG height=1 src="$images/spacer.gif" w
+idth=3 border=0></TD>
                <TD vAlign=top align=right bgColor=#509C10 height=15>
                    <IMG src="$images/blue_tr.gif" border=0 width="7" 
+height="7"></TD>
                </TR>
                <TR bgColor=$light_table_bg>
                <TD colSpan=5><IMG height=3 src="$images/spacer.gif" w
+idth=1 border=0></TD>
                </TR>
                <TR bgColor=$light_table_bg>
                <TD><IMG height=3 src="$images/spacer.gif" width=3></T
+D>
                <TD align=middle><IMG height=3 src="$images/spacer.gif
+" width=3></TD>
                <TD align=middle>

                    <TABLE cellSpacing=0 cellPadding=0 width="100%" bo
+rder=0>
                    <TBODY>
                    <TR>
                    <TD align=middle><IMG height=3 src="$images/spacer
+.gif" width=3></TD>
                    </TR>
                    <tr>
                    <TD vAlign=center align=left><FONT face="verdana,a
+rial,helvetica,sans serif" color=#509C10 size=2>New Campaign Name:
                        <input type=text name=cname value="$cname" siz
+e=50></font></td>
                    </tr>    
                    <TR>
                    <TD vAlign=center align=left><FONT face="verdana,a
+rial,helvetica,sans serif" 
                        color=#509C10 size=2>
end_of_html

# get schedule information for this campaign

if ($old_dname eq "")
{
    $old_dname="NONE";
}

if ($status eq "D")
{
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localti
+me();
    $year = $year + 1900;
    $mon = $mon + 1;
    if ($mon < 10)
    {
        $mon = "0$mon";
    }
    if ($mday < 10)
    {
        $mday = "0$mday";
    }
    $schedule_date = "$mon/$mday/$year";
print<<"end_of_html";
<script language="JavaScript1.2" src="/CalendarPopup.js"></script>
    <SCRIPT LANGUAGE="JavaScript">
    var cal = new CalendarPopup();
    </SCRIPT>
end_of_html
    print qq {
        <INPUT style="BACKGROUND: $light_table_bg" type=radio CHECKED 
+name=schedule 
        value=D>Draft<BR>
        <INPUT style="BACKGROUND: $light_table_bg" type=radio name=sch
+edule 
        value=S>Scheduled for
        <INPUT type="text" name="sdate" size="10" value="$schedule_dat
+e">\n };
    print qq {
         <A HREF="#" onClick="cal.select(document.forms['bdate'].sdate
+,'anchor1','MM/dd/yyyy'); return false;" NAME="anchor1" ID="anchor1">
+<img src="/images/calendar_Icon.jpg" border=0 width="27" height="25">
+</A> };
}
else
{
    $schedule_date = substr($schedule_date,5,2) . "/" . substr($schedu
+le_date,8,2) . 
        "/" . substr($schedule_date,0,4);

    print qq { 
        <INPUT style="BACKGROUND: $light_table_bg" type=radio name=sch
+edule value=D>Draft<BR>
        <INPUT style="BACKGROUND: $light_table_bg" type=radio CHECKED 
+name=schedule 
        value="$status">Scheduled for
        <INPUT type="text" name="sdate" size="10" value="$schedule_dat
+e"> \n };
    print qq {
         <A HREF="#" onClick="cal.select(document.forms['bdate'].sdate
+,'anchor1','MM/dd/yyyy'); return false;" NAME="anchor1" ID="anchor1">
+<img src="/images/calendar_Icon.jpg" border=0 width="27" height="25">
+</A> };
}
$sth->finish();
my $i=0;
print "&nbsp;&nbsp;Hour: <select name=shour>\n";
while ($i < 24)
{
    if ($i == $shour)
    {
        print "<option selected value=$i>$i</option>";
    }
    else
    {
        print "<option value=$i>$i</option>";
    }
    $i++;
}
print "</select>";
my $i=0;
print "&nbsp;&nbsp;Minute: <select name=smin>\n";
while ($i < 60)
{
    if ($i == $smin)
    {
        print "<option selected value=$i>$i</option>";
    }
    else
    {
        print "<option value=$i>$i</option>";
    }
    $i++;
}
print "</select>";

if ($clast60 eq "Y")
{
    $yes_flag="checked";
    $no_flag = "";
    $seven_flag = "";
    $last90_flag = "";
    $last120_flag = "";
    $last240_flag = "";
}
elsif ($clast60 eq "7")
{
    $no_flag="";
    $yes_flag = "";
    $seven_flag = "checked";
    $last90_flag = "";
    $last120_flag = "";
    $last240_flag = "";
}
elsif ($clast60 eq "9")
{
    $no_flag="";
    $yes_flag = "";
    $seven_flag = "";
    $last90_flag = "checked";
    $last120_flag = "";
    $last240_flag = "";
}
elsif ($clast60 eq "2")
{
    $no_flag="";
    $yes_flag = "";
    $seven_flag = "";
    $last90_flag = "";
    $last120_flag = "checked";
    $last240_flag = "";
}
elsif ($clast60 eq "4")
{
    $no_flag="";
    $yes_flag = "";
    $seven_flag = "";
    $last90_flag = "";
    $last120_flag = "";
    $last240_flag = "checked";";

[download]

Replies are listed 'Best First'.
Re: Object Identifier?
by LanX (Saint) on Oct 21, 2018 at 23:17 UTC
    > doesn't work

    Doesn't work!

    Please tell us about the errors you get.

    Your code is incomplete, the last elsif isn't properly closed.

    This is definitely a syntax error

    $last240_flag = "checked";";
                          ^^

    [download]

    Please have a look at SSCCE and Basic debugging checklist

    > and my admin retired so I cannot get any help

    And maybe think about hiring a new admin.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

[reply]
[d/l]

      Thanks for the reply. I only inserted part of the code to show where the addition was among its similar elements. Every other $lastflag works. This code was written and worked for a decade. I just wanted to add the new flag. I'd hire a new admin if I had the money. I am doing what I can to keep things going at this point, hence the plea for help here. I would just like to know why my additional elseif for $last240_flag does not work. The error I get is that it selects all recipients instead of ones that have been active for last 240 days. All the other last flags perform correctly.

      Read more... (27 kB)
[reply]
[d/l]
        You write:
        The error I get is that it selects all recipients instead of ones that have been active for last 240 days. All the other last flags perform correctly.

        I am pretty sure that there's more to this application than the script you've shown us. You seem to have added a radio button for the clast60 field with a value of 4 and a meaning of Last 240 Days in the script which offers the selection. But this is not the script doing the database query: There is no place in this code where you actually use that parameter. So I guess that you need also to make this new value known to your other script camp_copy_schedule_save.cgi. If that script has the same programming style, then a newly added value of "4" might end up in the final else branch of some if/elsif/else abomination - and treat it as if the clast60 has not been provided at all.

        Good luck! You'll need it.

[reply]
Re: Object Identifier? (red flags, more subs)
by Anonymous Monk on Oct 22, 2018 at 00:41 UTC

    I tried to add a parameter to the following code and it does not work.

    Thats because that code is unorganized and full of "Red flags".

    Organize your code, box up everything into subroutines (Every loop, every heredoc template, every giant if/else block).

    This is a "Red flag" localtime ... $year + 1900, . Time::Piece and DateTime is what you want to use for date stamps/math, none of this +1900 stuff.

    You would benefit heavily from reading "Red flag" as it was written exactly for you. Almost every example is one you have posted here.

    Subroutines should take arguments not work on globals. You shouldn't mix who prints from where....

    This is something like what your program should end up looking like 

    Main( @ARGV );
exit( 0 );
sub Main {
    my $pms = empire->new;
    my $query = CGI->new;
    my( $header, $body ) = Dispatch( $pms, $query );
    print $header, $body;
}
sub Dispatch {
    my( $pms, $q ) = @_;
    if( $pms->authenticate( $q ) ){
        my $page = $q->page || 'default';
        return ThisPage( $pms, $q  ) if $page eq 'thisone';
        return ThatPage( $pms, $q  ) if $page eq 'thatone';
        return DefaultPage( $pms, $q );
    } else {
        return UnauthorizedPage( $pqms, $q );
    }
}
sub UnauthorizedPage {
    my( $pms, $q ) = @_;
    return RedirectTo($q, 'notloggedin.cgi');
}
sub RedirectTo {
    my( $q , $page ) = @_;
    my $header = $q->redirect( UrlFor( $page ) );
    my $body = '';
    return $header, $body;
}
sub UrlFor {
    my( $name ) = @_;
    return $name; 
}
sub DefaultPage {
    my( $pms, $q ) = @_;
    my $members  = $pms->list_members;
    my $schedule = $pms->campaign_schedule;
    return $q->header, CampaignMembersHtml( $pms, $q, $members, $sched
+ule );
}
sub CampaignMembersHtml {
    my( $pms, $q, $members, $schedule ) = @_;
    my $html = MembersHtml( $q, $members );
    $html   .= ScheduleHtml( $q, $schedule );
    return $html;
}
sub MembersHtml {
    ...;
}
sub ScheduleHtml {
    my( $q, $schedule ) =@_;
    my (
        $status,
        $schedule_date,
        $max_emails,
        $clast60,
        $aolflag,
        $openflag,
        $yaho­o_flag,
        $shour,
        $smin,
        $old_mid,
        $old_dname,
        $cname,
    ) = @$schedule;
    ...;
    return $html;
}
sub Empire::authenticate {
    my( $pms, $query ) = @_;
    my $user = $query->param('user');
    my $pass = $query->param('pass');
    return !! $pms->check_security( $user, $pass )
}
sub Empire::list_members {
    my( $pms, $q ) = @_;
    ...
    my $members = $dbh->selectall_arrayref($sql);
    ...
    return $members;
}
sub Empire::campaign_schedule {
    my( $pms, $q ) = @_;
    ...
    my $schedule = $dbh->selectall_arrayref($sql);
    ...
    return $schedule;
}

    [download]
[reply]
[d/l]
[select]

      Thanks for the reply and help. I didn't write the code. I only added in $last240_flag. Every other last_flag works as intended.

      I don't know the first thing about Perl, just enough about general code to get myself in trouble. I posted the complete code in the reply above. If you have any other recommendations, I would appreciate the help.

[reply]

        Hi damfer21,

        On first sight I don't see anything wrong with your modification. I just wonder if you also changed the file camp_copy_schedule_save.cgi? I mean, that is where the form action leads to. So I suspect you need to modify that file as well.

        Veltro

[reply]
Re: Object Identifier?
by Anonymous Monk on Oct 22, 2018 at 21:56 UTC
    Slightly change 2 lines to make your code more secure: 
    
OLD:
$sql = "select list_id from campaign_list where campaign_id = $campaig
+n_id";

NEW:
$sql = "select list_id from campaign_list where campaign_id = ?";

OLD:
$sth->execute();

NEW:
$sth->execute($campaign_id);

    [download]
    Because $campaign_id comes from the user it is very dangerous to use in a database query unless it is properly handled and placeholders (the ? thingy) does that for you.
[reply]
[d/l]

      Awesome. Thanks.

      Any idea how to make the $last240_flag work like the others?

[reply]
[d/l]
        I think you need to follow this advice from haj and edit camp_copy_schedule_save.cgi to receive the new value you added.
[reply]
Re: Object Identifier?
by Anonymous Monk on Oct 22, 2018 at 22:50 UTC
    Perlmonks is not a code writing service.

    If you don't want to learn Perl or SQL, pay someone who does.

[reply]

      I am not asking for someone to write code for me. I am sorry if it came across that way. I have spent days getting this far and only reached out for help when I finally hit a wall I couldn't get through.

      I wouldn't know secure code from insecure code if my life depended on it. I've been using this database/client for ten years and the admin/coder just retired out of nowhere. I don't generally go looking for help but I saw no other option.

      I am trying to do this by myself because I don't have much to pay, but would gladly pay for services if I even knew what exactly to look for. With people already saying my script/site could get hacked, I don't feel so confident about handing it all over to a stranger.

      I help others in a totally different forum for writing, and I see plenty of people wanting everything done for them. I am happy to help, and I get your point about soliciting free work. I wasn't trying to do that.

[reply]
        ... I don't have much to pay ...

        If you don't know Perl, can't afford to hire someone who does, and can't find a source of unlimited free support, you're in a pickle. I wish I had something constructive to offer, but as you've discovered, the extent of the free support that is available, e.g., PerlMonks, has its limits. Pray for a benefactor.

        ... I don't feel so confident about handing it all over to a stranger.

        You should realize that by operating an insecure site, "handing it all over to a stranger," possibly a very scary one, is exactly what may happen at any moment. Make thorough, secure backups. Often.

        Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]

Back to Seekers of Perl Wisdom