view release on metacpan or  search on metacpan

lib/CGI/Bus/tm.pm  view on Meta::CPAN

 if    (!defined($_[0])) {}
 elsif (ref($_[0]) eq 'ARRAY') {return $s->parent->qparam([map {$px .$_} @{$_[0]}], @_[1..$#_])}
 elsif (ref($_[0]) eq 'HASH')  {return $s->parent->qparam({map {$px .$_ => $_[0]->{$_}} keys %{$_[0]}}, @_[1..$#_])}
 else  {return $s->parent->qparam($px .$_[0], @_[1..$#_])}
 my $r  =[];
 foreach my $e ($s->cgi->param) {
   next if $px ne '' ? substr($e,0,length($px)) ne $px
        : grep {$s->{$_} eq substr($e,0,length($s->{$_}))} qw(-pxpv -pxsw -pxcb -pxqc);
   push @$r, $e;
 }
 $r
}

sub qloval {	# query list option value compose
		# (self, list name, param=>val,...)
	join("\t", $_[1], map {defined($_) ? $_ : ''
	} @_[2..(lc($_[$#_ -1]) eq lc(pxnme($_[0],-pxsw=>'listurm')) 
		? $#_ -2 : $#_)])
}

sub qlourl {	# query list option url
 $_[0]->qurl('' # (self, list name, param=>val,...)
	,pxnme($_[0],-pxcb=>'cmd') =>'-lst'
	,pxnme($_[0],-pxsw=>'LIST')=>$_[1]
	,pxnme($_[0],-pxsw=>'LSO') =>qloval(@_)
	,(map {	my ($n, $v) =($_,$_[0]->qparam($_));
		!defined($v) || $v eq ''
		|| substr($n,0,length($_[0]->{-pxcb})) eq $_[0]->{-pxcb}
		|| substr($n,0,length($_[0]->{-pxpv})) eq $_[0]->{-pxpv}
		|| $n eq '_login'
		|| $n eq pxnme($_[0],-pxsw=>'FRMCOUNT')
		|| $n eq pxnme($_[0],-pxsw=>'LIST')
		|| $n eq pxnme($_[0],-pxsw=>'LSO')
		|| $n eq pxnme($_[0],-pxsw=>'listurm')
		? ()
		: ($n=>$v)
		} $_[0]->cgi->param)
	,lc($_[$#_ -1]) eq lc(pxnme($_[0],-pxsw=>'listurm'))
	? (@_[($#_ -1)..$#_])
	: ())
}

sub qlowgh {	# query list option hidden widget
		# (self, ?default value)
 $_[0]->qparam(pxnme($_[0],-pxsw=>'LSO')) 
? ''
: ($_[0]->cgi->hidden(-name=>pxnme($_[0],-pxsw=>'LSO')
	, $#_ >0 
	? (-value=>$_[0]->qparam(pxnme($_[0],-pxsw=>'LSO'), qloval(@_))
		, -override=>1)
	: ()) ."\n")
}

sub qlowgl {	# query list option hyperlink widget
 my $s =shift;	# (self, ?(options), label, list name, param=>val,...)
 my $o =ref($_[0]) ? (shift @_) : undef;
 my $v =qloval($s,@_[1..$#_]);
 my $c =$v eq ($s->qparam(pxnme($s,-pxsw=>'LSO'))||'');
 $s->cgi->a({$o ? %$o : ()
	, -href=>qlourl($s,@_[1..$#_])
	, $c ? (-style=>'{ text-decoration: none; font-weight: bolder; }') : ()
			# font-style: italic;  font-weight: bolder;
#	, -onClick=>'{' .pxnme($s,-pxsw=>'LSO') .'.value="' # !!! read marking?
#		.do{	$v =~s/([\\"])/\\$1/g;
#			$v =~s/([\x00-\x1f])/sprintf("\\x%02x",ord($1))/eg;
# 			$v} .'"; ' 
#		.pxnme($s,-pxsw=>'LIST') .'.value="' .$_[1] .'"; '
#		.pxnme($s,-pxcb=>'cmdi') .'.value="-lst"; submit(); return(false)}'
	}, $_[0])
}

sub qloparse {	# query list option parse
 my $g =$_[0]->cgi;	# (self)
 my $v =$g->param(pxnme($_[0],-pxsw=>'LSO'));
 return(undef)	if !$v 
		|| $v !~/^([^\t]+)\t+(.+)$/
		|| lc($1) ne lc($g->param(pxnme($_[0],-pxsw=>'LIST')));
 local $^W=undef;
 my %p =(split /\t/, $2);
 my $w =pxnme($_[0],-pxsw=>'WHERE');
 foreach my $k (keys %p) {
	next if !defined($p{$k}) || $p{$k} eq '';
	$g->param($k
		, $k ne $w
		? $p{$k}
		: $g->param($w) && index(lc($g->param($w)||''), lc($p{$k})) <0
		? '(' .$g->param($w) .') AND (' .$p{$k} .')'
		: $p{$k});
 }
 $_[0]
}


###################################
# DECLARATIONS UTILITY METHODS
###################################


sub qlst {         # Query List Name
 my $s =shift;
 my $l =$s->qparamsw('LIST');
 return($l)    if $l && $s->{-lists} && $s->{-lists}->{$l};
 return(undef) if !$s->{-lists};
 my @a =sort keys %{$s->{-lists}};
 foreach my $v (@a) {
	return($l =$v)
	if	($v && substr($v,length($v)-1) eq '_')
	||	&{sub{$_[0] && substr($_[0],length($_[0])-1) eq '_'}}
		(ref($s->{-lists}->{$v}) eq 'HASH' && $s->{-lists}->{$v}->{-lbl})
 }
 $l =$a[0];
}


sub qlstnmes {     # Lists Names
 my $l =$_[0]->{-lists};
 my $r =[];
 if ($l) {
    foreach my $e (keys %$l) {
      next if substr($e,0,1) eq '_';
      push @$r, $e
    }