File Coverage

blib/lib/StorageDisplay/Data/Partition.pm
Criterion Covered Total %
statement 197 208 94.7
branch 32 40 80.0
condition 6 7 85.7
subroutine 50 53 94.3
pod 0 27 0.0
total 285 335 85.0


line stmt bran cond sub pod time code
1             #
2             # This file is part of StorageDisplay
3             #
4             # This software is copyright (c) 2014-2023 by Vincent Danjean.
5             #
6             # This is free software; you can redistribute it and/or modify it under
7             # the same terms as the Perl 5 programming language system itself.
8             #
9 9     9   75 use strict;
  9         23  
  9         450  
10 9     9   89 use warnings;
  9         23  
  9         996  
11              
12             package StorageDisplay::Data::Partition;
13             # ABSTRACT: Handle partition tables data for StorageDisplay
14              
15             our $VERSION = '2.06'; # VERSION
16              
17 9     9   93 use Moose;
  9         21  
  9         80  
18 9     9   83255 use namespace::sweep;
  9         24  
  9         132  
19             extends 'StorageDisplay::Data::Elem';
20              
21             with (
22             'StorageDisplay::Role::HasBlock',
23             'StorageDisplay::Role::Style::Label::HTML::Table',
24             'StorageDisplay::Role::Style::WithSize',
25             );
26              
27             sub disk {
28 226     226 0 526 my $self = shift;
29 226         9098 return $self->block(@_);
30             }
31              
32             has 'kind' => (
33             is => 'ro',
34             isa => 'Str',
35             required => 1,
36             );
37              
38             around BUILDARGS => sub {
39             my $orig = shift;
40             my $class = shift;
41             my $block = shift;
42             my $st = shift;
43              
44             $st->log({level=>1}, 'Partition table on '.$block->dname);
45              
46             return $class->$orig(
47             'name' => $block->name,
48             'part_infos' => $st->get_info('partitions', $block->name),
49             'block' => $block,
50             'consume' => [$block],
51             @_
52             );
53             };
54              
55             has 'table' => (
56             is => 'ro',
57             isa => 'StorageDisplay::Data::Partition::Table',
58             required => 1,
59             default => sub {
60             my $self = shift;
61             return $self->newChild(
62             'Partition::Table',
63             'ignore_name' => 1,
64             'partition' => $self,
65             );
66             },
67             lazy => 1,
68             );
69              
70             sub dotStyleNode {
71 42     42 0 117 my $self=shift;
72 42         118 my $t=shift;
73              
74 42         117 my $fc='';
75             my $it = $self->table->iterator(
76             recurse => 1,
77             filter => sub {
78 236     236   19840 my $part = shift;
79 236         3715 return ! $part->isa('StorageDisplay::Data::Partition::Table::Part::SubTable');
80             },
81 42         2407 );
82 42         94285 while (defined(my $part = $it->next)) {
83 234         1772 my $state="free";
84 234 100       1172 if (! $part->isa("StorageDisplay::Data::Partition::Table::Part::Free")) {
85 134         291 $state = "busy";#$part->block->state;
86             }
87 234         1181 my $color=$self->statecolor($state);
88 234 100       911 $fc .= ':' if $fc ne '';
89 234         12665 $fc .= "$color;".sprintf("%.6f", $part->size/$self->size);
90             }
91             return (
92 42         589 $self->_dotDefaultStyleNode($t, @_),
93             "// Style node",
94             "color=white;",
95             "fillcolor=lightgrey;",
96             'shape="rectangle";',
97             #'gradientangle="270";',
98             'style=striped;',
99             'fillcolor="'.$fc.'";',
100             );
101             }
102              
103             sub dotStyleTable {
104 42     42 0 141 my $self=shift;
105              
106 42         446 return "BORDER=\"0\" CELLPADDING=\"0\" CELLSPACING=\"0\"";
107             }
108              
109             sub dotLabel {
110 42     42 0 93 my $self = shift;
111 42         240 my @label = ($self->disk->dname);
112 42 100       188 if (defined($self->disk->blk_info('MODEL'))) {
113 40         155 push @label, 'Model: '.$self->disk->blk_info('MODEL');
114             }
115 42 100       186 if (defined($self->disk->blk_info('SERIAL'))) {
116 40         148 push @label, 'Serial: '.$self->disk->blk_info('SERIAL');
117             }
118 42         1785 push @label, 'Label: '.$self->kind;
119 42         426 return @label;
120             }
121              
122             sub dotTable {
123 42     42 0 121 my $self = shift;
124 42   50     199 my $t = shift // "\t";
125 42         90 my $it = shift;
126              
127 42         1989 my @tablecontents = (
128             "<TR> <TD COLSPAN=\"2\">".$self->label."</TD> </TR>".
129             "<TR><TD >".$self->dotFormatedFullLabel($t, @_)."</TD>".
130             " <TD BGCOLOR=\"lightgrey\">",
131             $self->table->dotNode($t, @_),
132             "</TD> </TR>".
133             "<TR> <TD COLSPAN=\"2\"> </TD> </TR>");
134              
135 42         7156 return @tablecontents;
136             }
137              
138             1;
139              
140             ##################
141             package StorageDisplay::Data::Partition::Table;
142              
143 9     9   9188 use Moose;
  9         25  
  9         66  
