home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / datetime.pm < prev    next >
Encoding:
Text File  |  2001-11-05  |  3.0 KB  |  129 lines
  1. ############################################################################
  2. #
  3. # Win32::ASP::Field::datetime - implements datetime fields in the Win32-ASP-DB system
  4. #
  5. # Author: Toby Everett
  6. # Revision: 0.02
  7. # Last Change:
  8. ############################################################################
  9. # Copyright 1999, 2000 Toby Everett.  All rights reserved.
  10. #
  11. # This file is distributed under the Artistic License. See
  12. # http://www.ActiveState.com/corporate/artistic_license.htm or
  13. # the license that comes with your perl distribution.
  14. #
  15. # For comments, questions, bugs or general interest, feel free to
  16. # contact Toby Everett at teverett@alascom.att.com
  17. ############################################################################
  18.  
  19. use Win32::ASP::Field;
  20. use Error qw/:try/;
  21. use Win32::ASP::Error;
  22. use Win32::OLE::Variant;
  23.  
  24. package Win32::ASP::Field::datetime;
  25.  
  26. @ISA = ('Win32::ASP::Field');
  27.  
  28. use strict;
  29.  
  30. sub _check_value {
  31.   my $self = shift;
  32.   my($value) = @_;
  33.  
  34.   if (defined $value and $self->clean_datetime($value) eq '-1') {
  35.     throw Win32::ASP::Error::Field::bad_value (field => $self, bad_value => $value,
  36.         error => "The value is not in a legal datetime format.");
  37.   }
  38.  
  39.   $self->SUPER::_check_value($value);
  40. }
  41.  
  42. sub _read {
  43.   my $self = shift;
  44.   my($record, $results, $columns) = @_;
  45.  
  46.   my $name = $self->name;
  47.   ref($columns) and !$columns->{$name} and return;
  48.   $self->can_view($record) or return;
  49.   my $temp = $results->Fields->Item($name);
  50.   if ($temp) {
  51.     my $value = $temp->Value;
  52.     $value ne '' and $value = $self->clean_datetime($value);
  53.     $record->{orig}->{$name} = $value;
  54.   }
  55. }
  56.  
  57. sub _post {
  58.   my $self = shift;
  59.   my($record, $row) = @_;
  60.  
  61.   $self->SUPER::_post($record, $row);
  62.  
  63.   my $name = $self->name;
  64.   if (defined $record->{edit}->{$name}) {
  65.     my $temp = $self->clean_datetime($record->{edit}->{$name});
  66.     $temp ne '-1' and $record->{edit}->{$name} = $temp;
  67.   }
  68. }
  69.  
  70. sub _as_sql {
  71.   my $self = shift;
  72.   my($value) = @_;
  73.  
  74.   $self->check_value($value);
  75.  
  76.   defined $value or return 'NULL';
  77.  
  78.   $value = "'".$self->clean_datetime($value)."'";
  79.   return $value;
  80. }
  81.  
  82. sub _date_lcid {
  83.   my $self = shift;
  84.   my($DTobj) = @_;
  85.  
  86.   return "M/d/yyyy";
  87. }
  88.  
  89. sub _time_lcid {
  90.   my $self = shift;
  91.   my($DTobj) = @_;
  92.  
  93.   return "h:mm:ss tt";
  94. }
  95.  
  96. sub _format_date {
  97.   my $self = shift;
  98.   my($DTobj) = @_;
  99.  
  100.   return $DTobj->Date($self->date_lcid);
  101. }
  102.  
  103. sub _format_time {
  104.   my $self = shift;
  105.   my($DTobj) = @_;
  106.  
  107.   my $temp = $DTobj->Time($self->time_lcid);
  108.   my $temp2 = Win32::OLE::Variant->new(8, $temp);
  109.   $temp2->ChangeType(7);
  110.   $temp2->ChangeType(5);
  111.   return $temp2 ? $temp : '';
  112. }
  113.  
  114. { my %memo;
  115. sub _clean_datetime {
  116.   my $self = shift;
  117.   my($DTstr) = @_;
  118.  
  119.   unless (exists $memo{$DTstr}) {
  120.     my $temp = Win32::OLE::Variant->new(8, $DTstr);
  121.     $temp->ChangeType(7) or return -1;
  122.     $memo{$DTstr} = $self->format_date($temp)." ".$self->format_time($temp);
  123.   }
  124.   return $memo{$DTstr};
  125. }
  126. }
  127.  
  128. 1;
  129.