Dotaz: Perl - parsování textu do n-dimenzionálního hash-pole

[Jakub Lucký]

Snažím se naparsovat výstup z getfacl do Perlu... Relevantní část vypadá zhruba takto

user::rw-
user:gemini:rwx
group::r--
mask::rwx
other::r--

Já se snažím, aby z toho vzniklo vícedimenzionální hash, kde by se dalo přistupovat k datům zhruba takto:

$acl{user}{gemini}{read}=1

Pokud máte svůj vlastní, jednoduchý nápad na řešení, klidně i s jiným způsobem uložení dat, nečtěte dále a navrhněte vaše řešení

Mám nějaký svůj kód, který ale selhává právě na vytváření vícedimenzionální hashe... Kód není dokončený, výsledné spojení do jednoho hashe by se měl udít pomocí Hash::Merge, nicméně navazování těch hashí do té vícedimenzové nějak selhává... problémový řádek je označený komentářem, je skoro dole...

#!/usr/bin/perl -w

use strict;
use Data::Dump qw(dump);


my $string = "user::rw-
user:gemini:rwx
group::r--
mask::rwx
other::r--
";

#Stripping last end of line
$string =~ s/^$//g;

my @lines = split(/\n/,$string);
my %result = ();
my %output = ();

foreach	my $line(@lines)
{
	my @parts = split(/:/,$line);
	#This small part of code is ugly hack for situation, when while dies, if $part is empty string (OMG why?)
	if (!$parts[1] and $parts[2])  #FIXME  
	{
		$parts[1] = 'NULL';
	}
	INTERN:while( my $part = pop(@parts))
	{
		if ($part =~ m/[r-][w-][x-]/)
		{
			my @perms = split(//,$part);
			if($perms[0] eq 'r') { $result{'read'} = 1 }
			else {$result{'read'} = 0 }
			if($perms[1] eq 'w') { $result{'write'} = 1 }
			else {$result{'write'} = 0 }
			if($perms[2] eq 'x') { $result{'exec'} = 1 }
			else {$result{'exec'} = 0 }
#			print "$result{'read'},$result{'write'},$result{'exec'} \n";
		}
		else
		{
			my %meta = ();
			%meta = %result;
			%result = ();
                        #Tento radek vsechno rozbije!!
			$result{$part} = %meta;
		}	
	}	
dump(%result);

}

Bohužel, výstup z toho vůbec není takový, jako by člověk čekal, označený řádek to nějak rozbije a výstupem dumpu je tohle...

jakub@gondolin:/tmp$ ./test.pl 
("user", "1/8")
("user", "1/8")
("group", "1/8")
("mask", "1/8")
("other", "1/8")

---

---

Odpovědi

[Jakub Lucký]

Jinak rád přijmu i jiné rady k Perl kódu... nějak jsem začal zase po dlouhé době Perlit a mám pocit, že můj kód je ošklivě neelegantní...

[petr_p]

Nechcete si raději ohnout Solaris::ACL?

[Jakub Lucký]

Tam je právě pod tím Cčková knihovna pro Solaris a to já asi neumím, abych to naportoval do Linuxu... Ale bylo by to fajn, protože to co implementuju je hack-of-a-hack

[omg]

man perlxstut

je to jednodussi nez se zda pokud uz vis jak pouzivat C a umis psat kod v perlu neni nic snazsiho nez si napsat vlastni modul co bude volat C kod. staci jit akorat po tech examplech s tim, ze na odsazeni zalezi... vse dulezite uz vis.

[happy barney]

použi $result{$part} = \%meta ... referencia na hash.

to "parts =~" skús takto:

if ($parts =~ m/([-r])([-w])([-x])/) {
  $result{read} = $1 eq 'r';
  $result{write} = $1 eq 'w';
  $result{exec} = $1 eq 'x';
)

[Jakub Lucký]

Jo, to je ono... děkuju... <Rve si vlasy z hlavy, že ho to za ty dvě hodiny nenapadlo>

A to druhé taky funguje... Já věděl, že to moje ošklivé mi v Perlu neprojde...

[pht]

Pokud máte svůj vlastní, jednoduchý nápad na řešení, klidně i s jiným způsobem uložení dat, nečtěte dále a navrhněte vaše řešení

Asi by se dalo vymyslet 100 způsobů, jde o to, na co to chcete použít...

Každopádně ale doporučuju u takovéto datové struktury použít rovnou referenci na hash ($acl->{user}{gemini}) místo hashe.

Jinak se mi moc nezdá že by ten kód byl v Perlu :) zkusil jsem to napsat takto:

