Alzabo

 view release on metacpan or  search on metacpan

lib/Alzabo/SQLMaker.pm  view on Meta::CPAN

            push @args, "                                      $k => 1";
        }
    }

    my $args = join ",\n", @args;

    my $code = <<"EOF";
sub ${class}::$p{function}
{
    shift if defined \$_[0] && Alzabo::Utils::safe_isa( \$_[0], 'Alzabo::SQLMaker' );
    $valid
    return Alzabo::SQLMaker::Function->new( $args );
}
EOF

    eval $code;

    {
	no strict 'refs';
	push @{ "$class\::EXPORT_OK" }, $p{function};
	my $exp = \%{ "$class\::EXPORT_TAGS" };
	foreach ( @{ $p{groups} } )
	{
	    push @{ $exp->{$_}  }, $p{function};
	}
	push @{ $exp->{all} }, $p{function};
    }
}

sub load
{
    shift;
    my %p = @_;

    my $class = "Alzabo::SQLMaker::$p{rdbms}";
    eval "use $class";
    Alzabo::Exception::Eval->throw( error => $@ ) if $@;

    $class->init(@_);

    return $class;
}

sub available { __PACKAGE__->subclasses }

sub init
{
    1;
}

use constant NEW_SPEC => { driver => { isa => 'Alzabo::Driver' },
                           quote_identifiers  => { type => BOOLEAN,
                                                   default => 0 },
                         };

sub new
{
    my $class = shift;
    my %p = validate( @_, NEW_SPEC );

    return bless { last_op => undef,
		   expect => undef,
		   type => undef,
		   sql => '',
		   bind => [],
		   placeholders => [],
		   as_id => 'aaaaa10000',
                   alias_in_having => 1,
                   %p,
		 }, $class;
}

# this just needs to be some unique thing that won't ever look like a
# valid bound parameter
my $placeholder = do { my $x = 1; bless \$x, 'Alzabo::SQLMaker::Placeholder' };
sub placeholder { $placeholder }

sub last_op
{
    return shift->{last_op};
}

