view release on metacpan or  search on metacpan

lib/Data/Section/Writer.pm  view on Meta::CPAN

  use File::Temp ();

  sub BUILD ($self, $) {

    # use the callers filename if not provided.
    unless(defined $self->perl_filename) {
      my(undef, $fn) = caller 2;
      $self->perl_filename($fn);
    }

    # upgrade to Path::Tiny if it is not already
    unless(is_blessed_ref $self->perl_filename && $self->isa('Path::Tiny')) {
      $self->perl_filename(Path::Tiny->new($self->perl_filename));
    }

    $self->_files({});
    $self->_formats({});

  }


  sub add_file ($self, $filename, $content, $encoding=undef) {
    Carp::croak("Unknown encoding $encoding") if defined $encoding && $encoding ne 'base64';
    $self->_files->{"$filename"} = [ $content, $encoding ];
    return $self;
  }

  sub _render_file ($self, $filename, $data) {
    my $text = "@@ $filename";
    $text .= " (" . $data->[1] . ")" if defined $data->[1];
    $text .= "\n";

    my $content = $data->[0];

    if($filename =~ /\.(.*?)\z/ && ($self->_formats->{$1} // [])->@*) {
        my $ext = $1;
        $content = $_->($self, $content) for $self->_formats->{$ext}->@*;
    }

    if(defined $data->[1] && $data->[1] eq 'base64') {
        $text .= encode_base64($data->[0]);
    } else {
        $text .= $content;
    }
    chomp $text;
    return $text;
  }


  sub render_section ($self) {
    my $files = $self->_files;
    return "__DATA__\n" unless %$files;
    return join("\n",
      "__DATA__",
      (map { $self->_render_file($_, $files->{$_}) } sort keys $files->%*),
      ''
    );
  }


  sub update_file ($self) {
    my $perl;
    my $orig;

    if(-f $self->perl_filename) {
      $orig = $perl = $self->perl_filename->slurp_utf8;

      if($perl =~ /^__DATA__/) {
        $perl = '';
      } else {
        # read the file in, removing __DATA__ and everything after that
        # if there is no __DATA__ section then leave unchanged.
        $perl =~ s/(?<=\n)__DATA__.*//s;

        # Add a new line at the end if it doesn't already exist.
        $perl .= "\n" unless $perl =~ /\n\z/s;
      }

    } else {
      $perl = '';
    }

    $perl .= $self->render_section;

    if(defined $orig && $orig eq $perl) {
      $self->_same(1);
      return $self;
    } else {
      $self->_same(0);
    }

    if(-f $self->perl_filename) {
      use autodie qw( truncate close );
      # re-write the perl to the file, using the existing inode
      my $backup = Path::Tiny->new(File::Temp::tempnam($self->perl_filename->parent, $self->perl_filename->basename));
      $self->perl_filename->copy($backup) if -f $self->perl_filename;
      my $fh = $self->perl_filename->openrw_utf8;
      truncate $fh, 0;
      print $fh $perl or die "unable to write to @{[ $self->perl_filename ]} $!";
      close $fh;
      $backup->remove if -f $backup;
    } else {
      $self->perl_filename->spew_utf8($perl);
    }

    return $self;
  }


  sub unchanged ($self) {
      return $self->_same;
  }


    sub add_format ($self, $ext, $cb) {
        Carp::croak("callback is not a code reference") unless is_coderef $cb;
        push $self->_formats->{$ext}->@*, $cb;
        return $self;
    }