XAO::Objects - dynamic objects loader

XAO-Base documentation Contained in the XAO-Base distribution.

Index

Code Index:

NAME

Top

XAO::Objects - dynamic objects loader

SYNOPSIS

Top

 use XAO::Objects;

 sub foo {
    ...
    my $page=XAO::Objects->new(objname => 'Web::Page');
 }

DESCRIPTION

Top

Loader for XAO dynamic objects. This module is most extensively used throughout all XAO utilities and packages.

The idea of XAO dynamic objects is to seamlessly allow multiple projects co-exist in the same run-time environment -- for instance multiple web sites in mod_perl environment. Using traditional Perl modules or objects it is impossible to have different implementations of an object in the same namespace -- once one site loads a Some::Object the code is then re-used by all sites executing in the same instance of Apache/mod_perl.

The architecture of XAO::Web and XAO::FS requires the ability to load an object by name and at the same time provide a pissibly different functionality for different sites.

This is achieved by always loading XAO objects using functions of XAO::Objects package.

Have a look at this example:

 my $dobj=XAO::Objects->new(objname => 'Web::Date');

What happens when this code is executed is that in case current site has an extended version of Web::Date object -- this extended version will be returned, otherwise the standard Web::Date is used. This allows for customizations of a standard object specific to a web site without affecting other web sites.

For creating an site specific object based on standard object the following syntax should be used:

 package XAO::DO::Web::MyObject;
 use strict;
 use XAO::Objects;

 use base XAO::Objects->load(objname => 'Web::Page');

 sub display ($%) {
     my $self=shift;
     my $args=get_args(\@_);

     .....
 }

To extend or alter the functionality of a standard object the following syntax should be used to avoid infinite loop in the object loader:

 package XAO::DO::Web::Date;
 use strict;
 use XAO::Objects;

 use base XAO::Objects->load(objname => 'Web::Date', baseobj => 1);

XAO::Objects is not limited to web site use only, in fact it is used in XAO Foundation server to load database objects, in XAO::Catalogs to load custom catalog filters and so on.

FUNCTIONS

Top

The following functions are available. They can be called either as 'XAO::Objects->function()' or as 'XAO::Objects::function()'. XAO::Objects never creates objects of its own namespace, so these are functions, not methods.

load

Pre-loads an object into memory for quicker access and inheritance.

On success returns class name of the loaded object, on error -- undefined value.

It is allowed to call load outside of any site context - it just would not check site specific objects.

Arguments:

 objname  => object name (required)
 baseobj  => ignore site specific objects even if they exist (optional)
 sitename => should only be used to load Config object
new (%)

Creates an instance of named object. There is just one required argument - 'objname', everything else is passed into object's constructor unmodified.

AUTHOR

Top

Copyright (c) 2000-2002 XAO Inc.

Andrew Maltsev <am@xao.com>.

SEE ALSO

Top

Have a look at: XAO::Web, XAO::Utils, XAO::FS.

XAO-Base documentation Contained in the XAO-Base distribution. 
###############################################################################
package XAO::Objects;
use strict;
use XAO::Base qw($homedir $projectsdir);
use XAO::Utils qw(:args :debug);
use XAO::Errors qw(XAO::Objects);
use XAO::Projects;

use vars qw($VERSION);
$VERSION=(0+sprintf('%u.%03u',(q$Id: Objects.pm,v 2.1 2005/01/13 22:34:34 am Exp $ =~ /\s(\d+)\.(\d+)\s/))) || die "Bad VERSION";

##
# Prototypes
#
sub load (@);
sub new ($%);

###############################################################################


use vars qw(%objref_cache);
sub load (@) {
    my $class=(scalar(@_)%2 || ref($_[1]) ? shift(@_) : 'XAO::Objects');
    my $args=get_args(\@_);
    my $objname=$args->{objname} ||
        throw XAO::E::Objects "load - no objname given";

    ##
    # Config object is a special case. When we load it we do not have
    # site configuration yet and so we have to rely on supplied site
    # name.
    #
    my $sitename;
    if($args->{baseobj}) {
        # No site name for base object
    }
    elsif($objname eq 'Config') {
        $sitename=$args->{sitename} ||
            throw XAO::E::Objects "load - no sitename given for Config object";
    }
    else {
        $sitename=$args->{sitename} ||
                  XAO::Projects::get_current_project_name() ||
                  '';
    }

    ##
    # Checking cache first
    #
    my $tref;
    if($sitename && ($tref=$objref_cache{$sitename})) {
        return $tref->{$objname} if exists $tref->{$objname};
    }
    elsif(!$sitename && ($tref=$objref_cache{'/'})) {
        return $tref->{$objname} if exists $tref->{$objname};
    }

    ##
    # Checking project directory
    #
    my $objref;
    my $system;
    if($sitename) {
        (my $objfile=$objname) =~ s/::/\//sg;
        $objfile="$projectsdir/$sitename/objects/$objfile.pm";
        if(-f $objfile && open(F,$objfile)) {

            ##
            # Changing $/ can affect module initialization below, so
            # making it in as small scope as possible (bug fix by Eugene
            # Karpachov).
            #
            my $text=do { local $/; <F> };
            close(F);

            $text=~s{^\s*(package\s+(XAO::DO|Symphero::Objects))::($objname\s*;)}
                                        {${1}::${sitename}::${3}}m;
            $1 || throw XAO::E::Objects
                  "load - package name is not XAO::DO::$objname in $objfile";
            $2 eq 'XAO::DO' ||
                eprint "Old style package name in $objfile - change to XAO::DO::$objname";

            eval "\n#line 1 \"$objfile\"\n" . $text;
            throw XAO::E::Objects
                  "load - error loading $objname ($objfile) -- $@" if $@;

            $objref="XAO::DO::${sitename}::${objname}";
        }
        $system=0;
    }
    if(! $objref) {
        $objref="XAO::DO::${objname}";
        eval "require $objref";
        throw XAO::E::Objects
              "load - error loading $objname ($objref) -- $@" if $@;
        $system=1;
    }

    ##
    # In case no object was found.
    #
    $objref || throw XAO::E::Objects
                     "load - no object file found for sitename='$sitename', objname='$objname'";

    ##
    # Returning class name and storing into cache
    #
    $objref_cache{$sitename ? $sitename : '/'}->{$objname}=$objref;
}

###############################################################################


sub new ($%) {
    my $class=(scalar(@_)%2 || ref($_[1]) ? shift(@_) : 'XAO::Objects');
    my $args=get_args(\@_);

    my $objname=$args->{objname} ||
        throw XAO::E::Objects "new - no 'objname' given";

    ##
    # Looking up what is real object reference for that objname.
    #
    my $objref=$class->load($args) ||
        throw XAO::E::Objects "new - can't load object ($args->{objname})";

    ##
    # Creating instance of that object
    #
    my $obj=$objref->new($args) ||
        throw XAO::E::Objects "new - error creating instance of $objref ($@)";

    $obj;
}

###############################################################################

1;
__END__