144 9     9   80283 use namespace::sweep;
  9         22  
  9         68  
145              
146 9     9   825 use Carp;
  9         27  
  9         8086  
147              
148             extends 'StorageDisplay::Data::Elem';
149              
150             with (
151             'StorageDisplay::Role::Style::IsLabel',
152             'StorageDisplay::Role::Style::Label::HTML::Table',
153             );
154              
155             has 'disk' => (
156             is => 'ro',
157             isa => 'StorageDisplay::Block',
158             default => sub {
159             my $self = shift;
160             return $self->elem->disk;
161             },
162             lazy => 1,
163             required => 1,
164             );
165              
166             has 'partition' => (
167             is => 'ro',
168             isa => 'StorageDisplay::Data::Partition',
169             required => 1,
170             );
171              
172             sub elem {
173 68     68 0 159 my $self = shift;
174 68         2935 return $self->partition(@_);
175             }
176              
177             sub addPart {
178 118     118 0 335 my $self = shift;
179 118         269 my $part = shift;
180              
181 118 100       1531 if ($part->isa('StorageDisplay::Data::Partition::Table::Part::SubTable')) {
    100          
    50          
182 1         55 $part->block->state("special");
183             } elsif ($part->isa('StorageDisplay::Data::Partition::Table::Part::Data')) {
184 67 100 100     3046 if ($part->label =~ /efi|grub/i || $part->flags =~ /boot/i) {
185 15         665 $part->block->state("special");
186             }
187             } elsif ($part->isa('StorageDisplay::Data::Partition::Table::Part::Free')) {
188              
189             } else {
190 0         0 carp "W: unsupported part ".$part->name." (".$part.")\n";
191             }
192 118         778 return $self->addChild($part);
193             }
194              
195             sub dotTable {
196 42     42 0 114 my $self = shift;
197 42         185 return $self->partDotTable(@_);
198             }
199              
200             sub partDotTable {
201 44     44 0 106 my $self = shift;
202 44         103 my $t = shift;
203 44         89 my $it = shift;
204              
205 44         101 my @text;
206             #print STDERR "dotTable in ".$self->name." (".$self.")\n";
207 44         244 while (defined(my $e = $it->next)) {
208 236         2535 push @text, '<TR>',
209             $self->dotIndent($t, $e->dotNode($t, @_)),
210             '</TR>';
211             }
212             #use Data::Dumper;
213             #print STDERR "RES: ", Dumper(\@text);
214 44         1028 return @text;
215             }
216              
217             1;
218              
219             ##################
220             package StorageDisplay::Data::Partition::Table::Part;
221              
222 9     9   82 use Moose;
  9         24  
  9         64  
223 9     9   81535 use namespace::sweep;
  9         67  
  9         113  
224              
225             extends 'StorageDisplay::Data::Elem';
226              
227             with (
228             'StorageDisplay::Role::Style::Label::HTML',
229             'StorageDisplay::Role::Style::IsLabel',
230             'StorageDisplay::Role::Style::WithSize',
231             );
232              
233             has 'table' => (
234             is => 'ro',
235             isa => 'StorageDisplay::Data::Partition::Table',
236             required => 1,
237             );
238              
239             has 'start' => (
240             is => 'ro',
241             isa => 'Int',
242             required => 1,
243             );
244              
245             has 'label' => (
246             is => 'ro',
247             isa => 'Str',
248             required => 0,
249             );
250              
251             sub BUILD {
252 118     118 0 288429 my $self = shift;
253              
254             #print STDERR "BUILD in ".__PACKAGE__."\n";
255 118         6836 $self->table->addPart($self);
256             }
257              
258             sub partStyle {
259 0     0 0 0 my $self = shift;
260              
261 0         0 return '';
262             }
263              
264             sub dotNode {
265 234     234 0 521 my $self = shift;
266             return (
267 234         978 "<TD ".$self->partStyle(@_).">",
268             $self->_dotDefaultNode(@_),
269             "</TD>",
270             );
271             }
272              
273             1;
274              
275             ##################
276             package StorageDisplay::Data::Partition::Table::Part::Data;
277              
278 9     9   3718 use Moose;
  9         24  
  9         88  
