package MyDateExperiment ; use base qw/Class::DBI/ ; use Class::DBI::Plugin::DateFormat::Oracle qw(0.01) ; my $NLS_DATE_FORMAT_CONVENTIONAL = 'YYYY-MM-DD HH24:MI:SS' ; # # connection stuff... # name the table... # field definitions... # sub create { my $class = shift ; my $oldFormat = $class->get_nls_date_format; $class->set_nls_date_format( $NLS_DATE_FORMAT_CONVENTIONAL ) ; my $ans = $class->SUPER::create( @_ ) ; $class->set_nls_date_format( $oldFormat ) ; return $ans ; } sub get { my $class = shift ; my $oldFormat = $class->get_nls_date_format; $class->set_nls_date_format( $NLS_DATE_FORMAT_CONVENTIONAL ) ; my $ans = $class->SUPER::get( @_ ) ; $class->set_nls_date_format( $oldFormat ) ; return $ans ; } sub set { my $class = shift ; my $oldFormat = $class->get_nls_date_format; $class->set_nls_date_format( $NLS_DATE_FORMAT_CONVENTIONAL ) ; my $ans = $class->SUPER::set( @_ ) ; $class->set_nls_date_format( $oldFormat ) ; return $ans ; } #### foreach my $meth (qw/create get set/) { no strict qw/refs/ ; *{__PACKAGE__ . "::$meth"} = sub { my $class = shift ; my $oldFormat = $class->get_nls_date_format; $class->set_nls_date_format( $NLS_DATE_FORMAT_CONVENTIONAL ) ; my $ans = _good_lord_what_function( @_ ) ; ### ??? $class->set_nls_date_format( $oldFormat ) ; return $ans ; } } #### no strict qw/refs/ ; my $originalFunction = \&{__PACKAGE__ . "::$meth" } ; *{__PACKAGE__ . "::$meth"} = sub { ... my $ans = $originalFunction->( $class, @_ ) ; ... } #### ... my ($papa) = Class::ISA::super_path($class) ; my $papaMethod = $papa->can($meth) ; my $ans = $papaMethod->($papa, @_ ) ; ... #### ... my $ans = $class->SUPER::{"$meth"}( @_ ) ; ...