This file is indexed.

/usr/share/perl5/Language/INTERCAL/SharkFin.pm is in clc-intercal 1:1.0~4pre1.-94.-2-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
package Language::INTERCAL::SharkFin;

# Special version of Language::INTERCAL::Arrays used for "Shark Fin"
# registers

# This file is part of CLC-INTERCAL

# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

use strict;
use vars qw($VERSION $PERVERSION);
($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/SharkFin.pm 1.-94.-2") =~ /\s(\S+)$/;

use Carp;
use Language::INTERCAL::Exporter '1.-94.-2';
use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
use Language::INTERCAL::Arrays '1.-94.-2';
use vars qw(@ISA);
@ISA = qw(Language::INTERCAL::Arrays::Tail);

my %types = (
    vector => [\&_code_vector, \&_decode_vector],
);

sub new {
    @_ == 3 || @_ == 4
	or croak "Usage: Language::INTERCAL::SharkFin->new(TYPE, OBJECT [,VALUE])";
    my ($class, $type, $object, @value) = @_;
    exists $types{$type} or faint(SP_SPECIAL, "(type $type)");
    my $arr;
    if (@value) {
	@value = &{$types{$type}[0]}($object, @value);
	# note, we don't use SUPER here, rather we rebless later
	$arr = Language::INTERCAL::Arrays::Tail->from_list(\@value);
    } else {
	$arr = Language::INTERCAL::Arrays::Tail->new([]);
    }
    $arr->{sharkfin} = {
	object => $object,
	type => $types{$type}[0],
	typename => $type,
	decode => $types{$type}[1],
    };
    bless $arr, $class;
}

sub type {
    @_ == 1 or croak "Usage: SHARKFIN->type";
    my ($arr) = @_;
    $arr->{sharkfin}{typename};
}

sub _assign {
    @_ == 2 or croak "Usage: SHARKFIN->assign(VALUE)";
    my ($arr, $value) = @_;
    exists $arr->{sharkfin} or faint(SP_NOSPECIAL);
    $arr->{sharkfin}{type} or faint(SP_NOSPECIAL);
    my @value = &{$arr->{sharkfin}{type}}($arr->{sharkfin}{object}, $value);
    $arr->SUPER::_assign(@value ? [scalar @value] : []);
    for (my $i = 1; $i <= @value; $i++) {
	$arr->_store([$i], $value[$i - 1]);
    }
    $arr;
}

sub _get_number {
    my ($value) = @_;
    return $value->spot->number
	if ref $value && UNIVERSAL::isa($value, 'Language::INTERCAL::Numbers');
    return $value
	if ! ref $value && defined $value && $value =~ /^\d+$/;
    faint(SP_INVARRAY, 'Not a number');
}

sub _get_vector {
    my ($value) = @_;
    return $value->spot->number
	if ref $value && UNIVERSAL::isa($value, 'Language::INTERCAL::Numbers');
    return $value
	if ! ref $value && defined $value && $value =~ /^\d+$/;
    return (unpack('C*', $value), 0)
	if ! ref $value && defined $value;
    return ( map { _get_number($_) } @$value )
	if ref $value eq 'ARRAY';
    faint(SP_INVARRAY, 'Not a number');
}

sub _code_vector {
    my ($object, $value) = @_;
    if (ref $value) {
	return ( map { _get_vector($_) } @$value )
	    if ref $value eq 'ARRAY';
	return ( $value->spot->number )
	    if UNIVERSAL::isa($value, 'Language::INTERCAL::Numbers');
	return ((map { $_->spot->number } $value->tail->as_list))
	    if UNIVERSAL::isa($value, 'Language::INTERCAL::Arrays');
	faint(SP_NOARRAY, "Not an array");
    }
    if (defined $value) {
	return (unpack('C*', $value));
    }
    faint(SP_NOARRAY, "Not an array");
}

sub _decode_vector {
    my ($object, $value) = @_;
    my @list = map { $_->number } $value->as_list;
    pop @list while @list && $list[-1] == 0;
    my $list = pack('C*', @list);
    $list =~ s/([\\'])/\\$1/g;
    $list = "'$list'" if $list =~ /['\s\\]/;
    $list;
}

sub print {
    @_ == 1 or croak "Usage: SHARKFIN->print";
    my ($arr) = @_;
    my $s = $arr->{sharkfin};
    return &{$s->{decode}}($s->{object}, $arr) if $s->{decode};
    $arr->SUPER::print;
}

sub range {
    @_ == 3 or croak "Usage: SHARKFIN->range(START, LEN)";
    my ($arr, $start, $len) = @_;
    # we just rebless it to a Tail and use their range()
    bless $arr, 'Language::INTERCAL::Arrays::Tail';
    $arr->range($start, $len);
}

1;