Скрипт аналог Data::Dumper

Вопросы и обсуждения, касающиеся программирования на Perl.
Ответить
Аватара пользователя
ZEN
Администратор
Сообщения: 1357
Зарегистрирован: 27 сен 2012, 18:23
Темы: 208
Откуда: Украина, Одесса
Статус: Не в сети

Скрипт аналог Data::Dumper

Сообщение ZEN » 12 авг 2013, 14:20

[spoiler="Подробное описание задания"]Входные данные:

файл, первая строка которого - название переменной. Остальные строки - код на perl (в котором переменная инициализируется). Пример файла:

Код: Выделить всё

diesel@bender-2:~/07$ cat dat/00_example.dat
hash
$hash = {
    a => "1j",
    b => "23",
    c => {
        d => "inner",
        e => "outer",
        f => {
            g => "one more level",
            x => "d level",
        },
        g2 => {
            g => "one more level",
            x => "d level",
        }
    },

    array1 => [
        "val1",
        "val2",
    ],

    hash_obj => MyTestHash->new({"a"=>"b", "c"=>"d"}),
    array_obj => MyTestArray->new(["a", "b", "c", "d", "e", "f"]),
    regexp => qr/.*/,
    code   => \&{1+1},
};
$hash->{ref_to_itself} = $hash;
my $scalar_variable = "scalar_variable";
my $ref_to_scalar_variable = \$scalar_variable;
my $ref_to_ref = \$ref_to_scalar_variable;
$hash->{ref_to_ref} = $ref_to_ref;

my $array = ['a', 0, 2 ];
my $ref_to_array_ref = \$array;
$hash->{ref_to_array_ref} = $ref_to_array_ref;

my $one_more_hash = { "key1" => "value1", "key2" => "value2" };
my $ref_to_one_more_hash = \$one_more_hash;
$hash->{ref_to_hash_ref} = \$ref_to_one_more_hash;

{
    package MyTestHash;

    sub new {
        my $class = shift;
        my $self = shift;

        bless $self, $class;
        return $self;
    }

    sub get_struct {
        my $self = shift;
        return "IN<-" . join(",", map( $_ . "=>" . $self->{$_} ,keys %$self));
    }
};

{
    package MyTestArray;

    sub new {
        my $class = shift;
        my $self = shift;

        bless $self, $class;
        return $self;
    }

    sub get_struct {
        my $self = shift;
        return "IN<-" . join(",", @$self);
    }
};
Выходные данные:
Вывод, похожий на вывод Data::Dumper::Dumper, для указанной переменной. В случае если мы получаем объект - для него печатается вывод его метода get_struct, хэши/ссылки на хэши отстортированы по ключам, остальные случаи показаны для примера выше:

Код: Выделить всё

diesel@bender-2:~/scripts/projects/students/students/model/07$ ./07.pl dat/00_example.dat
{
    a => '1j',
    array1 => [
        'val1',
        'val2'
    ],
    array_obj => IN<-a,b,c,d,e,f,
    b => '23',
    c => {
        d => 'inner',
        e => 'outer',
        f => {
            g => 'one more level',
            x => 'd level'
        },
        g2 => {
            g => 'one more level',
            x => 'd level'
        }
    },
    code => CODE,
    hash_obj => IN<-c=>d,a=>b,
    ref_to_array_ref => REF:[
        'a',
        '0',
        '2'
    ],
    ref_to_hash_ref => REF:REF:{
        key1 => 'value1',
        key2 => 'value2'
    },
    ref_to_itself => HASH,
    ref_to_ref => REF:'scalar_variable',
    regexp => Regexp
}
[/spoiler]

Код: Выделить всё

#!/usr/bin/perl -w

sub recursiveDumper {
    my $node = $_[0];
    my $split = $_[1];
    my $used = $_[2];
    my $ref = ref($node);

    if (defined $node) {    
        for (my $i=0; $i < scalar(@{$used}); $i++) {
            if (@{$used}[$i] eq $node) {
                print $ref;
                return;
            }
        }
        push(@{$used}, $node);
    }
    
    if (not defined $node) {
        print "''";
    } elsif ($ref eq "") {
        print "'".$node."'";
    } elsif ($node =~ m/(.*)=(.*)/) {
        print $node->get_struct();
    } elsif ($ref eq "ARRAY") {
        print "[\n";
        my $size = scalar(@{$node});
        for (my $i = 0; $i < $size; $i++) {
            if (ref($node->[$i]) eq "") {
                print $split;
                recursiveDumper($node->[$i], $split, $used);
            } else {
                print $split;
                recursiveDumper($node->[$i], $split."\t", $used);
            }
            print "," if ($i+1 < $size);
            print "\n";
        }
        $split =~ s/\t//;
        print $split."]";
    } elsif ($ref eq "HASH") {
        print "{\n";
        my $count = keys( $node );
        foreach my $key (sort keys $node) {
            if (ref($node->{$key}) eq "") {
                my $buff = $split.$key." => \'".$node->{$key}."\'";
                print $buff;
            } else {
                print $split.$key." => ";
                recursiveDumper($node->{$key}, $split."\t", $used);
            }
            print "," if (--$count > 0);
            print "\n"; 
        }
        $split =~ s/\t//;
        print $split."}";
    } elsif ($ref eq "SCALAR") {
        print "'$$node'";
    } elsif ($ref eq "REF") {
        print "REF:";
        recursiveDumper($$node, $split, $used);
    } else { # CODE, Regexp, GLOB, LVALUE, FORMAT, IO, VSTRING
        print $ref;
    }
}

# use first argument of script as file name whith data
my $test_file_path = $ARGV[0];
# open file and get file handler or die
open( FH, "<", "$test_file_path") or die "Missing file names";
my $ptrname;
my $code;
my $first = 0;
while (<FH>) {
    if ($first == 0) {
        $first++;
        chomp;
        $ptrname = $_;
        next;
    } 
    $code .= $_;
}
eval($code);
if ($@) {
    print "ERROR\n";
    warn("$@");
    exit 1;
}

recursiveDumper($$ptrname, "\t", []);
print "\n";

exit 0;
бог создал труд и обезьяну
чтоб получился человек
а вот пингвина он не трогал
тот сразу вышел хорошо

Ответить

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и 1 гость