2021-08-24 09:51:58 +00:00
#!/usr/bin/perl
use Switch ;
use DBI ;
use CGI qw( :cgi ) ;
###############################################################################
# configuration
### server
$ website_url = 'https://www.feraltrade.org/budget' ;
#### local
#$website_url='http://localhost';
$ projectname = 'f20 budget' ;
$ script_name = 'f20_budget.pl' ;
### server
$ website_url = 'https://www.feraltrade.org' ;
$ feral_logo = "$website_url/budget/feral_pigeon.jpg" ;
### local
#$website_url='http://localhost';
$ currency = '€' ;
$ logo_url = "$website_url/budget/logo/" ;
$ logo_path = '/home/feraltrade/htdocs/budget/logo/' ;
$ arrow = "$website_url/im6/arrow.jpg" ;
$ locations_script_name = './locations.pl' ;
$ agents_script_name = './agents/agents.pl' ;
$ locations_image_url = "$website_url/locn_image/thumb/" ;
$ locations_image_path = '/home/feraltrade/htdocs/budget/locn_image/thumb/' ;
# database connection
$ db_conect = "DBI:mysql:feralbudget" ;
$ db_user = "feraltrade" ;
$ db_pass = "********" ;
2021-08-24 11:19:54 +00:00
2021-08-24 09:51:58 +00:00
###############################################################################
# main 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://
$ new_item = $ q - > param ( "new_item" ) ;
$ new_item =~ s/\'/\'\'/g ;
$ new_item =~ s/\x92/’/g ;
$ new_labour = $ q - > param ( "new_labour" ) ;
$ new_labour =~ s/\'/\'\'/g ;
$ new_labour =~ s/\x92/’/g ;
$ new_resource = $ q - > param ( "new_resource" ) ;
$ new_resource =~ s/\'/\'\'/g ;
$ new_resource =~ s/\x92/’/g ;
$ new_status = $ q - > param ( "new_status" ) ;
$ new_lstatus = $ q - > param ( "new_lstatus" ) ;
$ new_rstatus = $ q - > param ( "new_rstatus" ) ;
$ type = $ q - > param ( "type" ) ;
for ( $ i = 0 ; $ i <= 50 ; $ i += 1 ) {
$ new_status { $ i } = $ q - > param ( "new_status$i" ) ;
$ type { $ i } = $ q - > param ( "type$i" ) ;
$ new_item { $ i } = $ q - > param ( "new_item$i" ) ;
$ new_item { $ i } =~ s/\'/\'\'/g ;
$ new_item { $ i } =~ s/\x92/’/g ;
$ new_resource { $ i } = $ q - > param ( "new_resource$i" ) ;
$ new_resource { $ i } =~ s/\'/\'\'/g ;
$ new_resource { $ i } =~ s/\x92/’/g ;
$ new_labour { $ i } = $ q - > param ( "new_labour$i" ) ;
$ new_labour { $ i } =~ s/\'/\'\'/g ;
$ new_labour { $ i } =~ s/\x92/’/g ;
$ new_status { $ i } = $ q - > param ( "new_status$i" ) ;
$ new_lstatus { $ i } = $ q - > param ( "new_lstatus$i" ) ;
$ new_rstatus { $ i } = $ q - > param ( "new_rstatus$i" ) ;
$ new_firstname { $ i } = $ q - > param ( "new_firstname$i" ) ;
$ new_firstname { $ i } =~ s/\'/\'\'/g ;
$ new_firstname { $ i } =~ s/\x92/’/g ;
$ new_lastname { $ i } = $ q - > param ( "new_lastname$i" ) ;
$ new_lastname { $ i } =~ s/\'/\'\'/g ;
$ new_lastname { $ i } =~ s/\x92/’/g ;
$ new_codename { $ i } = $ q - > param ( "new_codename$i" ) ;
$ new_codename { $ i } =~ s/\'/\'\'/g ;
$ new_codename { $ i } =~ s/\x92/’/g ;
$ 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" ) ;
}
( $ 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 '' ) { $ new_name = $ new_auto_name ; }
if ( $ new_location eq '' ) { $ new_location = $ new_auto_location ; }
if ( $ new_remarks eq '' ) { $ new_remarks = $ new_auto_remarks ; }
if ( $ new_url eq '' ) { $ new_remarks = $ new_auto_url ; }
switch ( $ action )
{
'select_budget' { & select_budget ; }
'add_form' { & add_form ; }
'add_budget' { & add_budget ; }
'add_budget_information' { & add_budget_information ; }
'prepare_agents' { & prepare_agents ; }
'input_agents' { & input_agents ; }
'edit_agent' { & edit_agent ; }
'update_agent' { & update_agent ; }
'edit_form' { & edit_form ; }
'edit_select_form' { & edit_select_form ; }
'edit_budget' { & edit_budget ; }
'list_budgets' { & list_budgets ; }
'prepare_budget' { & prepare_budget ; }
'prepare_money' { & prepare_money ; }
'input_budget' { & input_budget ; }
'input_money' { & input_money ; }
'prepare_expenditure' { & prepare_expenditure ; }
'input_expenditure' { & input_expenditure ; }
'compile_budget' { & compile_budget ; }
'display_budgets' { & display_budgets ; }
'present_budget' { & present_budget ; }
'delete_form' { & delete_form ; }
'delete_budget' { & delete_budget ; }
'select_budget' { & select_budget ; }
'upload_image' { & upload_image ; }
#else {&display_budgets; }
else { & select_budget ; }
}
exit ;
###############################################################################
# select budget
sub select_budget {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT name from budgets ORDER BY id DESC ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
my $ sql2 = qq( SELECT DISTINCT firstname, lastname from agents ORDER BY firstname ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
& header ;
print "<center>\n" ;
print ( qq( <table width="700" cellspacing="20" cellpadding="0" bgcolor="#cccccc">\n ) ) ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator: enter agent </b></td></tr>\n" ;
print "<tr><td height=\"20\"> </td></tr>\n" ;
print "<tr><td colspan=\"1\">budget:</td> " ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_budget\">\n" ;
## name budget
print "<td height=\"10\" colspan=\"2\"><select name=\"new_name\">" ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( $ record - > { name } eq 'f20' ) {
print "<option>$record->{name}</option>\n" ;
}
}
print "</select></td></tr>\n" ;
## enter agent code
print "<tr><td colspan=\"1\">enter your agent codename:</td> " ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<td colspan=\"3\"><input type=\"text\" name=\"new_codename\" value=\"\" size=\"5\" maxsize=\"5\"></td></tr>\n" ;
print "<tr><td colspan=\"2\"><INPUT TYPE=\"submit\" VALUE=\"ENTER\"></td></tr>\n" ;
print "</td></tr>\n" ;
print "</FORM>\n" ;
print "</td></tr></table></table>\n" ; & footer ;
$ dbh - > disconnect ;
}
###############################################################################
# prepare budget
sub prepare_budget {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT * from budgets WHERE name="$new_name" ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
## identify agent by codename
my $ sql2 = qq( SELECT * from agents where codename ="$new_codename" ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( my $ record2 = $ sth2 - > fetchrow_hashref ) {
# while (my $record2 = $sth2->fetchrow_hashref) {
# if ($record2->{codename} ne '') {
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 ;
& header ;
print "<center>\n" ;
print "<table width=\"1000\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"900\" cellspacing=\"1\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
print "<tr><td height=\"10\" class=\"medbig\" colspan=\"5\"><b> Instructions</td></tr>" ;
print "<tr><td height=\"10\" class=\"\" colspan=\"2\"><td align=\"center\" valign=\"top\"><BR><img src=\"$feral_logo\"></td>\n" ;
print "<td><table width=\"500\" border=\"0\"<tr><td class=\"serif\">" ;
print "Enter your budget requests & contributions. You can return to edit your entries at any time. " ;
# print "MONEY<font size=\"2px\">[1]</font> will remain anonymous, RESOURCES<font size=\"2px\">[2]</font> will be linked to the resource giver when the budget is activated. ";
# print "The MONEY & RESOURCES will together serve to bankroll the $record->{name} as a whole.";
print "<BR><BR></td></tr></table>\n" ;
print "<tr><table width=\"1000\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\"><td colspan=\"1\">budget name:</td> " ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"input_budget\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$record->{id}\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$record2->{id}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$new_codename\">\n" ;
print "<td height=\"10\" colspan=\"2\" class=\"medbig\">" ;
print "<b>$record->{name}</b></td><tr>\n" ;
print "<tr><td colspan=\"1\">your name:</td> " ;
print "<td height=\"10\" colspan=\"3\" class=\"medbig\">$record2->{firstname} $record2->{lastname}</td></tr>\n" ;
print "<tr><td colspan=\"1\" class=\"medbig\"><b>request money</b></td><td colspan=\"3\">your monetary requests from the f20 budget (all sums in €)</td></tr>" ;
print "</td></tr>\n" ;
print "<tr><td>\n" ;
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 "<tr><td colspan=\"2\">$i. \n" ;
print "$currency" ;
print "<input type =\"text\" name=\"new_cost$i\" " ;
print "value=\"$record4->{cost}\" " ;
print " size=\"2\" maxsize=\"5\"></td>\n" ;
print "<td><select name=\"type$i\">" ;
@ cats = ( 'select category' , 'fee' , 'materials' , 'misc' ) ;
foreach $ cat ( @ cats ) {
print "<option" ;
if ( $ cat eq $ record4 - > { type } ) { print " selected" ; }
print ">$cat</option>\n" ;
}
print "</select></td>\n" ;
print "<td colspan=\"3\">item <input type=\"text\" name=\"new_item$i\" value=\"$record4->{item}\" size=\"70\" maxsize=\"100\"></td>\n" ;
print "</tr>\n" ;
$ i + +
}
if ( $ i <= 5 ) {
print "<tr><td colspan=\"2\">$i. \n" ;
print "€ <input type =\"text\" name=\"new_cost$i\" " ;
print " size=\"2\" maxsize=\"5\"></td>\n" ;
print "<td><select name=\"type$i\">" ;
@ cats = ( 'select category' , 'fee' , 'materials' , 'misc' ) ;
foreach $ cat ( @ cats ) {
print "<option" ;
if ( $ cat eq $ record4 - > { type } ) { print " selected" ; }
print ">$cat</option>\n" ;
}
print "</select></td>\n" ;
print "<td colspan=\"3\">item <input type=\"text\" name=\"new_item$i\" value=\"$record4->{item}\" size=\"70\" maxsize=\"100\"></td>\n" ;
print "</tr>\n" ;
}
}
print "</td></tr></table>\n" ;
print "<tr><table width=\"950\" cellspacing=\"1\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\"><td colspan=\"1\"></td> " ;
print "<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 "<tr><td colspan=\"1\">€<input type =\"text\" name=\"new_amount\" " ;
while ( my $ record3 = $ sth3 - > fetchrow_hashref ) {
print "value=\"$record3->{amount}\" " ;
}
print " size=\"3\" maxsize=\"5\"></td></tr>\n" ;
## resources section !!! read-in notworking !!!
print "<tr><td colspan=\"8\" height=\"20\"> </td></tr>\n" ;
print "<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 "<tr><td colspan=\"1\"><b>$i.</b></td>\n" ;
print "<td><input type=\"checkbox\" NAME=\"new_lstatus$i\" VALUE=\"delivered\"" ;
if ( $ record5 - > { status } eq 'delivered' ) { print "CHECKED" } ;
print "></td>\n" ;
print "<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 "<tr><td colspan=\"1\"><b>$i.</b></td>\n" ;
print "<td><input type=\"checkbox\" NAME=\"new_lstatus$i\" VALUE=\"delivered\"" ;
if ( $ record5 - > { status } eq 'delivered' ) { print "CHECKED" } ;
print "></td>\n" ;
print "<td colspan=\"3\"><input type=\"text\" name=\"new_labour$i\" size=\"100\" maxsize=\"200\"></td></tr>\n" ;
}
}
print "<tr><td colspan=\"8\" height=\"20\"> </td></tr>\n" ;
print "<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 "<tr><td colspan=\"1\"><b>$i.</b></td>\n" ;
print "<td><input type=\"checkbox\" NAME=\"new_rstatus$i\" VALUE=\"delivered\"" ;
if ( $ record5 - > { status } eq 'delivered' ) { print "CHECKED" } ;
print "></td>\n" ;
print "<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 "<tr><td colspan=\"1\"><b>$i.</b></td>\n" ;
print "<td><input type=\"checkbox\" NAME=\"new_rstatus$i\" VALUE=\"delivered\"" ;
if ( $ record5 - > { status } eq 'delivered' ) { print "CHECKED" } ;
print "></td>\n" ;
print "<td colspan=\"3\"><input type=\"text\" name=\"new_resource$i\" size=\"100\" maxsize=\"200\"></td></tr>\n" ;
}
}
print "<tr><td colspan=\"1\"></td><td colspan=\"1\"></td><td colspan=\"1\"><INPUT TYPE=\"submit\" VALUE=\"SUBMIT\"></td></tr>\n" ;
print "</td></tr>\n" ;
print "</FORM>\n" ;
print "<tr><td height=\"10\"></td></tr>\n" ;
print "<tr><td colspan=\"5\"></td><td colspan=\"3\" class=\"serif_sm\">Notes:</td></tr>\n" ;
print "</td></tr></table></table>\n" ;
} else {
& header ;
print "codeame not recognised. please retry\n" ;
# }
}
}
& footer ;
$ dbh - > disconnect ;
}
###############################################################################
# input budget: input individual budet items - money & resources
sub input_budget {
#for ($i=1; $i<=8; $i++) {
# if (('$type{$i}' eq 'select category') && ('$new_item{$i}' ne '')) {
# print "<center>\n";
# print "<table width=\"700\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n";
# print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n";
# print "<input type=\"hidden\" name=\"action\" value=\"prepare_budget\">\n";
# print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n";
# print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n";
# print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n";
# print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n";
# print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n";
# print "<tr><td colspan=\"1\"><INPUT TYPE=\"submit\" VALUE=\"please go back and select a category for each expenditure\"></td></tr>\n";
# print "</FORM>\n";
#} else {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<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 ;
}
}
## read in finance for agent
my $ sql = qq( SELECT * 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" ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
#while (my $record = $sth->fetchrow_hashref) {
print "<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 ;
}
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 ;
}
}
## 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
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
WHERE expenditure . agent_id = $ agent_id AND expenditure . budget_id = $ budget_id } ) ;
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 "<tr><td colspan=\"1\" width=\"\" height=\"10\"class=\"medbig\">$projectname: <b>$recordn->{fullname}</b></td></tr> " ;
}
# print "<tr><td colspan=\"4\"><b>your PROPOSITION:</b> ";
while ( my $ recordv = $ sthv - > fetchrow_hashref ) {
if ( $ recordv - > { item } ne '' ) {
print "<tr><td>$recordv->{$currency} $recordv->{$cost} $recordv->{$item} $recordv->{$type}</td></tr>\n" ;
}
}
print "<tr><td></td></tr>\n" ;
print "<tr><td></td></tr>\n" ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_budget\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<tr><td colspan=\"1\"><INPUT TYPE=\"submit\" VALUE=\"return to edit your contribution\"></td></tr>\n" ;
print "</FORM>\n" ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"compile_budget\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<tr><td colspan=\"1\"><INPUT TYPE=\"submit\" VALUE=\"go to view the budget as a whole\"></td></tr>\n" ;
print "</td></tr></table>\n" ;
print "</FORM>\n" ;
}
& footer ;
# }
# }
}
###############################################################################
# input money
sub input_money {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
## read in finance for agent+ budget
my $ sql = qq( SELECT * 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" ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( $ record - > { id } ne '' ) {
## 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 ;
}
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 "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator: $record->{name}</b></td></tr>\n" ;
print "<tr><td colspan=\"1\" width=\"\">your name:</td> " ;
print "<td height=\"10\" colspan=\"3\" class=\"medbig\">$new_fullname</td></tr>\n" ;
print "</td></tr>\n" ;
print "<tr><td colspan=\"1\">your monetary contribution:</td> " ;
print "<td height=\"10\" colspan=\"3\" class=\"medbig\">€$new_amount</td></tr>\n" ;
print "</td></tr>\n" ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"compile_budget\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<tr><td colspan=\"1\"><INPUT TYPE=\"submit\" VALUE=\"go to view the budget as a whole\"></td></tr>\n" ;
print "</td></tr></table>\n" ;
print "</FORM>\n" ;
& footer ;
}
###############################################################################
# compile budget: lay out the whole budget as it assembles
sub compile_budget {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
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 ) ;
my $ sthd = $ dbh - > prepare ( $ sqld ) ;
$ sthd - > execute ;
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 ) ;
my $ sthol = $ dbh - > prepare ( $ sqlol ) ;
$ sthol - > execute ;
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 ) ;
my $ sthor = $ dbh - > prepare ( $ sqlor ) ;
$ sthor - > execute ;
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 ) ;
my $ sthdl = $ dbh - > prepare ( $ sqldl ) ;
$ sthdl - > execute ;
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 ) ;
my $ sthdr = $ dbh - > prepare ( $ sqldr ) ;
$ sthdr - > execute ;
## count potential deposits
my $ sqla = qq( SELECT COUNT ( fullname ) AS qty FROM agents WHERE budget_id=$budget_id AND status!='staff' ) ;
my $ stha = $ dbh - > prepare ( $ sqla ) ;
$ stha - > execute ;
## count deposits received
my $ sqlar = qq( SELECT COUNT ( fullname ) AS qty FROM agents WHERE budget_id=$budget_id AND status='deposit' ) ;
my $ sthar = $ dbh - > prepare ( $ sqlar ) ;
$ sthar - > execute ;
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 ) ;
my $ sthc = $ dbh - > prepare ( $ sqlc ) ;
$ sthc - > execute ;
my $ sqlf = qq( SELECT * FROM finance WHERE budget_id=$budget_id ORDER by amount ) ;
my $ sthf = $ dbh - > prepare ( $ sqlf ) ;
$ sthf - > execute ;
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 ) ;
my $ sthb = $ dbh - > prepare ( $ sqlb ) ;
$ sthb - > execute ;
my $ sqlfc = qq( SELECT COUNT ( id ) AS count FROM finance WHERE budget_id=$budget_id ) ;
my $ sthfc = $ dbh - > prepare ( $ sqlfc ) ;
$ sthfc - > execute ;
my $ sqls = qq( SELECT SUM ( amount ) FROM finance WHERE budget_id=$budget_id ) ;
my $ sths = $ dbh - > prepare ( $ sqls ) ;
$ sths - > execute ;
my $ sqlse = qq( SELECT SUM ( cost ) FROM expenditure WHERE budget_id=$budget_id ) ;
my $ sthse = $ dbh - > prepare ( $ sqlse ) ;
$ sthse - > execute ;
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" ) ;
my $ sthr = $ dbh - > prepare ( $ sqlr ) ;
$ sthr - > execute ;
my $ sqlef = 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='fee' ORDER BY expenditure.item ) ;
my $ sthef = $ dbh - > prepare ( $ sqlef ) ;
$ sthef - > execute ;
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 ) ;
my $ sthem = $ dbh - > prepare ( $ sqlem ) ;
$ sthem - > execute ;
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 ) ;
my $ sthex = $ dbh - > prepare ( $ sqlex ) ;
$ sthex - > execute ;
& header ;
print "<META HTTP-EQUIV=\"Refresh\" CONTENT=20; URL=\"$script_name\">\n" ;
print "<table width=\"1200\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"1\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"3\"><font color=\"#000000\"><b>feral budget generator</b> | | https://feraltrade.org/cgi-bin/budget/f20_budget.pl</td></tr>\n" ;
print "<center>\n" ;
print "<table width=\"1200\" height=\"\" cellspacing=\"5\" cellpadding=\"10\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
# print "<tr><td><table width=\"1200\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n";
$ sthb - > execute ;
while ( my $ recordb = $ sthb - > fetchrow_hashref ) {
print "<table width=\"1200\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\" border=\"1\">\n" ;
print "<tr><td height=\"10\" class=\"medbig\" colspan=\"3\"><b>$projectname </b> | | $recordb->{location} " ;
print " | |</b> <font size=\"\"> budget adjustments to $currentdayofmonth/$currentmonth/$currentyear</font></td></tr></table>" ;
# print " | |</b> <font size=\"\"> Budget";
while ( my $ recordd = $ sthd - > fetchrow_hashref ) {
$ title = substr ( $ recordd - > { item } , 0 , 30 ) ;
# print ": $title ";
}
# print "</font></td></tr></table>";
print "<table width=\"1100\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\" border=\"1\">\n" ;
print "<tr><td align=\"left\" valign=\"middle\"><img src=\"$feral_logo\"></td>\n" ;
print "<td class=\"serif\" colspan=\"6\">\n" ;
if ( $ agent_id ne "" ) {
while ( my $ recordfc = $ sthfc - > fetchrow_hashref ) {
print " Contributing agents <b>[$recordfc->{count}]</b>. This budget will remain open for negotiations until <b>$recordb->{end_date}</b>.\n" ;
print " Monetary items will be kept anonymous (although visible to the budget r/administrators) labour & resources will be tagged with the ID of the resourcer.\n" ;
}
}
print "<BR><BR></td>\n\n" ;
}
$ sthr - > execute ;
while ( my $ recordr = $ sthr - > fetchrow_hashref ) {
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_budget\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$recordr->{name}\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$recordr->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$recordr->{codename}\">\n" ;
print "<td><INPUT TYPE=\"submit\" VALUE=\"return to edit your contribution\"></td>\n" ;
print "</FORM>\n\n" ;
}
if ( $ agent_id eq "" ) {
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$recordr->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<td><INPUT TYPE=\"submit\" VALUE=\"log in\"></td></tr>\n" ;
print "</FORM>\n" ;
print "<BR><BR></td></tr>\n\n" ;
} else {
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_expenditure\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$recordr->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "</FORM>\n" ;
print "<BR><BR></td></tr>\n\n" ;
}
print "<table width=\"1200\" height=\"200\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"1\">\n" ;
print "<tr><td valign=\"top\"><table width=\"600\" border=\"0\">" ;
print "<tr><td class=\"medbig\" colspan=\"\"><b>FINANCIAL</b></td></tr>\n" ;
print "<tr><td class=\"serif\" colspan=\"1\">OUTGOINGS: / money requested or supplied</td></tr>\n" ;
print "<tr><td class=\"serif_m\" colspan=\"1\">Fees</td></tr>\n" ;
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 "<tr><td bgcolor=\"#ffffff\" colspan=\"9\">$recordef->{item}</td> <td bgcolor=\"#ffffff\" colspan=\"\">$recordef->{currency}$display_cost</td></tr> \n" ;
}
print "<tr><td class=\"serif_m\" colspan=\"1\">Materials</td></tr>\n" ;
while ( my $ recordem = $ sthem - > fetchrow_hashref ) {
my $ cost = $ recordem - > { cost } ;
$ display_cost = sprintf "%.2f" , $ cost ;
$ display_cost =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
print "<tr><td bgcolor=\"#ffffff\" colspan=\"9\">$recordem->{item}</td> <td bgcolor=\"#ffffff\" colspan=\"\">$recordem->{currency}$display_cost</td></tr> \n" ;
}
print "<tr><td class=\"serif_m\" colspan=\"1\">Miscellaneous</td></tr>\n" ;
while ( my $ recordex = $ sthex - > fetchrow_hashref ) {
my $ cost = $ recordex - > { cost } ;
$ display_cost = sprintf "%.2f" , $ cost ;
$ display_cost =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g ; ## add commma
print "<tr><td bgcolor=\"#ffffff\" colspan=\"9\">$recordex->{item}</td> <td bgcolor=\"#ffffff\" colspan=\"\">$recordex->{currency}$display_cost</td></tr> \n" ;
}
print "<tr><td class=\"serif\" colspan=\"2\" height=\"30\"> </td></tr>\n" ;
print "<tr><td class=\"serif\" colspan=\"10\">INCOME: / donations, contributions, sums, funds</td></tr>\n" ;
# print "<tr><td class=\"serif\" colspan=\"9\">MONEY:</td>\n";
print "<tr><td class=\"medium\" colspan=\"9\">" ;
while ( my $ recordf = $ sthf - > fetchrow_hashref ) {
print "€$recordf->{amount} " ;
}
print "</td</tr>\n" ;
## actual paid deposits
while ( my $ recordar = $ sthar - > fetchrow_hashref ) {
print "<tr><td class=\"serif\" colspan=\"1\"> </td><td class=\"medium\"></td></tr>\n" ;
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
print "<tr><td class=\"serif\" colspan=\"9\">RUNNING total IN:</td><td class=\"medbig\">€$display_running</td></tr>\n" ;
}
}
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
print "<tr><td class=\"serif\" colspan=\"9\">RUNNING total OUT:</td><td class=\"medbig\">€$display_runningex</td></tr>\n" ;
print "<tr><td class=\"serif\" colspan=\"9\" height=\"80\">BALANCE OF FINANCIAL TRADE:</td><td class=\"medbig\">€$display_surplus</td></tr>\n" ;
}
print "</table>\</td>\n\n" ;
print "<td valign=\"top\"><table width=\"600\" border=\"0\">\n" ;
print "<tr><td class=\"medbig\" colspan=\"\"><b>NONFINANCIAL</b></td></tr>\n" ;
print "<tr><td class=\"serif\" colspan=\"1\">Human and nonhuman budget contributions: / labour and resources, deployed &/or offfered, latent, awaiting activation</td></tr>\n" ;
print "<tr><td height=\"2\"></td><tr><tr><td class=\"serif_m\" colspan=\"2\">Labour / deployed</td></tr>\n" ;
$ sthdl - > execute ;
while ( my $ record = $ sthdl - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
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 "<tr><td colspan=\"3\" width=\"800\">$record->{item} [$first_init$last_init]</td></tr>\n" ;
# print "<tr><td class=\"print\" colspan=\"3\" width=\"800\">$record->{item} [$first_init$last_init]</td></tr>\n";
}
print "<tr><td height=\"10\"></td><tr><tr><td class=\"serif_m\" colspan=\"2\">Resources / deployed</td></tr>\n" ;
while ( my $ record = $ sthdr - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
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 "<tr><td colspan=\"3\" width=\"800\">$record->{item} [$first_init$last_init]</td></tr>\n" ;
}
print "<tr><td height=\"2\"></td><tr><tr><td class=\"serif_m\" colspan=\"2\">Labour / offered</td></tr>\n" ;
$ sthol - > execute ;
while ( my $ record = $ sthol - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
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 "<tr><td colspan=\"3\" width=\"800\">$record->{item} [$first_init$last_init]</td></tr>\n" ;
}
print "<tr><td height=\"10\"></td><tr><tr><td class=\"serif_m\" colspan=\"2\">Resources / offered</td></tr>\n" ;
while ( my $ record = $ sthor - > fetchrow_hashref ) {
$ record - > { item } =~ s/^([a-z])/\U$1/ ; ## capitalise first letter
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 "<tr><td colspan=\"3\" width=\"800\">$record->{item} [$first_init$last_init]</td></tr>\n" ;
}
print "</table></td></tr>\n" ;
$ dbh - > disconnect ;
& footer ;
}
############################################################################
# prepare expenditure
sub prepare_expenditure {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
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 ;
my $ sqln = qq( SELECT name FROM budgets where id = $budget_id ) ;
my $ sthn = $ dbh - > prepare ( $ sqln ) ;
$ sthn - > execute ;
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
while ( my $ recordn = $ sthn - > fetchrow_hashref ) {
print "<tr><td height=\"10\" class=\"medbig\" colspan=\"5\"><b> Expenditure: $recordn->{name}</td></tr>" ;
}
print "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"input_expenditure\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<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 "<tr><td><b>$i.</b></td><td>[$first_init$last_init] </td>\n" ;
print "<td><input type=\"text\" name=\"new_item$i\" value=\"$record->{item}\" size=80 maxsize=100></td>\n" ;
print "<td><input type=\"text\" name=\"cost$i\" value=\"$dec_cost\" size=6 maxsize=10></td>\n" ;
print "<td><select name=\"currency$i\">" ;
# @currencies = ('€', '£', '$');
@ currencies = ( '€' ) ;
foreach $ currency ( @ currencies ) {
print "<option" ;
if ( $ currency eq $ record - > { currency } ) { print " selected" ; }
print ">$currency</option>\n" ;
}
print "</select></td></tr>\n" ;
$ i + +
}
print "<tr><td><b>$i.</b></td><td></td>\n" ;
print "<td><input type=\"text\" name=\"new_item$i\" size=80 maxsize=100></td>\n" ;
print "<td><input type=\"text\" name=\"cost$i\" size=6 maxsize=10></td>\n" ;
print "<td><select name=\"currency$i\">" ;
# @currencies = ('€', '£', '$');
@ currencies = ( '€' ) ;
foreach $ currency ( @ currencies ) {
print "<option" ;
if ( $ currency eq $ record - > { currency } ) { print " selected" ; }
print ">$currency</option>\n" ;
}
print "</select></td></tr>\n" ;
}
print "<tr><td><INPUT TYPE=\"submit\" VALUE=\"submit\"></td></tr>\n" ;
print "</FORM>\n" ;
print "<tr><td><BR><BR></td></tr>\n" ;
}
############################################################################
# input expenditure
sub input_expenditure {
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 ;
}
}
# read back expenditure info
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 ;
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
print "<tr><td height=\"10\" class=\"medbig\" colspan=\"5\"><b> Expenditure</td></tr>" ;
print "<table width=\"700\" cellspacing=\"1\" cellpadding=\"0\" bgcolor=\"#C0C0C0\">\n" ;
print "<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
# print "<tr><td bgcolor=\"#ffffff\">$record2->{item}</td> <td bgcolor=\"#ffffff\">$record2->{currency}$record2->{cost}</td></tr> \n";
print "<tr><td bgcolor=\"#ffffff\">$record2->{item}</td> <td bgcolor=\"#ffffff\">$dec_cost</td></tr> \n" ;
}
print "<tr><td></td></tr>\n" ;
print "</table>\n" ;
print "<table><tr><td height=\"10\"></td></tr>\n" ;
print "</table>\n" ;
my $ sql = qq( SELECT * 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" ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_expenditure\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<table><tr><td colspan=\"1\" height=\"20\"><INPUT TYPE=\"submit\" VALUE=\"return to edit expenditure\"></td></tr>\n" ;
print "</FORM>\n" ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"compile_budget\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<tr><td colspan=\"1\" hegiht=\"10\"><INPUT TYPE=\"submit\" VALUE=\"go to view the budget as a whole\"></td></tr>\n" ;
print "</td></tr></table>\n" ;
print "</FORM>\n" ;
}
# print "<br><br><a href=\"$script_name?action=prepare_expenditure&budget_id=$budget_id\">add or ammend more expenditure items</a>\n";
# print "<br><br><a href=\"$script_name?action=compile_budget&budget_id=$budget_id\">got to view the budget as a whole</a>\n";
print "</center>\n" ;
print "</body>\n" ;
print "</html>\n" ;
$ dbh - > disconnect ;
}
############################################################################
# prepare agents
sub prepare_agents {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT * FROM agents WHERE budget_id = $budget_id ORDER BY lastname ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
my $ sqlc = qq( SELECT COUNT ( * ) AS count FROM agents WHERE budget_id = $budget_id ) ;
my $ sthc = $ dbh - > prepare ( $ sqlc ) ;
$ sthc - > execute ;
my $ sqln = qq( SELECT name FROM budgets where id = $budget_id ) ;
my $ sthn = $ dbh - > prepare ( $ sqln ) ;
$ sthn - > execute ;
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
while ( my $ recordn = $ sthn - > fetchrow_hashref ) {
print "<tr><td height=\"10\" class=\"medbig\" colspan=\"5\"><b> Agents: $recordn->{name}</td></tr>" ;
}
print "<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 "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"edit_agent\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"edit_agent_id\" value=\"$record->{id}\">\n" ;
print "<input type=\"hidden\" name=\"new_firstname\" value=\"$record->{firstname}\">\n" ;
print "<input type=\"hidden\" name=\"new_lastname\" value=\"$record->{lastname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<tr><td><INPUT TYPE=\"submit\" VALUE=\"$i\"></td>\n" ;
print "<td>$record->{firstname}</td>\n" ;
print "<td>$record->{lastname}</td>\n" ;
print "<td>$record->{codename}</td>\n" ;
print "</FORM>\n" ;
$ i + +
}
}
print "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"input_agents\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<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 "<tr><td><b>$i.</b></td>\n" ;
print "<td><input type=\"text\" name=\"new_firstname$i\" size=20 maxsize=40></td>\n" ;
print "<td><input type=\"text\" name=\"new_lastname$i\" size=20 maxsize=40></td>\n" ;
print "<td><input type=\"text\" name=\"new_codename$i\" size=10 maxsize=10></td>\n" ;
# $i++
}
}
print "<tr><td><INPUT TYPE=\"submit\" VALUE=\"submit\"></td></tr>\n" ;
print "</FORM>\n" ;
print "<tr><td><BR><BR></td></tr>\n" ;
}
############################################################################
# edit agent
sub edit_agent {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
# read in agent data
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
print "<tr><td height=\"10\" class=\"medbig\" colspan=\"5\"><b> Edit agent</td></tr>" ;
print "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"update_agent\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"edit_agent_id\" value=\"$edit_agent_id\">\n" ;
print "<td><input type=\"text\" name=\"new_firstname\" value=\"$new_firstname\" size=20 maxsize=40></td>\n" ;
print "<td><input type=\"text\" name=\"new_lastname\" value=\"$new_lastname\" size=20 maxsize=40></td>\n" ;
print "<td><input type=\"text\" name=\"new_codename\" value=\"$new_codename\" size=10 maxsize=10></td>\n" ;
print "<tr><td><INPUT TYPE=\"submit\" VALUE=\"submit\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</table>\n" ;
print "<table><tr><td height=\"10\"></td></tr>\n" ;
print "</table>\n" ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_agents\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<input type=\"hidden\" name=\"new_agent\" value=\"$record->{fullname}\">\n" ;
print "<input type=\"hidden\" name=\"new_codename\" value=\"$record->{codename}\">\n" ;
print "<table><tr><td colspan=\"1\" height=\"20\"><INPUT TYPE=\"submit\" VALUE=\"return to agents overview\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</center>\n" ;
print "</body>\n" ;
print "</html>\n" ;
$ dbh - > disconnect ;
}
############################################################################
# update agent
sub update_agent {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
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 ;
# read back agent info
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
print "<table><tr><td height=\"10\"></td></tr>\n" ;
print "</table>\n" ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_agents\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<table><tr><td colspan=\"1\" height=\"20\"><INPUT TYPE=\"submit\" VALUE=\"return to agents overview\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</center>\n" ;
print "</body>\n" ;
print "</html>\n" ;
$ dbh - > disconnect ;
}
############################################################################
# input agents
sub input_agents {
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 ;
}
}
# read back agent info
& header ;
print "<center>\n" ;
print "<table width=\"700\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<tr><td><table width=\"700\" cellspacing=\"5\" cellpadding=\"2\" bgcolor=\"#ffffff\" border=\"0\">\n" ;
print "<tr><td class=\"lge\" align=\"center\" bgcolor=\"#fff000\" colspan=\"5\"><font color=\"#000000\"><b>feral budget generator</b></td></tr>\n" ;
print "<table><tr><td height=\"10\"></td></tr>\n" ;
print "</table>\n" ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"prepare_agents\">\n" ;
print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n" ;
print "<input type=\"hidden\" name=\"budget_id\" value=\"$budget_id\">\n" ;
print "<input type=\"hidden\" name=\"agent_id\" value=\"$agent_id\">\n" ;
print "<table><tr><td colspan=\"1\" height=\"20\"><INPUT TYPE=\"submit\" VALUE=\"return to agents overview\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</center>\n" ;
print "</body>\n" ;
print "</html>\n" ;
$ dbh - > disconnect ;
}
############################################################################
# add form
sub add_form {
& header ;
print "<center>\n" ;
print "<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 "<h3> </h3>\n" ;
print "\n" ;
print "<table width=\"600\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#efefef\">\n" ;
print "<tr><td><b>Budget</b><td><b>Date</b></td><td><b></b></td></tr>" ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print "<tr><td>" ;
print "<a href=\"$script_name?action\=edit_form&edit_id=$record->{id}\">$record->{name}</a> </td>" ;
print "<td>$record->{date}</td>" ;
print "<td></td>" ;
print "</tr>" ;
}
print "<tr><td> </td></tr>\n" ;
$ dbh - > disconnect ;
print "<FORM ACTION=\"$script_name\"METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"add_budget\">\n" ;
print "<tr><td><b>add a new budget</b><br>\n" ;
print "<input type=\"text\" name=\"new_name\" size=60 maxsize=80><br></td>\n" ;
print "<td><b>date</b><br>" ;
print "<td><b></b><br>\n" ;
print "<tr><td> </td></tr>\n" ;
#print "<tr><td><b>password</b></td></tr>\n";
#print "<td><input type=\"password\" name=\"password\" size=10 value=\"\"maxsize=20></td></tr>\n";
print "<tr><td><br><INPUT TYPE=\"submit\" VALUE=\"add\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</table>\n" ;
& footer ;
$ dbh - > disconnect ;
}
###############################################################################
###############################################################################
# add budget
sub add_budget {
#if ($password eq $admin_password) {
### test if workshop exists already in database
if ( $ new_name ne '' ) {
$ new_name_found = 'false' ;
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT name FROM budgets ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
if ( $ record - > { name } eq $ new_name ) { $ new_name_found = 'true' ; }
}
if ( $ new_name_found eq 'false' ) {
my $ sql = ( qq{ INSERT INTO budgets (name) VALUES ('$new_name') } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
my $ sql2 = ( qq{ SELECT * from budgets where name='$new_name' } ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
$ dbh - > disconnect ;
& header ;
while ( my $ record2 = $ sth2 - > fetchrow_hashref ) {
print "<center>\n" ;
print "<table width=\"800\" cellspacing=\"0\" cellpadding=\"2\" bgcolor=\"#efefef\">\n" ;
print "<tr><td>budget added <a href=\"$script_name?action=edit_form&edit_id=$record2->{id}\">$new_name</a></td></tr>\n" ;
print "</table>\n" ;
}
& footer ;
} else {
& header ;
print "duplicate budget entry<br>\n" ;
& footer ;
}
} else {
& header ;
print "no budget entered<br>\n" ;
& footer ;
}
#} else {
#&header;
#print "<h3>Wrong password !</h3><p>\n";
#&footer;
# }
}
###############################################################################
# add budget information
sub add_budget_information {
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',
WHERE name = '$new_name' } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
$ dbh - > disconnect ;
& header ;
print "<center>\n" ;
print "<b> $projectname:</b> $new_name added " ;
#print "$add_information \n";
print "<p><a href=\"$script_name?action=display_budgets\">view all budgets</a></p>\n" ;
print "<p><a href=\"$script_name\"></a></p>\n" ;
& footer ;
}
###############################################################################
# edit select form: select which budget to edit
sub edit_select_form {
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 ;
& header ;
print "<center>\n" ;
print "<b> edit a budget <br> \n" ;
print "<table width=\"500\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#efefef\">\n" ;
print "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"edit_form\">\n" ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print "<tr><td><input type=\"radio\" name=\"edit_id\" value=\"$record->{id}\"</td> \n" ;
print " <td>$record->{name}\n" ;
}
print "<tr><td colspan=\"2\"><INPUT TYPE=\"submit\" VALUE=\"edit budget\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</table>\n" ;
$ dbh - > disconnect ;
& footer ;
}
###############################################################################
# edit form: edit selected budget
sub edit_form {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT * FROM budgets WHERE id=$edit_id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
& header ;
print "<center>\n" ;
print "<h3> $projectname: edit budget</h3>\n" ;
# print "<img src=\"$image_url/thumb/$edit_id.jpg\" width=\"100\"border=0\" alt=\"\">\n";
print "<table width=\"800\" cellspacing=\"0\" cellpadding=\"2\" bgcolor=\"#efefef\">\n" ;
print "<tr><td bgcolor=\"#ffffff\"> </td></tr>\n" ;
print "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"edit_budget\">\n" ;
print "<input type=\"hidden\" name=\"edit_id\" value=\"$edit_id\">\n" ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print "<tr><td class=\"mini\"><i></i> <input type=\"text\" name=\"new_name\" value=\"$record->{name}\"size=50 maxsize=100></td></tr>\n" ;
print "<tr><td class=\"mini\"><input type=\"text\" name=\"new_location\" value=\"$record->{location}\"size=50 maxsize=100> location</td></tr>\n" ;
print "<tr><td class=\"mini\"><input type=\"text\" name=\"new_url\" value=\"$record->{url}\"size=100 maxsize=100> url</td></tr>\n" ;
print "<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 "<tr><td class=\"\"><TEXTAREA name=\"new_remarks\" ROWS=\"16\" COLS=\"120\" WRAP=SOFT>$record->{remarks}</TEXTAREA></td></tr>\n" ;
print "<tr><td><b></b></td></tr>\n" ;
# print "<tr><td><i>password</i></td></tr><tr><td><input type=\"password\" name=\"password\" size=10 value=\"\"maxsize=20></td></tr>\n";
print "<tr><td><INPUT TYPE=\"submit\" VALUE=\"edit budget\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</table>\n" ;
print "</table>\n" ;
}
& footer ;
###############################################################################
# present budget: present singlebudget
sub present_budget {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = qq( SELECT DISTINCT * FROM budgets WHERE id=$edit_id ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
& header ;
# print "<center>\n";
print "<h3> $projectname: budget notes</h3>\n" ;
# print "<img src=\"$image_url/thumb/$edit_id.jpg\" width=\"100\"border=0\" alt=\"\">\n";
print "<table width=\"1000\" cellspacing=\"20\" cellpadding=\"0\" bgcolor=\"#ffffff\">\n" ;
print "<input type=\"hidden\" name=\"edit_id\" value=\"$edit_id\">\n" ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
$ record - > { remarks } =~ s/\n/\<br>/g ;
print "<tr><td bgcolor=\"fff000\" class=\"max\"><i></i>$record->{name}, \n" ;
print "$record->{location}</td><td> </td></tr>\n" ;
print "<tr><td class=\"med\"><a href=\"$record->{url}\">$record->{url}</a></td></tr>\n" ;
# print "<tr><td height=\"20\"><b></b></td></tr>\n";
print "<tr><td class=\"max\"><b>Remarks:</b> When, where, who</td></tr>\n" ;
print "<tr><td class=\"med\">$record->{remarks}</td></tr>\n" ;
# print "<tr><td height=\"20\"><b></b></td></tr>\n";
# print "<tr><td><i>password</i></td></tr><tr><td><input type=\"password\" name=\"password\" size=10 value=\"\"maxsize=20></td></tr>\n";
print "<tr><td></td></tr>\n" ;
print "</table>\n" ;
print "</table>\n" ;
}
& footer ;
}
###############################################################################
# edit budget: edit budget results
sub edit_budget {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
#if ($password eq $admin_password) {
& header ;
### update budgets table
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 ;
### display results
my $ sql = qq( SELECT * FROM budgets WHERE id = '$edit_id' ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
print "<center>\n" ;
# print "<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 "<table width=\"300\" cellspacing=\"0\" cellpadding=\"2\" bgcolor=\"#efefef\">\n" ;
print "<tr><td bgcolor=\"#ffffff\">updated</td></tr>\n" ;
print "<tr><td><a href=\"$script_name?action=edit_form&edit_id=$edit_id\">$record->{name}</a></td></tr>\n" ;
print "</table><br>" ;
}
$ dbh - > disconnect ;
& footer ;
}
###############################################################################
# delete form: select a budget to delete
sub delete_form {
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 ;
& header ;
print "<center>\n" ;
print "<b> delete a budget <br> \n" ;
print "<table width=\"800\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#efefef\">\n" ;
print "<FORM ACTION=\"$script_name\" METHOD=\"GET\">\n" ;
print "<input type=\"hidden\" name=\"action\" value=\"delete_budget\">\n" ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
# print "<input type=\"hidden\" name=\"new_name\" value=\"$record->{name}\">\n";
print "<tr><td><input type=\"radio\" name=\"delete_id\" value=\"$record->{id}\"</td> \n" ;
print " <td>$record->{name}\n" ;
print "$record->{location}\n" ;
}
print "<tr><td><b>password</b></td><td><input type=\"password\" name=\"password\" size=10 value=\"\"maxsize=20></td></tr>\n" ;
print "<tr><td colspan=\"2\"><INPUT TYPE=\"submit\" VALUE=\"delete budget\"></td></tr>\n" ;
print "</FORM>\n" ;
print "</table>\n" ;
$ dbh - > disconnect ;
& footer ;
}
###############################################################################
# delete budget: budget delete results
sub delete_budget {
my $ dbh = DBI - > connect ( $ db_conect , $ db_user , $ db_pass )
or die ( "can't connect: $DBI::errstr" ) ;
my $ sql = ( qq{ SELECT * FROM budgets WHERE id = '$delete_id' } ) ;
my $ sth = $ dbh - > prepare ( $ sql ) ;
$ sth - > execute ;
my $ sql2 = ( qq{ DELETE FROM budgets WHERE id = '$delete_id' } ) ;
my $ sth2 = $ dbh - > prepare ( $ sql2 ) ;
$ sth2 - > execute ;
while ( my $ record = $ sth - > fetchrow_hashref ) {
& header ;
print "$record->{name} deleted\n" ;
}
& footer ;
$ dbh - > disconnect ;
}
###############################################################################
# display budget: displays all budgets
sub display_budgets {
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 ;
& header ;
print "<center>\n" ;
print "<h3> $projectname: all budgets: edit mode</h3>\n" ;
print "<table width=\"1000\" cellspacing=\"2\" cellpadding=\"2\" bgcolor=\"#ffffff\"\">\n" ;
print "<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 "<tr>\n" ;
print "<td bgcolor=\"#efefef\"><a href=\"$script_name?action\=edit_form&edit_id=$record->{id}\">$record->{name}</a></td>" ;
print "<td bgcolor=\"#efefef\">$record->{location}</td>" ;
print "<td bgcolor=\"#efefef\">$record->{deliver_date}</td>" ;
print "<td bgcolor=\"#efefef\"><a href=\"$record->{url}\">$record->{url}</a></td>" ;
# print "<td bgcolor=\"#efefef\"><img src=\"$image_url/thumb/$record->{id}.jpg\" width=\"100\"border=\"0\" title=\"edit $record->{name}\" alt=\"\"></td>";
print "</td></tr>\n" ;
}
$ dbh - > disconnect ;
print "</table>\n" ;
& footer ;
}
###############################################################################
# list budgets: list all budgets, non-edit mode
sub list_budgets {
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 ;
& header ;
print "<center>\n" ;
print "<h3> $projectname: all budgets: read-only</h3>\n" ;
print "<table width=\"1000\" cellspacing=\"2\" cellpadding=\"2\" bgcolor=\"#ffffff\"\">\n" ;
print "<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 "<tr>\n" ;
print "<td bgcolor=\"#efefef\"><a href=\"$script_name?action\=present_budget&edit_id=$record->{id}\">$record->{name}</a></td>" ;
print "<td bgcolor=\"#efefef\">$record->{location}</td>" ;
print "<td bgcolor=\"#efefef\">$record->{deliver_date}</td>" ;
print "<td bgcolor=\"#efefef\"><a href=\"$record->{url}\">$record->{url}</a></td>" ;
# print "<td bgcolor=\"#efefef\"><img src=\"$image_url/thumb/$record->{id}.jpg\" width=\"100\"border=\"0\" title=\"edit $record->{name}\" alt=\"\"></td>";
print "</td></tr>\n" ;
}
$ dbh - > disconnect ;
print "</table>\n" ;
& footer ;
}
##############################################################################################
# select start date subroutine
sub select_start_date {
### day
print "<td colspan=\"2\"><select name=\"new_start_day\">\n" ;
for ( $ i = 1 ; $ i < 10 ; $ i += 1 ) {
print "<option" ;
if ( $ new_start_day eq "0$i" ) { print " selected" ; }
if ( ( $ new_start_day eq "" ) && ( $ currentdayofmonth eq $ i ) ) { print " selected" ; }
print ">0$i</option>\n" ;
}
for ( $ i = 10 ; $ i < 32 ; $ i += 1 ) {
print "<option" ;
if ( $ new_start_day eq $ i ) { print " selected" ; }
if ( ( $ new_start_day eq "" ) && ( $ currentdayofmonth eq $ i ) ) { print " selected" ; }
print ">$i</option>\n" ;
}
print "</select>\n" ;
### month
print "<select name=\"new_start_month\">\n" ;
for ( $ j = 1 ; $ j < 10 ; $ j += 1 ) {
print "<option" ;
if ( $ new_start_month eq "0$j" ) { print " selected" ; }
if ( ( $ new_start_month eq "" ) && ( $ currentmonth eq $ j ) ) { print " selected" ; }
print ">0$j</option>\n" ;
}
for ( $ j = 10 ; $ j < 13 ; $ j += 1 ) {
print "<option" ;
if ( $ new_start_month eq $ j ) { print " selected" ; }
if ( ( $ new_start_month eq "" ) && ( $ currentmonth eq $ j ) ) { print " selected" ; }
print ">$j</option>\n" ;
}
print "</select>\n" ;
### year
print "<select name=\"new_start_year\">\n" ;
for ( $ j = 2003 ; $ j < 2022 ; $ j += 1 ) {
print "<option" ;
if ( $ new_start_year eq $ j ) { print " selected" ; }
if ( ( $ new_start_year eq "" ) && ( $ currentyear eq $ j ) ) { print " selected" ; }
print ">$j</option>\n" ;
}
print "</select></td></tr>\n" ;
}
###############################################################################
# header subroutine
sub header {
print << END ;
< ! DOCTYPE html >
< html lang = "en" >
<head>
< meta charset = "UTF-8" >
< meta name = "viewport" content = "width=device-width" >
<title> feral budget generator </title>
< link rel = "stylesheet" href = "css/styles.css" >
< link rel = "stylesheet" href = "css/print.css" media = "print" >
</head>
END
}
###############################################################################
# footer subroutine
sub footer {
print << END ;
</body>
</html>
END
}
###############################################################################
# adminfooter subroutine
sub adminfooter {
print "<tr><td bgcolor=\"ffffff\" colspan=\"4\"><br><a href=\"$script_name?action\=display_budgets\">all budgets: edit</a></td></tr>\n" ;
print "<tr><td bgcolor=\"ffffff\" colspan=\"4\"><br><a href=\"$script_name?action\=list_budgets\">all budgets: list</a></td></tr>\n" ;
print "<tr><td bgcolor=\"ffffff\" colspan=\"4\"><br><a href=\"$script_name?action\=add_form\">add a budget</a> \ \; \|\n" ;
print "<a href=\"$script_name?action\=delete_form\">delete a budget</a> \ \; \n" ;
print "</center>\n" ;
print "</body>\n" ;
print "</html>\n" ;
}
}