RT 4.2.11, ticket#13852
[freeside.git] / rt / lib / RT / Migrate / Serializer.pm
diff --git a/rt/lib/RT/Migrate/Serializer.pm b/rt/lib/RT/Migrate/Serializer.pm
new file mode 100644 (file)
index 0000000..92be629
--- /dev/null
@@ -0,0 +1,492 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Migrate::Serializer;
+
+use strict;
+use warnings;
+
+use base 'RT::DependencyWalker';
+
+use Storable qw//;
+sub cmp_version($$) { RT::Handle::cmp_version($_[0],$_[1]) };
+use RT::Migrate::Incremental;
+use RT::Migrate::Serializer::IncrementalRecord;
+use RT::Migrate::Serializer::IncrementalRecords;
+
+sub Init {
+    my $self = shift;
+
+    my %args = (
+        AllUsers            => 1,
+        AllGroups           => 1,
+        FollowDeleted       => 1,
+
+        FollowScrips        => 0,
+        FollowTickets       => 1,
+        FollowACL           => 0,
+
+        Clone       => 0,
+        Incremental => 0,
+
+        Verbose => 1,
+        @_,
+    );
+
+    $self->{Verbose} = delete $args{Verbose};
+
+    $self->{$_} = delete $args{$_}
+        for qw/
+                  AllUsers
+                  AllGroups
+                  FollowDeleted
+                  FollowScrips
+                  FollowTickets
+                  FollowACL
+                  Clone
+                  Incremental
+              /;
+
+    $self->{Clone} = 1 if $self->{Incremental};
+
+    $self->SUPER::Init(@_, First => "top");
+
+    # Keep track of the number of each type of object written out
+    $self->{ObjectCount} = {};
+
+    if ($self->{Clone}) {
+        $self->PushAll;
+    } else {
+        $self->PushBasics;
+    }
+}
+
+sub Metadata {
+    my $self = shift;
+
+    # Determine the highest upgrade step that we run
+    my @versions = ($RT::VERSION, keys %RT::Migrate::Incremental::UPGRADES);
+    my ($max) = reverse sort cmp_version @versions;
+    # we don't want to run upgrades to 4.2.x if we're running
+    # the serializier on an 4.0 instance.
+    $max = $RT::VERSION unless $self->{Incremental};
+
+    return {
+        Format       => "0.8",
+        VersionFrom  => $RT::VERSION,
+        Version      => $max,
+        Organization => $RT::Organization,
+        Clone        => $self->{Clone},
+        Incremental  => $self->{Incremental},
+        ObjectCount  => { $self->ObjectCount },
+        @_,
+    },
+}
+
+sub PushAll {
+    my $self = shift;
+
+    # To keep unique constraints happy, we need to remove old records
+    # before we insert new ones.  This fixes the case where a
+    # GroupMember was deleted and re-added (with a new id, but the same
+    # membership).
+    if ($self->{Incremental}) {
+        my $removed = RT::Migrate::Serializer::IncrementalRecords->new( RT->SystemUser );
+        $removed->Limit( FIELD => "UpdateType", VALUE => 3 );
+        $removed->OrderBy( FIELD => 'id' );
+        $self->PushObj( $removed );
+    }
+    # XXX: This is sadly not sufficient to deal with the general case of
+    # non-id unique constraints, such as queue names.  If queues A and B
+    # existed, and B->C and A->B renames were done, these will be
+    # serialized with A->B first, which will fail because there already
+    # exists a B.
+
+    # Principals first; while we don't serialize these separately during
+    # normal dependency walking (we fold them into users and groups),
+    # having them separate during cloning makes logic simpler.
+    $self->PushCollections(qw(Principals));
+
+    # Users and groups
+    $self->PushCollections(qw(Users Groups GroupMembers));
+
+    # Tickets
+    $self->PushCollections(qw(Queues Tickets Transactions Attachments Links));
+
+    # Articles
+    $self->PushCollections(qw(Articles), map { ($_, "Object$_") } qw(Classes Topics));
+
+    # Custom Fields
+    if (RT::ObjectCustomFields->require) {
+        $self->PushCollections(map { ($_, "Object$_") } qw(CustomFields CustomFieldValues));
+    } elsif (RT::TicketCustomFieldValues->require) {
+        $self->PushCollections(qw(CustomFields CustomFieldValues TicketCustomFieldValues));
+    }
+
+    # ACLs
+    $self->PushCollections(qw(ACL));
+
+    # Scrips
+    $self->PushCollections(qw(Scrips ObjectScrips ScripActions ScripConditions Templates));
+
+    # Attributes
+    $self->PushCollections(qw(Attributes));
+}
+
+sub PushCollections {
+    my $self  = shift;
+
+    for my $type (@_) {
+        my $class = "RT::\u$type";
+
+        $class->require or next;
+        my $collection = $class->new( RT->SystemUser );
+        $collection->FindAllRows;   # be explicit
+        $collection->CleanSlate;    # some collections (like groups and users) join in _Init
+        $collection->UnLimit;
+        $collection->OrderBy( FIELD => 'id' );
+
+        if ($self->{Clone}) {
+            if ($collection->isa('RT::Tickets')) {
+                $collection->{allow_deleted_search} = 1;
+                $collection->IgnoreType; # looking_at_type
+            }
+            elsif ($collection->isa('RT::ObjectCustomFieldValues')) {
+                # FindAllRows (find_disabled_rows) isn't used by OCFVs
+                $collection->{find_expired_rows} = 1;
+            }
+
+            if ($self->{Incremental}) {
+                my $alias = $collection->Join(
+                    ALIAS1 => "main",
+                    FIELD1 => "id",
+                    TABLE2 => "IncrementalRecords",
+                    FIELD2 => "ObjectId",
+                );
+                $collection->DBIx::SearchBuilder::Limit(
+                    ALIAS => $alias,
+                    FIELD => "ObjectType",
+                    VALUE => ref($collection->NewItem),
+                );
+            }
+        }
+
+        $self->PushObj( $collection );
+    }
+}
+
+sub PushBasics {
+    my $self = shift;
+
+    # System users
+    for my $name (qw/RT_System root nobody/) {
+        my $user = RT::User->new( RT->SystemUser );
+        my ($id, $msg) = $user->Load( $name );
+        warn "No '$name' user found: $msg" unless $id;
+        $self->PushObj( $user ) if $id;
+    }
+
+    # System groups
+    foreach my $name (qw(Everyone Privileged Unprivileged)) {
+        my $group = RT::Group->new( RT->SystemUser );
+        my ($id, $msg) = $group->LoadSystemInternalGroup( $name );
+        warn "No '$name' group found: $msg" unless $id;
+        $self->PushObj( $group ) if $id;
+    }
+
+    # System role groups
+    my $systemroles = RT::Groups->new( RT->SystemUser );
+    $systemroles->LimitToRolesForObject( RT->System );
+    $self->PushObj( $systemroles );
+
+    # CFs on Users, Groups, Queues
+    my $cfs = RT::CustomFields->new( RT->SystemUser );
+    $cfs->Limit(
+        FIELD => 'LookupType',
+        OPERATOR => 'IN',
+        VALUE => [ qw/RT::User RT::Group RT::Queue/ ],
+    );
+    $self->PushObj( $cfs );
+
+    # Global attributes
+    my $attributes = RT::Attributes->new( RT->SystemUser );
+    $attributes->LimitToObject( $RT::System );
+    $self->PushObj( $attributes );
+
+    # Global ACLs
+    if ($self->{FollowACL}) {
+        my $acls = RT::ACL->new( RT->SystemUser );
+        $acls->LimitToObject( $RT::System );
+        $self->PushObj( $acls );
+    }
+
+    # Global scrips
+    if ($self->{FollowScrips}) {
+        my $scrips = RT::Scrips->new( RT->SystemUser );
+        $scrips->LimitToGlobal;
+
+        my $templates = RT::Templates->new( RT->SystemUser );
+        $templates->LimitToGlobal;
+
+        $self->PushObj( $scrips, $templates );
+        $self->PushCollections(qw(ScripActions ScripConditions));
+    }
+
+    if ($self->{AllUsers}) {
+        my $users = RT::Users->new( RT->SystemUser );
+        $users->LimitToPrivileged;
+        $self->PushObj( $users );
+    }
+
+    if ($self->{AllGroups}) {
+        my $groups = RT::Groups->new( RT->SystemUser );
+        $groups->LimitToUserDefinedGroups;
+        $self->PushObj( $groups );
+    }
+
+    if (RT::Articles->require) {
+        $self->PushCollections(qw(Topics Classes));
+    }
+
+    $self->PushCollections(qw(Queues));
+}
+
+sub InitStream {
+    my $self = shift;
+
+    # Write the initial metadata
+    my $meta = $self->Metadata;
+    $! = 0;
+    Storable::nstore_fd( $meta, $self->{Filehandle} );
+    die "Failed to write metadata: $!" if $!;
+
+    return unless cmp_version($meta->{VersionFrom}, $meta->{Version}) < 0;
+
+    my %transforms;
+    for my $v (sort cmp_version keys %RT::Migrate::Incremental::UPGRADES) {
+        for my $ref (keys %{$RT::Migrate::Incremental::UPGRADES{$v}}) {
+            push @{$transforms{$ref}}, $RT::Migrate::Incremental::UPGRADES{$v}{$ref};
+        }
+    }
+    for my $ref (keys %transforms) {
+        # XXX Does not correctly deal with updates of $classref, which
+        # should technically apply all later transforms of the _new_
+        # class.  This is not relevant in the current upgrades, as
+        # RT::ObjectCustomFieldValues do not have interesting later
+        # upgrades if you start from 3.2 (which does
+        # RT::TicketCustomFieldValues -> RT::ObjectCustomFieldValues)
+        $self->{Transform}{$ref} = sub {
+            my ($dat, $classref) = @_;
+            my @extra;
+            for my $c (@{$transforms{$ref}}) {
+                push @extra, $c->($dat, $classref);
+                return @extra if not $$classref;
+            }
+            return @extra;
+        };
+    }
+}
+
+sub NextPage {
+    my $self = shift;
+    my ($collection, $last) = @_;
+
+    $last ||= 0;
+
+    if ($self->{Clone}) {
+        # Clone provides guaranteed ordering by id and with no other id limits
+        # worry about trampling
+
+        # Use DBIx::SearchBuilder::Limit explicitly to avoid shenanigans in RT::Tickets
+        $collection->DBIx::SearchBuilder::Limit(
+            FIELD           => 'id',
+            OPERATOR        => '>',
+            VALUE           => $last,
+            ENTRYAGGREGATOR => 'none', # replaces last limit on this field
+        );
+    } else {
+        # XXX TODO: this could dig around inside the collection to see how it's
+        # limited and do the faster paging above under other conditions.
+        $self->SUPER::NextPage(@_);
+    }
+}
+
+sub Process {
+    my $self = shift;
+    my %args = (
+        object => undef,
+        @_
+    );
+
+    my $obj = $args{object};
+    my $uid = $obj->UID;
+
+    # Skip all dependency walking if we're cloning; go straight to
+    # visiting them.
+    if ($self->{Clone} and $uid) {
+        return if $obj->isa("RT::System");
+        $self->{progress}->($obj) if $self->{progress};
+        return $self->Visit(%args);
+    }
+
+    return $self->SUPER::Process( @_ );
+}
+
+sub StackSize {
+    my $self = shift;
+    return scalar @{$self->{stack}};
+}
+
+sub ObjectCount {
+    my $self = shift;
+    return %{ $self->{ObjectCount} };
+}
+
+sub Observe {
+    my $self = shift;
+    my %args = (
+        object    => undef,
+        direction => undef,
+        from      => undef,
+        @_
+    );
+
+    my $obj = $args{object};
+    my $from = $args{from};
+    if ($obj->isa("RT::Ticket")) {
+        return 0 if $obj->Status eq "deleted" and not $self->{FollowDeleted};
+        return $self->{FollowTickets};
+    } elsif ($obj->isa("RT::ACE")) {
+        return $self->{FollowACL};
+    } elsif ($obj->isa("RT::Scrip") or $obj->isa("RT::Template") or $obj->isa("RT::ObjectScrip")) {
+        return $self->{FollowScrips};
+    } elsif ($obj->isa("RT::GroupMember")) {
+        my $grp = $obj->GroupObj->Object;
+        if ($grp->Domain =~ /^RT::(Queue|Ticket)-Role$/) {
+            return 0 unless $grp->UID eq $from;
+        } elsif ($grp->Domain eq "SystemInternal") {
+            return 0 if $grp->UID eq $from;
+        }
+    }
+
+    return 1;
+}
+
+sub Visit {
+    my $self = shift;
+    my %args = (
+        object => undef,
+        @_
+    );
+
+    # Serialize it
+    my $obj = $args{object};
+    warn "Writing ".$obj->UID."\n" if $self->{Verbose};
+    my @store;
+    if ($obj->isa("RT::Migrate::Serializer::IncrementalRecord")) {
+        # These are stand-ins for record removals
+        my $class = $obj->ObjectType;
+        my %data  = ( id => $obj->ObjectId );
+        # -class is used for transforms when dropping a record
+        if ($self->{Transform}{"-$class"}) {
+            $self->{Transform}{"-$class"}->(\%data,\$class)
+        }
+        @store = (
+            $class,
+            undef,
+            \%data,
+        );
+    } elsif ($self->{Clone}) {
+        # Short-circuit and get Just The Basics, Sir if we're cloning
+        my $class = ref($obj);
+        my $uid   = $obj->UID;
+        my %data  = $obj->RT::Record::Serialize( UIDs => 0 );
+
+        # +class is used when seeing a record of one class might insert
+        # a separate record into the stream
+        if ($self->{Transform}{"+$class"}) {
+            my @extra = $self->{Transform}{"+$class"}->(\%data,\$class);
+            for my $e (@extra) {
+                $! = 0;
+                Storable::nstore_fd($e, $self->{Filehandle});
+                die "Failed to write: $!" if $!;
+                $self->{ObjectCount}{$e->[0]}++;
+            }
+        }
+
+        # Upgrade the record if necessary
+        if ($self->{Transform}{$class}) {
+            $self->{Transform}{$class}->(\%data,\$class);
+        }
+
+        # Transforms set $class to undef to drop the record
+        return unless $class;
+
+        @store = (
+            $class,
+            $uid,
+            \%data,
+        );
+    } else {
+        @store = (
+            ref($obj),
+            $obj->UID,
+            { $obj->Serialize },
+        );
+    }
+
+    # Write it out; nstore_fd doesn't trap failures to write, so we have
+    # to; by clearing $! and checking it afterwards.
+    $! = 0;
+    Storable::nstore_fd(\@store, $self->{Filehandle});
+    die "Failed to write: $!" if $!;
+
+    $self->{ObjectCount}{$store[0]}++;
+}
+
+1;