Defining new link types

RT Developers
1

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?

-Todd

2

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?

3

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.