code/UserTag/button.tag

   1 # Copyright 2002-2008 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: button.tag,v 1.25 2008-06-15 19:11:16 jure Exp $
   9
  10 UserTag button Order     name src text
  11 UserTag button addAttr
  12 UserTag button attrAlias value text
  13 UserTag button hasEndTag
  14 UserTag button Version   $Revision: 1.25 $
  15 UserTag button Routine   <<EOR
  16 sub {
  17         my ($name, $src, $text, $opt, $action) = @_;
  18
  19         my $trigger_text;
  20
  21         if($opt->{wait_text}) {
  22                 $trigger_text = $opt->{wait_text};
  23         }
  24         else {
  25                 $trigger_text = $text;
  26         }
  27
  28         my @js;
  29         my $image;
  30
  31         my @from_html = qw/class id style/;
  32
  33         if($src) {
  34                 if( $opt->{srcliteral} || $src =~ m{^https?://}i ) {
  35                         $image = $src;
  36                 }
  37                 else {
  38                         my $dr = $::Variable->{DOCROOT};
  39                         my $id = $Tag->image( { dir_only => 1 } );
  40                         $id =~ s:/+$::;
  41                         $id =~ s:/~[^/]+::;
  42
  43                         if( $dr and $id and $src =~ m{^[^/]} and -f "$dr$id/$src" ) {
  44                                 $image = $src;
  45                         }
  46                         elsif( $dr and $src =~ m{^/} and -f "$dr/$src" ) {
  47                                 $image = "$id/$src";
  48                         }
  49                         else {
  50                                 ::logError("No image file '$src' found or image file name is invalid.");
  51                         }
  52                 }
  53         }
  54         my $onclick = '';
  55         my $onmouseover = '';
  56         my $onmouseout = '';
  57         while($action =~ s! \[
  58                                                 (
  59                                                         j (?:ava)? s (?:cript)?
  60                                                 )
  61                                                 \]
  62                                                         (.*?)
  63                                           \[ / \1 \]
  64                                           !!xis
  65                 )
  66         {
  67                 my $script = $2;
  68                 $script =~ s/\s+$//;
  69                 $script =~ s/^\s+//;
  70                 if($script =~ s/\bonclick\s*=\s*"(.*?)"//is) {
  71                         $onclick = $1;
  72                         next;
  73                 }
  74                 if ($script =~ s/\bonmouse(\w+)\s*=\s*"(.*?)"//is) {
  75                         if (lc($1) eq 'over') {
  76                                 $onmouseover .= ($onmouseover ? ';' : '') . $2;
  77                         }
  78                         elsif (lc($1) eq 'out') {
  79                                 $onmouseout .= ($onmouseout ? ';' : '') . $2;
  80                         }
  81                         else {
  82                                 logError(q{Skipping 'onmouse%s', invalid JavaScript event}, $1);
  83                         }
  84                         next;
  85                 }
  86                 push @js, $script;
  87         }
  88
  89         if(! $name or $name eq 'mv_click') {
  90                 $action =~ s/^\s+//;
  91                 $action =~ s/\s+$//;
  92                 my $set_text = HTML::Entities::decode($trigger_text);
  93                 $::Scratch->{$set_text} = $action;
  94                 $name = 'mv_click' if ! $name;
  95         }
  96
  97         my $out = '';
  98         my $confirm = '';
  99         my $wait = '';
 100         $opt->{extra} = $opt->{extra} ? " $opt->{extra}" : '';
 101         if($opt->{confirm}) {
 102                 $opt->{confirm} =~ s/'/\\'/g;
 103                 $confirm = "confirm('$opt->{confirm}')";
 104         }
 105
 106         if($onclick) {
 107                 $confirm .= ' && ' if $confirm;
 108                 $onclick = qq{ onClick="$confirm$onclick"};
 109         }
 110
 111         # Constructing form button. Will be sent back in all cases,
 112         # either as the primary button or as the <noscript> option
 113         # for JavaScript-challenged browsers.
 114         $text =~ s/"/&quot;/g;
 115         $name =~ s/"/&quot;/g;
 116         $out = qq{<input type="submit" name="$name" value="$text"$onclick$Vend::Xtrailer>};
 117         if (@js) {
 118                 $out =~ s/ /join "\n", '', @js, ''/e;
 119         }
 120
 121         $opt->{extra} ||= '';
 122         for(@from_html) {
 123                 next unless $opt->{$_};
 124                 $opt->{extra} .= qq{ $_="$opt->{$_}"};
 125         }
 126
 127         # return submit button if not an image
 128         if(! $image) {
 129                 $text =~ s/"/&quot;/g;
 130                 $name =~ s/"/&quot;/g;
 131                 if(! $onclick and $confirm) {
 132                         $onclick = qq{ onclick="return $confirm"};
 133                 }
 134                 elsif(! $onclick and $opt->{wait_text}) {
 135                         $opt->{wait_text} = HTML::Entities::encode($trigger_text);
 136                         $onclick  = qq{ onClick="};
 137                         $onclick .= qq{var msg = 'Already submitted.';};
 138                         $onclick .= qq{this.value = '$opt->{wait_text}';};
 139                         $onclick .= qq{this.onclick = 'alert(msg)'; return true;};
 140                         $onclick .= qq{"};
 141                 }
 142
 143                 my $out = $opt->{bold} ? '<b>' : '';
 144                 $out .= qq{<input$opt->{extra} type="submit" name="$name" value="$text"$onclick$Vend::Xtrailer>};
 145                 $out .= '</b>' if $opt->{bold};
 146                 if(@js) {
 147                         $out =~ s/ /join "\n", '', @js, ''/e;
 148                 }
 149                 return $out;
 150         }
 151
 152         # If we got here the button is an image
 153         # Wrap form button code in <noscript>
 154         my $no_script = qq{<noscript>$out</noscript>\n};
 155         $out = '';
 156
 157         my $wstatus = $opt->{alt} || $text;
 158         $wstatus =~ s/'/\\'/g;
 159
 160         my $clickname = $name;
 161         my $clickvar = $name;
 162         if($image and $name eq 'mv_click') {
 163                 $clickvar = $text;
 164                 $clickvar =~ s/\W/_/g;
 165                 $clickname = "mv_click_$clickvar";
 166                 $out = qq{<input type='hidden' name='mv_click_map' value='$clickvar'$Vend::Xtrailer>};
 167         }
 168
 169         $out .= qq{<input type='hidden' name='$clickname' value=''$Vend::Xtrailer>} if $image;
 170
 171         my $formname;
 172         $opt->{form} = 'forms[0]'
 173                 if ! $opt->{form};
 174
 175         $confirm .= ' && ' if $confirm;
 176         $opt->{border} = 0 if ! $opt->{border};
 177
 178         if($opt->{getsize}) {
 179                 eval {
 180                         require Image::Size;
 181                         ($opt->{width}, $opt->{height}) = Image::Size::imgsize($image);
 182                 };
 183         }
 184
 185         $opt->{align} = 'top' if ! $opt->{align};
 186
 187         my $position = '';
 188         for(qw/height width vspace hspace align/) {
 189                 $position .= " $_='$opt->{$_}'" if $opt->{$_};
 190         }
 191
 192         my $anchor = '';
 193         unless( $opt->{hidetext}) {
 194                 $anchor = $opt->{anchor} || $text;
 195                 $anchor =~ s/ /&nbsp;/g;
 196                 $anchor = "<b>$anchor</b>";
 197         }
 198
 199         my $a_before = '</a>';
 200         my $a_after  = '';
 201         if($opt->{link_text_too}) {
 202                 $a_before = '';
 203                 $a_after = '</a>';
 204         }
 205
 206         $opt->{link_href} ||= 'javascript: void 0';
 207         if ($onclick =~ /^\s*onclick\s*=\s*"(.*?)"/i) {
 208                 $onclick = $1 . ' && ';
 209         }
 210         # QUOTING (fix here too?)
 211         $out .= <<EOF;
 212 <a href="$opt->{link_href}"$opt->{extra} onMouseOver="window.status='$wstatus';$onmouseover"
 213 EOF
 214         $out .= <<EOF if $onmouseout;
 215         onMouseOut="$onmouseout"
 216 EOF
 217         $out .= <<EOF;
 218         onClick="$confirm $onclick mv_click_map_unique(document.$opt->{form}, '$clickname', '$text') && $opt->{form}.submit(); return(false);"
 219         alt="$wstatus"><img alt="$wstatus" src="$src" border='$opt->{border}'$position>$a_before$anchor$a_after
 220 EOF
 221
 222         my $function = '';
 223         unless ($::Instance->{js_functions}{mv_do_click}++) {
 224                 $function = "\n" . <<'EOJS';
 225 function mv_click_map_unique(myform, clickname, clicktext) {
 226         for (var i = 0; i < myform.length; i++) {
 227                 var widget = myform.elements[i];
 228                 if (
 229                         (widget.type == 'hidden')
 230                         && (widget.name != 'mv_click_map')
 231                         && (widget.name.indexOf('mv_click_') == 0)
 232                 )
 233                         widget.value = (widget.name == clickname) ? clicktext : '';
 234         }
 235         return true;
 236 }
 237 EOJS
 238         }
 239
 240         # Must escape backslashes and single quotes for JavaScript write function.
 241         # Also must get rid of newlines and carriage returns.
 242         $out =~ s/(['\\])/\\$1/g;
 243         $out =~ s/[\n\r]+/ /g;
 244         $out = <<EOV;
 245 <script language="javascript1.2" type="text/javascript">
 246 <!--$function
 247 document.write('$out');
 248 // -->
 249 </script>
 250 $no_script
 251 EOV
 252
 253         return $out;
 254 }
 255
 256 EOR