view release on metacpan or  search on metacpan

contrib/parse-man.pl  view on Meta::CPAN

    }

    # inject the migration instruction that retrieve $from element setting
    # from Service class (where it's deprecated) and copy them to the new
    # $from element in Unit class in a service file (hence this migration
    # instruction is done only in ServiceUnit class)
    $meta_root->load( steps => [
        qq!class:Systemd::Section::ServiceUnit element:$to!,
        qq!migrate_from variables:service="- - Service $from" formula="\$service"!
    ]);
}

my $data = parse_xml([@list, @service_list], \%map) ;

# Itself constructor returns an object to read or write the data
# structure containing the model to be edited
my $rw_obj = Config::Model::Itself -> new () ;

# now load the existing model to be edited
$rw_obj -> read_all() ;
my $meta_root = $rw_obj->meta_root;

# remove old generated classes
foreach my $config_class ($meta_root->fetch_element('class')->fetch_all_indexes) {
    my $gen = $meta_root->grab_value(
        step => qq!class:$config_class generated_by!,
        mode => 'loose',
    );
    next unless $gen and $gen =~ /parse-man/;
    $meta_root->load(qq!class:-$config_class!);
}


say "Creating systemd model...";

foreach my $config_class (keys $data->{class}->%*) {
    say "Creating model class $config_class";
    my $desc_ref = $data->{class}{$config_class};

    # cleanup leading white space and add formatting
    my $desc_text = join("\n\n", map { s/\n[\t ]+/\n/gr =~ s/C<([A-Z]\w+)=>/C<$1>/gr;} $desc_ref->@*);

    $desc_text.="\nThis configuration class was generated from systemd documentation.\n"
        ."by L<parse-man.pl|https://github.com/dod38fr/config-model-systemd/contrib/parse-man.pl>\n";

    # detect verbatim parts setup with programlisting tag
    $desc_text =~ s/^\+-\+/    /gm;

    my $steps = "class:$config_class class_description";
    $meta_root->grab(step => $steps, autoadd => 1)->store($desc_text);

    $meta_root->load( steps => [
        qq!class:$config_class generated_by="parse-man.pl from systemd $systemd_version doc"!,
        qq!copyright:0="2010-2016 Lennart Poettering and others"!,
        qq!copyright:1="2016 Dominique Dumont"!,
        qq!license="LGPLv2.1+"!,
        qq!accept:".*" type=leaf value_type=uniline warn="$unknown_param_msg"!,
    ]);
}

foreach my $cdata ($data->{element}->@*) {
    my ($config_class, $element, $desc, $extra_info, $supersedes) = $cdata->@*;

    my $obj = setup_element ($meta_root, $config_class, $element, $desc, $extra_info, $supersedes);

    $desc =~ s/ +$//gm;
    $obj->fetch_element("description")->store(wrap('','',$desc));
}

say "Tweaking systemd model...";

$meta_root->load(
    'class:Systemd::Section::Service generated_by="parse-man.pl from systemd doc"
     include:=Systemd::Common::ResourceControl,Systemd::Common::Exec,Systemd::Common::Kill'
);

# doc for IOSchedulingClass is too complicated to parse,
$meta_root->load(
    '! class:Systemd::Common::Exec
       element:IOSchedulingClass value_type=enum
                                 choice=0,1,2,3,none,realtime,best-effort,idle'
);

# doc for Exec/SetLoginEnvironment is misleading
$meta_root->load(
    '! class:Systemd::Common::Exec
       element:SetLoginEnvironment upstream_default~'
);

# doc for RefreshOnReload is misleading
$meta_root->load(
    '! class:Systemd::Section::Service
       element:RefreshOnReload value_type=uniline replace:.clear'
);


# these warping instructions are used for most services. Services are
# disabled when a service file is a symlink to /dev/null
my $common_warp = q!
    warp
      follow:disable="- disable"
      rules:0
        when="$disable"
        apply
          level=hidden - - - !;

foreach my $service (@service_list) {
    my $name = ucfirst($service);
    my $sub_class = 'Systemd::'.( $map{$name} || 'Section::'.ucfirst($name));

    my $unit_class = $name.'Unit';
    # make sure that the unit class exists (and fill it later when needed)
    $meta_root->load("class:Systemd::Section::$unit_class");

    foreach my $class_name ("Systemd::$name", "Systemd::StandAlone::$name") {
        # create class that hold the service created by parsing man page
        $meta_root->load(
            qq!
            class:$class_name
              generated_by="parse-man.pl from systemd doc"
              accept:".*"
                type=leaf