File: Sybase.pm

package info (click to toggle)
libtangram-perl 2.04-1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 572 kB
  • ctags: 495
  • sloc: perl: 5,061; makefile: 36
file content (74 lines) | stat: -rw-r--r-- 1,684 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
use strict;

############################################
# derive a DateExpr class from existing Expr

package Tangram::Dialect::Sybase::DateExpr;
use base qw( Tangram::Expr );

############################
# add method datepart($part)

sub datepart
{
	my ($self, $part) = @_; # $part is 'year', 'month', etc
	my $expr = $self->expr(); # the SQL string for this Expr

	##################################
	# build a new Expr of Integer type
	# pass this Expr's remote object list to the new Expr

	return Tangram::Integer->expr("DATEPART($part, $expr)", $self->objects);
}

###########################
# subclass Tangram::Dialect

package Tangram::Dialect::Sybase;
use Tangram::Dialect;
use base qw( Tangram::Dialect );

############################################
# a hash that maps date-related Types to the
# DateExpr - the improved Expr class

my %improved =
  (
   'Tangram::RawDateTime' => 'Tangram::Dialect::Sybase::DateExpr',
   'Tangram::RawDate' => 'Tangram::Dialect::Sybase::DateExpr',
  );

######################################################
# Tangram calls this method to obtain new Expr objects

sub expr
  {
    my $self = shift;
    my $type = shift;
    my ($expr, @remotes) = @_;
    
    ###################################################
    # is $type related to dates? if not, return default
    
    my $improved = $improved{ref($type)} or return $type->expr(@_);
    
    ####################################
    # $type is a Date; return a DateExpr
    
    return $improved->new($type, $expr, @remotes);
}

sub rate_connect_string
  {
    my ($self, $cs) = @_;
    return +($cs =~ m/^dbi:Sybase:/i);
  }

Tangram::Dialect::Sybase->register();

1;