SPOPS::Tool::ReadOnly - Make a particular object read-only

SPOPS documentation Contained in the SPOPS distribution.

Index

Code Index:

NAME

Top

SPOPS::Tool::ReadOnly - Make a particular object read-only

SYNOPSIS

Top

 # Load information with read-only rule

 my $spops = {
    class               => 'This::Class',
    isa                 => [ 'SPOPS::DBI' ],
    field               => [ 'email', 'language', 'country' ],
    id_field            => 'email',
    base_table          => 'test_table',
    rules_from          => [ 'SPOPS::Tool::ReadOnly' ],
 };
 SPOPS::Initialize->process({ config => { test => $spops } });

 # Fetch an object, modify it... 
 my $object = This::Class->fetch( 45 );
 $object->{foo} = "modification";

 # Trying to save the object throws an error:
 # "This::Class is read-only; no changes allowed"
 eval { $object->save };

DESCRIPTION

Top

This is a simple rule to ensure that save() and remove() calls to a particular class do not actually do any work. Instead they just result in a warning that the class is read-only.

METHODS

Top

behavior_factory()

Installs the behavior during the class generation process.

generate_persistence_methods()

Generates save() and remove() methods that just throw exceptions.

BUGS

Top

None known.

TO DO

Top

Nothing known.

SEE ALSO

Top

SPOPS::Manual::ObjectRules (SPOPS::Manual::ObjectRules)

SPOPS::ClassFactory

COPYRIGHT

Top

Copyright (c) 2001-2004 intes.net, inc.. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

AUTHORS

Top

Chris Winters <chris@cwinters.com>

SPOPS documentation Contained in the SPOPS distribution. 
package SPOPS::Tool::ReadOnly;

# $Id: ReadOnly.pm,v 3.3 2004/06/02 00:48:24 lachoy Exp $

use strict;
use Log::Log4perl qw( get_logger );
use SPOPS;
use SPOPS::ClassFactory qw( OK );

my $log = get_logger();

$SPOPS::Tool::ReadOnly::VERSION = sprintf("%d.%02d", q$Revision: 3.3 $ =~ /(\d+)\.(\d+)/);

sub behavior_factory {
    my ( $class ) = @_;
    $log->is_info &&
        $log->info( "Installing read-only persistence methods for ($class)" );
    return { read_code => \&generate_persistence_methods };
}

sub generate_persistence_methods {
    my ( $class ) = @_;
    $log->is_info &&
        $log->info( "Generating read-only save() and remove() for ($class)" );
    no strict 'refs';
    *{ "${class}::save" }   =
        sub {
            SPOPS::Exception->throw( ref $_[0], " is read-only; no changes allowed" );
        };
    *{ "${class}::remove" } =
        sub {
            SPOPS::Exception->throw( ref $_[0], " is read-only; no changes allowed" );
        };
    return OK;
}

1;

__END__