use 5.008;
use warnings;
use strict;

package Class::Scaffold::Storable;
  $Class::Scaffold::Storable::VERSION = '1.102280';

# ABSTRACT: Base class for all framework classes that support a storage.
use parent 'Class::Scaffold::Base';

# Don't store the storage object itself, store the method we need to call on
# the delegate to get the storage object. This is just a little overhead, but
# saves us from a lot of headache when serializing and deserializing objects
# with Storable's freeze() and thaw(), because storage objects can't be
# deserialized properly.
# Impose a certain order on how the constructor args are processed. We want
# the storage to be set first, because other properties could be defined using
# mk_framework_object_accessors(). Now if the args were set in an arbitrary
# order, the framework_object-properties could be processed before the storage
# is set, which would cause an error, because the storage wouldn't be set yet,
# so it can't be asked to make an object.
# We can't have storage_type as a key within the storage_info hash, because we
# want to be able to set it directly if passed as an argument to the
# constructor; we also need to be able to prefer it in
# Class::Scaffold::Storable::FIRST_CONSTRUCTOR_ARGS().
# We use the storage's signature as the id key, i.e. to find the id of the
# object within the storage. It would not be sufficient to use the storage's
# package name as the hash key because we can think of a multiplex storage
# that multiplexes onto two file system paths. In that case each of the
# multiplexed storages would have the same package name. And we can't use the
# storage's memory address (0x012345678) because different stages can be run
# within different processes and on different machines.
# For example, the attributes of an object of this class might look like:
# storage_type: core_storage
# storage_info:
#   id:
#     'Registry::NICAT::Storage::DBI::Oracle::NICAT,dbname=db.test,dbuser=nic': id12345
#     'Some::File::Storage,fspath=/path/to/storage/root': id45678
# This example assumes that the core storage is multiplexing on a DBI storage
# and a file system storage.
use constant FIRST_CONSTRUCTOR_ARGS => ('storage_type');
use constant SKIP_COMPARABLE_KEYS   => (qw/storage_type storage_info/);
use constant HYGIENIC               => (qw/storage storage_type/);

    my ($self, @args) = @_;

    # needed in order to mix object creation of a given class with and without
    # explicitly setting the storage object for it (Erik P. Ostlyngen, NORID):
    if (@args % 2 == 0) {
        my %args = @args;
        return %args if $args{storage_type};

    # The superclass does nothing, so we'll skip this for performance reasons
    # - this method is called very often.
    # @args = $self->SUPER::MUNGE_CONSTRUCTOR_ARGS(@args);
    our %cache;
    my $extra_args;
    unless ($extra_args = $cache{ ref $self }) {
        my $object_type = $self->get_my_factory_type;
        if (defined $object_type) {
            my $storage_type =

            # storage will be disconnected in Class::Scaffold::App->app_finish
            $extra_args = $cache{ ref $self } =
              [ storage_type => $storage_type ];
        } else {
            $extra_args = $cache{ ref $self } = [];
    (@args, @$extra_args);

sub storage {
    my $self   = shift;
    my $method = $self->storage_type;
    if ($method) {
    } else {
        local $Error::Depth = $Error::Depth + 1;
        throw Error::Hierarchy::Internal::CustomMessage(custom_message =>
              "can't find method to get storage object from delegate");

sub id {
    my $self    = shift;
    my $storage = shift;
    if (@_) {
        my $id = shift;
        $self->storage_info->{id}{ $storage->signature } = $id;
    } else {
        $self->storage_info->{id}{ $storage->signature };


=head1 NAME

Class::Scaffold::Storable - Base class for all framework classes that support a storage.

=head1 VERSION

version 1.102280

=head1 METHODS

=head2 id


=head2 storage



See perlmodinstall for information and options on installing Perl modules.


No bugs have been reported.

Please report any bugs or feature requests through the web interface at


The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit L<> to find a CPAN
site near you, or see

The development version lives at
Instead of sending patches, please fork this project using the standard git
and github infrastructure.

=head1 AUTHORS

=over 4

=item *

Marcel Gruenauer <>

=item *

Florian Helmberger <>

=item *

Achim Adam <>

=item *

Mark Hofstetter <>

=item *

Heinz Ekker <>



This software is copyright (c) 2008 by Marcel Gruenauer.

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