view release on metacpan or  search on metacpan

lib/DBIx/Class/Fixtures.pm  view on Meta::CPAN

          my ( $self, $v ) = @_;
          if (! defined($ENV{$v})) {
            return "";
          } else {
            return $ENV{ $v };
          }
        },
        ATTR => sub {
          my ($self, $v) = @_;
          if(my $attr = $self->config_attrs->{$v}) {
            return $attr;
          } else {
            return "";
          }
        },
        catfile => sub {
          my ($self, @args) = @_;
          io->catfile(@args);
        },
        catdir => sub {
          my ($self, @args) = @_;
          io->catdir(@args);
        },
      };

      my $subsre = join( '|', keys %$subs );
      $_ =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $self, $2 ? split( /,/, $2 ) : () ) }eg;

      return $_;
    }
  );

  $v->visit( $config_set );


  my %sets_by_src;
  if($config_set) {
    %sets_by_src = map { delete($_->{class}) => $_ }
      @{$config_set->{sets}}
  }

  if (-e "$tmp_fixture_dir") {
    $self->msg("- deleting existing temp directory $tmp_fixture_dir");
    $tmp_fixture_dir->rmtree;
  }
  $self->msg("- creating temp dir");
  $tmp_fixture_dir->mkpath();
  for ( map { $self->_name_for_source($schema->source($_)) } $schema->sources) {
    my $from_dir = io->catdir($fixture_dir, $_);
    next unless -e "$from_dir";
    $from_dir->copy( io->catdir($tmp_fixture_dir, $_)."" );
  }

  unless (-d "$tmp_fixture_dir") {
    DBIx::Class::Exception->throw("Unable to create temporary fixtures dir: $tmp_fixture_dir: $!");
  }

  my $fixup_visitor;
  my $formatter = $schema->storage->datetime_parser;
  unless ($@ || !$formatter) {
    my %callbacks;
    if ($params->{datetime_relative_to}) {
      $callbacks{'DateTime::Duration'} = sub {
        $params->{datetime_relative_to}->clone->add_duration($_);
      };
    } else {
      $callbacks{'DateTime::Duration'} = sub {
        $formatter->format_datetime(DateTime->today->add_duration($_))
      };
    }
    $callbacks{object} ||= "visit_ref";
    $fixup_visitor = new Data::Visitor::Callback(%callbacks);
  }

  my @sorted_source_names = $self->_get_sorted_sources( $schema );
  $schema->storage->txn_do(sub {
    $schema->storage->with_deferred_fk_checks(sub {
      foreach my $source (@sorted_source_names) {
        $self->msg("- adding " . $source);
        my $rs = $schema->resultset($source);
        my $source_dir = io->catdir($tmp_fixture_dir, $self->_name_for_source($rs->result_source));
        next unless (-e "$source_dir");
        my @rows;
        while (my $file = $source_dir->next) {
          next unless ($file =~ /\.fix$/);
          next if $file->is_dir;
          my $contents = $file->slurp;
          my $HASH1;
          eval($contents);
          $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
          if(my $external = delete $HASH1->{external}) {
            my @fields = keys %{$sets_by_src{$source}->{external}};
            foreach my $field(@fields) {
              my $key = $HASH1->{$field};
              my $content = decode_base64 ($external->{$field});
              my $args = $sets_by_src{$source}->{external}->{$field}->{args};
              my ($plus, $class) = ( $sets_by_src{$source}->{external}->{$field}->{class}=~/^(\+)*(.+)$/);
              $class = "DBIx::Class::Fixtures::External::$class" unless $plus;
              eval "use $class";
              $class->restore($key, $content, $args);
            }
          }
          if ( $params->{use_create} ) {
            $rs->create( $HASH1 );
          } elsif( $params->{use_find_or_create} ) {
            $rs->find_or_create( $HASH1 );
          } else {
            push(@rows, $HASH1);
          }
        }
        $rs->populate(\@rows) if scalar(@rows);

        ## Now we need to do some db specific cleanup
        ## this probably belongs in a more isolated space.  Right now this is
        ## to just handle postgresql SERIAL types that use Sequences
        ## Will completely ignore sequences in Oracle due to having to drop
        ## and recreate them

        my $table = $rs->result_source->name;
        for my $column(my @columns =  $rs->result_source->columns) {
          my $info = $rs->result_source->column_info($column);
          if(my $sequence = $info->{sequence}) {
             $self->msg("- updating sequence $sequence");
            $rs->result_source->storage->dbh_do(sub {
              my ($storage, $dbh, @cols) = @_;
              if ( $dbh->{Driver}->{Name} eq "Oracle" ) {
                $self->msg("- Cannot change sequence values in Oracle");
              } else {
                $self->msg(
         my $sql = sprintf("SELECT setval(?, (SELECT max(%s) FROM %s));",$dbh->quote_identifier($column),$dbh->quote_identifier($table))
             );
                my $sth = $dbh->prepare($sql);