279 9     9   88512 use namespace::sweep;
  9         25  
  9         72  
280             extends 'StorageDisplay::Data::Partition::Table::Part';
281              
282             has 'id' => (
283             is => 'ro',
284             isa => 'Int',
285             required => 1,
286             );
287              
288             has 'flags' => (
289             is => 'ro',
290             isa => 'Str',
291             required => 0,
292             );
293              
294              
295 9     9   1063 use Carp;
  9         22  
  9         7558  
296             around BUILDARGS => sub {
297             my $orig = shift;
298             my $class = shift;
299             my $args = { @_ };
300              
301             my $block;
302              
303             #print STDERR "BUILDARGS in ".__PACKAGE__."\n";
304             my $part_id = $args->{id};
305             my $table = $args->{table};
306             my $it = $table->disk->iterator(
307             'recurse' => 0,
308             'uniq' => 1,
309             );
310             while(defined(my $b=$it->next)) {
311             # PARTN does not exists for kpartx mapped partitions
312             my $num = $b->udev_info("ID_PART_ENTRY_NUMBER") // -1;
313             next if $num != $part_id;
314             $block = $b;
315             last;
316             }
317             if (! defined($block)) {
318             my $b = StorageDisplay::Block::NoSystem->new(
319             'id' => $part_id,
320             );
321             $block=$b;
322             }
323              
324             return $class->$orig(
325             'name' => $block->name,
326             'block' => $block,
327             @_
328             );
329             };
330              
331             sub BUILD {
332 68     68 0 1140 my $self = shift;
333              
334             #print STDERR "BUILD in ".__PACKAGE__."\n";
335             #print STDERR "Looking for ", $self->id, " into ", $self->table->disk->name, "\n";
336 68         3341 $self->provideBlock($self->block);
337             }
338              
339             sub rawlinkname {
340 0     0 0 0 my $self = shift;
341              
342 0         0 confess "No rawlinkname for ".$self->fullname;
343             }
344              
345             sub linkname {
346 48     48 0 108 my $self = shift;
347              
348 48         2380 return $self->table->elem->linkname.':"'.$self->id.'"';
349             }
350              
351             sub partStyle {
352 136     136 0 326 my $self = shift;
353              
354 136         378 my $state = "unknown";
355 136 50       8025 if (defined($self->block)) {
356 136         6260 $state = $self->block->state;
357             }
358              
359 136         6777 return 'PORT="'.$self->id.'"'.
360             ' BGCOLOR="'.$self->statecolor($state).'"';
361             }
362              
363             sub dotLabel {
364 136     136 0 286 my $self = shift;
365 136         239 my $dev;
366 136 50       6805 if (defined($self->block)) {
367 136         5827 $dev = $self->block->dname;
368             } else {
369 0         0 $dev = $self->name;
370             }
371 136 100       7123 if ($self->label) {
372 126         5662 return ($dev, $self->label);
373             } else {
374 10         98 return $dev;
375             }
376             }
377              
378             with (
379             'StorageDisplay::Role::HasBlock',
380             );
381              
382             1;
383              
384             ##################
385             package StorageDisplay::Data::Partition::Table::Part::SubTable;
386              
387 9     9   90 use Moose;
  9         25  
  9         67  
388 9     9   129785 use namespace::sweep;
  9         24  
  9         80  