use Modern::Perl;
use Test::More tests => 1;

my @input = qw/user::rw- user:gemini:rwx group::r-- mask::rwx other::r--/;
my $expected_output = {
        user => {
                NULL   => { read => 1, write => 1, execute => 0 },
                gemini => { read => 1, write => 1, execute => 1 },
        },
        group => {
                NULL   => { read => 1, write => 0, execute => 0 },
        },
        mask => {
                NULL   => { read => 1, write => 1, execute => 1 },
        },
        other => {
                NULL   => { read => 1, write => 0, execute => 0 },
        },
};

is_deeply(acl_as_hash(@input), $expected_output);

sub acl_as_hash {
        my $output;
        for my $line (@_) {
                my ($type, $name, $priv) = split(/:/, $line, 3);
                $name ||= 'NULL';
                $output->{$type}->{$name} = _privs_for($priv);
        }
        return $output;
}

sub _privs_for {
        my $priv = shift;
        return {
                read    => $priv =~ /r/ ? 1 : 0,
                write   => $priv =~ /w/ ? 1 : 0,
                execute => $priv =~ /x/ ? 1 : 0,
        };
}

[Jakub Lucký]

Ohledně hash_ref jsem to celkem asi pochopil... Holt, pořád ještě málo Perl-skill

Jinak váš kód je pěkný, akorát neřeší věc, kterou jsem zapomněl uvést... ACL má proměnnou délku (teda, moc ne, 3 nebo 4, pokud se nepletu) a tak jsem to chtěl implementovat víc obecně (ačkoliv je to kráse kódu celkem naškodu)

[pht]

Proměnnou délku čeho?

[Jakub Lucký]

počet sloupců v těch ACL datech

tak jako máme user:gemini:r-x tak můžeme mít ještě default:user:someone:rwx (můj blik: čtvrtý sloupec může být pouze(!!!) default)

A teď, když se na to dívám, tak to vážně šlo všechno udělat jednodušeji a já si jen trval na obecném řešení pro nekonečný počet sloupců

Důvod pro implementaci je zhruba takový, že potřebuju nějaké programovací rozhraní pro ACL, v Perl není vůbec (jen výše zmíněné nepřenositelné Solaris::ACL) a v Pythonu je jen python-libacl, které je celé nějaké divné...

[pht]

tak jako máme user:gemini:r-x tak můžeme mít ještě default:user:someone:rwx (můj blik: čtvrtý sloupec může být pouze(!!!) default)

Jo tohle. No, ale to bych asi držel oboje na stejné úrovni jinak v tom bude pěknej bordel.

Důvod pro implementaci je zhruba takový, že potřebuju nějaké programovací rozhraní pro ACL

OK, v tom případě to berete za špatný konec. Začněte s tím, že to rozhraní použijete (i když ho nemáte), tím zjistíte, jaký potřebujete interface, a pak dodělejte tu implementaci. Datová struktura je implementační detail až úplně na konci. Třeba zjistíte že to chcete úplně jinak.

Např.

my $acl = Moje::ACL->new('/home/franta');
if ($acl->readable_by('franta')) { ... }

nebo

my $acl = Moje::ACL->new( { franta => 'rw-' } );
$acl->apply_to('/home/franta');

atd.

[Jakub Lucký]

Důvod pro implementaci je zhruba takový, že potřebuju nějaké programovací rozhraní pro ACL

OK, v tom případě to berete za špatný konec. Začněte s tím, že to rozhraní použijete (i když ho nemáte), tím zjistíte, jaký potřebujete interface, a pak dodělejte tu implementaci. Datová struktura je implementační detail až úplně na konci. Třeba zjistíte že to chcete úplně jinak.

Např.

my $acl = Moje::ACL->new('/home/franta');
if ($acl->readable_by('franta')) { ... }

No, do něčeho podobného to směřuju, akorát tu hash chci použít jako podklad pro ty funkce... Každopádně dobrá rada s tou implementací... (A taky jsem díky vám objevil Modern::Perl)

[pht]

No, do něčeho podobného to směřuju, akorát tu hash chci použít jako podklad pro ty funkce... Každopádně dobrá rada s tou implementací...

Pokud se Vám líbí ta objektová notace, tak zkuste třeba Moose. Jak říkám, jestli tam nakonec bude ten hash nebo něco jiného vyplyne z kontextu až budete psát sub readable_by.