File Coverage

blib/lib/Metabrik/Brik/Tool.pm
Criterion Covered Total %
statement 12 494 2.4
branch 0 308 0.0
condition 0 36 0.0
subroutine 4 33 12.1
pod 2 29 6.9
total 18 900 2.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # brik::tool Brik
5             #
6             package Metabrik::Brik::Tool;
7 1     1   1187 use strict;
  1         4  
  1         33  
8 1     1   5 use warnings;
  1         2  
  1         35  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command);
  1         3  
  1         469  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable program) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             repository => [ qw(Repository) ],
21             },
22             attributes_default => {
23             use_pager => 1,
24             },
25             commands => {
26             get_require_briks => [ qw(Brik|OPTIONAL) ],
27             get_require_briks_recursive => [ qw(Brik|OPTIONAL) ],
28             get_require_modules => [ qw(Brik|OPTIONAL) ],
29             get_require_modules_recursive => [ qw(Brik) ],
30             get_need_packages => [ qw(Brik|OPTIONAL) ],
31             get_need_packages_recursive => [ qw(Brik) ],
32             get_brik_hierarchy => [ qw(Brik) ],
33             get_brik_hierarchy_recursive => [ qw(Brik) ],
34             install_packages => [ qw(package_list) ],
35             install_modules => [ qw(module_list) ],
36             install_all_require_modules => [ ],
37             install_all_need_packages => [ ],
38             install_needed_packages => [ qw(Brik) ],
39             install_required_modules => [ qw(Brik) ],
40             install_required_briks => [ qw(Brik) ],
41             install => [ qw(Brik) ],
42             get_dependencies => [ qw(Brik) ],
43             create_tool => [ qw(filename.pl Repository|OPTIONAL) ],
44             create_brik => [ qw(Brik Repository|OPTIONAL) ],
45             update_core => [ ],
46             update_repository => [ ],
47             update => [ ],
48             test_repository => [ ],
49             view_brik_source => [ qw(Brik) ],
50             get_brik_module_file => [ qw(Brik directory_list|OPTIONAL) ],
51             clone => [ qw(Brik Repository|OPTIONAL) ],
52             get_require_binaries => [ qw(Brik|OPTIONAL) ],
53             },
54             # We can't activate that, because we would have a chicken-and-egg problem.
55             #need_packages => {
56             #ubuntu => [ qw(mercurial) ],
57             #debian => [ qw(mercurial) ],
58             #kali => [ qw(mercurial) ],
59             #freebsd => [ qw(mercurial) ],
60             #},
61             #require_binaries => {
62             #hg => [ ],
63             #},
64             require_modules => {
65             'Metabrik::Devel::Git' => [ ],
66             'Metabrik::File::Find' => [ ],
67             'Metabrik::File::Text' => [ ],
68             'Metabrik::Perl::Module' => [ ],
69             'Metabrik::System::File' => [ ],
70             'Metabrik::System::Package' => [ ],
71             },
72             };
73             }
74              
75             sub brik_use_properties {
76 0     0 1   my $self = shift;
77              
78             return {
79             attributes_default => {
80             repository => defined($self->global) && $self->global->repository
81 0   0       || defined($ENV{HOME}) && $ENV{HOME}.'/metabrik/repository'
82             || '/tmp/metabrik/repository',
83             },
84             };
85             }
86              
87             sub get_require_briks {
88 0     0 0   my $self = shift;
89 0           my ($brik) = @_;
90              
91 0 0         if (! defined($self->context)) {
92 0           return $self->log->error("get_require_briks: no core::context Brik");
93             }
94              
95 0           my $con = $self->context;
96              
97 0           my $available = $con->available;
98              
99             # If we asked for one Brik, we rewrite available to only have this one.
100 0 0         if (defined($brik)) {
101 0           $available = { $brik => $available->{$brik} };
102             }
103              
104 0           my %modules = ();
105 0           for my $this (keys %$available) {
106 0 0         next if $this =~ m{^core::};
107 0 0 0       if (defined($available->{$this})
108             && exists($available->{$this}->brik_properties->{require_modules})) {
109 0           my $list = $available->{$this}->brik_properties->{require_modules};
110 0           for my $m (keys %$list) {
111 0 0         next if $m !~ m{^Metabrik::};
112 0           $modules{$m}++;
113             }
114             }
115             }
116              
117 0           my @modules = sort { $a cmp $b } keys %modules;
  0            
118 0           for (@modules) {
119 0           s{^Metabrik::}{};
120 0           $_ = lc($_);
121             }
122              
123 0           return \@modules;
124             }
125              
126             sub get_require_briks_recursive {
127 0     0 0   my $self = shift;
128 0           my ($brik) = @_;
129              
130 0 0         $self->brik_help_run_undef_arg('get_require_briks_recursive', $brik) or return;
131              
132 0 0         my $hierarchy = $self->get_brik_hierarchy_recursive($brik) or return;
133              
134 0           my %required = ();
135 0           for my $this ($brik, @$hierarchy) {
136 0 0         my $require_briks = $self->get_require_briks($this) or next;
137 0           for my $b (@$require_briks) {
138 0           $required{$b}++;
139             }
140             }
141              
142 0           return [ sort { $a cmp $b } keys %required ];
  0            
143             }
144              
145             #
146             # Will return the complete list of required modules if no Argument is given,
147             # or the list of required modules for the specified Brik.
148             #
149             sub get_require_modules {
150 0     0 0   my $self = shift;
151 0           my ($brik) = @_;
152              
153 0 0         if (! defined($self->context)) {
154 0           return $self->log->error("get_require_modules: no core::context Brik");
155             }
156              
157 0           my $con = $self->context;
158 0           my $available = $con->available;
159              
160             # If we asked for one Brik, we rewrite available to only have this one.
161 0 0         if (defined($brik)) {
162 0           $available = { $brik => $available->{$brik} };
163             }
164              
165 0           my %modules = ();
166 0           for my $this (keys %$available) {
167 0 0         next if $this =~ m{^core::};
168 0 0 0       if (defined($available->{$this})
169             && exists($available->{$this}->brik_properties->{require_modules})) {
170 0           my $list = $available->{$this}->brik_properties->{require_modules};
171 0           for my $m (keys %$list) {
172 0 0         next if $m =~ m{^Metabrik::};
173 0           $modules{$m}++;
174             }
175             }
176             }
177              
178 0           return [ sort { $a cmp $b } keys %modules ];
  0            
179             }
180              
181             #
182             # Will return the complete list of required modules of given Brik.
183             # This includes searching in the Brik complete hierarchy recursively.
184             #
185             sub get_require_modules_recursive {
186 0     0 0   my $self = shift;
187 0           my ($brik) = @_;
188              
189 0 0         $self->brik_help_run_undef_arg('get_require_modules_recursive', $brik) or return;
190              
191 0 0         my $hierarchy = $self->get_brik_hierarchy_recursive($brik) or return;
192              
193 0           my %required = ();
194 0           for my $this ($brik, @$hierarchy) {
195 0 0         my $require_modules = $self->get_require_modules($this) or next;
196 0           for my $b (@$require_modules) {
197 0           $required{$b}++;
198             }
199             }
200              
201 0           return [ sort { $a cmp $b } keys %required ];
  0            
202             }
203              
204             #
205             # Will return the complete list of needed packages if no Argument is given,
206             # or the list of needed packages for the specified Brik.
207             #
208             sub get_need_packages {
209 0     0 0   my $self = shift;
210 0           my ($brik) = @_;
211              
212 0 0         if (! defined($self->context)) {
213 0           return $self->log->error("get_need_packages: no core::context Brik");
214             }
215              
216 0           my $con = $self->context;
217 0           my $available = $con->available;
218              
219             # If we asked for one Brik, we rewrite available to only have this one.
220 0 0         if (defined($brik)) {
221 0           $available = { $brik => $available->{$brik} };
222             }
223              
224 0 0         my $sp = Metabrik::System::Package->new_from_brik_init($self) or return;
225 0 0         my $os = $sp->my_os or return;
226              
227 0           my %packages = ();
228 0           for my $this (keys %$available) {
229 0 0         next if $this =~ m{^core::};
230 0 0 0       if (defined($available->{$this})
231             && exists($available->{$this}->brik_properties->{need_packages})) {
232 0 0         my $list = $available->{$this}->brik_properties->{need_packages}{$os} or next;
233 0           for my $p (@$list) {
234 0           $packages{$p}++;
235             }
236             }
237             }
238              
239 0           return [ sort { $a cmp $b } keys %packages ];
  0            
240             }
241              
242             #
243             # Will return the complete list of needed packages of given Brik.
244             # This includes searching in the Brik complete hierarchy recursively.
245             #
246             sub get_need_packages_recursive {
247 0     0 0   my $self = shift;
248 0           my ($brik) = @_;
249              
250 0 0         $self->brik_help_run_undef_arg('get_require_packages_recursive', $brik) or return;
251              
252 0 0         my $hierarchy = $self->get_brik_hierarchy_recursive($brik) or return;
253              
254 0           my %needed = ();
255 0           for my $this ($brik, @$hierarchy) {
256 0 0         my $need_packages = $self->get_need_packages($this) or next;
257 0           for my $b (@$need_packages) {
258 0           $needed{$b}++;
259             }
260             }
261              
262 0           return [ sort { $a cmp $b } keys %needed ];
  0            
263             }
264              
265             #
266             # Return the list of ancestors for the Brik.
267             #
268             sub get_brik_hierarchy {
269 0     0 0   my $self = shift;
270 0           my ($brik) = @_;
271              
272 0 0         $self->brik_help_run_undef_arg('get_brik_hierarchy', $brik) or return;
273              
274 0           my @toks = split(/::/, $brik);
275              
276 0           my @final = ();
277              
278             # Rebuild module name from Brik name so we can read its @ISA
279 0           my $m = 'Metabrik';
280 0           for (@toks) {
281 0           $_ = ucfirst($_);
282 0           $m .= "::$_";
283             }
284              
285             {
286 1     1   8 no strict 'refs';
  1         3  
  1         4289  
  0            
287 0           my @isa = @{$m.'::ISA'};
  0            
288 0           for (@isa) {
289 0 0         next unless /^Metabrik::/;
290 0           (my $name = $_) =~ s/^Metabrik:://;
291 0           $name = lc($name);
292 0           push @final, $name;
293 0 0         my $list = $self->get_brik_hierarchy($name) or next;
294 0           push @final, @$list;
295             }
296             }
297              
298 0           return \@final;
299             }
300              
301             #
302             # Will return a list of all Briks needed to complete the full hierarchy.
303             # That means we also crawl required Briks own hierarchy.
304             #
305             sub get_brik_hierarchy_recursive {
306 0     0 0   my $self = shift;
307 0           my ($brik) = @_;
308              
309 0 0         $self->brik_help_run_undef_arg('get_brik_hierarchy_recursive', $brik) or return;
310              
311 0           my $hierarchy = {};
312              
313             # We first gather the provided Brik hierarchy
314 0 0         my $provided = $self->get_brik_hierarchy($brik) or return;
315 0           for (@$provided) {
316 0           $self->log->debug("get_brik [$_]");
317 0           $hierarchy->{$_}++;
318             }
319              
320             # And required Briks hierarchy
321 0 0         my $required = $self->get_require_briks($brik) or return;
322 0           for (@$required) {
323 0           $self->log->debug("get_require [$_]");
324 0           $hierarchy->{$_}++;
325             }
326              
327             # Then we search for complete hierarchy recursively
328 0           for my $this (keys %$hierarchy) {
329 0 0         next if $this eq $brik; # Skip the provided one.
330 0 0         next if exists $hierarchy->{$this}; # Skip already analyzed ones.
331 0 0         my $new = $self->get_brik_hierarchy_recursive($this) or return;
332 0           for (@$new) {
333 0           $hierarchy->{$_}++;
334             }
335             }
336              
337 0           return [ sort { $a cmp $b } keys %$hierarchy ];
  0            
338             }
339              
340             sub install_packages {
341 0     0 0   my $self = shift;
342 0           my ($packages) = @_;
343              
344 0 0         $self->brik_help_run_undef_arg('install_packages', $packages) or return;
345 0 0         $self->brik_help_run_invalid_arg('install_packages', $packages, 'ARRAY') or return;
346              
347 0 0         my $sp = Metabrik::System::Package->new_from_brik_init($self) or return;
348 0           return $sp->install($packages);
349             }
350              
351             sub install_modules {
352 0     0 0   my $self = shift;
353 0           my ($modules) = @_;
354              
355 0 0         $self->brik_help_run_undef_arg('install_modules', $modules) or return;
356 0 0         $self->brik_help_run_invalid_arg('install_modules', $modules, 'ARRAY') or return;
357              
358 0 0         my $pm = Metabrik::Perl::Module->new_from_brik_init($self) or return;
359 0           return $pm->install($modules);
360             }
361              
362             sub install_all_need_packages {
363 0     0 0   my $self = shift;
364              
365 0 0         if (! defined($self->context)) {
366 0           return $self->log->error("install_all_need_packages: no core::context Brik");
367             }
368              
369             # We don't want to fail on a missing package, so we install Brik by Brik
370             #my $packages = $self->get_need_packages or return;
371             #my $sp = Metabrik::System::Package->new_from_brik_init($self) or return;
372             #return $sp->install($packages);
373              
374 0           my $con = $self->context;
375              
376 0           my @missing = ();
377 0           my $available = $con->available;
378 0           for my $brik (sort { $a cmp $b } keys %$available) {
  0            
379             # Skipping log modules to avoid messing stuff
380 0 0         next if ($brik =~ /^log::/);
381             # Skipping system packages modules too
382 0 0         next if ($brik =~ /^system::.*(?:::)?package$/);
383 0           $self->log->verbose("install_all_need_packages: installing packages for Brik [$brik]");
384 0           my $r = $self->install_needed_packages($brik);
385 0 0         if (! defined($r)) {
386 0           push @missing, $brik;
387             }
388             }
389              
390 0 0         if (@missing > 0) {
391 0           $self->log->warning("install_all_need_packages: unable to install packages for ".
392             "Brik(s): [".join(', ', @missing)."]");
393             }
394              
395 0           return 1;
396             }
397              
398             sub install_all_require_modules {
399 0     0 0   my $self = shift;
400              
401 0 0         my $modules = $self->get_require_modules or return;
402              
403 0 0         my $pm = Metabrik::Perl::Module->new_from_brik_init($self) or return;
404 0           return $pm->install($modules);
405             }
406              
407             sub install_needed_packages {
408 0     0 0   my $self = shift;
409 0           my ($brik) = @_;
410              
411 0 0         $self->brik_help_run_undef_arg('install_needed_packages', $brik) or return;
412              
413 0 0         my $packages = $self->get_need_packages_recursive($brik) or return;
414 0 0         if (@$packages == 0) {
415 0           return 1;
416             }
417              
418 0 0         my $sp = Metabrik::System::Package->new_from_brik_init($self) or return;
419 0           return $sp->install($packages);
420             }
421              
422             #
423             # Install modules that are NOT Briks.
424             #
425             sub install_required_modules {
426 0     0 0   my $self = shift;
427 0           my ($brik) = @_;
428              
429 0 0         $self->brik_help_run_undef_arg('install_required_modules', $brik) or return;
430              
431 0 0         my $modules = $self->get_require_modules_recursive($brik) or return;
432 0 0         if (@$modules == 0) {
433 0           return 1;
434             }
435              
436 0 0         my $pm = Metabrik::Perl::Module->new_from_brik_init($self) or return;
437 0           return $pm->install($modules);
438             }
439              
440             #
441             # Install modules that are ONLY Briks.
442             #
443             sub install_required_briks {
444 0     0 0   my $self = shift;
445 0           my ($brik) = @_;
446              
447 0 0         $self->brik_help_run_undef_arg('install_required_briks', $brik) or return;
448              
449 0 0         my $briks = $self->get_require_briks_recursive($brik) or return;
450 0 0         if (@$briks == 0) {
451 0           return 1;
452             }
453              
454 0           my $packages = [];
455 0           my $modules = [];
456 0           for my $brik (@$briks) {
457 0 0         my $this_packages = $self->get_need_packages_recursive($brik) or next;
458 0 0         my $this_modules = $self->get_require_modules_recursive($brik) or next;
459 0           push @$packages, @$this_packages;
460 0           push @$modules, @$this_modules;
461             }
462              
463 0           my $uniq_packages = {};
464 0           my $uniq_modules = {};
465 0           for (@$packages) { $uniq_packages->{$_}++; }
  0            
466 0           for (@$modules) { $uniq_modules->{$_}++; }
  0            
467 0           $packages = [ sort { $a cmp $b } keys %$uniq_packages ];
  0            
468 0           $modules = [ sort { $a cmp $b } keys %$uniq_modules ];
  0            
469              
470 0           $self->install_packages($packages);
471 0           $self->install_modules($modules);
472              
473 0           return 1;
474             }
475              
476             sub install {
477 0     0 0   my $self = shift;
478 0           my ($briks) = @_;
479              
480 0 0         $self->brik_help_run_undef_arg('install', $briks) or return;
481 0 0         my $ref = $self->brik_help_run_invalid_arg('install', $briks, 'ARRAY', 'SCALAR')
482             or return;
483              
484 0 0         if ($ref eq 'SCALAR') {
485 0           $briks = [ $briks ];
486             }
487              
488 0           my $packages = [];
489 0           my $modules = [];
490 0           for my $brik (@$briks) {
491 0 0         my $this_packages = $self->get_need_packages_recursive($brik) or return;
492 0 0         my $this_modules = $self->get_require_modules_recursive($brik) or return;
493 0 0         my $this_briks = $self->get_require_briks_recursive($brik) or return;
494 0           push @$packages, @$this_packages;
495 0           push @$modules, @$this_modules;
496              
497 0           for my $this_brik (@$this_briks) {
498 0 0         my $this_sub_packages = $self->get_need_packages_recursive($this_brik) or next;
499 0 0         my $this_sub_modules = $self->get_require_modules_recursive($this_brik) or next;
500 0           push @$packages, @$this_sub_packages;
501 0           push @$modules, @$this_sub_modules;
502             }
503             }
504              
505 0           my $uniq_packages = {};
506 0           my $uniq_modules = {};
507 0           for (@$packages) { $uniq_packages->{$_}++; }
  0            
508 0           for (@$modules) { $uniq_modules->{$_}++; }
  0            
509 0           $packages = [ sort { $a cmp $b } keys %$uniq_packages ];
  0            
510 0           $modules = [ sort { $a cmp $b } keys %$uniq_modules ];
  0            
511              
512 0 0         if (@$packages) {
513 0 0         $self->install_packages($packages) or return;
514             }
515 0 0         if (@$modules) {
516 0 0         $self->install_modules($modules) or return;
517             }
518              
519             # Execute special install Command if any.
520 0           for my $brik (@$briks) {
521 0           my $module = 'Metabrik';
522 0           my @toks = split(/::/, $brik);
523 0           for (@toks) {
524 0           $module .= '::'.ucfirst($_);
525             }
526              
527 0 0         my $new = $module->new_from_brik_no_checks($self) or return;
528 0 0         if ($new->can('install')) {
529 0 0         $new->install or return;
530             }
531             }
532              
533 0           return 1;
534             }
535              
536             sub get_dependencies {
537 0     0 0   my $self = shift;
538 0           my ($brik_list) = @_;
539              
540 0 0         $self->brik_help_run_undef_arg('get_dependencies', $brik_list) or return;
541 0 0         my $ref = $self->brik_help_run_invalid_arg('get_dependencies', $brik_list,
542             'ARRAY', 'SCALAR') or return;
543              
544 0 0         if ($ref eq 'SCALAR') {
545 0           $brik_list = [ $brik_list ];
546             }
547              
548 0           my $briks = [];
549 0           my $packages = [];
550 0           my $modules = [];
551 0           for my $brik (@$brik_list) {
552 0 0         my $this_packages = $self->get_need_packages_recursive($brik) or return;
553 0 0         my $this_modules = $self->get_require_modules_recursive($brik) or return;
554 0 0         my $this_briks = $self->get_require_briks_recursive($brik) or return;
555 0 0         my $this_hierarchy = $self->get_brik_hierarchy($brik) or return;
556 0           push @$packages, @$this_packages;
557 0           push @$modules, @$this_modules;
558 0           push @$briks, @$this_briks;
559 0           push @$briks, @$this_hierarchy;
560              
561 0           for my $this_brik (@$this_briks) {
562 0 0         my $this_sub_packages = $self->get_need_packages_recursive(
563             $this_brik) or next;
564 0 0         my $this_sub_modules = $self->get_require_modules_recursive(
565             $this_brik) or next;
566 0 0         my $this_sub_briks = $self->get_require_briks_recursive(
567             $this_brik) or next;
568 0 0         my $this_sub_hierarchy = $self->get_brik_hierarchy(
569             $this_brik) or next;
570 0           push @$packages, @$this_sub_packages;
571 0           push @$modules, @$this_sub_modules;
572 0           push @$briks, @$this_sub_briks;
573 0           push @$briks, @$this_sub_hierarchy;
574             }
575             }
576              
577 0           my $uniq_packages = {};
578 0           my $uniq_modules = {};
579 0           my $uniq_briks = {};
580 0           for (@$packages) { $uniq_packages->{$_}++; }
  0            
581 0           for (@$modules) { $uniq_modules->{$_}++; }
  0            
582 0           for (@$briks) { $uniq_briks->{$_}++; }
  0            
583 0           $packages = [ sort { $a cmp $b } keys %$uniq_packages ];
  0            
584 0           $modules = [ sort { $a cmp $b } keys %$uniq_modules ];
  0            
585 0           $briks = [ sort { $a cmp $b } keys %$uniq_briks ];
  0            
586              
587             return {
588 0           packages => $packages,
589             modules => $modules,
590             briks => $briks,
591             };
592             }
593              
594             sub create_tool {
595 0     0 0   my $self = shift;
596 0           my ($filename, $repository) = @_;
597              
598 0   0       $repository ||= $self->repository || '';
      0        
599 0 0         $self->brik_help_run_undef_arg('create_tool', $filename) or return;
600              
601 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
602              
603 0           my $data =<
604             #!/usr/bin/env perl
605             #
606             # \$Id\$
607             #
608             use strict;
609             use warnings;
610              
611             # Uncomment to use a custom repository
612             #use lib qw($repository/lib);
613              
614             use Data::Dumper;
615             use Metabrik::Core::Context;
616             # Put other Briks to use here
617             # use Metabrik::File::Text;
618              
619             my \$con = Metabrik::Core::Context->new or die("core::context");
620              
621             # Init other Briks here
622             # my \$ft = Metabrik::File::Text->new_from_brik_init(\$con) or die("file::text");
623              
624             # Put Metatool code here
625             # \$ft->write("test", "/tmp/test.txt");
626              
627             exit(0);
628             EOF
629             ;
630              
631 0 0         $ft->write($data, $filename) or return;
632              
633 0           return $filename;
634             }
635              
636             sub create_brik {
637 0     0 0   my $self = shift;
638 0           my ($brik, $repository) = @_;
639              
640 0   0       $repository ||= $self->repository;
641 0 0         $self->brik_help_run_undef_arg('create_brik', $brik) or return;
642 0 0         $self->brik_help_run_undef_arg('create_brik', $repository) or return;
643              
644 0           $brik = lc($brik);
645 0 0         if ($brik !~ m{^\w+::\w+(::\w+)*$}) {
646 0           return $self->log->error("create_brik: invalid format for Brik [$brik]");
647             }
648              
649 0           my @toks = split(/::/, $brik);
650 0 0         if (@toks < 2) {
651 0           return $self->log->error("create_brik: invalid format for Brik [$brik]");
652             }
653 0           for (@toks) {
654 0           $_ = ucfirst($_);
655             }
656              
657 0           my $directory;
658 0 0         if (@toks > 2) {
659 0           $directory = join('/', $repository, 'lib/Metabrik', @toks[0..$#toks-1]);
660             }
661             else {
662 0           $directory = join('/', $repository, 'lib/Metabrik', $toks[0]);
663             }
664 0           my $filename = $directory.'/'.$toks[-1].'.pm';
665 0           my $package = join('::', 'Metabrik', @toks);
666              
667 0 0         my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
668 0 0         $sf->mkdir($directory) or return;
669              
670 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
671              
672 0           my $data =<
673             #
674             # \$Id\$
675             #
676             # $brik Brik
677             #
678             package $package;
679             use strict;
680             use warnings;
681              
682             use base qw(Metabrik::Shell::Command Metabrik::System::Package);
683              
684             sub brik_properties {
685             return {
686             revision => '\$Revision\$',
687             tags => [ qw(unstable) ],
688             author => 'GomoR ',
689             license => 'http://opensource.org/licenses/BSD-3-Clause',
690             attributes => {
691             datadir => [ qw(datadir) ],
692             },
693             attributes_default => {
694             },
695             commands => {
696             install => [ ], # Inherited
697             },
698             require_modules => {
699             },
700             require_binaries => {
701             },
702             optional_binaries => {
703             },
704             need_packages => {
705             },
706             };
707             }
708              
709             sub brik_use_properties {
710             my \$self = shift;
711              
712             return {
713             attributes_default => {
714             },
715             };
716             }
717              
718             sub brik_preinit {
719             my \$self = shift;
720              
721             # Do your preinit here, return 0 on error.
722              
723             return \$self->SUPER::brik_preinit;
724             }
725              
726             sub brik_init {
727             my \$self = shift;
728              
729             # Do your init here, return 0 on error.
730              
731             return \$self->SUPER::brik_init;
732             }
733              
734             sub example_command {
735             my \$self = shift;
736             my (\$arg1, \$arg2) = \@_;
737              
738             \$arg2 ||= \$self->arg2;
739             \$self->brik_help_run_undef_arg('example_command', \$arg1) or return;
740             my \$ref = \$self->brik_help_run_invalid_arg('example_command', \$arg2, 'ARRAY', 'SCALAR')
741             or return;
742              
743             if (\$ref eq 'ARRAY') {
744             # Do your stuff
745             }
746             else {
747             # Do other stuff
748             }
749              
750             return 1;
751             }
752              
753             sub brik_fini {
754             my \$self = shift;
755              
756             # Do your fini here, return 0 on error.
757              
758             return \$self->SUPER::brik_fini;
759             }
760              
761             1;
762              
763             __END__