1__NAME__ ui_order_button_build 2[calc] 3 $Scratch->{tables_to_open} = join " ", @{$Config->{ProductFiles}}; 4 return; 5[/calc] 6[perl tables="[scratch tables_to_open]"] 7 delete $Scratch->{item_result}; 8 delete $Scratch->{test_button}; 9 my $result = <<EOF; 10<tr> 11<td colspan=2 class=rnorm VALIGN=TOP> 12 <B>Resulting button</B><BR> 13<TEXTAREA ROWS=5 COLS=70 NAME="item_result"> 14EOF 15 $result =~ s/\s+$//; 16 my @parms; 17 BUILD: { 18 if(! $CGI->{item_id}) { 19 $result .= "ERROR: no item selected"; 20 last BUILD; 21 } 22 my (@items) = split /\0/, $CGI->{item_id}; 23 for (@items) { 24 push @parms, "mv_order_item=$_"; 25 } 26 my @ones; 27 QUANTITY: { 28 last QUANTITY if ! length $CGI->{item_quantity}; 29 $CGI->{item_quantity} =~ s/[\s\0,]+$//; 30 @ones = split /[\0,\s]/, $CGI->{item_quantity}; 31 for(@ones) { 32 if(/[^\d.]/) { 33 $result .= "Error: item quantities must be numbers"; 34 last BUILD; 35 } 36 if( ! $Config->{FractionalItems} and $_ =~ /\./) { 37 $result .= "Error: item quantities must be integers with FractionalItems=no"; 38 last BUILD; 39 } 40 push @parms, "mv_order_quantity=$_"; 41 } 42 } 43 if(length $CGI->{item_separate}) { 44 push @parms, "mv_separate_items=$CGI->{item_separate}"; 45 } 46 if(length $CGI->{item_destination}) { 47 push @parms, "mv_nextpage=$CGI->{item_destination}"; 48 } 49 if($CGI->{item_button} > 1) { 50 my @fly; 51 if(! $CGI->{description}) { 52 $result .= "Error: on-the-fly item requires description"; 53 last BUILD; 54 } 55 push @fly, "description=$CGI->{description}"; 56 if(! $CGI->{price}) { 57 $result .= "Error: on-the-fly item requires price"; 58 last BUILD; 59 } 60 push @fly, "price=$CGI->{price}"; 61 push @parms, "mv_order_fly=" . join("|", @fly);; 62 } 63 if(length $CGI->{item_group}) { 64 push @parms, "mv_order_group=$CGI->{item_group}"; 65 } 66 if(length $CGI->{affiliate}) { 67 push @parms, "mv_source=$CGI->{affiliate}"; 68 } 69 for my $mod (@{$Config->{UseModifier}}) { 70 if($CGI->{"item_modifier_$mod"}) { 71 @ones = split /\s*,\s*/, $CGI->{"item_modifier_$mod"}; 72 for(@ones) { 73 push @parms, qq!mv_order_$mod=$_!; 74 } 75 } 76 } 77 } 78 my $button; 79 my $isbutton; 80 if(@parms) { 81 if($CGI->{item_button} == 1 || $CGI->{item_button} == 3) { 82 $isbutton = 1; 83 my $url = $Config->{VendURL} . '/order'; 84 $button = qq{<FORM ACTION="$url" METHOD=POST>\n}; 85 for(@parms) { 86 my ($name, $value) = split /=/, $_, 2; 87 $value =~ s/"/"/g; 88 $button .= qq{<INPUT TYPE=hidden NAME=$name VALUE="$value">\n}; 89 } 90 $button .= qq{<INPUT TYPE=submit VALUE="Test button"></FORM>}; 91 } 92 else { 93 $button = $Tag->area( 94 { 95 href => 'order', 96 form => join ("\n", @parms), 97 } 98 ); 99 $button =~ s/\bmv_session_id=\w+&?//; 100 } 101 $result .= $button; 102 } 103 $result .= "</TEXTAREA>\n"; 104 if ($isbutton and $button) { 105 $Scratch->{test_button} = $button; 106 $Scratch->{test_button} =~ s/METHOD=/TARGET=item_test METHOD=/; 107 } 108 else { 109 $Scratch->{test_button} = qq{<B><A HREF="$button" TARGET=item_test><FONT COLOR=__CONTRAST__>Test order link</FONT></A></B><BR> }; 110 } 111 $result .= "</td></tr>\n\n"; 112 $Scratch->{item_result} = $result; 113[/perl] 114__END__ 115