389              
390             # keep Table::Part::Data first to pick its dotNode redefinition
391             extends
392             'StorageDisplay::Data::Partition::Table::Part::Data',
393             'StorageDisplay::Data::Partition::Table';
394              
395             sub dotNode {
396 2     2 0 8 my $self = shift;
397 2         5 my $t = shift;
398             #print STDERR "BUILD in ".__PACKAGE__."\n";
399             return (
400 2         18 '<TD>',
401             $self->dotIndent(
402             $t,
403             '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR>',
404             '<TD '.$self->partStyle($t, @_).'>',
405             #$self->dotLabel($t, @_),
406             $self->dotFormatedFullLabel($t, @_),
407             '</TD></TR><TR><TD>',
408             $self->_dotDefaultNode(@_),
409             '</TD></TR></TABLE>',
410             ),
411             '</TD>',
412             );
413             }
414              
415             sub dotTable {
416 2     2 0 8 my $self = shift;
417 2         33 return $self->partDotTable(@_);
418             }
419              
420             with (
421             'StorageDisplay::Role::Style::IsLabel',
422             'StorageDisplay::Role::Style::Label::HTML::Table',
423             );
424              
425             1;
426              
427             ##################
428             package StorageDisplay::Data::Partition::Table::Part::Free;
429              
430 9     9   3064 use Moose;
  9         24  
  9         59  
431 9     9   85881 use namespace::sweep;
  9         25  
  9         73  
432             extends 'StorageDisplay::Data::Partition::Table::Part';
433              
434             sub block {
435 0     0 0 0 my $self = shift;
436             return
437 0         0 }
438              
439             sub dotLabel {
440 100     100 0 227 my $self = shift;
441 100         1090 return "Free";
442             }
443              
444             sub partStyle {
445 100     100 0 297 my $self = shift;
446 100         782 return 'bgcolor="green"';
447             }
448              
449             1;
450              
451             ##################################################################
452             package StorageDisplay::Data::Partition::None;
453              
454 9     9   2133 use Moose;
  9         40  
  9         67  
455 9     9   119514 use namespace::sweep;
  9         29  
  9         75  
456             extends 'StorageDisplay::Data::Elem';
457              
458             with (
459             'StorageDisplay::Role::HasBlock',
460             'StorageDisplay::Role::Style::WithSize',
461             'StorageDisplay::Role::Style::FromBlockState',
462             );
463              
464             sub disk {
465 30     30 0 42 my $self = shift;
466 30         909 return $self->block(@_);
467             }
468              
469             around BUILDARGS => sub {
470             my $orig = shift;
471             my $class = shift;
472             my $block = shift;
473             my $st = shift;
474              
475             $st->log({level=>1}, 'Disk with no partition tables on '.$block->dname);
476              
477             return $class->$orig(
478             'name' => $block->name,
479             'block' => $block,
480             'provide' => [$block],
481             'size' => $st->get_info('lsblk', $block->name, 'size'),
482             @_
483             );
484             };
485              
486             sub BUILD {
487 3     3 0 6846 my $self = shift;
488              
489             #print STDERR "BUILD in ".__PACKAGE__."\n";
490             #print STDERR "Looking for ", $self->id, " into ", $self->table->disk->name, "\n";
491 3         140 $self->provideBlock($self->block);
492             }
493              
494             sub dotLabel {
495 6     6 0 13 my $self = shift;
496 6         25 my @label = ($self->disk->dname);
497 6 50       17 if (defined($self->disk->blk_info('MODEL'))) {
498 6         21 push @label, 'Model: '.$self->disk->blk_info('MODEL');
499             }
500 6 50       17 if (defined($self->disk->blk_info('SERIAL'))) {
501 6         19 push @label, 'Serial: '.$self->disk->blk_info('SERIAL');
502             }
503 6         38 return @label;
504             }
505              
506             around 'dotStyleNode' => sub {
507             my $orig = shift;
508             my $self = shift;
509             return (
510             $self->$orig(@_),
511             'style=filled',
512             'shape=rectangle',
513             );
514             };
515              
516             1;
517              
518             ##################################################################
519             package StorageDisplay::Data::Partition::GPT;
520              
521 9     9   5064 use Moose;
  9         25  
  9         64  
522 9     9   95539 use namespace::sweep;
  9         24  
  9         213  
523             extends 'StorageDisplay::Data::Partition';
524              
525 9     9   1655 use Carp;
  9         182  
  9         3552  
