view release on metacpan or  search on metacpan

perllib/Arch/Changeset.pm  view on Meta::CPAN

	if (!-f $patch_file) {
		my $patch_content = "*** Currently unsupported patch type, possibly metadata or symlink change ***";
		if ($type >= 2) {
			if (-l $patch_file) {
				$patch_content = readlink($patch_file);
			} else {
				die "No file $filepath patch in revision $self->{revision} changeset\n";
			}
		} else {
			$patch_file = "/dev/null";
			$change_type = "unsupported";
		}
		return wantarray? ($patch_content, $patch_file, $change_type, 1): $patch_content;
	}
	my $patch_content = load_file($patch_file);

	# create fake patch from full file if needed
	my $asis = 0;
	if ($change_type ne "" && !($asis = $full_file_asis || -B $patch_file)) {
		my $has_end_line = $patch_content =~ /\n$/;
		my $num_lines = $patch_content =~ s/\n/\n/g;
		$num_lines += $has_end_line? 0: 1;
		my $file = $patch_file;
		$file =~ s!^\Q$dir\E/[^/]+/!!s;
		my ($file1, $file2, $line1, $line2, $prefix);
		if ($change_type eq "new") {
			$file1 = "/dev/null";
			$file2 = $file;
			$line1 = "-0,0";
			$line2 = "+1,$num_lines";
			$prefix = "+";
		} else {
			$file1 = $file;
			$file2 = "/dev/null";
			$line1 = "-1,$num_lines";
			$line2 = "+0,0";
			$prefix = "-";
		}
		chop $patch_content if $has_end_line;
		$patch_content =~ s/(^|\012)/$1$prefix/g;
		$patch_content .= "\n\\ No newline at end of file" unless $has_end_line;
		$patch_content = "--- $file1\n+++ $file2\n@@ $line1 $line2 @@\n$patch_content\n";
		$change_type = "";
	}

	$change_type ||= "patch";
	return wantarray? ($patch_content, $patch_file, $change_type, $asis): $patch_content;
}

sub ancestor ($) {
	my $self = shift;
	my $ancestor = $self->{ancestor};
	return $ancestor if $ancestor;

	if (-f "$self->{dir}/=ancestor") {
		$ancestor = load_file("$self->{dir}/=ancestor");
		chomp($ancestor);
	}
	unless ($ancestor) {
		# just guess
		my $revision = $self->{revision};
		$ancestor = adjacent_revision($revision, -1) || $revision;
	}
	return $self->{ancestor} = $ancestor;
}

sub get_index ($$) {
	my $self  = shift;
	my $index = shift;

	return %{$self->{index_memo}->{$index}}
		if (exists $self->{index_memo}->{$index});

	my $index_hash = {};

	# TODO: add proper unescaping support
	foreach my $line (split /\n/, load_file($self->{dir} . '/' . $index)) {
		my ($path, $id) = split / /, $line, 2;

		$path =~ s,^\./,,;
		$index_hash->{$id} = $path;
	}

	$self->{index_memo}->{$index} = $index_hash;
	return %$index_hash;
}

sub get_changes ($) {
	my $self = shift;

	my %orig_dirs  = $self->get_index('orig-dirs-index');
	my %mod_dirs   = $self->get_index('mod-dirs-index');

	my %orig_files = $self->get_index('orig-files-index');
	my %mod_files  = $self->get_index('mod-files-index');

	my $changes = Arch::Changes->new;

	# added dirs
	foreach my $id (keys %mod_dirs) {
		$changes->add(ADD, 1, $mod_dirs{$id})
			unless (exists $orig_dirs{$id});
	}

	# added files
	foreach my $id (keys %mod_files) {
		$changes->add(ADD, 0, $mod_files{$id})
			unless (exists $orig_files{$id});
	}

	# deleted dirs
	foreach my $id (keys %orig_dirs) {
		$changes->add(DELETE, 1, $orig_dirs{$id})
			unless (exists $mod_dirs{$id});
	}

	# deleted files
	foreach my $id (keys %orig_files) {
		$changes->add(DELETE, 0, $orig_files{$id})
			unless (exists $mod_files{$id});

perllib/Arch/Changeset.pm  view on Meta::CPAN

B<ancestor>.

=over 4

=item B<new> I<revision-spec> I<dir-name>

Construct the Arch::Changeset object associated with the given
fully-qualified I<revision-spec> and the existing directory I<dir-name>.

=item B<get_patch> I<file-path>

=item B<get_patch> I<file-path> I<type>

=item B<get_patch> I<file-path> I<type> I<full-file-asis>

Return the patch (or otherwise content) of the given I<file-path> in the
changeset.

I<type> is integer: 0 (unknown, try to autodetect, this is the default),
1 (modified file, or metadata change), 2 (new file), 3 (removed file).

The default behaviour is to create a fake diff against I</dev/null> for
non-binary new and removed files; the I<full-file-asis> flag, if set to
true, changes this behaviour and causes to return the content of such file
as-is. Binary new and removed files are always returned as-is regardless
of the flag. This flag is also ignored if I<type> is 1.

In the scalar content return the patch in diff(1) format (or the whole file
content as described above). In the list content return 4 scalars: the
patch, the file name on the disk containing this patch (or the whole file),
the change type (that is "patch", "new" or "removed") and the as-is flag.

The returned values that follow the first one (the patch/file content)
share the order of the corresponding parameters; the parameters are
more hints, while the returned values accurately describe the content.

=item B<get_index> I<name>

Returns the content of the index file I<name> as an B<ID> => B<path> hash.

Valid I<name>s are 'orig-dirs-index', 'orig-files-index', 'mod-dirs-index' and
'mod-files-index'.

=item B<get_changes>

Returns a list of changes in the changeset.

=item B<get_all_diffs>

Returns all diffs in the changeset (array or arrayref). This includes
changes of types I<MODIFY>, I<ADD> and I<DELETE>.

=item B<join_all_diffs>

Returns concatenated output of all diffs in the changeset.

=item B<ancestor>

Return the ancestor of the changeset. If I<=ancestor> file is found (that is
the case for library changesets) its content is returned, otherwise try to
guess the ancestor of the revision using B<Arch::Util::adjacent_revision>.

=back

=head1 BUGS

Awaiting for your reports.

=head1 AUTHORS

Mikhael Goikhman (migo@homemail.com--Perl-GPL/arch-perl--devel).

=head1 SEE ALSO

For more information, see L<tla>, L<Arch::Session>, L<Arch::Library>,
L<Arch::Util>.

=cut