[ic] date widget

[Jonathan Clark]

This is a multi-part message in MIME format.

------=_NextPart_000_0005_01C1C390.C4F51EB0
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit


> I have a field in the products database called "date" and it is of course
> the product's publish date.  I setup the meta data to use the Date widget
> for the input.  The problem is that the date widget goes all the
> way back to
> 2001 for the year, when I need it to go farther.  I suppose this is being
> automatically generated with something somewhere.  I've searched the docs
> and list to no avail.  Any pointers on where to go to change the
> behavior of
> this widget would be very helpful.

Widgets live in Primiive.pm.

Yes, its hard-coded in 4.8.x:

my (@years) = ( $t[5] + 1899 .. $t[5] + 1910 );

4.9 improves things muchly with two new variables:

UI_DATE_BEGIN - year to start dropdown
UI_DATE_END - year to stop (defaults to start+10)

Attached is the new subroutine fyi. This may work as a replacement in
Primitive.pm (not tested)

Jonathan
Webmaint.

------=_NextPart_000_0005_01C1C390.C4F51EB0
Content-Type: text/plain;
	name="date_widget.txt"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
	filename="date_widget.txt"

sub date_widget {
	my($name, $val, $time) = @_;
	if($val =~ /\D/) {
		$val = Vend::Interpolate::filter_value('date_change', $val);
	}
	my $now;
	if($time and $time =~ /([-+])(\d+)/) {
		my $sign = $1;
		my $adjust = $2;
		$adjust *= 3600;
		$now = time;
		$now += $sign eq '+' ? $adjust : -$adjust;
	}

	@t = localtime($now || time);
	if (not $val) {
		$t[2]++ if $t[2] < 23;
		$val = POSIX::strftime("%Y%m%d%H00", @t);
	}
	my $sel = 0;
	my $out = qq{<SELECT NAME="$name">};
	my $o;
	for(@months) {
		$o = qq{<OPTION VALUE="$_->[0]">} . errmsg($_->[1]) . '</OPTION>';
		($out .= $o, next) unless ! $sel and $val;
		$o =~ s/>/ SELECTED>/ && $sel++
			if substr($val, 4, 2) eq $_->[0];
		$out .= $o;
	}
	$sel = 0;
	$out .= qq{</SELECT>};
	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE="/">};
	$out .= qq{<SELECT NAME="$name">};
	for(@days) {
		$o = qq{<OPTION VALUE="$_->[0]">$_->[1]} . '</OPTION>';
		($out .= $o, next) unless ! $sel and $val;
		$o =~ s/>/ SELECTED>/ && $sel++
			if substr($val, 6, 2) eq $_->[0];
		$out .= $o;
	}
	$sel = 0;
	$out .= qq{</SELECT>};
	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE="/">};
	$out .= qq{<SELECT NAME="$name">};
	if($::Variable->{UI_DATE_BEGIN}) {
		my $cy = $t[5] + 1900;
		my $by = $::Variable->{UI_DATE_BEGIN};
		my $ey = $::Variable->{UI_DATE_END} || ($cy + 10);
		if($by < 100) {
			$by = $cy - abs($by);
		}
		if($ey < 100) {
			$ey += $cy;
		}
		@years = ($by .. $ey);
	}
	for(@years) {
		$o = qq{<OPTION>$_} . '</OPTION>';
		($out .= $o, next) unless ! $sel and $val;
		$o =~ s/>/ SELECTED>/ && $sel++
			if substr($val, 0, 4) eq $_;
		$out .= $o;
	}
	$out .= qq{</SELECT>};
	return $out unless $time;

	$val =~ s/^\d{8}//;
	$val =~ s/\D+//g;
	$val = round_to_fifteen($val);
	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE=":">};
	$out .= qq{<SELECT NAME="$name">};
	
	my $ampm = $time =~ /pm/ ? 1 : 0;
	my $mod = '';
	undef $sel;
	my %special = qw/ 0 midnight 12 noon /;
	
	$ampm =1;
	for my $hr ( 0 .. 23) {
		for my $min ( 0,15,30,45 ) {
			my $disp_hour = $hr;
			if($ampm) {
				if( $hr < 12) {
					$mod = 'am';
				}
				else {
					$mod = 'pm';
					$disp_hour = $hr - 12 unless $hr == 12;
				}
				$mod = errmsg($mod);
				$mod = " $mod";
			}
			if($special{$hr} and $min == 0) {
				$disp_hour = errmsg($special{$hr});
			}
			elsif($ampm) {
				$disp_hour = sprintf("%2d:%02d%s", $disp_hour, $min, $mod);
			}
			else {
				$disp_hour = sprintf("%02d:%02d", $hr, $min);
			}
			my $time = sprintf "%02d%02d", $hr, $min;
			$o = sprintf qq{<OPTION VALUE="%s">%s}, $time, $disp_hour;
			($out .= $o, next) unless ! $sel and $val;
#::logDebug("prospect=$time actual=$val");
			$o =~ s/>/ SELECTED>/ && $sel++
				if $val eq $time;
			$out .= $o;
		}
	}
	$out .= "</SELECT>";
	return $out;
}
------=_NextPart_000_0005_01C1C390.C4F51EB0--