526              
527             around BUILDARGS => sub {
528             my $orig = shift;
529             my $class = shift;
530             my $block = shift;
531             my $st = shift;
532              
533             return $class->$orig(
534             $block,
535             $st,
536             'kind' => 'gpt',
537             %{$st->get_info('partitions', $block->name) // {} }, # size, label, parts
538             @_
539             );
540             };
541              
542             sub BUILD {
543 19     19 0 41442 my $self = shift;
544 19         46 my $args = shift;
545              
546             #print STDERR "Managing ".$self->disk->dname." (".($self->disk).")\n";
547              
548 19         50 my $id_free = 1;
549              
550 19         41 foreach my $part (@{$args->{'parts'}}) {
  19         105  
551             #print STDERR "*******************\n";
552              
553 112 100       1665 if ($part->{kind} eq 'free') {
    50          
554 48         159 delete($part->{kind});
555             StorageDisplay::Data::Partition::Table::Part::Free->new(
556             'name' => '_'.$id_free,
557             'table' => $self->table,
558 48         2290 %{$part},
  48         511  
559             );
560 48         717 $id_free ++;
561             } elsif ($part->{kind} eq 'part') {
562 64         198 delete($part->{kind});
563             StorageDisplay::Data::Partition::Table::Part::Data->new(
564             'table' => $self->table,
565 64         2890 %{$part},
  64         474  
566             );
567             } else {
568 9     9   90 use Data::Dumper;
  9         23  
  9         2030  
569 0         0 print STDERR Dumper($part);
570 0         0 croak "ARghh for ".$self->disk->dname;
571             }
572             }
573             }
574              
575             1;
576              
577             ##################################################################
578             package StorageDisplay::Data::Partition::MSDOS;
579              
580 9     9   78 use Moose;
  9         33  
  9         68  
581 9     9   87813 use namespace::sweep;
  9         24  
  9         90  
582             extends 'StorageDisplay::Data::Partition';
583              
584 9     9   880 use Carp;
  9         22  
  9         5808  
585              
586             around BUILDARGS => sub {
587             my $orig = shift;
588             my $class = shift;
589             my $block = shift;
590             my $st = shift;
591              
592             my $info = $st->get_info('partitions', $block->name) // {};
593              
594             return $class->$orig(
595             $block,
596             $st,
597             'kind' => 'msdos',
598             (map { $_ => $info->{$_} } ("size", "label", "parts")),
599             'extended_num' => $info->{'extended'},
600             @_
601             );
602             };
603              
604             has 'extended' => (
605             is => 'rw',
606             isa => 'StorageDisplay::Data::Partition::Table',
607             required => 0,
608             );
609              
610             sub BUILD {
611 2     2 0 4000 my $self = shift;
612 2         7 my $args = shift;
613              
614 2   100     12 my $extended = $args->{'extended_num'} // '';
615 2         5 my $id_free = 1;
616              
617 2         6 foreach my $part (@{$args->{'parts'}}) {
  2         9  
618 6 100       88 if ($part->{kind} eq 'free') {
    50          
619 2         31 delete($part->{kind});
620             StorageDisplay::Data::Partition::Table::Part::Free->new(
621             'name' => '_'.$id_free,
622             'table' => $self->table,
623 2         95 %{$part},
  2         65  
624             );
625 2         25 $id_free ++;
626             } elsif ($part->{kind} eq 'part') {
627 4         12 delete($part->{kind});
628 4 100       22 if ($part->{id} eq $extended) {
    100          
629             $self->extended(
630             StorageDisplay::Data::Partition::Table::Part::SubTable->new(
631             'table' => $self->table,
632             'partition' => $self,
633 1         59 %{$part},
  1         25  
634             ));
635             } elsif ($part->{id} <= 4) {
636             StorageDisplay::Data::Partition::Table::Part::Data->new(
637             'table' => $self->table,
638 2         94 %{$part},
  2         48  
639             );
640             } else {
641 1 50       52 confess if not defined($self->extended);
642             StorageDisplay::Data::Partition::Table::Part::Data->new(
643             'table' => $self->extended,
644 1         48 %{$part},
  1         8  
645             );
646             }
647             } else {
648 0           croak "ARghh";
649             }
650             }
651             }
652              
653             1;
654              
655             __END__
656              
657             =pod
658              
659             =encoding UTF-8
660              
661             =head1 NAME
662              
663             StorageDisplay::Data::Partition - Handle partition tables data for StorageDisplay
664              
665             =head1 VERSION
666              
667             version 2.06
668              
669             =head1 AUTHOR
670              
671             Vincent Danjean <Vincent.Danjean@ens-lyon.org>
672              
673             =head1 COPYRIGHT AND LICENSE
674              
675             This software is copyright (c) 2014-2023 by Vincent Danjean.
676              
677             This is free software; you can redistribute it and/or modify it under
678             the same terms as the Perl 5 programming language system itself.
679              
680             =cut