Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

RFC: newscript.pl , my very first script!

by Darfoune (Novice)
on Jul 24, 2015 at 19:40 UTC ( [id://1136223]=perlmeditation: print w/replies, xml ) Need Help??

Hello monks,

This is my very first post on this site! I wrote my first program, newscript.pl , a few times ago, in order to save some repetitive typing and I really want your opinions, critics, suggestions etc..

It's job is very simple, create an empty script. At first written in bash, with only bash as supported language, now written in Perl it includes Perl, Bash and I started slowly working to include C as well. It's not very portable and surely not very efficient, but I'm using it everyday, when reading thru intermediate Perl, advanced Bash scripting and learning C the hard way.

The script first ask user for the name of the new script, then it asks for the language you're going to use. It will then print the shebang line as well as wanted modules (if you asked for a Perl script) and save it to a file withyourname.test. It then fires up emacs -nw with your newscript so you are ready to input code right away.

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
############################
#
# Name :     newscript 
# Usage:     Makes ready to use script templates for 
#            Bash and Perl only at the moment. It includes 
#            the shebang line for both. Perl templates 
#            includes some useful pragmas and the option to
#            include the required modules on the command line.
#
############################

# declare some required vars
my ($name, $language);
my @modules = ();
my $fullname = $0;
my $progname = basename($fullname);

## main program: 

print "Name of the new script  : ";
chomp ($name = <STDIN>);

print "Language of $name script: ";
chomp ($language = <STDIN>);

# If laguage is Bash, make a Bash script
if ($language =~ /bash/i) {
    $name = "$name.test";
    print "\nMaking a Bash script: $name\n";
    _makebash();


# If language is Perl, make a Perl script    
} elsif ($language =~ /perl/i) {
    $name = "$name.pl.test";
    print "\nMaking a Perl script: $name\n";
    print "\nAdd modules? ex: File::Basename;\n(use strict and use war
+ning are turned on by default).\n";
    print "[yes/no]: ";
    # check if user wants modules
    chomp (my $addmodule = <STDIN>);
    if ($addmodule =~ /yes/i) {
        print "\nThis script does NOT add a ';' for you!\nSay 'done' w
+hen you done..\nModules: ";
        while (<STDIN>) {
            last if ($_ =~ /done(;)?/i);
            push @modules, $_;
        }
        _makeperl();
    } elsif ($addmodule =~ /no/i) { _makeperl();}
    else { 
        print "I assume no.\n";
        _makeperl();
    }



# If language is C, make a C program
} elsif ($language =~ /c/i) {
    $name = "$name.test.c";
    print "\nMaking a C program: $name\n";
    print "\nThis is the first version with C included, no more option
+s yet.\n";
    print "Only '#include <stdio.h>' added at this time.\n\n";
    _makec();


} else {
    print "This might help you:\n";
    _usage();
}





# Make a bash script
sub _makebash {
    if ($language eq 'bash') {
        open (NEWSCRIPT, '>', $name);
        print NEWSCRIPT "#!/bin/bash\n\n";
        close NEWSCRIPT;
        chmod 0700, "$name";
        exec (`emacs -nw +3 $name`);
    }
} 



# Make a perl script
sub _makeperl {
    open (NEWSCRIPT, '>', $name);
    print NEWSCRIPT "#!/usr/bin/perl\n\nuse warnings;\nuse strict;\n";
    if (defined($modules[0])){                  # if module is defined
+, include them to the template
        for my $mods (@modules) {
            print NEWSCRIPT "use $mods";
        }
    }
    print NEWSCRIPT "\n";
    close NEWSCRIPT;
    print "\n";
    chmod 0700, "$name";
    exec (`emacs -nw +50 $name`);

}


# Make a C program
sub _makec {
    open (NEWPROG, '>', $name);
    print NEWPROG "#include <stdio.h>\n\n";
    close NEWPROG;
    print "\n";
    chmod 0700, "$name";
    exec (`emacs -nw +10 $name`);
}



# Sets the usage message.
sub _usage {
    print<<EOF;



Usage: $progname [no options yet]
    
    Creates ready to use script templates.
   
    The script will first ask you for the name of your program,
    then the language in which you want it written.

    If your chosen language is supported, it will make an empty
    script, with your name and 'test' appended to it. The script
    then makes an exec call to emacs -nw with your new file.
    (not very portable yet ..)

  note: If your chosen language is Perl, The script will ask you
  if you wish to import more modules. If you do want more input them
  then followed by a ';' and input 'done' when finish.

  bash:
    #/bin/bash

  perl:
    #/usr/bin/perl
    use warnings;
    use strict;
    use [yourmods];

  C:
    #include <stdio.h>


EOF
}

[download]

Replies are listed 'Best First'.
Re: RFC: newscript.pl , my very first script!
by Paladin (Vicar) on Jul 24, 2015 at 20:38 UTC
    You use a global variable @modules to pass what modules you want to add to your Perl script. It's better practice to pass in an array to the _makeperl() function with what you want to add. Change: 
        if ($addmodule =~ /yes/i) {
        print "\nThis script does NOT add a ';' for you!\nSay 'done' w
+hen you done..\nModules: ";
        while (<STDIN>) {
            last if ($_ =~ /done(;)?/i);
            push @modules, $_;
        }
        _makeperl();
    } elsif ($addmodule =~ /no/i) { _makeperl();}
    else { 
        print "I assume no.\n";
        _makeperl();
    }

    [download]
    to 
        if ($addmodule =~ /yes/i) {
        my @modules;
        print "\nThis script does NOT add a ';' for you!\nSay 'done' w
+hen you done..\nModules: ";
        while (<STDIN>) {
            last if ($_ =~ /done(;)?/i);
            push @modules, $_;
        }
        _makeperl(@modules);
    } elsif ($addmodule =~ /no/i) { _makeperl();}
    else { 
        print "I assume no.\n";
        _makeperl();
    }

    [download]
    and remove the  my @modules; from the top of the script. Then in your _makeperl() change: 
    sub _makeperl {
    open (NEWSCRIPT, '>', $name);
    print NEWSCRIPT "#!/usr/bin/perl\n\nuse warnings;\nuse strict;\n";
    if (defined($modules[0])){                  # if module is defined
+, include them to the template
        for my $mods (@modules) {
            print NEWSCRIPT "use $mods";
        }
    }

    [download]
    to 
    sub _makeperl {
    my @mods = @_
    open (NEWSCRIPT, '>', $name);
    print NEWSCRIPT "#!/usr/bin/perl\n\nuse warnings;\nuse strict;\n";
    if (@mods){                  # if module is defined, include them 
+to the template
        for my $mod (@mods) {
            print NEWSCRIPT "use $mod";
        }
    }

    [download]
    Note, I also changed the if (@mods){ which is the usual way of checking if an array has any elements in it.

    Similarly you could pass the $name of the script into all the functions as well.

[reply]
[d/l]
[select]

      Thanks for you feedback!

      I moved the @modules array into the _makeperl sub and changed it to look like your exemple as well as the $name var. thanks! 

      #!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
############################
#
# Name :     newscript 
# Usage:     Makes ready to use script templates for 
#            Bash and Perl only at the moment. It includes 
#            the shebang line for both. Perl templates 
#            includes some useful pragmas and the option to
#            include the required modules on the command line.
#
############################

# declare some required vars
my ($name, $language);
my $fullname = $0;
my $progname = basename($fullname);

## main program: 

print "Name of the new script  : ";
chomp ($name = <STDIN>);

print "Language of $name script: ";
chomp ($language = <STDIN>);

# If laguage is Bash, make a Bash script
if ($language =~ /bash/i) {
    print "\nMaking a Bash script: $name\n";
    _makebash();


# If language is Perl, make a Perl script    
} elsif ($language =~ /perl/i) {
    print "\nMaking a Perl script: $name\n";
    print "\nAdd modules? ex: File::Basename;\n(use strict and use war
+ning are turned on by default).\n";
    print "[yes/no]: ";
    # check if user wants modules
    chomp (my $addmodule = <STDIN>);
    if ($addmodule =~ /yes/i) {
        my @modules;
        print "\nThis script does NOT add a ';' for you!\nSay 'done' w
+hen you're done..\nModules: ";
        while (<STDIN>) {
            last if ($_ =~ /done(;)?/i);
            push @modules, $_;
        }
        _makeperl(@modules);
    } elsif ($addmodule =~ /no/i) { _makeperl();}
    else { 
        print "I assume no.\n";
        _makeperl();
    }



# If language is C, make a C program
} elsif ($language =~ /c/i) {
    print "\nMaking a C program: $name\n";
    print "\nThis is the first version with C included, no more option
+s yet.\n";
    print "Only '#include <stdio.h>' added at this time.\n\n";
    _makec();


} else {
    print "This might help you:\n";
    _usage();
}





# Make a bash script
sub _makebash {
    if ($language eq 'bash') {
        $name = "$name.test";
        open (NEWSCRIPT, '>', $name);
        print NEWSCRIPT "#!/bin/bash\n\n";
        close NEWSCRIPT;
        chmod 0700, "$name";
        exec (`emacs -nw +3 $name`);
    }
} 



# Make a perl script
sub _makeperl {
    $name = "$name.pl.test";
    my @mods = @_;
   open (NEWSCRIPT, '>', $name);
    print NEWSCRIPT "#!/usr/bin/perl\n\nuse warnings;\nuse strict;\n";
    if (@mods){             # If module is defined, add it to the temp
+late.
        for my $mod (@mods) {
            print NEWSCRIPT "use $mod";
        }
    }
    print NEWSCRIPT "\n";
    close NEWSCRIPT;
    print "\n";
    chmod 0700, "$name";
    exec (`emacs -nw +50 $name`);

}


# Make a C program
sub _makec {
    $name = "$name.test.c";
    open (NEWPROG, '>', $name);
    print NEWPROG "#include <stdio.h>\n\n";
    close NEWPROG;
    print "\n";
    chmod 0700, "$name";
    exec (`emacs -nw +10 $name`);
}



# Sets the usage message.
sub _usage {
    print<<EOF;



Usage: $progname [no options yet]
    
    Creates ready to use script templates.
   
    The script will first ask you for the name of your program,
    then the language in which you want it written.

    If your chosen language is supported, it will make an empty
    script, with your name and 'test' appended to it. The script
    then makes an exec call to emacs -nw with your new file.
    (not very portable yet ..)

  note: If your chosen language is Perl, The script will ask you
  if you wish to import more modules. If you do want more input them
  then followed by a ';' and input 'done' when finish.

  bash:
    #/bin/bash

  perl:
    #/usr/bin/perl
    use warnings;
    use strict;
    use [yourmods];

  C:
    #include <stdio.h>


EOF
}

      [download]
[reply]
[d/l]
Re: RFC: newscript.pl , my very first script!
by roboticus (Chancellor) on Jul 24, 2015 at 20:55 UTC

    Darfoune:

    Overall, it looks fine. Here are some suggestions, though:

    First, you have a _usage() function that'll give help on the program. You may want to use POD for your documentation, and have your usage message be brief and refer the user to run perldoc newscript.pl to see full documentation.

    The second thing I'd suggest is to use 'heredocs' for your script templates. That way, they're easier to edit correctly and get the way you want them to be, something like:

    print NEWSCRIPT <<EOPerlTpl;
#!/usr/bin/perl
# $name
#
use warnings;
use strict;

EOPerlTpl

    [download]

    My final suggestion is to have a couple tags you can use to add clusters of frequently-used modules. As an example, I was often asked to generate reports from our database, and they normally would want the report in a spreadsheet. So I'd code it so that if it recognized "RPT" as a module, that I'd automatically add:

    use DBI;
use Spreadsheet::WriteExcel;
use Spreadsheet::WriteExcel::Styler;

my ($DBName, $DBUID, $DBPWD) = ("MyDatabase", "reportAccount", "tehRpt
+P@55werd");
. . . add a few lines here to define my favorite excel styles . . .

    [download]

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

[reply]
[d/l]
[select]

      Hi roboticus

      I will need to look into POD documentation and how to make one but it's a good idea. As with the heredoc style for the templates, how would I be able to add user chosen modules to the heredoc ? Correct me if I'm mistaken but heredocs are a fixed lenght. This is the thought that led me to use print statement at first. Thanks alot for you feedback !!!

[reply]

        Darfoune:

        While a heredoc is fixed length (barring variable substitution), you can still do multiple writes to the file. So the heredoc could have the basic header for your script. Then as the user selects other modules, you can continue to add them to the script.

        open my $FH, '>', 'afile.pl';
print $FH <<EOHDR;
Some header stuff
EOHDR

while (<>) {
    if (/^RPT/) { print $FH, "another line of your script" }
    elsif (/^FOO/) { print $FH, "something completely different" }
    elsif (/^Q/) { last; }
}

        [download]

        Alternatively, you can use a heredoc to load a variable, then continue to add data to the variable:

        my $SCRIPT = <<EOHDR
Some header stuff
EOHDR;

$SCRIPT .= "More script stuff";

        [download]

        ...roboticus

        When your only tool is a hammer, all problems look like your thumb.

[reply]
[d/l]
[select]
Re: RFC: newscript.pl , my very first script!
by 1nickt (Canon) on Jul 24, 2015 at 22:03 UTC

    You have an error in your code: 

    exec (`emacs -nw +50 $name`);

    [download]

    The backticks are already a system call, so you are nesting them by putting them inside a call to exec(). Try changing it to: 

    exec ("emacs -nw +50 $name");

    [download]
    The way forward always starts with a minimal test.
[reply]
[d/l]
[select]
      exec ("emacs -nw +50 $name");

      ... and finally, to avoid nasty surprises when $name contains characters that the default shell interprets instead of passing them unmodified to emacs, get rid of the shell. And check for errors, because exec could fail, like most other system calls.

      exec('emacs','-nw','+50',$name) or die "exec emacs failed: $!";

      Alexander

      --
      Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
[reply]
[d/l]
[select]

        That's a very good point. Is it safer to make checks for everything the user can input or that has no influence in the security of the program?

        What I need to do:

        - add possibility for the user to cluster frequently used modules/libraries with tags (thinking about using hashes)

        - make use of environment variable to determine which is the default editor and make use of it, instead of assuming emacs. (not sure how to do that yet)

        thanks for your suggestions :)

[reply]
Re: RFC: newscript.pl , my very first script!
by 1nickt (Canon) on Jul 24, 2015 at 20:59 UTC

    UPDATE: this was an error in the OP code, not a Mac thing

    Doesn't work for me on Mac OSX. It creates the file properly (determined in post-mortem) but hangs when trying to open the file with emacs. 

    [13:52][nick:~/monks]$ perl 1136223.pl
Name of the new script  : foo
Language of foo script: perl

Making a Perl script: foo.pl.test

Add modules? ex: File::Basename;
(use strict and use warning are turned on by default).
[yes/no]: yes

This script does NOT add a ';' for you!
Say 'done' when you done..
Modules: Data::Dumper;
done

<-- hangs here
<-- then after killing process:






































----:---F1  *scratch*      All L1     (Fundamental)-------------------
+--------------------------------------------------------------
": No such file or directory at 1136223.pl line 104, <STDIN> line 5.
[13:54][nick:~/monks]$

    [download]
    The way forward always starts with a minimal test.
[reply]
[d/l]

      Thanks alot, I changed it.

      I also added the possibility to add additional libraries when you choose a C program.

      #!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
############################
#
# Name :     newscript 
# Usage:     Makes ready to use script templates for 
#            Bash and Perl only at the moment. It includes 
#            the shebang line for both. Perl templates 
#            includes some useful pragmas and the option to
#            include the required modules on the command line.
#
############################

# declare some required vars
my ($name, $language);
my $fullname = $0;
my $progname = basename($fullname);

## main program: 

print "Name of the new script  : ";
chomp ($name = <STDIN>);

print "Language of $name script: ";
chomp ($language = <STDIN>);

# If laguage is Bash, make a Bash script
if ($language =~ /bash/i) {
    print "\nMaking a Bash script: $name\n";
    _makebash();


# If language is Perl, make a Perl script    
} elsif ($language =~ /perl/i) {
    print "\nMaking a Perl script: $name\n";
    print "\nAdd modules? ex: File::Basename;\n(use strict and use war
+ning are turned on by default).\n";
    print "[yes/no]: ";
    # check if user wants modules
    chomp (my $addmodule = <STDIN>);
    if ($addmodule =~ /yes/i) {
        my @modules;
        print "\nThis script does NOT add a ';' for you!\nSay 'done' w
+hen you're done..\nModules: ";
        while (<STDIN>) {
            last if ($_ =~ /done(;)?/i);
            push @modules, $_;
        }
        _makeperl(@modules);
    } elsif ($addmodule =~ /no/i) { _makeperl();}
    else { 
        print "I assume no.\n";
        _makeperl();
    }



# If language is C, make a C program
} elsif ($language =~ /c/i) {
    print "\nMaking a C program: $name\n";
    # Check if user wants to add more libraries
    print "Add other libraries? ex: <stdlib.h>\nYou may ommit the '<',
+'>'\n[yes/no]: ";
    chomp (my $addlib =  <STDIN>);
    if ($addlib =~ /yes/i) {
        my @libs;
        print "Say 'done' when you are finished.\nLibraries: ";
        while (<>) {
            last if ($_ =~ /done/i);
            push @libs, $_;
        }
    _makec(@libs);
    } elsif ($addlib =~ /no/i) { _makec(); }
    else {
        print "Fine. ONLY <stdio.h> for you !\n";
        _makec();
    }

} else {
    print "This might help you:\n";
    _usage();
}





# Make a bash script
sub _makebash {
    if ($language eq 'bash') {
        $name = "$name.test";
        open (NEWSCRIPT, '>', $name);
        print NEWSCRIPT "#!/bin/bash\n\n";
        close NEWSCRIPT;
        chmod 0700, "$name";
        exec ("emacs -nw +3 $name");
    }
} 



# Make a perl script
sub _makeperl {
    $name = "$name.pl.test";
    my @mods = @_;
    open (NEWSCRIPT, '>', $name);
    print NEWSCRIPT "#!/usr/bin/perl\n\nuse warnings;\nuse strict;\n";
    if (@mods){             # If module is defined, add it to the temp
+late.
        for my $mod (@mods) {
            print NEWSCRIPT "use $mod";
        }
    }
    print NEWSCRIPT "\n";
    close NEWSCRIPT;
    print "\n";
    chmod 0700, "$name";
    exec ("emacs -nw +50 $name");

}


# Make a C program
sub _makec {
    $name = "$name.test.c";
    my @library = @_;
    open (NEWPROG, '>', $name);
    print NEWPROG "#include <stdio.h>\n\n";
    if (@library) {
        for my $lib (@library){
            chomp $lib;
            if ($lib =~ /^<.*>$/) {
                print NEWPROG "#include $lib\n";
            } else {
                print NEWPROG "#include <$lib>\n";
            }
        }
    }
    print NEWPROG "\n";
    close NEWPROG;
    print "\n";
    chmod 0700, "$name";
    exec ("emacs -nw +10 $name");
}



# Sets the usage message.
sub _usage {
    print<<EOF;



Usage: $progname [no options yet]
    
    Creates ready to use script templates.
   
    The script will first ask you for the name of your program,
    then the language in which you want it written.

    If your chosen language is supported, it will make an empty
    script, with your name and 'test' appended to it. The script
    then makes an exec call to emacs -nw with your new file.
    (not very portable yet ..)

  note: If your chosen language is Perl, The script will ask you
  if you wish to import more modules. If you do want more input them
  then followed by a ';' and input 'done' when finish.

  bash:
    #/bin/bash

  perl:
    #/usr/bin/perl
    use warnings;
    use strict;
    use [yourmods];

  C:
    #include <stdio.h>


EOF
}

      [download]

      I didn't have a chance to try it on OSX yet. I'll try to make it more portable.

      I appreciate all your suggestions and ideas, thanks alot.

[reply]
[d/l]

      Hello sir

      I would really like to implement that feature but I'm not sure how to proceed in order to see why emacs is failing to it's job. Do I have to redirect the error output from the shell to stdout or is it some perl trick I can't think of right now? I have a few days off so I'll soon take time to run newscript.pl on my father's mac osx and see if I could figure how to make it work. Thanks for trying it !!

[reply]
Re: RFC: newscript.pl , my very first script!
by Monk::Thomas (Friar) on Jul 29, 2015 at 11:52 UTC

    You could use a dispatch table:

    my %filetype = (
  'c'    => \&create_c,
  'bash' => \&create_bash, 
  'perl' => \&create_perl_script,
  'pl'   => \&create_perl_script,
  'pm'   => \&create_perl_module,
);

sub create_c {
  my $filename = shift;
  # stuff for creating a c file
}

sub create_bash {
  my $filename = shift;
  # stuff for creating a bash script
}

...

print  "What kind of file do you want to create?\n";
printf "Supported file types: %s\n", join ', ', sort keys %filetype;

# ask user for desired filetype -> $type
# ask user for desired filename -> $name

if (exists $filetype{$type}) {
  # this calls the function that is stored in the hash
  # e.g. create_bash($filename)
  $filetype{$type}->($name);
}
else {
  die "Sorry, file type '$type' is not supported.\n";
}

    [download]

    If you want to support some other filetype (e.g. SQL) at some point then you only need to write a new function 'create_sql' and update the %filetype hash.

[reply]
[d/l]

      Hello Monk::Thomas

      Your idea is brilliant, it will make newscript much clearer and easier to maintain!

      Although, right now I'm working on an interactive clustering facility, a way to regroupe modules or libraries under tags, or clusters.

      It's still a stand-alone program, I haven't added it to newscript yet and once I get it implemented I will work on a way to make, remove and choose cluster from the command line directly

      It's operating on a file, .cluster, created in the user's $HOME directory. Although a little cryptic to read, it's possible to edit the file directly to add, remove and edit cluster as long as the ;name;modules, syntax is followed (both semi colons arround name and trailing coma after every module is important). As of right now, it's not possible to edit interactively an already made cluster. At the moment, only perl module can be clustered.

      It's a work in progress but if you want, have a try and tell me what you think of it ;)

      As of the many "why the hell did he do it this way oO " that you gonna ask yourself.. well I did with what I knew :P.

      Thanks for you feedback ! :)

       #!/usr/bin/perl

use warnings;
use strict;

my ($cmd,$usercmd);
my $cfile_content = '';
my $command = 1;
my $home = $ENV{HOME};
chomp  ( my $cfile = "$home/.cluster") ;
my ( @namelist, @modname);
my %nammod;
my $timedone = 0;
my $doneit = 0;
my $tempfile = "/$home/tmp_cluster";

# Greetings
print "\n\n\t\t\tWelcome to the Cluster Facility\n";
_filecheck();
_cluster_help();
# We need some vars that are setup in this sub
_make_list();
_input();



# Get command from user
sub _input {
    print "\n\nCommand -> ";
    chomp ($usercmd = <STDIN>);
    _ineed($usercmd);
}

# Main menu
sub _ineed {
    $cmd = shift ;
    # Make a list of registered cluster
    if ($cmd =~ /list/i) {
        _thelist();
        _input();
    }
    # Add a new cluster to /$home/.cluster
    elsif ($cmd =~ /add/i) {
        _add();
        _input();
    }
    # Remove a cluster from /$home/.cluster
    elsif ($cmd =~ /remove/i ) {
        _removec();
        _input();
    }
    # Edit a cluster using it's name
    elsif ($cmd =~ /edit/i) {
        #       _edit();
        print "\n\n\nNot Available Yet\n\n\n";
        _input();
    }
    # Call the usage sub
    elsif ($cmd =~ /help/i ) {
        _cluster_help();
        _input();
    }
    # Exit the program
    elsif ($cmd =~ /(exit|quit)/i ) {
        exit;
    }
    # Else you're lost, print usage for you
    else {
        print "\n\n//Invalid command; Take a look a this:\n";
        _cluster_help();
        _input();
    }
}



# to add a cluster:
sub _add {
    # call on _filecheck to verify if /$home/.cluster exist
    # skip if we've done the check once already.
    my $addclus = 1;
    print "\n\n\t\t\t\tAdd a Cluster:\n";
    while ($addclus) {
        my @cmodules;
        # Get cluster name from user
        print "\t\tFor a list of registered cluster use 'list',\n";
        print "\t\t'return' to get back to main menu, 'exit' to leave.
+\n\n\n";
        print "\nName of your new cluster: ";
        chomp (my $cname = <STDIN>);
        # Test the input, return 2 if everything is good
        # return 1 if a test fails, return 3 if 'list' was input 
        my $checkres = input_check($cname);
        print "\$checkres is $checkres\n\n";
        if ($checkres == 1) {
            print "//problem inside input_check\n\n";
            redo;
        } elsif ($checkres == 3) {
            redo;
        }
        # check for duplicates
        for my $uname (@namelist) {
            return _add() unless ($uname !~ m/\Q$cname/);
        }
        print "Which module you want in the $cname cluster?:\n";
        # get modules from user
        print "Module name: ";
        while (<>) {
            if ($_ =~ /done/i) {
                last;
            } else {
                my $modcopy = $_;
                my $test = input_check($modcopy);
                if ($test == 2) {
                    push @cmodules, $_;
                } elsif (($test == 1) || ($test == 3)) {
                    print "Module name: ";
                    next;
                }
            }
            print "Module name: ";
        }
        # write cluster name; followed by each modules, to /$home/.clu
+ster 
        open (my $CLUS, '>>', $cfile);
        print $CLUS ";$cname;";
        for my $mods (@cmodules) {
            chomp $mods;
            # append a coma after each module
            print $CLUS "$mods,";
        }
        close $CLUS;
        # ask user for more cluster, if no call _input();
        print "\nAdd another cluster? [yes/no]: ";
        chomp (my $answer = <STDIN>);
        if ($answer =~ /yes|y/) {
            @cmodules = undef;
            redo;
        } else {
        # if answer is no, we're done here
            $addclus--;
        }
    }

}

# Used to modify existing cluster entry.
# Not sure how to edit modules of a given cluster yet.
#sub _edit {
#    my $editit = 1;
#    while ($editit) {
#       print "\n\nWhich Cluster would you like to modify?: ";
#       chomp (my $modify = <STDIN>);
#       if ($modify =~ /return/i) {
#           print "\nBack to main menu.\n";
#           return _input();
#       } elsif ($modify =~ /list/i) {
#           _thelist();
#       }
#       for my $name (@namelist) {
#           if ($name =~ m/\Q$modify/) {
#               print "\nWe editing -> $modify\n";
#               print "Name of Cluster: $name. Modules of $name: $namm
+od{$name}\n\n";
#
#           } 
#       }
#       print "Edit other Clusters? [yes/no]: ";
#       chomp (my $yesno = <STDIN>);
#       if ($yesno =~ /yes|y/i) {
#           redo;
#       } else {
#           $editit--;
#       }
#    }
#}


# Used to remove whole existing clusters.
sub _removec {
    my $keepgoing = 1;
    while ($keepgoing == 1) {
        my $chkinhash;
        my $newcfile = '';
        # Print a list of Clusters
        _thelist();
        print "Cluster to remove: ";
        # Ask user which Cluster he wishes removed
        chomp (my $remclus = <STDIN>);
        my $testres = input_check($remclus);
        if ($testres == 1) {
            print "Syntax error\n";
            redo;
        } elsif ($testres == 2){
        } elsif ($testres == 3){
            redo;
        }
        
        # Checks if the input name matches one from namelist
        for my $name (@namelist) {
            # If yes print a warning
            if ($name =~ m/\Q$remclus/) {
                print "\$name is \$remclus: $name == $remclus\n";
                $chkinhash = $nammod{$remclus};
                print "\$chkinhash is: $chkinhash\n";
                
                # If it doesn't match, append it to $newcfile to rebui
+ld cfile    
            } else {
                if ($newcfile) {
                    $newcfile = "$newcfile;$name;$nammod{$name}";
                } else {
                    $newcfile = ";$name;$nammod{$name}";
                }
            }
        }
        print "\n\n\$newcfile is $newcfile\n\n";
        unlink "$cfile";
        open (my $NCLUS, '>', $cfile);
        print $NCLUS "$newcfile";
        close $NCLUS;
        $keepgoing--;
    }
}
    


# This is done once every time the program run
sub _filecheck {
    # check if .cluster file exist
    if (-e $cfile) {
        # If it does, make sure it's a file and not something wierd
        if (-f $cfile) {
            # Check if you have read and write permission
            if (-r -w $cfile) {
                # you are all good
                print "All checks are good\n";
                # We don't wanna redo these test.
#               $doneit++;
                # Make a list of cluster name
#               return _make_list();

            } else { # if you can't read or write cfile, we've got a p
+roblem
                print "You can't read nor write $cfile\n";
                exit;
            }
        } else { # if cfile isn't a plain file, we've got a problem
            print "$cfile is not a plain file\n";
            exit;
        }
        
    } else {  # if file doesn't exist, print a warning and continue
        print "$cfile doesn't exist\n";
    }
}

# Make a hash to map cluster names to their modules
sub _make_list {
    # Read in $home/.cluster file
    open (my $CLUS, '<', $cfile);
    while (<$CLUS>) {
        chomp;
        # If .cluster is single lined, assign $_ to it
        if ($cfile_content eq '') {
            $cfile_content = $_;
        # If .cluster is multi lined, apend $_ to clusterfile_content 
+   
        } else {
            $cfile_content = "$cfile_content$_";
        }
    }
    close $CLUS;
    # use ';' to separate cluster names and modules. Put the result in
+ array
    my @splitted_file = split /;/, $cfile_content;
    # Discard the first entry, not sure where it gets the whitespace
    shift @splitted_file;
    # set up the hash. Keys are the names, values the modules
    %nammod = @splitted_file;
    # Assign keys and value to their respective array for later use
    @modname  = values %nammod;
    @namelist = keys %nammod;
    # unset variables to get a new list everytime
    $cfile_content = '';
    $timedone++

   
}

sub _thelist {
    _make_list();
    print "\n\t\tThere's the list of registered Clusters:\n";
    print "Cluster_Name => Modules, \n\n";
    # sort Cluster by name and print 
    for my $key (sort keys %nammod) {
        my $value = $nammod{$key};
        print "$key => $value\n";
    }
    print "\n\n";
}

# Validates input
sub input_check {
    chomp (my $totest = shift);
        # (2) Check for punctuation
    if ($totest =~  /^(\w)+(::(\w)+)*?[^[:punct:]]$/ )  {
        print "//(2); pass\n";
        # Check if input match list
        if ($totest !~ /list/i) {
            print "//(3): pass\n";
            # Check if input match return
            if ($totest !~ /return/i) {
                print "//(4): pass\n";
                if ($totest !~ /exit|quit/i) {
                    print "//(5): pass\n";
                    return(2);
                    
                    
                } else { # match exit or quit
                    print "//(5): Failed: $totest: Leaving\n";
                    exit;
            } else { # match return
                print "//(4): Failed: $totest: Going back to main menu
+\n";
                _input();
            }
        } else { # match list
            print "//(3): List\n";
            _thelist();
            return(3);
        }
        
        
    } else { # match punctuation
        print "\n//(2): Failed: Contain bad characters\n";
        print "//No punctuation allowed\n\n";
        return(1);
    }
}
sub _cluster_help {
    print<<EOF;



   Newscript.pl: Cluster Facility



        You can use this facility to group your most frenquently
        used modules.

        For exemple, you select Perl and a name,
        inet, then you can make a new cluster that contain your module
+s:
        In this case only 2 modules LWP::* and CGI::*.

        Next time you create a newscript, you can use the following:

        newscript.pl [--cluster=inet] [name]

        and newscript will create a template with the apropriate
        language and your clustered modules.

      Options:
        -list        Print a list of existing cluster and their conten
+t.
        -add         Add a new cluster.
        -remove      Remove an existing cluster.
        -edit        Remove a modules from within an existing cluster.
        -help        Print this message.
        -exit        Exit program.
        -quit        Exit program.

EOF
}

      [download]
[reply]
[d/l]
Re: RFC: newscript.pl , my very first script!
by Nemo Clericus (Beadle) on Jul 27, 2015 at 13:01 UTC
    Kudos on your use of the Strictures!
[reply]

Back to Meditations

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlmeditation [id://1136223]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others examining the Monastery: (2)
As of 2024-04-26 02:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found