File: RenameClass.pm

package info (click to toggle)
libur-perl 0.470%2Bds-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 7,184 kB
  • sloc: perl: 61,813; javascript: 255; xml: 108; sh: 13; makefile: 9
file content (86 lines) | stat: -rw-r--r-- 2,279 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86


package UR::Namespace::Command::Update::RenameClass;                         

use strict;
use warnings;
use UR;
our $VERSION = "0.47"; # UR $VERSION;

UR::Object::Type->define(
    class_name => __PACKAGE__,
    is => "UR::Namespace::Command::Update::RewriteClassHeader",
);

# Standard methods used to output help.

sub shell_args_description {
    "My::Old My::New";
}

sub help_description {
    "Updates class descriptions for to correspond with database schema changes."
}

# Wrap execute since we take different parameters than a standard
# "runs on modules in tree" rewrite command.

our $old;
our $new;

sub execute {
    my $self = shift;
    $old = shift;
    $new = shift;
    $self->error_message("rename $old to $new not implemented");
    return;
}

# Override "before" to do the class editing.

sub before {
    my $self = shift;
    my $class_objects = shift;
    
    # By default, no classes are rewritten.
    # As we find classes with the $old name, in their metadata,
    # we add them to this list.
    $class_objects = [];
    
    print "finding properties which seem to refernce a class\n";
    my @p = UR::Object::Property->is_loaded(
        property_name => ["class_name","r_class_name","parent_class_name"]
    );
    
    print "found " . join("\n",map { $_->class_name . " -> " . $_->property_name } @_) . "\n";
    
    print "checking instances of those properties\n";
    my @changes;
    for my $p (@p) {
        my $class_name = $p->class_name;
        my $property_name = $p->property_name;
        my @obj = $class_name->is_loaded();
        for my $obj (@obj) {
            if ($obj->$property_name eq $new) {
                Carp::confess("Name $new is already in use on $class_name, " 
                    . $obj->{id} 
                    . $property_name . "!"
                );
            }
            elsif ($obj->$property_name eq $old) {
                print "Setting $new in place of $old on $class_name, " 
                    . $obj->{id} 
                    . $property_name . ".\n";
                push @changes, [$obj,$property_name,$new];
            }
        }
    }
    
    return 1;
}

# we implement before() but use the default call to  
# for_each_class_object() call in UR::Namespace::Command::rewrite

1;