sbotools2

Maintenance fork of the original sbotools version 2
git clone git://git.server.ky/slackcoder/sbotools2
Log | Files | Refs | README

Readme.pm (6375B)


      1 package SBO::Lib::Readme;
      2 
      3 use 5.016;
      4 use strict;
      5 use warnings;
      6 
      7 our $VERSION = '2.9.0';
      8 
      9 use SBO::Lib::Util qw/ prompt script_error slurp open_read _ERR_OPENFH usage_error /;
     10 use SBO::Lib::Tree qw/ is_local /;
     11 
     12 use Exporter 'import';
     13 
     14 our @EXPORT_OK = qw{
     15   ask_opts
     16   ask_other_readmes
     17   ask_user_group
     18   get_opts
     19   get_readme_contents
     20   get_user_group
     21   user_prompt
     22 };
     23 
     24 our %EXPORT_TAGS = (
     25   all => \@EXPORT_OK,
     26 );
     27 
     28 =pod
     29 
     30 =encoding UTF-8
     31 
     32 =head1 NAME
     33 
     34 SBO::Lib::Readme - Routines for interacting with a typical SBo README file.
     35 
     36 =head1 SYNOPSIS
     37 
     38   use SBO::Lib::Readme qw/ get_readme_contents /;
     39 
     40   print get_readme_contents($sbo);
     41 
     42 =head1 SUBROUTINES
     43 
     44 =cut
     45 
     46 =head2 ask_opts
     47 
     48   my $opts = ask_opts($sbo, $readme);
     49 
     50 C<ask_opts()> displays the C<$readme> and asks if we should set any of the
     51 options it defines. If the user indicates that we should, we prompt them for
     52 the options to set and then returns them as a string. If the user didn't supply
     53 any options or indicated that we shouldn't, it returns C<undef>.
     54 
     55 =cut
     56 
     57 # provide an opportunity to set options
     58 sub ask_opts {
     59   # TODO: check number of args
     60   script_error('ask_opts requires an argument') unless @_;
     61   my ($sbo, $readme) = @_;
     62   say "\n". $readme;
     63   if (prompt("\nIt looks like $sbo has options; would you like to set any when the slackbuild is run?", default => 'no')) {
     64     my $ask = sub {
     65       chomp(my $opts = prompt("\nPlease supply any options here, or enter to skip: "));
     66       return $opts;
     67     };
     68     my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
     69     my $opts = $ask->();
     70     return() unless $opts;
     71     while ($opts !~ $kv_regex) {
     72       warn "Invalid input received.\n";
     73       $opts = $ask->();
     74       return() unless $opts;
     75     }
     76     return $opts;
     77   }
     78   return();
     79 }
     80 
     81 =head2 ask_other_readmes
     82 
     83   ask_other_readmes($sbo, $location);
     84 
     85 C<ask_other_readmes()> checks if there are other readmes for the C<$sbo> in
     86 C<$location>, and if so, asks the user if they should be displayed, and then
     87 displays them if the user didn't decline.
     88 
     89 =cut
     90 
     91 sub ask_other_readmes {
     92   my ($sbo, $location) = @_;
     93   my @readmes = sort grep { ! m!/README$! } glob "$location/README*";
     94 
     95   return unless @readmes;
     96 
     97   return unless prompt("\nIt looks like $sbo has additional README files. Would you like to see those too?", default => 'yes');
     98 
     99   for my $fn (@readmes) {
    100     my ($display_fn) = $fn =~ m!/(README.*)$!;
    101     say "\n$display_fn:";
    102     say slurp $fn;
    103   }
    104 }
    105 
    106 =head2 ask_user_group
    107 
    108   my $bool = ask_user_group($cmds, $readme);
    109 
    110 C<ask_user_group()> displays the C<$readme> and commands found in C<$cmds>, and
    111 asks the user if we should automatically run the C<useradd>/C</groupadd>
    112 commands found. If the user indicates that we should, it returns the C<$cmds>,
    113 otherwise it returns C<undef>.
    114 
    115 =cut
    116 
    117 # offer to run any user/group add commands
    118 sub ask_user_group {
    119   script_error('ask_user_group requires two arguments') unless @_ == 2;
    120   my ($cmds, $readme) = @_;
    121   say "\n". $readme;
    122   print "\nIt looks like this slackbuild requires the following";
    123   say ' command(s) to be run first:';
    124   say "    # $_" for @$cmds;
    125   return prompt('Shall I run them prior to building?', default => 'yes') ? $cmds : undef;
    126 }
    127 
    128 =head2 get_opts
    129 
    130   my $bool = get_opts($readme);
    131 
    132 C<get_opts()> checks if the C<$readme> has any options defined, and if so
    133 returns a true value. Otherwise it returns a false value.
    134 
    135 =cut
    136 
    137 # see if the README mentions any options
    138 sub get_opts {
    139   script_error('get_opts requires an argument') unless @_ == 1;
    140   my $readme = shift;
    141   return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef;
    142 }
    143 
    144 =head2 get_readme_contents
    145 
    146   my $contents = get_readme_contents($location);
    147 
    148 C<get_readme_contents()> will open the README file in C<$location> and return
    149 its contents. On error, it will return C<undef>.
    150 
    151 =cut
    152 
    153 sub get_readme_contents {
    154   script_error('get_readme_contents requires an argument.') unless @_ == 1;
    155   return undef unless defined $_[0];
    156   my $readme = slurp(shift . '/README');
    157   return $readme;
    158 }
    159 
    160 =head2 get_user_group
    161 
    162   my @cmds = @{ get_user_group($readme) };
    163 
    164 C<get_user_group()> searches through the C<$readme> for C<useradd> and
    165 C<groupadd> commands, and returns them in an array reference.
    166 
    167 =cut
    168 
    169 # look for any (user|group)add commands in the README
    170 sub get_user_group {
    171   script_error('get_user_group requires an argument') unless @_ == 1;
    172   my $readme = shift;
    173   my @cmds = $readme =~ /^\s*#*\s*(useradd.*?|groupadd.*?)(?<!\\)\n/msg;
    174   return \@cmds;
    175 }
    176 
    177 =head2 user_prompt
    178 
    179   my ($cmds, $opts, $exit) = user_prompt($sbo, $location);
    180 
    181 C<user_prompt()> checks for options and commands, to see if we should run them,
    182 and asks if we should proceed with the C<$sbo> in question.
    183 
    184 It returns a list of three values, and if the third one is a true value, the
    185 first indicates an error message. Otherwise, the first value will either be an
    186 C<'N'>, C<undef>, or an array reference. If it's C<'N'>, the user indicated
    187 that we should B<not> build this C<$sbo>. Otherwise it indicates if we should
    188 run any C<useradd>/C<groupadd> commands, or if it's C<undef>, that we
    189 shouldn't. The second return value indicates the options we should specify if
    190 we build this C<$sbo>.
    191 
    192 B<Note>: This should really be changed.
    193 
    194 =cut
    195 
    196 # for a given sbo, check for cmds/opts, prompt the user as appropriate
    197 sub user_prompt {
    198   script_error('user_prompt requires two arguments.') unless @_ == 2;
    199   my ($sbo, $location) = @_;
    200   if (not defined $location) { usage_error("Unable to locate $sbo in the SlackBuilds.org tree."); }
    201   my $readme = get_readme_contents($location);
    202   return "Could not open README for $sbo.", undef, _ERR_OPENFH if not defined $readme;
    203   if (is_local($sbo)) { print "\nFound $sbo in local overrides.\n"; }
    204   # check for user/group add commands, offer to run any found
    205   my $user_group = get_user_group($readme);
    206   my $cmds;
    207   $cmds = ask_user_group($user_group, $readme) if $$user_group[0];
    208   # check for options mentioned in the README
    209   my $opts = 0;
    210   $opts = ask_opts($sbo, $readme) if get_opts($readme);
    211   print "\n". $readme unless $opts;
    212   ask_other_readmes($sbo, $location);
    213   # we have to return something substantial if the user says no so that we
    214   # can check the value of $cmds on the calling side. we should be able to
    215   # assume that 'N' will  never be a valid command to run.
    216   return 'N' unless prompt("\nProceed with $sbo?", default => 'yes');
    217   return $cmds, $opts;
    218 }
    219 
    220 1;