[Rt-devel] Defining new link types

[Todd Chapman]

On Fri, Dec 02, 2005 at 06:18:14PM -0500, Jesse Vincent wrote:
> 
> 
> 
> On Fri, Dec 02, 2005 at 06:53:41PM -0500, Todd Chapman wrote:
> > I refactored Asset Tracker so that a user could create
> > new link types in the site config and everything would
> > just work. This includes auto-generating all the Limit
> > subs, accessors, etc.
> > 
> > Would this be useful for RT?
> 
> Possibly. What's the code look like?

For AT it looks a little like this:

file: lib/RTx/AssetTracker/Asset_Overlay.pm

%LINKMAP = (
    RunsOn      => 'IsRunning',
    RefersTo    => 'ReferredToBy',
    DependsOn   => 'DependedOnBy',
    ComponentOf => 'HasComponent',
);

while ( my ($base, $target) = each %LINKMAP ) {
    RegisterLinkType( $base, $target );
}

#RegisterLinkType( 'ComponentOf', 'HasComponents' );
#RegisterLinkType( 'ComponentOf', 'Components' );

sub RegisterLinkType {

    my $base   = shift;
    my $target = shift;

    $LINKTYPEMAP{$base}{Type} = $base;
    $LINKTYPEMAP{$base}{Mode} = 'Target';
    my $base_name = $base;
    $base_name =~ s/([a-z])([A-Z])/$1 $2/g;
    $LINKTYPEMAP{$base}{Name} = $base_name;
    $LINKTYPEMAP{$base}{Mate} = $target;

    $LINKTYPEMAP{$target}{Type} = $base;
    $LINKTYPEMAP{$target}{Mode}   = 'Base';
    my $target_name = $target;
    $target_name =~ s/([a-z])([A-Z])/$1 $2/g;
    $LINKTYPEMAP{$target}{Name} = $target_name;
    $LINKTYPEMAP{$target}{Mate} = $base;

    $LINKDIRMAP{$base} = { Base => $base, Target => $target };

    push @LINKORDER, $base, $target;

    {

    no strict 'refs';

    *$base   = sub {
        my $self = shift;
        return ( $self->_Links( $LINKTYPEMAP{$target}{Mode}, $base ) );
    };

    *$target = sub {
        my $self = shift;
        return ( $self->_Links( $LINKTYPEMAP{$base}{Mode},   $base ) );
    };

    }

    # sets up the Limit methods for links
    $RTx::AssetTracker::Assets::FIELDS{$base}   = [ 'LINK' => To   => $base ];
    $RTx::AssetTracker::Assets::FIELDS{$target} = [ 'LINK' => From => $base ];

    {
        no strict 'refs';

        my $limit_base   = "RTx::AssetTracker::Assets::Limit$base";
        my $limit_target = "RTx::AssetTracker::Assets::Limit$target";

        *$limit_base = sub {
            my $self = shift;
            my $asset_id = shift;
            $self->LimitLinkedTo ( TARGET => "\$asset_id",
                                   TYPE => $base,          );

        };
        *$limit_target = sub {
            my $self = shift;
            my $asset_id = shift;
            $self->LimitLinkedTo ( BASE => "\$asset_id",
                                   TYPE => $target,        );

        };

    }


}

__END__

And all Mason components use the link structures instead of
having any link names hardcoded into them.

> 
> > -Todd
> > _______________________________________________
> > Rt-devel mailing list
> > Rt-devel at lists.bestpractical.com
> > http://lists.bestpractical.com/cgi-bin/mailman/listinfo/rt-devel
> > 
> 
> --