2021-08-24 17:43:29 +00:00
#!/usr/bin/perl
use DBI ;
use CGI qw( :cgi ) ;
use feature qw( switch ) ;
no warnings qw( experimental::smartmatch ) ;
##############################################################################
# #
2021-08-29 10:06:08 +00:00
# configuration options are kept in a separate file #
2021-08-24 17:43:29 +00:00
# #
##############################################################################
2021-08-27 17:04:05 +00:00
do "./f20-budget.config.pl" ;
2021-08-24 17:43:29 +00:00
##############################################################################
# #
# main CGI loop #
# #
##############################################################################
$ CGI:: DISABLE_UPLOADS = 0 ;
$ CGI:: POST_MAX = '10000000' ;
$ q = new CGI ;
$ action = $ q - > param ( "action" ) ;
$ password = $ q - > param ( 'password' ) ;
$ askpassword = $ q - > param ( 'askpassword' ) ;
$ delete_id = $ q - > param ( "delete_id" ) ;
$ edit_id = $ q - > param ( "edit_id" ) ;
$ budget_id = $ q - > param ( "budget_id" ) ;
$ agent_id = $ q - > param ( "agent_id" ) ;
$ edit_agent_id = $ q - > param ( "edit_agent_id" ) ;
$ new_auto_name = $ q - > param ( 'new_auto_name' ) ;
$ new_auto_name =~ s/\'/\'\'/g ;
$ new_auto_location = $ q - > param ( 'new_auto_location' ) ;
$ new_auto_location =~ s/\'/\'\'/g ;
$ new_auto_remarks = $ q - > param ( 'new_auto_remarks' ) ;
$ new_auto_remarks =~ s/\'/\'\'/g ;
$ new_auto_url = $ q - > param ( 'new_auto_url' ) ;
$ new_auto_url =~ s/\'/\'\'/g ;
$ new_name = $ q - > param ( 'new_name' ) ;
$ new_name =~ s/\'/\'\'/g ;
$ new_codename = $ q - > param ( 'new_codename' ) ;
$ new_codename =~ s/\'/\'\'/g ;
$ new_pseudo = $ q - > param ( 'new_pseudo' ) ;
$ new_pseudo =~ s/\'/\'\'/g ;
$ new_firstname = $ q - > param ( 'new_firstname' ) ;
$ new_firstname =~ s/\'/\'\'/g ;
$ new_lastname = $ q - > param ( 'new_lastname' ) ;
$ new_lastname =~ s/\'/\'\'/g ;
$ new_lastname = $ q - > param ( 'new_lastname' ) ;
$ new_fullname =~ s/\'/\'\'/g ;
$ new_fullname = $ q - > param ( 'new_fullname' ) ;
$ new_agent = $ q - > param ( 'new_agent' ) ;
$ new_location = $ q - > param ( 'new_location' ) ;
$ new_location =~ s/\'/\'\'/g ;
$ new_remarks = $ q - > param ( 'new_remarks' ) ;
$ new_remarks =~ s/\'/\'\'/g ;
$ new_url = $ q - > param ( 'new_url' ) ;
$ new_url =~ s/\'/\'\'/g ;
$ new_amount = $ q - > param ( 'new_amount' ) ;
$ new_amount = sprintf "%.2f" , $ new_amount ; ## 2 decimal places
$ new_url = $ q - > param ( "new_url" ) ;
#$new_url=~ s/http\:\/\///g; # don't remove http://
2021-08-29 11:44:32 +00:00
$ new_item = sanitise ( $ q - > param ( "new_item" ) ) ;
$ new_labour = sanitise ( $ q - > param ( "new_labour" ) ) ;
$ new_resource = sanitise ( $ q - > param ( "new_resource" ) ) ;
$ new_status = sanitise ( $ q - > param ( "new_status" ) ) ;
$ new_lstatus = sanitise ( $ q - > param ( "new_lstatus" ) ) ;
$ new_rstatus = sanitise ( $ q - > param ( "new_rstatus" ) ) ;
$ type = sanitise ( $ q - > param ( "type" ) ) ;
2021-08-24 17:43:29 +00:00
for ( $ i = 0 ; $ i <= 50 ; $ i += 1 ) {
2021-08-29 11:44:32 +00:00
$ new_status { $ i } = sanitise ( $ q - > param ( "new_status$i" ) ) ;
$ type { $ i } = sanitise ( $ q - > param ( "type$i" ) ) ;
$ new_item { $ i } = sanitise ( $ q - > param ( "new_item$i" ) ) ;
$ new_resource { $ i } = sanitise ( $ q - > param ( "new_resource$i" ) ) ;
$ new_labour { $ i } = sanitise ( $ q - > param ( "new_labour$i" ) ) ;
$ new_status { $ i } = sanitise ( $ q - > param ( "new_status$i" ) ) ;
$ new_lstatus { $ i } = sanitise ( $ q - > param ( "new_lstatus$i" ) ) ;
$ new_rstatus { $ i } = sanitise ( $ q - > param ( "new_rstatus$i" ) ) ;
$ new_firstname { $ i } = sanitise ( $ q - > param ( "new_firstname$i" ) ) ;
$ new_lastname { $ i } = sanitise ( $ q - > param ( "new_lastname$i" ) ) ;
$ new_codename { $ i } = sanitise ( $ q - > param ( "new_codename$i" ) ) ;
2021-08-26 16:37:00 +00:00
$ cost { $ i } =~ s/\€/@euro/g ;
$ cost { $ i } = $ q - > param ( "cost$i" ) ;
$ new_cost { $ i } =~ s/\€/@euro/g ;
$ new_cost { $ i } = $ q - > param ( "new_cost$i" ) ;
$ currency { $ i } = $ q - > param ( "currency$i" ) ;
2021-08-24 17:43:29 +00:00
}
( $ second , $ minute , $ hour , $ currentdayofmonth , $ month , $ year , $ weekday , $ dayofyear , $ IsDST ) = localtime ( time ) ;
$ currentmonth = $ month + 1 ;
$ currentyear = $ year + '1900' ;
$ new_day = $ q - > param ( "'new_day" ) ;
$ new_month = $ q - > param ( "new_month" ) ;
$ new_year = $ q - > param ( "new_year" ) ;
$ new_date = $ q - > param ( 'new_year' ) . $ q - > param ( "new_month" ) . $ q - > param ( "new_day" ) ;
$ new_start_date = $ q - > param ( 'new_start_year' ) . $ q - > param ( "new_start_month" ) . $ q - > param ( "new_start_day" ) ;
$ new_end_date = $ q - > param ( 'new_end_year' ) . $ q - > param ( "new_end_month" ) . $ q - > param ( "new_end_day" ) ;
$ new_print_date = $ q - > param ( 'new_print_year' ) . $ q - > param ( "new_print_month" ) . $ q - > param ( "new_print_day" ) ;
$ new_deliver_day = $ q - > param ( "new_deliver_day" ) ;
$ new_deliver_date = $ q - > param ( 'new_deliver_year' ) . $ q - > param ( "new_deliver_month" ) . $ q - > param ( "new_deliver_day" ) ;
if ( $ new_name eq '' ) {
2021-08-26 16:37:00 +00:00
$ new_name = $ new_auto_name ;
2021-08-24 17:43:29 +00:00
}
if ( $ new_location eq '' ) {
2021-08-26 16:37:00 +00:00
$ new_location = $ new_auto_location ;
2021-08-24 17:43:29 +00:00
}
if ( $ new_remarks eq '' ) {
2021-08-26 16:37:00 +00:00
$ new_remarks = $ new_auto_remarks ;
2021-08-24 17:43:29 +00:00
}
if ( $ new_url eq '' ) {
2021-08-26 16:37:00 +00:00
$ new_remarks = $ new_auto_url ;
2021-08-24 17:43:29 +00:00
}
given ( $ action ) {
2021-08-26 16:37:00 +00:00
when ( 'select_budget' ) { & select_budget ; }
when ( 'add_form' ) { & add_form ; }
when ( 'add_budget' ) { & add_budget ; }
when ( 'add_budget_information' ) { & add_budget_information ; }
when ( 'prepare_agents' ) { & prepare_agents ; }
when ( 'input_agents' ) { & input_agents ; }
when ( 'edit_agent' ) { & edit_agent ; }
when ( 'update_agent' ) { & update_agent ; }
when ( 'edit_form' ) { & edit_form ; }
when ( 'edit_select_form' ) { & edit_select_form ; }
when ( 'edit_budget' ) { & edit_budget ; }
when ( 'list_budgets' ) { & list_budgets ; }
when ( 'prepare_budget' ) { & prepare_budget ; }
when ( 'prepare_money' ) { & prepare_money ; }
when ( 'input_budget' ) { & input_budget ; }
when ( 'input_money' ) { & input_money ; }
when ( 'prepare_expenditure' ) { & prepare_expenditure ; }
when ( 'input_expenditure' ) { & input_expenditure ; }
when ( 'compile_budget' ) { & compile_budget ; }
when ( 'display_budgets' ) { & display_budgets ; }
when ( 'present_budget' ) { & present_budget ; }
when ( 'delete_form' ) { & delete_form ; }
when ( 'delete_budget' ) { & delete_budget ; }
when ( 'select_budget' ) { & select_budget ; }
when ( 'upload_image' ) { & upload_image ; }
#default {&display_budgets; }
default {
& select_budget ;
}
2021-08-24 17:43:29 +00:00
}
exit ;
2021-08-29 11:44:32 +00:00
# saniti[sz]e parameters and sql inputs as needed
2021-08-26 16:37:00 +00:00
sub sanitise {
my $ string = shift ;
2021-08-29 11:44:32 +00:00
$ string =~ s/\'/\'\'/g ; # convert ' to ''
$ string =~ s/\x92/’/g ; # convert "RIGHT SINGLE QUOTATION MARK" to html
2021-08-26 16:37:00 +00:00
return $ string ;
}
2021-08-24 17:43:29 +00:00
##############################################################################
# #
# select budget #
# #
##############################################################################
sub select_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT DISTINCT name from budgets ORDER BY id DESC ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql2 = qq( SELECT DISTINCT firstname, lastname from agents ORDER BY firstname ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print << END ;
2021-08-24 17:43:29 +00:00
<center>
< table width = "700" cellspacing = "20" cellpadding = "0" bgcolor = "#cccccc" >
<tr> <td> < table width = "700" cellspacing = "5" cellpadding = "2" bgcolor = "#ffffff" border = "0" >
<tr> < td class = "lge" align = "center" bgcolor = "#fff000" colspan = "5" > < font color = "#000000" >
<b> feral budget generator: enter agent </b> </td> </tr>
<tr> < td height = "20" > & nbsp ; </td> </tr>
<tr> < td colspan = "1" > budget: </td>
< FORM ACTION = "$script_name" METHOD = "GET" >
< input type = "hidden" name = "action" value = "prepare_budget" >
END
2021-08-26 16:37:00 +00:00
## name budget
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <td height="10" colspan="2"><select name="new_name"> ) ) ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( $ record - > { name } eq 'f20' ) {
print ( qq( <option>$record->{name}</option>\n ) ) ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( </select></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## enter agent code
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print << END ;
2021-08-24 17:43:29 +00:00
<tr> < td colspan = "1" > enter your agent codename: </td>
< FORM ACTION = "$script_name" METHOD = "GET" >
< td colspan = "3" >
< input type = "text" name = "new_codename" value = "" size = "5" maxsize = "5" >
</td> </tr>
<tr> < td colspan = "2" >
< INPUT TYPE = "submit" VALUE = "ENTER" > </td> </tr>
</td> </tr>
</FORM>
</td> </tr> </table> </table>
END
2021-08-26 16:37:00 +00:00
& print_footer ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
##############################################################################
# #
# prepare budget #
# #
##############################################################################
sub prepare_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT * from budgets WHERE name="$new_name" ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## identify agent by codename
my $ sql2 = qq( SELECT * from agents where codename ="$new_codename" ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( my $ record2 = $ sth2 - > fetchrow_hashref ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql3 = qq( SELECT * from finance LEFT JOIN agents ON finance.agent_id=agents.id WHERE finance.budget_id='$record->{id}' AND finance.agent_id ='$record2->{id}' ) ;
my $ sth3 = $ dbh - > prepare ( $ sql3 ) ;
$ sth3 - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
print << END ;
2021-08-24 17:43:29 +00:00
<center>
< table width = "1000" cellspacing = "20" cellpadding = "0" bgcolor = "#ffffff" >
<tr> <td> < table width = "900" cellspacing = "1" cellpadding = "2" bgcolor = "#ffffff" border = "0" >
<tr> < td class = "lge" align = "center" bgcolor = "#fff000" colspan = "5" > < font color = "#000000" > <b> feral budget generator </b> </td> </tr>
<tr> < td height = "10" class = "medbig" colspan = "5" > <b> Instructions </td> </tr>
<tr> < td height = "10" class = "" colspan = "2" > < td align = "center" valign = "top" > <BR>
< img src = "$feral_logo" > </td>
<td> < table width = "500" border = "0" <tr> < td class = "serif" >
Enter your budget requests & amp ; contributions . You can return to edit your entries at any time . <BR> <BR> </td> </tr> </table>
<tr> < table width = "1000" cellspacing = "5" cellpadding = "2" bgcolor = "#ffffff" border = "0" > < td colspan = "1" > budget name: </td>
< FORM ACTION = "$script_name" METHOD = "GET" >
< input type = "hidden" name = "action" value = "input_budget" >
< input type = "hidden" name = "budget_id" value = "$record->{id}" >
< input type = "hidden" name = "agent_id" value = "$record2->{id}" >
< input type = "hidden" name = "new_codename" value = "$new_codename" >
< td height = "10" colspan = "2" class = "medbig" >
<b> $ record - > { name } </b> </td> <tr>
<tr> < td colspan = "1" > your name: </td>
< td height = "10" colspan = "3" class = "medbig" >
$ record2 - > { firstname } $ record2 - > { lastname }
</td> </tr>
<tr> < td colspan = "1" class = "medbig" >
<b> request money </b> </td> < td colspan = "3" >
your monetary requests from the f20 budget ( all sums in & euro ; ) </td> </tr>
</td> </tr>
<tr> <td>
END
2021-08-26 16:37:00 +00:00
my $ sql4 = qq( SELECT * from expenditure where budget_id='$record->{id}' AND agent_id ='$record2->{id}' ) ;
my $ sth4 = $ dbh - > prepare ( $ sql4 ) ;
$ sth4 - > execute ;
for ( $ i = 1 ; $ i <= 5 ; $ i + + ) {
while ( my $ record4 = $ sth4 - > fetchrow_hashref ) {
print << END ;
<tr> < td colspan = "2" > $ i . $ currency
< input type = "text" name = "new_cost$i" value = "$record4->{cost}" size = "2" maxsize = "5" >
</td>
<td> < select name = "type$i" >
END
@ cats = ( 'select category' , 'fee' , 'materials' , 'misc' ) ;
foreach $ cat ( @ cats ) {
print ( qq( <option ) ) ;
if ( $ cat eq $ record4 - > { type } ) {
print ( qq( selected ) ) ;
}
print ( qq( >$cat</option> ) ) ;
}
print ( qq( </select></td> ) ) ;
print ( qq( <td colspan="3">item <input type="text" name="new_item$i" value="$record4->{item}" size="70" maxsize="100"></td></tr> ) ) ;
$ i + +
}
if ( $ i <= 5 ) {
print << END ;
<tr> < td colspan = "2" > $ i . & euro ;
< input type = "text" name = "new_cost$i" size = "2" maxsize = "5" > </td>
<td> < select name = "type$i" >
END
@ cats = ( 'select category' , 'fee' , 'materials' , 'misc' ) ;
foreach $ cat ( @ cats ) {
print ( qq( <option ) ) ;
if ( $ cat eq $ record4 - > { type } ) {
print ( qq( selected ) ) ;
}
print ( qq( >$cat</option> ) ) ;
}
print ( qq( </select></td> ) ) ;
print ( qq( <td colspan="3">item <input type="text" name="new_item$i" value="$record4->{item}" size="70" maxsize="100"></td></tr> ) ) ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( </td></tr></table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><table width="950" cellspacing="1" cellpadding="2" bgcolor="#ffffff" border="0"><td colspan="1"></td> ) ) ;
print ( qq( <tr><td colspan="1" class="medbig"><b>input money</b></td><td colspan="8">your monetary contribution to the budget ( direct payments for materials/services, donations to f20, as a sum total ) </td></tr> ) ) ;
print ( qq( <tr><td colspan="1">€<input type ="text" name="new_amount" ) ) ;
while ( my $ record3 = $ sth3 - > fetchrow_hashref ) {
print ( qq( value="$record3->{amount}" ) ) ;
}
print ( qq( size="3" maxsize="5"></td></tr>\n ) ) ;
## resources section !!! read-in notworking !!!
print ( qq( <tr><td colspan="8" height="20"> </td></tr>\n ) ) ;
print ( qq( <tr><td colspan="1" class="medbig"><b>input labour</b></td><td colspan="8">things you commit to doing, non-remunerated. ( check the box if this labour has already been deployed ) </td></tr> ) ) ;
my $ sql5 = qq( SELECT * from nonfinance where budget_id=$record->{id} AND agent_id =$record2->{id} AND kind='labour' ) ;
my $ sth5 = $ dbh - > prepare ( $ sql5 ) ;
$ sth5 - > execute ;
for ( $ i = 1 ; $ i <= 8 ; $ i + + ) {
while ( my $ record5 = $ sth5 - > fetchrow_hashref ) {
print ( qq( <tr><td colspan="1"><b>$i.</b></td>\n ) ) ;
print ( qq( <td><input type="checkbox" NAME="new_lstatus$i" VALUE="delivered" ) ) ;
if ( $ record5 - > { status } eq 'delivered' ) {
print ( qq( CHECKED ) ) ;
}
;
print ( qq( ></td>\n ) ) ;
print ( qq( <td colspan="3"><input type="text" name="new_labour$i" value="$record5->{item}" size="100" maxsize="200"></td></tr>\n ) ) ;
$ i + +
}
if ( $ i <= 5 ) {
print ( qq( <tr><td colspan="1"><b>$i.</b></td>\n ) ) ;
print ( qq( <td><input type="checkbox" NAME="new_lstatus$i" VALUE="delivered" ) ) ;
if ( $ record5 - > { status } eq 'delivered' ) {
print ( qq( CHECKED ) ) ;
}
;
print ( qq( ></td>\n ) ) ;
print ( qq( <td colspan="3"><input type="text" name="new_labour$i" size="100" maxsize="200"></td></tr>\n ) ) ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td colspan="8" height="20"> </td></tr>\n ) ) ;
print ( qq( <tr><td colspan="1" class="medbig"><b>input resources</b></td><td colspan="8">materials, spaces, tools, previous work etc ( check the box if your resource has already been deployed ) </td></tr> ) ) ;
my $ sql5 = qq( SELECT * from nonfinance where budget_id=$record->{id} AND agent_id =$record2->{id} AND kind='resources' ) ;
my $ sth5 = $ dbh - > prepare ( $ sql5 ) ;
$ sth5 - > execute ;
for ( $ i = 1 ; $ i <= 8 ; $ i + + ) {
while ( my $ record5 = $ sth5 - > fetchrow_hashref ) {
print ( qq( <tr><td colspan="1"><b>$i.</b></td>\n ) ) ;
print ( qq( <td><input type="checkbox" NAME="new_rstatus$i" VALUE="delivered" ) ) ;
if ( $ record5 - > { status } eq 'delivered' ) {
print ( qq( CHECKED ) ) ;
}
;
print ( qq( ></td>\n ) ) ;
print ( qq( <td colspan="3"><input type="text" name="new_resource$i" value="$record5->{item}" size="100" maxsize="200"></td></tr>\n ) ) ;
$ i + +
}
if ( $ i <= 5 ) {
print ( qq( <tr><td colspan="1"><b>$i.</b></td>\n ) ) ;
print ( qq( <td><input type="checkbox" NAME="new_rstatus$i" VALUE="delivered" ) ) ;
if ( $ record5 - > { status } eq 'delivered' ) {
print ( qq( CHECKED ) ) ;
}
print ( qq( ></td>\n ) ) ;
print ( qq( <td colspan="3"><input type="text" name="new_resource$i" size="100" maxsize="200"></td></tr>\n ) ) ;
}
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td colspan="1"></td><td colspan="1"></td><td colspan="1"><INPUT TYPE="submit" VALUE="SUBMIT"></td></tr>\n ) ) ;
print ( qq( </td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( <tr><td height="10"></td></tr>\n ) ) ;
print ( qq( <tr><td colspan="5"></td><td colspan="3" class="serif_sm">Notes:</td></tr>\n ) ) ;
print ( qq( </td></tr></table></table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
} else {
& print_header ;
print ( qq( codename not recognised. please retry\n ) ) ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
& print_footer ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
##############################################################################
# #
# input budget: input individual budet items - money & resources #
# #
##############################################################################
sub input_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="20" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><<table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
## delete expenditure line for agent + budget, if exists
my $ sqld = qq( DELETE from expenditure where budget_id="$budget_id" AND agent_id="$agent_id" ) ;
my $ sthd = $ dbh - > prepare ( $ sqld ) ;
$ sthd - > execute ;
## input new expenditure lines for agent
for ( $ i = 1 ; $ i <= 8 ; $ i + + ) {
if ( $ new_item { $ i } ne '' ) {
my $ sql = ( qq{ INSERT INTO expenditure (budget_id, agent_id, status, type, item, cost, currency) VALUES ($budget_id, $agent_id, '$new_status { $i } ', '$type { $i } ', '$new_item { $i } ', $new_cost { $i } , '€') } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
## read in finance for agent
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT * from finance LEFT JOIN agents ON finance.agent_id=agents.id
2021-08-24 17:43:29 +00:00
LEFT JOIN budgets ON finance . budget_id = budgets . id WHERE finance . budget_id = "$budget_id" AND finance . agent_id = "$agent_id" ) ;
2021-08-26 16:37:00 +00:00
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
#while (my $record = $sth->fetchrow_hashref) {
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator: $record->{name}</b></td></tr>\n ) ) ;
## delete finance line for agent + budget, if exists
my $ sqld = qq( DELETE from finance where budget_id="$budget_id" AND agent_id="$agent_id" ) ;
my $ sthd = $ dbh - > prepare ( $ sqld ) ;
$ sthd - > execute ;
## input money into finance
# if ($new_amount ne '') {
if ( $ new_amount eq '' ) {
$ new_amount = 0 ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
my $ sqli = ( qq{ INSERT INTO finance (budget_id, agent_id, amount) VALUES ($budget_id, $agent_id, $new_amount) } ) ;
my $ sthi = $ dbh - > prepare ( $ sqli ) ;
$ sthi - > execute ;
my $ sqld = qq( DELETE from nonfinance where budget_id="$budget_id" AND agent_id="$agent_id" ) ;
my $ sthd = $ dbh - > prepare ( $ sqld ) ;
$ sthd - > execute ;
## input labour into nonfinance for agent
for ( $ i = 1 ; $ i <= 8 ; $ i + + ) {
if ( $ new_labour { $ i } ne '' ) {
my $ sqll = ( qq{ INSERT INTO nonfinance (budget_id, agent_id, item, kind, status) VALUES ($budget_id, $agent_id, "$new_labour { $i } ", "labour", "$new_lstatus { $i } ") } ) ;
my $ sthl = $ dbh - > prepare ( $ sqll ) ;
$ sthl - > execute ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
## input resources into nonfinance for agent
for ( $ i = 1 ; $ i <= 8 ; $ i + + ) {
if ( $ new_resource { $ i } ne '' ) {
my $ sqlr = ( qq{ INSERT INTO nonfinance (budget_id, agent_id, item, kind, status) VALUES ($budget_id, $agent_id, "$new_resource { $i } ", "resources", "$new_rstatus { $i } ") } ) ;
my $ sthr = $ dbh - > prepare ( $ sqlr ) ;
$ sthr - > execute ;
}
}
## read back in to get these values from the db, not from the cgi
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqlv = ( qq{ SELECT DISTINCT item, cost, expenditure.currency, type, fullname from expenditure RIGHT JOIN agents on expenditure.agent_id=agents.id LEFT JOIN finance on expenditure.agent_id=finance.agent_id
2021-08-24 17:43:29 +00:00
WHERE expenditure . agent_id = $ agent_id AND expenditure . budget_id = $ budget_id } ) ;
2021-08-26 16:37:00 +00:00
my $ sthv = $ dbh - > prepare ( $ sqlv ) ;
$ sthv - > execute ;
my $ sqln = ( qq{ SELECT fullname from agents where id=$agent_id } ) ;
my $ sthn = $ dbh - > prepare ( $ sqln ) ;
$ sthn - > execute ;
while ( my $ recordn = $ sthn - > fetchrow_hashref ) {
print ( qq( <tr><td colspan="1" width="" height="10"class="medbig">$projectname: <b>$recordn->{fullname}</b></td></tr> ) ) ;
}
# print(qq(<tr><td colspan="4"><b>your PROPOSITION:</b> ));
while ( my $ recordv = $ sthv - > fetchrow_hashref ) {
if ( $ recordv - > { item } ne '' ) {
print ( qq( <tr><td>$recordv->{$currency} $recordv->{$cost} $recordv->{$item} $recordv->{$type}</td></tr>\n ) ) ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td></td></tr>\n ) ) ;
print ( qq( <tr><td></td></tr>\n ) ) ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="prepare_budget">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="new_agent" value="$record->{fullname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <tr><td colspan="1"><INPUT TYPE="submit" VALUE="return to edit your contribution"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="compile_budget">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="new_agent" value="$record->{fullname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <tr><td colspan="1"><INPUT TYPE="submit" VALUE="go to view the budget as a whole"></td></tr>\n ) ) ;
print ( qq( </td></tr></table>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
}
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# input money
sub input_money {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="20" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## read in finance for agent+ budget
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT * from finance LEFT JOIN agents ON finance.agent_id=agents.id
2021-08-24 17:43:29 +00:00
LEFT JOIN budgets ON finance . budget_id = budgets . id WHERE finance . budget_id = "$budget_id" AND finance . agent_id = "$agent_id" ) ;
2021-08-26 16:37:00 +00:00
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( $ record - > { id } ne '' ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## delete finance line for agent + budget, if exists
my $ sqld = qq( DELETE from finance where budget_id="$budget_id" AND agent_id="$agent_id" ) ;
my $ sthd = $ dbh - > prepare ( $ sqld ) ;
$ sthd - > execute ;
}
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## input money into finance
if ( $ new_amount eq '' ) {
$ new_amount = 0 ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
my $ sqli = ( qq{ INSERT INTO finance (budget_id, agent_id, amount) VALUES ($budget_id, $agent_id, $new_amount) } ) ;
my $ sthi = $ dbh - > prepare ( $ sqli ) ;
$ sthi - > execute ;
#}
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator: $record->{name}</b></td></tr>\n ) ) ;
print ( qq( <tr><td colspan="1" width="">your name:</td> ) ) ;
print ( qq( <td height="10" colspan="3" class="medbig">$new_fullname</td></tr>\n ) ) ;
print ( qq( </td></tr>\n ) ) ;
print ( qq( <tr><td colspan="1">your monetary contribution:</td> ) ) ;
print ( qq( <td height="10" colspan="3" class="medbig">€$new_amount</td></tr>\n ) ) ;
print ( qq( </td></tr>\n ) ) ;
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="compile_budget">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="new_agent" value="$record->{fullname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <tr><td colspan="1"><INPUT TYPE="submit" VALUE="go to view the budget as a whole"></td></tr>\n ) ) ;
print ( qq( </td></tr></table>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
& print_footer ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 17:17:58 +00:00
##############################################################################
# #
# compile budget: lay out the whole budget as it assembles #
# #
##############################################################################
2021-08-24 17:43:29 +00:00
sub compile_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqld = qq(
SELECT * FROM nonfinance
LEFT JOIN agents ON nonfinance . agent_id = agents . id
LEFT JOIN budgets ON nonfinance . budget_id = budgets . id
LEFT JOIN locations ON locations . structure = budgets . location
WHERE nonfinance . budget_id = $ budget_id
AND nonfinance . status = 'delivered'
ORDER BY nonfinance . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthd = $ dbh - > prepare ( $ sqld ) ;
$ sthd - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqlol = qq(
SELECT * FROM nonfinance
LEFT JOIN agents on nonfinance . agent_id = agents . id
LEFT JOIN budgets ON nonfinance . budget_id = budgets . id
LEFT JOIN locations ON locations . structure = budgets . location
WHERE nonfinance . budget_id = $ budget_id
AND nonfinance . status != 'delivered'
AND kind = 'labour'
ORDER BY nonfinance . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthol = $ dbh - > prepare ( $ sqlol ) ;
$ sthol - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqlor = qq(
SELECT * FROM nonfinance
LEFT JOIN agents on nonfinance . agent_id = agents . id
LEFT JOIN budgets ON nonfinance . budget_id = budgets . id
LEFT JOIN locations ON locations . structure = budgets . location
WHERE nonfinance . budget_id = $ budget_id
AND nonfinance . status != 'delivered'
AND kind = 'resources'
ORDER BY nonfinance . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthor = $ dbh - > prepare ( $ sqlor ) ;
$ sthor - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqldl = qq(
SELECT * FROM nonfinance
LEFT JOIN agents on nonfinance . agent_id = agents . id
LEFT JOIN budgets ON nonfinance . budget_id = budgets . id
LEFT JOIN locations ON locations . structure = budgets . location
WHERE nonfinance . budget_id = $ budget_id
AND nonfinance . status = 'delivered'
AND kind = 'labour'
ORDER BY nonfinance . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthdl = $ dbh - > prepare ( $ sqldl ) ;
$ sthdl - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqldr = qq(
SELECT * FROM nonfinance
LEFT JOIN agents on nonfinance . agent_id = agents . id
LEFT JOIN budgets ON nonfinance . budget_id = budgets . id
LEFT JOIN locations ON locations . structure = budgets . location
WHERE nonfinance . budget_id = $ budget_id
AND nonfinance . status = 'delivered'
AND kind = 'resources'
ORDER BY nonfinance . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthdr = $ dbh - > prepare ( $ sqldr ) ;
$ sthdr - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## count potential deposits
2021-08-29 10:06:08 +00:00
my $ sqla = qq(
SELECT COUNT ( fullname ) AS qty FROM agents
WHERE budget_id = $ budget_id
AND status != 'staff' ) ;
2021-08-26 16:37:00 +00:00
my $ stha = $ dbh - > prepare ( $ sqla ) ;
$ stha - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
## count deposits received
2021-08-29 10:06:08 +00:00
my $ sqlar = qq(
SELECT COUNT ( fullname ) AS qty FROM agents
WHERE budget_id = $ budget_id
AND status = 'deposit' ) ;
2021-08-26 16:37:00 +00:00
my $ sthar = $ dbh - > prepare ( $ sqlar ) ;
$ sthar - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqlc = qq(
SELECT COUNT ( * ) FROM nonfinance
LEFT JOIN agents on nonfinance . agent_id = agent . id
LEFT JOIN budgets ON nonfinance . budget_id = budgets . id
LEFT JOIN locations ON locations . structure = budgets . location
WHERE nonfinance . budget_id = $ budget_id ) ;
2021-08-26 16:37:00 +00:00
my $ sthc = $ dbh - > prepare ( $ sqlc ) ;
$ sthc - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqlf = qq(
SELECT * FROM finance WHERE budget_id = $ budget_id
ORDER by amount ) ;
2021-08-26 16:37:00 +00:00
my $ sthf = $ dbh - > prepare ( $ sqlf ) ;
$ sthf - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqlb = qq(
SELECT * , date_format ( deliver_date , '%d-%m-%Y' )
AS end_date FROM budgets
LEFT JOIN locations on budgets . location = locations . structure
WHERE budgets . id = $ budget_id ) ;
2021-08-26 16:37:00 +00:00
my $ sthb = $ dbh - > prepare ( $ sqlb ) ;
$ sthb - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqlfc = qq( SELECT COUNT ( id ) AS count FROM finance WHERE budget_id=$budget_id ) ;
my $ sthfc = $ dbh - > prepare ( $ sqlfc ) ;
$ sthfc - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqls = qq( SELECT SUM ( amount ) FROM finance WHERE budget_id=$budget_id ) ;
my $ sths = $ dbh - > prepare ( $ sqls ) ;
$ sths - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqlse = qq( SELECT SUM ( cost ) FROM expenditure WHERE budget_id=$budget_id ) ;
my $ sthse = $ dbh - > prepare ( $ sqlse ) ;
$ sthse - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-29 10:06:08 +00:00
my $ sqlr = qq(
SELECT name , fullname , codename FROM finance
LEFT JOIN agents ON finance . agent_id = agents . id
LEFT JOIN budgets ON finance . budget_id = budgets . id
WHERE finance . budget_id = "$budget_id"
AND finance . agent_id = "$agent_id" ) ;
2021-08-26 16:37:00 +00:00
my $ sthr = $ dbh - > prepare ( $ sqlr ) ;
$ sthr - > execute ;
2021-08-27 13:15:23 +00:00
my $ sqlef = qq(
SELECT budget_id , item , cost , currency , type
FROM expenditure
LEFT JOIN budgets on expenditure . budget_id = budgets . id
2021-08-29 10:06:08 +00:00
WHERE expenditure . budget_id = '$budget_id'
2021-08-27 13:15:23 +00:00
AND type = 'fee'
ORDER BY expenditure . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthef = $ dbh - > prepare ( $ sqlef ) ;
$ sthef - > execute ;
2021-08-29 10:06:08 +00:00
my $ sqlem = qq(
SELECT budget_id , item , cost , currency , type FROM expenditure
LEFT JOIN budgets on expenditure . budget_id = budgets . id
WHERE expenditure . budget_id = '$budget_id'
AND type = 'materials'
ORDER BY expenditure . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthem = $ dbh - > prepare ( $ sqlem ) ;
$ sthem - > execute ;
2021-08-29 10:06:08 +00:00
my $ sqlex = qq(
SELECT budget_id , item , cost , currency , type FROM expenditure
LEFT JOIN budgets on expenditure . budget_id = budgets . id
WHERE expenditure . budget_id = '$budget_id'
AND type = 'misc'
ORDER BY expenditure . item ) ;
2021-08-26 16:37:00 +00:00
my $ sthex = $ dbh - > prepare ( $ sqlex ) ;
$ sthex - > execute ;
$ sthb - > execute ;
my $ recordb = $ sthb - > fetchrow_hashref ;
2021-08-24 17:43:29 +00:00
2021-08-29 11:44:32 +00:00
# page header
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-29 11:44:32 +00:00
# budget header
2021-08-26 16:37:00 +00:00
print << END ;
< div class = "header" >
< div class = "headline-1" >
feral budget generator | | $ website_url / $ script_name
</div>
< div class = "headline-2" >
<b> $ projectname </b> | |
$ recordb - > { location } | |
budget adjustments to $ currentyear - $ currentmonth - $ currentdayofmonth
</div>
< div class = "headline-3" >
< img src = "$feral_logo" >
END
if ( $ agent_id ne "" ) {
while ( my $ recordfc = $ sthfc - > fetchrow_hashref ) {
2021-08-26 17:17:58 +00:00
print << END ;
Contributing agents <b> [ $ recordfc - > { count } ] </b> . This budget will remain open for editing until <b> $ recordb - > { end_date } </b> . Monetary items will be kept anonymous ( although identifable to the budget r / administrators ) . Labour & amp ; resources will be tagged with the name of the contributor .
END
2021-08-26 16:37:00 +00:00
}
}
print << END ;
</div>
</div>
END
2021-08-24 17:43:29 +00:00
2021-08-29 11:44:32 +00:00
# CGI parameter forms
2021-08-26 16:37:00 +00:00
$ sthr - > execute ;
while ( my $ recordr = $ sthr - > fetchrow_hashref ) {
print << END ;
2021-08-26 17:53:02 +00:00
< FORM ACTION = "$script_name" METHOD = "GET" >
2021-08-26 16:37:00 +00:00
< input type = "hidden" name = "action" value = "prepare_budget" >
< input type = "hidden" name = "new_name" value = "$recordr->{name}" >
< input type = "hidden" name = "agent_id" value = "$agent_id" >
< input type = "hidden" name = "budget_id" value = "$budget_id" >
< input type = "hidden" name = "new_agent" value = "$recordr->{fullname}" >
< input type = "hidden" name = "new_codename" value = "$recordr->{codename}" >
< INPUT TYPE = "submit" VALUE = "return to edit your contribution" >
</FORM>
END
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
if ( $ agent_id eq "" ) {
print << END ;
< FORM ACTION = "$script_name" METHOD = "GET" >
< input type = "hidden" name = "action" value = "" >
< input type = "hidden" name = "new_name" value = "$recordr->{name}" >
< input type = "hidden" name = "budget_id" value = "$budget_id" >
< INPUT TYPE = "submit" VALUE = "log in" >
</FORM>
END
} else {
print << END ;
< FORM ACTION = "$script_name" METHOD = "GET" >
< input type = "hidden" name = "action" value = "prepare_expenditure" >
< input type = "hidden" name = "new_name" value = "$recordr->{name}" >
< input type = "hidden" name = "budget_id" value = "$budget_id" >
< input type = "hidden" name = "agent_id" value = "$agent_id" >
</FORM>
END
}
2021-08-24 17:43:29 +00:00
2021-08-29 11:44:32 +00:00
# budget columns
2021-08-26 16:37:00 +00:00
print << END ;
< div id = "budget" class = "container" >
< div id = "left" class = "column" >
END
2021-08-24 17:43:29 +00:00
2021-08-29 11:44:32 +00:00
print_title ( "FINANCIAL" ) ;
print_subtitle ( "OUTGOINGS: / money requested or supplied" ) ;
2021-08-27 17:04:05 +00:00
print_subtitle ( "Labour / paid" ) ;
2021-08-26 16:37:00 +00:00
while ( my $ recordef = $ sthef - > fetchrow_hashref ) {
my $ cost = $ recordef - > { cost } ;
$ display_cost = sprintf "%.2f" , $ cost ;
$ display_cost =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
print << END ;
< div class = "budget-item" >
< p class = "item-name" > $ recordef - > { item } </p>
< p class = "item-amount" > $ recordef - > { currency } $ display_cost </p>
</div>
END
}
2021-08-27 17:04:05 +00:00
print_subtitle ( "Resources / remunerated" ) ;
2021-08-26 16:37:00 +00:00
2021-08-26 17:22:30 +00:00
while ( my $ recordem = $ sthem - > fetchrow_hashref ) {
2021-08-26 16:37:00 +00:00
my $ cost = $ recordem - > { cost } ;
$ display_cost = sprintf "%.2f" , $ cost ;
$ display_cost =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
2021-08-27 17:04:05 +00:00
print_item ( "$recordem->{item}" , "$recordem->{currency}$display_cost" ) ;
2021-08-26 16:37:00 +00:00
}
2021-08-24 17:43:29 +00:00
2021-08-26 17:05:17 +00:00
print_subtitle ( "Miscellaneous" ) ;
2021-08-26 16:37:00 +00:00
2021-08-26 17:22:30 +00:00
while ( my $ recordex = $ sthex - > fetchrow_hashref ) {
2021-08-26 16:37:00 +00:00
my $ cost = $ recordex - > { cost } ;
$ display_cost = sprintf "%.2f" , $ cost ;
$ display_cost =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
2021-08-26 17:53:02 +00:00
2021-08-27 17:04:05 +00:00
print_item ( "$recordex->{item}" , ">$recordex->{currency}$display_cost" ) ;
2021-08-26 16:37:00 +00:00
}
2021-08-27 17:04:05 +00:00
2021-08-29 11:44:32 +00:00
print_subtitle ( "INCOME: / donations, contributions, sums, funds" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ recordf = $ sthf - > fetchrow_hashref ) {
2021-08-27 18:03:22 +00:00
print_item ( "" , sprintf ( "€%.2f" , $ recordf - > { amount } ) ) ;
2021-08-26 16:37:00 +00:00
}
2021-08-27 17:04:05 +00:00
2021-08-26 16:37:00 +00:00
## actual paid deposits
while ( my $ recordar = $ sthar - > fetchrow_hashref ) {
while ( my @ sum = $ sths - > fetchrow_array ( ) ) {
$ deposits = $ recordar - > { qty } * 50 ;
$ running = $ sum [ 0 ] + $ deposits ;
$ display_running = sprintf "%.2f" , $ running ;
$ display_running =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
2021-08-26 17:53:02 +00:00
2021-08-29 12:05:05 +00:00
print_subtotal ( " " ) ; # spacing before running lines
2021-08-26 17:53:02 +00:00
print_subtotal ( "RUNNING total IN:" , "€$display_running" ) ;
2021-08-26 16:37:00 +00:00
}
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my @ sumex = $ sthse - > fetchrow_array ( ) ) {
$ runningex = $ sumex [ 0 ] ;
$ surplus = $ running - $ runningex ;
$ display_runningex = sprintf "%.2f" , $ runningex ;
$ display_runningex =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
$ display_surplus = sprintf "%.2f" , $ surplus ;
$ display_surplus =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
2021-08-26 17:38:30 +00:00
print_subtotal ( "RUNNING total OUT:" , "€$display_runningex" ) ;
2021-08-29 12:05:05 +00:00
print_subtotal ( " " ) ; # spacing between running & balance lines
2021-08-26 17:38:30 +00:00
print_subtotal ( "BALANCE OF FINANCIAL TRADE:" , " €$display_surplus" ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print << END ;
</div>
< div id = "right" class = "column" >
END
2021-08-29 11:44:32 +00:00
print_title ( "NONFINANCIAL" ) ;
2021-08-26 17:38:30 +00:00
print_subtitle ( "Human and nonhuman budget contributions: / labour and resources, deployed &/or offfered, latent, awaiting activation" ) ;
2021-08-26 17:05:17 +00:00
print_subtitle ( "Labour / deployed" ) ;
2021-08-26 16:37:00 +00:00
$ sthdl - > execute ;
while ( my $ record = $ sthdl - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
2021-08-29 10:06:08 +00:00
$ initials = get_initials ( $ record ) ;
print_item ( "$record->{item} [$initials]" ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
2021-08-26 17:38:30 +00:00
print_subtitle ( "Resources / deployed" ) ;
2021-08-26 16:37:00 +00:00
2021-08-26 17:53:02 +00:00
$ sthdr - > execute ;
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sthdr - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
2021-08-29 10:06:08 +00:00
$ initials = get_initials ( $ record ) ;
print_item ( "$record->{item} [$initials]" ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
2021-08-26 17:05:17 +00:00
print_subtitle ( "Labour / offered" ) ;
2021-08-26 16:37:00 +00:00
$ sthol - > execute ;
while ( my $ record = $ sthol - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
2021-08-29 10:06:08 +00:00
$ initials = get_initials ( $ record ) ;
print_item ( "$record->{item} [$initials]" ) ;
2021-08-26 16:37:00 +00:00
}
2021-08-26 17:05:17 +00:00
print_subtitle ( "Resources / offered" ) ;
2021-08-26 16:37:00 +00:00
2021-08-26 17:53:02 +00:00
$ sthor - > execute ;
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sthor - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
2021-08-29 11:44:32 +00:00
$ initials = get_initials ( $ record ) ;
print_item ( "$record->{item} [$initials]" ) ;
2021-08-26 16:37:00 +00:00
}
$ dbh - > disconnect ;
2021-08-29 11:44:32 +00:00
print ( qq( </div></div> ) ) ;
2021-08-26 16:37:00 +00:00
& print_footer ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 17:17:58 +00:00
2021-08-29 10:06:08 +00:00
# capitalise the initials of a name from a record
2021-08-29 11:44:32 +00:00
2021-08-29 10:06:08 +00:00
sub get_initials {
$ record = shift ;
my $ first = $ record - > { firstname } ;
my $ last = $ record - > { lastname } ;
$ first_init = substr ( $ first , 0 , 1 ) ;
$ last_init = substr ( $ last , 0 , 1 ) ;
$ first_init =~ s/^([a-z])/\U$1/ ;
$ last_init =~ s/^([a-z])/\U$1/ ;
return "$first_init$last_init"
}
2021-08-29 11:44:32 +00:00
2021-08-24 17:43:29 +00:00
############################################################################
# prepare expenditure
sub prepare_expenditure {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT item, cost, currency, firstname, lastname, type FROM expenditure LEFT JOIN agents on expenditure.agent_id = agents.id WHERE expenditure.budget_id = $budget_id ORDER BY fullname ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqln = qq( SELECT name FROM budgets where id = $budget_id ) ;
my $ sthn = $ dbh - > prepare ( $ sqln ) ;
$ sthn - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="0" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator</b></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ recordn = $ sthn - > fetchrow_hashref ) {
print ( qq( <tr><td height="10" class="medbig" colspan="5"><b> Expenditure: $recordn->{name}</td></tr> ) ) ;
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="input_expenditure">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <tr><td></td><td>agent</td><td>item</td><td colspan="2">cost</td><td>kind</td></tr>\n ) ) ;
for ( $ i = 1 ; $ i <= 23 ; $ i + + ) {
while ( my $ record = $ sth - > fetchrow_hashref ) {
my $ cost = $ record - > { cost } ;
$ dec_cost = sprintf "%.2f" , $ cost ; ## 2 decimal places
my $ first = $ record - > { firstname } ;
my $ last = $ record - > { lastname } ;
$ first_init = substr ( $ first , 0 , 1 ) ;
$ last_init = substr ( $ last , 0 , 1 ) ;
$ first_init =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
$ last_init =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
print ( qq( <tr><td><b>$i.</b></td><td>[$first_init$last_init] </td>\n ) ) ;
print ( qq( <td><input type="text" name="new_item$i" value="$record->{item}" size=80 maxsize=100></td>\n ) ) ;
print ( qq( <td><input type="text" name="cost$i" value="$dec_cost" size=6 maxsize=10></td>\n ) ) ;
print ( qq( <td><select name="currency$i"> ) ) ;
# @currencies = ('€', '£', '$');
@ currencies = ( '€' ) ;
foreach $ currency ( @ currencies ) {
print ( qq( <option ) ) ;
if ( $ currency eq $ record - > { currency } ) {
print ( qq( selected ) ) ;
}
print ( qq( >$currency</option> ) ) ;
}
print ( qq( </select></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ i + +
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td><b>$i.</b></td><td></td>\n ) ) ;
print ( qq( <td><input type="text" name="new_item$i" size=80 maxsize=100></td>\n ) ) ;
print ( qq( <td><input type="text" name="cost$i" size=6 maxsize=10></td>\n ) ) ;
print ( qq( <td><select name="currency$i"> ) ) ;
# @currencies = ('€', '£', '$');
@ currencies = ( '€' ) ;
foreach $ currency ( @ currencies ) {
print ( qq( <option ) ) ;
if ( $ currency eq $ record - > { currency } ) {
print ( qq( selected ) ) ;
}
print ( qq( >$currency</option>\n ) ) ;
}
print ( qq( </select></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td><INPUT TYPE="submit" VALUE="submit"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( <tr><td><BR><BR></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
############################################################################
# input expenditure
sub input_expenditure {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
# clear previous entries
my $ sql_del = ( qq{ DELETE FROM expenditure WHERE budget_id=$budget_id } ) ;
my $ sth_del = $ dbh - > prepare ( $ sql_del ) ;
$ sth_del - > execute ;
for ( $ i = 1 ; $ i <= 25 ; $ i + + ) {
if ( $ new_item { $ i } ne '' ) {
my $ sql = ( qq{ INSERT INTO expenditure (budget_id, item, cost, currency) VALUES ($budget_id, '$new_item { $i } ', $cost { $i } , '$currency { $i } ') } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
# read back expenditure info
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql2 = qq( SELECT budget_id, item, cost, currency FROM expenditure LEFT JOIN budgets on expenditure.budget_id=budgets.id WHERE expenditure.budget_id = '$budget_id' ORDER BY expenditure.id ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="0" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator</b></td></tr>\n ) ) ;
print ( qq( <tr><td height="10" class="medbig" colspan="5"><b> Expenditure</td></tr> ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <table width="700" cellspacing="1" cellpadding="0" bgcolor="#C0C0C0">\n ) ) ;
print ( qq( <tr><td bgcolor="#ffffff"><b>item</b></td> <td bgcolor="#ffffff"><b>cost</b></td></tr> \n ) ) ;
while ( my $ record2 = $ sth2 - > fetchrow_hashref ) {
my $ cost = $ record2 - > { cost } ;
$ dec_cost = sprintf "%.2f" , $ cost ; ## 2 decimal places
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
# print(qq(<tr><td bgcolor="#ffffff">$record2->{item}</td> <td bgcolor="#ffffff">$record2->{currency}$record2->{cost}</td></tr> \n));
print ( qq( <tr><td bgcolor="#ffffff">$record2->{item}</td> <td bgcolor="#ffffff">$dec_cost</td></tr> \n ) ) ;
}
print ( qq( <tr><td></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <table><tr><td height="10"></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT * from finance LEFT JOIN agents ON finance.agent_id=agents.id
2021-08-24 17:43:29 +00:00
LEFT JOIN budgets ON finance . budget_id = budgets . id WHERE finance . budget_id = "$budget_id" AND finance . agent_id = "$agent_id" ) ;
2021-08-26 16:37:00 +00:00
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="prepare_expenditure">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="new_agent" value="$record->{fullname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <table><tr><td colspan="1" height="20"><INPUT TYPE="submit" VALUE="return to edit expenditure"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="compile_budget">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="new_agent" value="$record->{fullname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <tr><td colspan="1" hegiht="10"><INPUT TYPE="submit" VALUE="go to view the budget as a whole"></td></tr>\n ) ) ;
print ( qq( </td></tr></table>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
}
# print(qq(<br><br><a href="$script_name?action=prepare_expenditure&budget_id=$budget_id">add or ammend more expenditure items</a>\n));
# print(qq(<br><br><a href="$script_name?action=compile_budget&budget_id=$budget_id">got to view the budget as a whole</a>\n));
print ( qq( </center>\n ) ) ;
print ( qq( </body>\n ) ) ;
print ( qq( </html>\n ) ) ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
############################################################################
# prepare agents
sub prepare_agents {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT * FROM agents WHERE budget_id = $budget_id ORDER BY lastname ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqlc = qq( SELECT COUNT ( * ) AS count FROM agents WHERE budget_id = $budget_id ) ;
my $ sthc = $ dbh - > prepare ( $ sqlc ) ;
$ sthc - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sqln = qq( SELECT name FROM budgets where id = $budget_id ) ;
my $ sthn = $ dbh - > prepare ( $ sqln ) ;
$ sthn - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="0" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator</b></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ recordn = $ sthn - > fetchrow_hashref ) {
print ( qq( <tr><td height="10" class="medbig" colspan="5"><b> Agents: $recordn->{name}</td></tr> ) ) ;
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td></td><td><b>firstname</b></td><td><b>lastname</b></td><td colspan="2"><b>codename</b></td><td></tr>\n ) ) ;
for ( $ i = 1 ; $ i <= 50 ; $ i + + ) {
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="edit_agent">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="edit_agent_id" value="$record->{id}">\n ) ) ;
print ( qq( <input type="hidden" name="new_firstname" value="$record->{firstname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_lastname" value="$record->{lastname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <tr><td><INPUT TYPE="submit" VALUE="$i"></td>\n ) ) ;
print ( qq( <td>$record->{firstname}</td>\n ) ) ;
print ( qq( <td>$record->{lastname}</td>\n ) ) ;
print ( qq( <td>$record->{codename}</td>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
$ i + +
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="input_agents">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
while ( my $ recordc = $ sthc - > fetchrow_hashref ) {
my $ c = ( $ recordc - > { count } ) ;
for ( $ i = 1 + $ c ; $ i <= 50 ; $ i + + ) {
print ( qq( <tr><td><b>$i.</b></td>\n ) ) ;
print ( qq( <td><input type="text" name="new_firstname$i" size=20 maxsize=40></td>\n ) ) ;
print ( qq( <td><input type="text" name="new_lastname$i" size=20 maxsize=40></td>\n ) ) ;
print ( qq( <td><input type="text" name="new_codename$i" size=10 maxsize=10></td>\n ) ) ;
# $i++
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td><INPUT TYPE="submit" VALUE="submit"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( <tr><td><BR><BR></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
############################################################################
# edit agent
sub edit_agent {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
# read in agent data
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="0" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator</b></td></tr>\n ) ) ;
print ( qq( <tr><td height="10" class="medbig" colspan="5"><b> Edit agent</td></tr> ) ) ;
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="update_agent">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="edit_agent_id" value="$edit_agent_id">\n ) ) ;
print ( qq( <td><input type="text" name="new_firstname" value="$new_firstname" size=20 maxsize=40></td>\n ) ) ;
print ( qq( <td><input type="text" name="new_lastname" value="$new_lastname" size=20 maxsize=40></td>\n ) ) ;
print ( qq( <td><input type="text" name="new_codename" value="$new_codename" size=10 maxsize=10></td>\n ) ) ;
print ( qq( <tr><td><INPUT TYPE="submit" VALUE="submit"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </table>\n ) ) ;
print ( qq( <table><tr><td height="10"></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="prepare_agents">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <input type="hidden" name="new_agent" value="$record->{fullname}">\n ) ) ;
print ( qq( <input type="hidden" name="new_codename" value="$record->{codename}">\n ) ) ;
print ( qq( <table><tr><td colspan="1" height="20"><INPUT TYPE="submit" VALUE="return to agents overview"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </center>\n ) ) ;
print ( qq( </body>\n ) ) ;
print ( qq( </html>\n ) ) ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
############################################################################
# update agent
sub update_agent {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = ( qq{ UPDATE agents set firstname='$new_firstname', lastname='$new_lastname', fullname='$new_firstname $new_lastname', codename='$new_codename' WHERE budget_id=$budget_id AND id=$edit_agent_id } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
# read back agent info
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="0" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator</b></td></tr>\n ) ) ;
print ( qq( <table><tr><td height="10"></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="prepare_agents">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <table><tr><td colspan="1" height="20"><INPUT TYPE="submit" VALUE="return to agents overview"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </center>\n ) ) ;
print ( qq( </body>\n ) ) ;
print ( qq( </html>\n ) ) ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
############################################################################
# input agents
sub input_agents {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
for ( $ i = 1 ; $ i <= 50 ; $ i + + ) {
if ( $ new_firstname { $ i } ne '' ) {
my $ sql = ( qq{ INSERT INTO agents (budget_id, firstname, lastname, fullname, codename) VALUES ($budget_id, '$new_firstname { $i } ', '$new_lastname { $i } ', '$new_firstname { $i } $new_lastname { $i } ','$new_codename { $i } ') } ) ;
# my $sql = (qq{INSERT INTO agents (budget_id, firstname, lastname, codename) VALUES ($budget_id, '$new_firstname{i}', '$new_lastname{i}', '$new_codename{i}')});
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
}
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
# read back agent info
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <table width="700" cellspacing="0" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <tr><td><table width="700" cellspacing="5" cellpadding="2" bgcolor="#ffffff" border="0">\n ) ) ;
print ( qq( <tr><td class="lge" align="center" bgcolor="#fff000" colspan="5"><font color="#000000"><b>feral budget generator</b></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <table><tr><td height="10"></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="prepare_agents">\n ) ) ;
print ( qq( <input type="hidden" name="new_name" value="$record->{name}">\n ) ) ;
print ( qq( <input type="hidden" name="budget_id" value="$budget_id">\n ) ) ;
print ( qq( <input type="hidden" name="agent_id" value="$agent_id">\n ) ) ;
print ( qq( <table><tr><td colspan="1" height="20"><INPUT TYPE="submit" VALUE="return to agents overview"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( </center>\n ) ) ;
print ( qq( </body>\n ) ) ;
print ( qq( </html>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
############################################################################
# add form
sub add_form {
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <b> $projectname:</b> add a budget \n ) ) ;
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT * FROM budgets ORDER BY id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
print ( qq( <h3> </h3>\n ) ) ;
print ( qq( \ n ) ) ;
print ( qq( <table width="600" cellspacing="0" cellpadding="0" bgcolor="#efefef">\n ) ) ;
print ( qq( <tr><td><b>Budget</b><td><b>Date</b></td><td><b></b></td></tr> ) ) ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <tr><td> ) ) ;
print ( qq( <a href="$script_name?action\=edit_form&edit_id=$record->{id}">$record->{name}</a> </td> ) ) ;
print ( qq( <td>$record->{date}</td> ) ) ;
print ( qq( <td></td> ) ) ;
print ( qq( </tr> ) ) ;
}
print ( qq( <tr><td> </td></tr>\n ) ) ;
$ dbh - > disconnect ;
print ( qq( <FORM ACTION="$script_name"METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="add_budget">\n ) ) ;
print ( qq( <tr><td><b>add a new budget</b><br>\n ) ) ;
print ( qq( <input type="text" name="new_name" size=60 maxsize=80><br></td>\n ) ) ;
print ( qq( <td><b>date</b><br> ) ) ;
print ( qq( <td><b></b><br>\n ) ) ;
print ( qq( <tr><td> </td></tr>\n ) ) ;
#print(qq(<tr><td><b>password</b></td></tr>\n));
#print(qq(<td><input type="password" name="password" size=10 value=""maxsize=20></td></tr>\n));
print ( qq( <tr><td><br><INPUT TYPE="submit" VALUE="add"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </table>\n ) ) ;
& print_footer ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# add budget
sub add_budget {
2021-08-26 16:37:00 +00:00
#if ($password eq $admin_password) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
### test if workshop exists already in database
if ( $ new_name ne '' ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ new_name_found = 'false' ;
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT DISTINCT name FROM budgets ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( $ record - > { name } eq $ new_name ) {
$ new_name_found = 'true' ;
}
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
if ( $ new_name_found eq 'false' ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = ( qq{ INSERT INTO budgets (name) VALUES ('$new_name') } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql2 = ( qq{ SELECT * from budgets where name='$new_name' } ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record2 = $ sth2 - > fetchrow_hashref ) {
print ( qq( <center>\n ) ) ;
print ( qq( <table width="800" cellspacing="0" cellpadding="2" bgcolor="#efefef">\n ) ) ;
print ( qq( <tr><td>budget added <a href="$script_name?action=edit_form&edit_id=$record2->{id}">$new_name</a></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
}
& print_footer ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
} else {
& print_header ;
print ( qq( duplicate budget entry<br>\n ) ) ;
& print_footer ;
}
2021-08-24 17:43:29 +00:00
} else {
2021-08-26 16:37:00 +00:00
& print_header ;
print ( qq( no budget entered<br>\n ) ) ;
& print_footer ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
#} else {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
#&print_header;
#print(qq(<h3>Wrong password !</h3><p>\n));
#&print_footer;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
# }
2021-08-24 17:43:29 +00:00
}
###############################################################################
# add budget information
sub add_budget_information {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = ( qq{ UPDATE budgets SET location='$new_location', deliver_date='$new_deliver_date', remarks='$new_remarks',
2021-08-24 17:43:29 +00:00
WHERE name = '$new_name' } ) ;
2021-08-26 16:37:00 +00:00
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ dbh - > disconnect ;
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <center>\n ) ) ;
print ( qq( <b> $projectname:</b> $new_name added ) ) ;
#print(qq($add_information \n));
print ( qq( <p><a href="$script_name?action=display_budgets">view all budgets</a></p>\n ) ) ;
print ( qq( <p><a href="$script_name"></a></p>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# edit select form: select which budget to edit
sub edit_select_form {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT DISTINCT * FROM budgets ORDER BY id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <center>\n ) ) ;
print ( qq( <b> edit a budget <br> \n ) ) ;
print ( qq( <table width="500" cellspacing="0" cellpadding="0" bgcolor="#efefef">\n ) ) ;
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="edit_form">\n ) ) ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <tr><td><input type="radio" name="edit_id" value="$record->{id}"</td> \n ) ) ;
print ( qq( <td>$record->{name}\n ) ) ;
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td colspan="2"><INPUT TYPE="submit" VALUE="edit budget"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# edit form: edit selected budget
sub edit_form {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT DISTINCT * FROM budgets WHERE id=$edit_id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <center>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <h3> $projectname: edit budget</h3>\n ) ) ;
# print(qq(<img src="$image_url/thumb/$edit_id.jpg" width="100"border=0" alt="">\n));
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <table width="800" cellspacing="0" cellpadding="2" bgcolor="#efefef">\n ) ) ;
print ( qq( <tr><td bgcolor="#ffffff"> </td></tr>\n ) ) ;
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="edit_budget">\n ) ) ;
print ( qq( <input type="hidden" name="edit_id" value="$edit_id">\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sth - > fetchrow_hashref ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td class="mini"><i></i> <input type="text" name="new_name" value="$record->{name}"size=50 maxsize=100></td></tr>\n ) ) ;
print ( qq( <tr><td class="mini"><input type="text" name="new_location" value="$record->{location}"size=50 maxsize=100> location</td></tr>\n ) ) ;
print ( qq( <tr><td class="mini"><input type="text" name="new_url" value="$record->{url}"size=100 maxsize=100> url</td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td><b><a href="$script_name?action=edit_field&edit_id=$edit_id&edit_field=remarks">Remarks:</a></b> When, where, who</td></tr>\n ) ) ;
print ( qq( <tr><td class=""><TEXTAREA name="new_remarks" ROWS="16" COLS="120" WRAP=SOFT>$record->{remarks}</TEXTAREA></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td><b></b></td></tr>\n ) ) ;
# print(qq(<tr><td><i>password</i></td></tr><tr><td><input type="password" name="password" size=10 value=""maxsize=20></td></tr>\n));
print ( qq( <tr><td><INPUT TYPE="submit" VALUE="edit budget"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </table>\n ) ) ;
print ( qq( </table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
}
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# present budget: present singlebudget
sub present_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT DISTINCT * FROM budgets WHERE id=$edit_id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
# print(qq(<center>\n));
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <h3> $projectname: budget notes</h3>\n ) ) ;
# print(qq(<img src="$image_url/thumb/$edit_id.jpg" width="100"border=0" alt="">\n));
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <table width="1000" cellspacing="20" cellpadding="0" bgcolor="#ffffff">\n ) ) ;
print ( qq( <input type="hidden" name="edit_id" value="$edit_id">\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sth - > fetchrow_hashref ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ record - > { remarks } =~ s/\n/\<br>/g ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td bgcolor="fff000" class="max"><i></i>$record->{name}, \n ) ) ;
print ( qq( $record->{location}</td><td> </td></tr>\n ) ) ;
print ( qq( <tr><td class="med"><a href="$record->{url}">$record->{url}</a></td></tr>\n ) ) ;
# print(qq(<tr><td height="20"><b></b></td></tr>\n));
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td class="max"><b>Remarks:</b> When, where, who</td></tr>\n ) ) ;
print ( qq( <tr><td class="med">$record->{remarks}</td></tr>\n ) ) ;
# print(qq(<tr><td height="20"><b></b></td></tr>\n));
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
# print(qq(<tr><td><i>password</i></td></tr><tr><td><input type="password" name="password" size=10 value=""maxsize=20></td></tr>\n));
print ( qq( <tr><td></td></tr>\n ) ) ;
print ( qq( </table>\n ) ) ;
print ( qq( </table>\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
}
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# edit budget: edit budget results
sub edit_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
#if ($password eq $admin_password) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
### update budgets table
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql_update = ( qq{ UPDATE budgets SET name='$new_name', location='$new_location', url='$new_url', remarks='$new_remarks', deliver_date="$new_deliver_date" WHERE id='$edit_id' } ) ;
my $ sth_update = $ dbh - > prepare ( $ sql_update ) ;
$ sth_update - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
### display results
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = qq( SELECT * FROM budgets WHERE id = '$edit_id' ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sth - > fetchrow_hashref ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( <center>\n ) ) ;
# print(qq(<a href="$image_url$edit_id.jpg" border="0"><img src="$image_url/thumb/$edit_id.jpg" width="100"border=0" alt=""></a>\n));
print ( qq( <table width="300" cellspacing="0" cellpadding="2" bgcolor="#efefef">\n ) ) ;
print ( qq( <tr><td bgcolor="#ffffff">updated</td></tr>\n ) ) ;
print ( qq( <tr><td><a href="$script_name?action=edit_form&edit_id=$edit_id">$record->{name}</a></td></tr>\n ) ) ;
print ( qq( </table><br> ) ) ;
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
$ dbh - > disconnect ;
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# delete form: select a budget to delete
sub delete_form {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT * FROM budgets ORDER BY id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <b> delete a budget <br> \n ) ) ;
print ( qq( <table width="800" cellspacing="0" cellpadding="0" bgcolor="#efefef">\n ) ) ;
print ( qq( <FORM ACTION="$script_name" METHOD="GET">\n ) ) ;
print ( qq( <input type="hidden" name="action" value="delete_budget">\n ) ) ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
# print(qq(<input type="hidden" name="new_name" value="$record->{name}">\n));
print ( qq( <tr><td><input type="radio" name="delete_id" value="$record->{id}"</td> \n ) ) ;
print ( qq( <td>$record->{name}\n ) ) ;
print ( qq( $record->{location}\n ) ) ;
}
print ( qq( <tr><td><b>password</b></td><td><input type="password" name="password" size=10 value=""maxsize=20></td></tr>\n ) ) ;
print ( qq( <tr><td colspan="2"><INPUT TYPE="submit" VALUE="delete budget"></td></tr>\n ) ) ;
print ( qq( </FORM>\n ) ) ;
print ( qq( </table>\n ) ) ;
$ dbh - > disconnect ;
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# delete budget: budget delete results
sub delete_budget {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql = ( qq{ SELECT * FROM budgets WHERE id = '$delete_id' } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
my $ sql2 = ( qq{ DELETE FROM budgets WHERE id = '$delete_id' } ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
while ( my $ record = $ sth - > fetchrow_hashref ) {
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_header ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( $record->{name} deleted\n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
}
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
& print_footer ;
$ dbh - > disconnect ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# display budget: displays all budgets
sub display_budgets {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT * FROM budgets ORDER BY id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <h3> $projectname: all budgets: edit mode</h3>\n ) ) ;
print ( qq( <table width="1000" cellspacing="2" cellpadding="2" bgcolor="#ffffff"">\n ) ) ;
print ( qq( <tr><td bgcolor="#ffffff"><b>Budget</b></td><td bgcolor="#ffffff"><b>Location</b></td><td bgcolor="#ffffff"><b>Date</b></td><td bgcolor="#ffffff"><b>URL</b></td></tr>\n ) ) ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <tr>\n ) ) ;
print ( qq( <td bgcolor="#efefef"><a href="$script_name?action\=edit_form&edit_id=$record->{id}">$record->{name}</a></td> ) ) ;
print ( qq( <td bgcolor="#efefef">$record->{location}</td> ) ) ;
print ( qq( <td bgcolor="#efefef">$record->{deliver_date}</td> ) ) ;
print ( qq( <td bgcolor="#efefef"><a href="$record->{url}">$record->{url}</a></td> ) ) ;
# print(qq(<td bgcolor="#efefef"><img src="$image_url/thumb/$record->{id}.jpg" width="100"border="0" title="edit $record->{name}" alt=""></td>));
print ( qq( </td></tr>\n ) ) ;
}
$ dbh - > disconnect ;
print ( qq( </table>\n ) ) ;
& print_footer ;
2021-08-24 17:43:29 +00:00
}
###############################################################################
# list budgets: list all budgets, non-edit mode
sub list_budgets {
2021-08-26 16:37:00 +00:00
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT * FROM budgets ORDER BY id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
& print_header ;
print ( qq( <center>\n ) ) ;
print ( qq( <h3> $projectname: all budgets: read-only</h3>\n ) ) ;
print ( qq( <table width="1000" cellspacing="2" cellpadding="2" bgcolor="#ffffff"">\n ) ) ;
print ( qq( <tr><td bgcolor="#ffffff"><b>Budget</b></td><td bgcolor="#ffffff"><b>Location</b></td><td bgcolor="#ffffff"><b>Date</b></td><td bgcolor="#ffffff"><b>URL</b></td></tr>\n ) ) ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print ( qq( <tr>\n ) ) ;
print ( qq( <td bgcolor="#efefef"><a href="$script_name?action\=present_budget&edit_id=$record->{id}">$record->{name}</a></td> ) ) ;
print ( qq( <td bgcolor="#efefef">$record->{location}</td> ) ) ;
print ( qq( <td bgcolor="#efefef">$record->{deliver_date}</td> ) ) ;
print ( qq( <td bgcolor="#efefef"><a href="$record->{url}">$record->{url}</a></td> ) ) ;
# print(qq(<td bgcolor="#efefef"><img src="$image_url/thumb/$record->{id}.jpg" width="100"border="0" title="edit $record->{name}" alt=""></td>));
print ( qq( </td></tr>\n ) ) ;
}
$ dbh - > disconnect ;
print ( qq( </table>\n ) ) ;
& print_footer ;
2021-08-24 17:43:29 +00:00
}
##############################################################################################
# select start date subroutine
sub select_start_date {
2021-08-26 16:37:00 +00:00
### day
print ( qq( <td colspan="2"><select name="new_start_day">\n ) ) ;
for ( $ i = 1 ; $ i < 10 ; $ i += 1 ) {
print ( qq( <option ) ) ;
if ( $ new_start_day eq "0$i" ) {
print ( qq( selected ) ) ;
}
if ( ( $ new_start_day eq "" ) && ( $ currentdayofmonth eq $ i ) ) {
print ( qq( selected ) ) ;
}
print ( qq( >0$i</option>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
for ( $ i = 10 ; $ i < 32 ; $ i += 1 ) {
print ( qq( <option ) ) ;
if ( $ new_start_day eq $ i ) {
print ( qq( selected ) ) ;
}
if ( ( $ new_start_day eq "" ) && ( $ currentdayofmonth eq $ i ) ) {
print ( qq( selected ) ) ;
}
print ( qq( >$i</option>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( </select>\n ) ) ;
### month
print ( qq( <select name="new_start_month">\n ) ) ;
for ( $ j = 1 ; $ j < 10 ; $ j += 1 ) {
print ( qq( <option ) ) ;
if ( $ new_start_month eq "0$j" ) {
print ( qq( selected ) ) ;
}
if ( ( $ new_start_month eq "" ) && ( $ currentmonth eq $ j ) ) {
print ( qq( selected ) ) ;
}
print ( qq( >0$j</option>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
for ( $ j = 10 ; $ j < 13 ; $ j += 1 ) {
print ( qq( <option ) ) ;
if ( $ new_start_month eq $ j ) {
print ( qq( selected ) ) ;
}
if ( ( $ new_start_month eq "" ) && ( $ currentmonth eq $ j ) ) {
print ( qq( selected ) ) ;
}
print ( qq( >$j</option>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( </select>\n ) ) ;
### year
print ( qq( <select name="new_start_year">\n ) ) ;
for ( $ j = 2003 ; $ j < 2022 ; $ j += 1 ) {
print ( qq( <option ) ) ;
if ( $ new_start_year eq $ j ) {
print ( qq( selected ) ) ;
}
if ( ( $ new_start_year eq "" ) && ( $ currentyear eq $ j ) ) {
print ( qq( selected ) ) ;
}
print ( qq( >$j</option>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 16:37:00 +00:00
print ( qq( </select></td></tr>\n ) ) ;
2021-08-24 17:43:29 +00:00
}
2021-08-26 17:38:30 +00:00
##############################################################################
# #
# printing and formatting #
# #
##############################################################################
2021-08-29 11:44:32 +00:00
## print a title
sub print_title {
my $ string = shift ;
print << END ;
< div class = "title" > $ string </div>
END
}
2021-08-26 17:38:30 +00:00
## print a subtitle
sub print_subtitle {
my $ string = shift ;
print << END ;
2021-08-29 11:44:32 +00:00
< div class = "subtitle" > $ string </div>
2021-08-26 17:38:30 +00:00
END
}
2021-08-29 11:44:32 +00:00
## print a budget subtotal line with a description and optional amount
2021-08-26 17:38:30 +00:00
sub print_subtotal {
my $ string = shift ;
my $ amount = shift ;
if ( not $ amount ) { $ amount = "" ; }
print << END ;
< div class = "budget-subtotal" >
< p class = "subtotal-name" > $ string </p>
< p class = "subtotal-amount" > $ amount </p>
</div>
END
}
2021-08-29 11:44:32 +00:00
## print standard budget item with a description and optional amount
2021-08-26 17:38:30 +00:00
sub print_item {
my $ string = shift ;
my $ amount = shift ;
if ( not $ amount ) { $ amount = "" ; }
print << END ;
< div class = "budget-item" >
< p class = "item-name" > $ string </p>
< p class = "item-amount" > $ amount </p>
</div>
END
}
## print the page header
2021-08-24 17:43:29 +00:00
sub print_header {
2021-08-26 16:37:00 +00:00
print << END ;
Content - type: text / html
2021-08-24 17:43:29 +00:00
< ! DOCTYPE html >
< html lang = "en" >
<head>
< meta charset = "UTF-8" >
< meta name = "viewport" content = "width=device-width" >
<title> feral budget generator </title>
2021-08-26 16:37:00 +00:00
< link rel = "stylesheet" href = "$css_screen_url" >
< link rel = "stylesheet" href = "$css_print_url" media = "print" >
2021-08-24 17:43:29 +00:00
</head>
2021-08-26 16:37:00 +00:00
<body>
2021-08-24 17:43:29 +00:00
END
}
2021-08-26 16:37:00 +00:00
2021-08-29 11:44:32 +00:00
## print a standard footer
2021-08-24 17:43:29 +00:00
sub print_footer {
2021-08-26 16:37:00 +00:00
print << END ;
2021-08-24 17:43:29 +00:00
</body>
</html>
END
}
2021-08-26 17:38:30 +00:00
## print the admin footer
2021-08-24 17:43:29 +00:00
sub adminfooter {
2021-08-26 16:37:00 +00:00
print ( qq( <tr><td bgcolor="ffffff" colspan="4"><br><a href="$script_name?action\=display_budgets">all budgets: edit</a></td></tr>\n ) ) ;
print ( qq( <tr><td bgcolor="ffffff" colspan="4"><br><a href="$script_name?action\=list_budgets">all budgets: list</a></td></tr>\n ) ) ;
print ( qq( <tr><td bgcolor="ffffff" colspan="4"><br><a href="$script_name?action\=add_form">add a budget</a> \ \; \|\n ) ) ;
print ( qq( <a href="$script_name?action\=delete_form">delete a budget</a> \ \; \n ) ) ;
2021-08-24 17:43:29 +00:00
2021-08-26 16:37:00 +00:00
print ( qq( </center>\n ) ) ;
print ( qq( </body>\n ) ) ;
print ( qq( </html>\n ) ) ;
2021-08-24 17:43:29 +00:00
}