# $Id: Default.pm,v 1.1 2001/08/02 16:32:22 matt Exp $ package Example::DB::Default; use strict; use Time::Object; use Time::Seconds; use Digest::MD5 qw(md5_hex); sub ping { my $self = shift; my $dbh = $self->get_dbh; return $dbh->ping; } sub commit { my $self = shift; # More commits than begin_tran. Not correct. unless ( defined $self->{tran_count} ) { my $callee = (caller(1))[3]; warn "$callee called commit without corresponding begin_tran call\n"; } $self->{tran_count}--; # Don't actually commit to we reach 'uber-commit' return if $self->{tran_count}; my $dbh = $self->get_dbh; if (!$dbh->{AutoCommit}) { $dbh->commit; } $dbh->{AutoCommit} = 1; $self->{tran_count} = undef; } sub rollback { my $self = shift; my $dbh = $self->get_dbh; if (!$dbh->{AutoCommit}) { $dbh->rollback; } $dbh->{AutoCommit} = 1; $self->{tran_count} = undef; } sub begin_tran { my $self = shift; $self->{tran_count} = 0 unless defined $self->{tran_count}; $self->{tran_count}++; $self->get_dbh->{AutoCommit} = 0; } sub DESTROY { my $self = shift; if ( $self->{tran_count} ) { warn "DB object is going out of scope with unbalanced begin_tran/commit call count of $self->{tran_count}\n"; } } ############################### # Utility SQL executing methods ############################### sub get_rows { my $self = shift; # ::Utils::check_params( @_, # mandatory => ['sql'], # optional => [ qw( begin limit bind ) ], # ); my %p = @_; my $sth = $self->_prepare_and_execute(%p); my @data; eval { my @row; $sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) ); while ( $sth->fetch ) { push @data, [@row]; } $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Example::Exception::SQL->throw( -text => $@, -sql => $p{sql}, -bind => \@bind ); } if ( $p{limit} && @data > $p{limit} ) { my $end = $p{limit} + $p{begin} - 1; $end = $#data if $end > $#data; @data = @data[$p{begin}..$end]; } return @data; } sub get_rows_hashref { my $self = shift; # ::Utils::check_params( @_, # mandatory => ['sql'], # optional => [ qw( begin limit bind ) ], # ); my %p = @_; my $sth = $self->_prepare_and_execute(%p); my @data; eval { my %hash; $sth->bind_columns( \ ( @hash{ @{ $sth->{NAME_lc} } } ) ); while ( $sth->fetch ) { push @data, {%hash}; } $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Example::Exception::SQL->throw( -text => $@, -sql => $p{sql}, -bind => \@bind ); } if ( $p{limit} && @data > $p{limit} ) { my $end = $p{limit} + $p{begin} - 1; $end = $#data if $end > $#data; @data = @data[$p{begin}..$end]; } return @data; } sub get_one_row { my $self = shift; # ::Utils::check_params( @_, # mandatory => ['sql'], # optional => [ qw( bind ) ], # ); my %p = @_; my $sth = $self->_prepare_and_execute(%p); my @row; eval { @row = $sth->fetchrow_array; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Example::Exception::SQL->throw( -text => $@, -sql => $p{sql}, -bind => \@bind ); } return wantarray ? @row : $row[0]; } sub get_one_row_hash { my $self = shift; # ::Utils::check_params( @_, # mandatory => ['sql'], # optional => [ qw( bind ) ], # ); my %p = @_; my $sth = $self->_prepare_and_execute(%p); my %hash; eval { my @row = $sth->fetchrow_array; @hash{ @{ $sth->{NAME_lc} } } = @row if @row; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Example::Exception::SQL->throw( -text => $@, -sql => $p{sql}, -bind => \@bind ); } return %hash; } sub get_column { my $self = shift; # ::Utils::check_params( @_, # mandatory => ['sql'], # optional => [ qw( begin limit bind ) ], # ); my %p = @_; my $sth = $self->_prepare_and_execute(%p); my @data; eval { my @row; $sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) ); while ( $sth->fetch ) { push @data, $row[0]; } $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Example::Exception::SQL->throw( -text => $@, -sql => $p{sql}, -bind => \@bind ); } if ( $p{limit} && @data > $p{limit} ) { my $end = $p{limit} + $p{begin} - 1; $end = $#data if $end > $#data; @data = @data[$p{begin}..$end]; } return wantarray ? @data : $data[0]; } sub do_sql { my $self = shift; # ::Utils::check_params( @_, # mandatory => ['sql'], # optional => [ qw( bind ) ], # ); my %p = @_; my $sth = $self->_prepare_and_execute(%p); my $rows; eval { $rows = $sth->rows; $sth->finish; }; if ($@) { my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : (); Example::Exception::SQL->throw( -text => $@, -sql => $p{sql}, -bind => \@bind ); } return $rows; } sub _prepare_and_execute { die "Virtual function _prepare_and_execute"; } sub _outer_join { my $self = shift; # ::Utils::check_params( @_, # mandatory => [ qw( select from join ) ], # optional => [ qw( where ) ], # ); my %p = @_; my $outer_join = $self->_outer_join_operator; my $sql = 'SELECT '; $sql .= join ', ', @{ $p{select} }; $sql .= ' FROM '; $sql .= join ', ', @{ $p{from} }; $sql .= " WHERE $p{join}->[0] $outer_join $p{join}->[1]"; $sql .= " AND $p{where}" if $p{where}; return $sql; } sub get_next_pk { die "get_next_pk is a virtual method and must be subclassed"; } sub last_id { die "last_id is a virtual method and must be subclassed"; } sub sql_date { my $time = $_[1] || time; return localtime($time)->strftime('%Y/%m/%d %H:%M:%S'); } sub sql_date_struct { my $self = shift; my $struct = shift; my $date = sprintf("%04d/%02d/%02d", $struct->{year}, $struct->{month}, $struct->{day_of_month}, ); $struct->{hours} ||= 0; $struct->{minutes} ||= 0; $struct->{seconds} ||= 0; $date .= sprintf(" %02d:%02d:%02d", $struct->{hours}, $struct->{minutes}, $struct->{seconds}, ); return $date; } ############################################################### # Main SQL methods here ############################################################### sub match_user { my $self = shift; my ($username, $password) = @_; my ($user_id) = $self->get_one_row( sql => "SELECT id FROM CMSUser WHERE username = ? AND password_md5 = ?", bind => [ $username, md5_hex($password) ], ); return $user_id; } sub get_asset { my $self = shift; my %p = @_; my @bind; push @bind, $p{asset_id} if $p{asset_id}; push @bind, $p{status} if $p{status}; push @bind, $p{type} if $p{type}; return $self->get_rows_hashref( sql => "SELECT WebItem.id, ItemType.short_desc AS item_type, WebItem.item_type_id, ItemStatus.description AS item_status, WebItem.item_status_id, ItemGroup.description AS item_group, WebItem.item_group_id, to_char(WebItem.date_created, 'Month DD, YYYY') AS date_created, to_char(WebItem.date_live, 'Month DD, YYYY') AS date_live, to_char(WebItem.date_live, 'YYYY') AS live_year, to_char(WebItem.date_live, 'MM') AS live_mon, to_char(WebItem.date_live, 'DD') AS live_day, to_char(WebItem.date_live, 'HH') as live_hour, to_char(WebItem.date_expires, 'Month DD, YYYY') AS date_expires, to_char(WebItem.date_expires, 'YYYY') AS expires_year, to_char(WebItem.date_expires, 'MM') AS expires_mon, to_char(WebItem.date_expires, 'DD') AS expires_day, WebItem.title, WebItem.link, WebItem.subtitle, WebItem.location, WebItem.booth, WebItem.body FROM WebItem JOIN ItemType ON WebItem.item_type_id = ItemType.id JOIN ItemStatus ON WebItem.item_status_id = ItemStatus.id JOIN ItemGroup ON WebItem.item_group_id = ItemGroup.id WHERE 1 = 1 " . ($p{asset_id} ? " AND WebItem.id = ? " : "") . ($p{status} ? " AND ItemStatus.description = ? " : "") . ($p{type} ? " AND ItemType.short_desc = ? " : "") . ($p{include_expired} ? "" : "AND WebItem.date_expires > now()"), (@bind ? (bind => \@bind) : ()), ); } sub update_announce { my $self = shift; my %p = @_; $p{expires} = $self->sql_date_struct($p{expires}); $p{live} = $self->sql_date_struct($p{live}); $self->do_sql( sql => "UPDATE WebItem SET title = ?, link = ?, date_expires = ?, date_live = ? WHERE id = ?", bind => [ @p{qw(title link expires live id)} ], ); } sub update_news { my $self = shift; my %p = @_; $p{expires} = $self->sql_date_struct($p{expires}); $p{live} = $self->sql_date_struct($p{live}); $self->do_sql( sql => "UPDATE WebItem SET title = ?, link = ?, date_expires = ?, date_live = ? WHERE id = ?", bind => [ @p{qw(title link expires live id)} ], ); } sub update_event { my $self = shift; my %p = @_; $p{expires} = $self->sql_date_struct($p{expires}); $p{live} = $self->sql_date_struct($p{live}); $self->do_sql( sql => "UPDATE WebItem SET title = ?, link = ?, date_expires = ?, date_live = ?, location = ?, booth = ? WHERE id = ?", bind => [ @p{qw(title link expires live location booth id)} ], ); } sub update_pr { my $self = shift; my %p = @_; $p{expires} = $self->sql_date_struct($p{expires}); $p{live} = $self->sql_date_struct($p{live}); $self->do_sql( sql => "UPDATE WebItem SET title = ?, date_expires = ?, date_live = ?, subtitle = ?, location = ?, body = ? WHERE id = ?", bind => [ @p{qw(title expires live subtitle location body id)} ], ); } sub update_asset_column { my $self = shift; my ($id, $column, $value) = @_; $self->do_sql( sql => "UPDATE WebItem SET $column = ? WHERE id = ?", bind => [ $value, $id ], ); } sub create_asset { my $self = shift; my %p = @_; $p{expires} = $self->sql_date_struct($p{expires} || {year => 2030, month => 1, day_of_month => 1 }); $p{live} = $self->sql_date_struct($p{live} || { year => 1970, month => 1, day_of_month => 1 }); # get defaults my ($item_group_id, $item_status_id, $item_type_id) = $self->get_one_row( sql => "SELECT ItemGroup.id AS itemgroup_id, ItemStatus.id AS itemstatus_id, ItemType.id AS itemtype_id FROM ItemGroup, ItemStatus, ItemType WHERE ItemStatus.description = 'Initial Edit' AND ItemGroup.description = 'None' AND ItemType.short_desc = ?", bind => [ $p{asset_type} ], ); my $next_id = $self->get_next_pk(table => "WebItem"); $self->do_sql( sql => "INSERT INTO WebItem (id, item_type_id, item_status_id, item_group_id, date_created, date_live, date_expires, title, link, subtitle, location, booth, body ) VALUES ( ?, ?, ?, ?, now(), ?, ?, ?, ?, ?, ?, ?, ? )", bind => [ $next_id, $item_type_id, $item_status_id, $p{item_group_id} || $item_group_id, @p{qw(live expires title link subtitle location booth body)} ], ); return $next_id; } sub get_create_pages { my $self = shift; my @rows = $self->get_rows( sql => "SELECT short_desc, create_page FROM ItemType ORDER BY id" ); my @results; foreach my $row (@rows) { push @results, @$row; } return @results; } sub get_edit_page { my $self = shift; my %p = @_; my $page; if ($p{create_page}) { $page = $self->get_one_row( sql => "SELECT edit_page FROM ItemType WHERE create_page = ?", bind => $p{create_page}, ); } elsif ($p{asset_id}) { $page = $self->get_one_row( sql => "SELECT ItemType.edit_page FROM ItemType JOIN WebItem ON WebItem.item_type_id = ItemType.id WHERE WebItem.id = ?", bind => $p{asset_id}, ); } return $page; } sub get_view_page { my $self = shift; my %p = @_; my $page; if ($p{create_page}) { $page = $self->get_one_row( sql => "SELECT view_page FROM ItemType WHERE create_page = ?", bind => $p{create_page}, ); } elsif ($p{asset_id}) { $page = $self->get_one_row( sql => "SELECT ItemType.view_page FROM ItemType JOIN WebItem ON WebItem.item_type_id = ItemType.id WHERE WebItem.id = ?", bind => $p{asset_id}, ); } return $page; } sub list_users { my $self = shift; return $self->get_rows_hashref( sql => "SELECT * FROM CMSUser ORDER BY super_user, last_name, first_name", ); } sub is_super_user { my $self = shift; my $user_id = shift; return $self->get_one_row( sql => "SELECT super_user FROM CMSUser WHERE id = ?", bind => $user_id, ); } use Digest::MD5 qw(md5_hex); sub add_user { my $self = shift; my %p = @_; $p{password_md5} = md5_hex($p{password}); $p{super_user} = $p{super_user} ? 't' : 'f'; $self->do_sql( sql => "INSERT INTO CMSUser (id, username, password_md5, first_name, last_name, email, super_user) VALUES (nextval('CMSUser_seq'), ?, ?, ?, ?, ?, ?)", bind => [ @p{qw(username password_md5 first_name last_name email super_user)} ], ); } sub get_user { my $self = shift; my $id = shift; return { $self->get_one_row_hash( sql => "SELECT * FROM CMSUser WHERE id = ?", bind => $id, ) }; } sub update_user { my $self = shift; my %p = @_; if ($p{password}) { $p{password_md5} = md5_hex($p{password}); } $p{super_user} = $p{super_user} ? 't' : 'f'; $self->do_sql( sql => "UPDATE CMSUser SET first_name = ?, last_name = ?, email = ?, super_user = ? " . ($p{password_md5} ? ", password_md5 = ?" : "") . " WHERE id = ?", bind => [ @p{qw(first_name last_name email super_user)}, ($p{password_md5} ? ($p{password_md5}) : ()), $p{id} ], ); } sub get_user_id { my $self = shift; my $username = shift; return $self->get_one_row( sql => "SELECT id FROM CMSUser WHERE username = ?", bind => $username, ); } sub log { my $self = shift; my $log_text = join('', @_); my $next_id = $self->get_next_pk(table => "CMSLog"); my $user_id = $self->get_user_id(Example::User::get_user()); $self->do_sql( sql => "INSERT INTO CMSLog (id, user_id, log_detail) VALUES ( ?, ?, ? )", bind => [ $next_id, $user_id, $log_text ], ); } sub set_status { my $self = shift; my ($status, $asset_id) = @_; if ($status =~ /\D/) { # status is a description $self->do_sql( sql => "UPDATE WebItem SET item_status_id = (SELECT ItemStatus.id FROM ItemStatus WHERE ItemStatus.description = ?) WHERE WebItem.id = ?", bind => [ $status, $asset_id ], ); } else { # status is a number $self->do_sql( sql => "UPDATE WebItem SET item_status_id = ? WHERE WebItem.id = ?", bind => [ $status, $asset_id ], ); } } sub get_statuses { my $self = shift; my @rows = $self->get_rows( sql => "SELECT id, description FROM ItemStatus ORDER BY ordering" ); return @rows; } sub get_asset_types { my $self = shift; my @rows = $self->get_rows( sql => "SELECT id, short_desc FROM ItemType ORDER BY id" ); return @rows; } sub get_long_desc { my $self = shift; my %p = @_; $self->get_one_row( sql => "SELECT long_desc FROM ItemType WHERE short_desc = ?", bind => $p{type}, ); } sub validate_date { my $self = shift; my (%date_struct) = @_; # Note: We're using WebItem here to do selects against simply because # selecting from no table is different depending on what DB you're using. # This allows us to do it db independantly, saving us one method to port # to Oracle should it be needed. my $date_str = $self->sql_date_struct(\%date_struct); eval { $self->do_sql(sql => "SELECT id FROM WebItem WHERE date_created > ?", bind => $date_str); }; if ($@) { die "Invalid date"; } eval { my $row = $self->get_one_row(sql => "SELECT id FROM WebItem WHERE now() > ?", bind => $date_str); if ($row) { die "1"; } }; if ($@) { die "Date is in the past"; } return 1; } sub compare_dates { my $self = shift; my ($date1, $date2) = @_; my $date1_str = $self->sql_date_struct($date1); my $date2_str = $self->sql_date_struct($date2); # NB: PostgreSQL specific code. return $self->get_one_row( sql => "SELECT CAST(? AS DATE) - CAST(? AS DATE)", bind => [ $date1_str, $date2_str ], ); } 1;