view release on metacpan or  search on metacpan

t/146-init-skill-write-in-place.t  view on Meta::CPAN

    my $before = ident($installed);
    my $r = install_into( $dir, $NEW );
    is( $r->{error}, '', 'the install succeeds' );

    my $after = ident($installed);
    is( $after->{dev}, $before->{dev}, 'same device' );
    is( $after->{ino}, $before->{ino}, 'same inode: the write went through the existing file' );
    is( $after->{nlink}, 2, 'link count is untouched' );
    is( ident($elsewhere)->{ino}, $before->{ino}, 'the second path is still that same inode' );

    is( $installed->slurp_utf8, $NEW, 'the installed path has the new skill' );
    is( $elsewhere->slurp_utf8, $NEW, 'and so does every other project on the chain' );

    like( $r->{stdout}, qr/Installed Claude Code skill/, 'and it still says so' );
    is( scalar( @{ $r->{warnings} } ), 0, 'an in-place write says nothing' )
        or diag "warnings emitted: @{ $r->{warnings} }";

    # Truncation, not overwrite-in-front: a shorter skill must not leave a tail
    # of the previous one behind.
    install_into( $dir, "short\n" );
    is( $elsewhere->slurp_utf8, "short\n", 'a shorter install truncates rather than overwriting in place' );
    is( ident($installed)->{ino}, $before->{ino}, 'still the same inode afterwards' );
};

subtest 'the content is encoded exactly once' => sub {
    my $dir = tempdir( CLEANUP => 1 );
    install_into( $dir, $NEW );
    my $installed = path($dir)->child('.claude/skills/karr/SKILL.md');

    my $raw = do {
        open my $fh, '<:raw', "$installed" or die "open $installed: $!";
        local $/;
        <$fh>;
    };
    is( $raw, "# karr skill \xe2\x80\x94 new\n\nBl\xc3\xb6cke \xe2\x80\xa6 \xc3\xbcml\xc3\xa4ute\n",
        'UTF-8 on disk, encoded once' );
    is( $installed->slurp_utf8, $NEW, 'and it reads back as the characters that went in' );
};

subtest 'a project without .claude yet still gets the skill installed' => sub {
    my $dir = tempdir( CLEANUP => 1 );
    my $installed = path($dir)->child('.claude/skills/karr/SKILL.md');
    ok( !$installed->exists, 'nothing there to begin with' );

    my $r = install_into( $dir, $NEW );
    is( $r->{error}, '', 'the install succeeds' );

    ok( $installed->exists, 'the file was created' );
    is( $installed->slurp_utf8, $NEW, 'with the right content' );
    is( ident($installed)->{nlink}, 1, 'one link, as a fresh file should have' );
};

subtest 'a read-only installed skill is still updated, and a broken chain is reported' => sub {
    plan skip_all => 'running as root: a read-only file is still writable'
        if $> == 0;

    my $dir = tempdir( CLEANUP => 1 );
    my ( $installed, $elsewhere ) = chained_install( $dir, $OLD );
    plan skip_all => 'filesystem does not support hardlinks' unless $installed;
    chmod 0444, "$installed" or plan skip_all => "cannot chmod the target: $!";
    plan skip_all => 'the target is writable despite mode 0444' if -w "$installed";

    my $before = ident($installed);
    my $r = install_into( $dir, $NEW );
    chmod 0644, "$installed", "$elsewhere";

    # Before the fix this case worked (the rename only needs a writable
    # directory), so it keeps working -- but it is the one path where the chain
    # cannot survive, and that is said out loud rather than done quietly.
    is( $r->{error}, '', 'the install still succeeds' );
    is( $installed->slurp_utf8, $NEW, 'the read-only target was updated, as it was before' );
    isnt( ident($installed)->{ino}, $before->{ino}, 'by replacement: in-place was impossible here' );
    is( $elsewhere->slurp_utf8, $OLD, 'so the other link is left on the old content' );

    is( scalar( @{ $r->{warnings} } ), 1, 'exactly one warning' )
        or diag "warnings emitted: @{ $r->{warnings} }";
    like( $r->{warnings}[0], qr/could not be written in place/, 'it says the write was not in place' );
    like( $r->{warnings}[0], qr/hardlink/, 'and that a hardlink is affected' );
    unlike( $r->{warnings}[0], qr/ at \S+ line \d+/, 'no karr source location in it' )
        or diag "warning was: $r->{warnings}[0]";
};

subtest 'an unwritable .claude is still the one-line error of ticket #77' => sub {
    plan skip_all => 'running as root: an unwritable directory is still writable'
        if $> == 0;

    # t/120-error-message-sweep.t pins this end to end; repeated here because
    # routing the write through the shared role is exactly the change that could
    # have swapped this message for the role's own "Could not write ...".
    my $dir    = tempdir( CLEANUP => 1 );
    my $claude = path($dir)->child('.claude');
    $claude->mkpath;
    chmod 0500, "$claude" or plan skip_all => "cannot chmod the directory: $!";

    my $r = install_into( $dir, $NEW );
    chmod 0700, "$claude";

    like( $r->{error}, qr/^Could not create /, 'the directory is what karr could not make' );
    like( $r->{error}, qr/Permission denied/,  'with the reason from the OS' );
    unlike( $r->{error}, qr/ at \S+ line \d+/, 'and no source location' )
        or diag "error was: $r->{error}";
    my @lines = split /\n/, $r->{error};
    is( scalar(@lines), 1, 'exactly one line' ) or diag "error was: $r->{error}";
};

subtest 'karr init --claude-skill through the real CLI keeps the inode' => sub {
    my $repo = tempdir( CLEANUP => 1 );
    system( 'git', 'init', '-q', $repo ) == 0
        or plan skip_all => 'git init failed';
    system( 'git', '-C', $repo, 'config', 'user.email', 'test@example.com' );
    system( 'git', '-C', $repo, 'config', 'user.name',  'Test User' );

    my ( $installed, $elsewhere ) = chained_install( $repo, $OLD );
    plan skip_all => 'filesystem does not support hardlinks' unless $installed;

    # A share dir of our own, ahead of everything else in @INC, so the child
    # reads a skill we control rather than an installed App::karr's (t/65 has
    # the long version of why this matters).
    my $share_lib = path( tempdir( CLEANUP => 1 ) );
    my $share_dir = $share_lib->child(qw( auto share dist App-karr ));
    $share_dir->mkpath;
    $share_dir->child('claude-skill.md')->spew_utf8($NEW);

    my $before = ident($installed);

    my $old_cwd = getcwd();
    chdir $repo or die "chdir $repo: $!";
    my $err_fh = gensym;
    my $pid = open3( my $in, my $out_fh, $err_fh,
        $^X, "-I$share_lib", "-I$ROOT/lib", $BIN, 'init', '--claude-skill' );
    close $in;
    my $out = do { local $/; <$out_fh> };
    my $err = do { local $/; <$err_fh> };
    waitpid( $pid, 0 );
    my $exit = $? >> 8;
    chdir $old_cwd or die "chdir $old_cwd: $!";

    is( $exit, 0, 'karr init --claude-skill exits 0' ) or diag "stderr: $err";
    like( $out, qr/Installed Claude Code skill/, 'and reports the install' );
    is( ident($installed)->{ino}, $before->{ino}, 'it wrote through the existing inode' );
    is( ident($installed)->{nlink}, 2, 'the chain still has both links' );
    is( $installed->slurp_utf8, $NEW, 'the project got the new skill' );
    is( $elsewhere->slurp_utf8, $NEW, 'and so did every other project on the chain' );
};

done_testing;