sub select
{
    my $self = shift;

    Alzabo::Exception::Params->throw( error => "The select method requires at least one parameter" )
	unless @_;

    $self->{sql} .= 'SELECT ';

    if ( lc $_[0] eq 'distinct' )
    {
	$self->{sql} .= ' DISTINCT ';
	shift;
    }

    my @sql;
    foreach my $elt (@_)
    {
	if ( Alzabo::Utils::safe_can( $elt, 'table' ) )
	{
            my $table = $elt->table;

	    $self->{column_tables}{"$table"} = 1;

            my $sql =
                ( $self->{quote_identifiers} ?
                  $self->{driver}->quote_identifier
                      ( $table->alias_name, $elt->name ) :
                  $table->alias_name . '.' . $elt->name );

            $sql .= ' AS ' .
                ( $self->{quote_identifiers} ?
                  $self->{driver}->quote_identifier( $elt->alias_name ) :
                  $elt->alias_name );

	    push @sql, $sql;
	}
	elsif ( Alzabo::Utils::safe_can( $elt, 'columns' ) )
	{
	    $self->{column_tables}{"$elt"} = 1;

            my @cols;

            foreach my $col ( $elt->columns )
            {
                my $sql =
                    ( $self->{quote_identifiers} ?
                      $self->{driver}->quote_identifier
                      ( $elt->alias_name, $col->name ) :
                      $elt->alias_name . '.' . $col->name );

                $sql .= ' AS ' .
                    ( $self->{quote_identifiers} ?

lib/Alzabo/SQLMaker.pm  view on Meta::CPAN

    }

    my $sql;
    unless ( $self->{tables}{$join_from} )
    {
        $sql .=
            ( $self->{quote_identifiers} ?
              $self->{driver}->quote_identifier( $join_from->name ) :
              $join_from->name );

        $sql .= ' AS ';
        $sql .=
            ( $self->{quote_identifiers} ?
              $self->{driver}->quote_identifier( $join_from->alias_name ) :
              $join_from->alias_name );
    }

    $sql .= " $type OUTER JOIN ";

    $sql .= ( $self->{quote_identifiers} ?
              $self->{driver}->quote_identifier( $join_on->name ) :
              $join_on->name );

    $sql .= ' AS ';

    $sql .=
        ( $self->{quote_identifiers} ?
          $self->{driver}->quote_identifier( $join_on->alias_name ) :
          $join_on->alias_name );

    $sql .= ' ON ';

    if ( $self->{quote_identifiers} )
    {
        $sql .=
            ( join ' AND ',
              map { $self->{driver}->quote_identifier
                        ( $join_from->alias_name, $_->[0]->name ) .
                    ' = ' .
                    $self->{driver}->quote_identifier
                        ( $join_on->alias_name, $_->[1]->name )
                  } $fk->column_pairs );
    }
    else
    {
        $sql .=
            ( join ' AND ',
              map { $join_from->alias_name . '.' . $_->[0]->name .
                    ' = ' .
                    $join_on->alias_name . '.' .  $_->[1]->name
                  } $fk->column_pairs );
    }

    @{ $self->{tables} }{ $join_from, $join_on } = (1, 1);

    if ($where)
    {
        $sql .= ' AND ';

        # make a clone
        my $sql_maker = bless { %$self }, ref $self;
        $sql_maker->{sql} = '';
        # sharing same ref intentionally
        $sql_maker->{bind} = $self->{bind};
        $sql_maker->{tables} = $self->{tables};

        # lie to Alzabo::Runtime::process_where_clause
        $sql_maker->{last_op} = 'where';

        Alzabo::Runtime::process_where_clause( $sql_maker, $where );

        $sql .= $sql_maker->sql;

        $sql .= ' ';

        $self->{as_id} = $sql_maker->{as_id};
    }

    return $sql;
}

sub where
{
    my $self = shift;

    $self->_assert_last_op( qw( from set ) );

    $self->{sql} .= ' WHERE ';

    $self->{last_op} = 'where';

    $self->condition(@_) if @_;

    return $self;
}

sub having
{
    my $self = shift;

    $self->_assert_last_op( qw( group_by ) );

    $self->{sql} .= ' HAVING ';

    $self->{last_op} = 'having';

    $self->condition(@_) if @_;

    return $self;
}

sub and
{
    my $self = shift;

    $self->_assert_last_op( qw( subgroup_end condition ) );

    return $self->_and_or( 'and', @_ );
}

sub or

lib/Alzabo/SQLMaker.pm  view on Meta::CPAN

sub sqlmaker_id
{
    shift()->_virtual;
}

sub distinct_requires_order_by_in_select { 0 }

sub _virtual
{
    my $self = shift;

    my $sub = (caller(1))[3];
    $sub =~ s/.*::(.*?)$/$1/;
    Alzabo::Exception::VirtualMethod->throw( error =>
					     "$sub is a virtual method and must be subclassed in " . ref $self );
}

sub debug
{
    my $self = shift;
    my $fh = shift;

    print $fh '-' x 75 . "\n";
    print $fh "SQL\n - " . $self->sql . "\n";
    print $fh "Bound values\n";

    foreach my $b ( @{ $self->bind } )
    {
        my $out = $b;

        if ( defined $out )
        {
            if ( length $out > 75 )
            {
                $out = substr( $out, 0, 71 ) . ' ...';
            }
        }
        else
        {
            $out = 'NULL';
        }

        print $fh " - [$out]\n";
    }
}

package Alzabo::SQLMaker::Function;

use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );

sub new
{
    my $class = shift;
    my %p = @_;

    $p{args} = [] unless defined $p{args};
    $p{quote} ||= [];

    return bless \%p, $class;
}

sub allows_alias { shift->{allows_alias} }

sub as_string
{
    my $self = shift;
    my $driver = shift;
    my $quote = shift;

    my @args;
    foreach ( 0..$#{ $self->{args} } )
    {
	if ( Alzabo::Utils::safe_can( $self->{args}[$_], 'table' ) )
	{
	    push @args,
		( $quote ?
                  $driver->quote_identifier( $self->{args}[$_]->table->alias_name,
                                             $self->{args}[$_]->name ) :
                  $self->{args}[$_]->table->alias_name . '.' .
                  $self->{args}[$_]->name );
	    next;
	}
	elsif ( Alzabo::Utils::safe_isa( $self->{args}[$_], 'Alzabo::SQLMaker::Function' ) )
	{
	    push @args, $self->{args}[$_]->as_string( $driver, $quote );
	    next;
	}

	# if there are more args than specified in the quote param
	# then this function must allow an unlimited number of
	# arguments, in which case the last value in the quote param
	# is the value that should be used for all of the extra
	# arguments.
	my $i = $_ > $#{ $self->{quote} } ? -1 : $_;
	push @args,
            $self->{quote}[$i] ? $driver->quote( $self->{args}[$_] ) : $self->{args}[$_];
    }

    my $sql = $self->{function};
    $sql =~ s/_/ /g if $self->{has_spaces};

    return $sql if $self->{is_modifier};

    $sql .= '('
        unless $self->{no_parens};

    if ( $self->{format} )
    {
	$sql .= sprintf( $self->{format}, @args );
    }
    else
    {
	$sql .= join ', ', @args;
    }

    $sql .= ')'
        unless $self->{no_parens};

    return $sql;