opalmod 0.2.2 / usr / share / perl5 / OpaL / manipulate.pm

#!/usr/bin/perl
#    OpaL Perl Modules
#    Copyright (C) 2000,2007-2008  Ola Lundqvist <ola@inguza.com>
#
#    For full COPYRIGHT notice see the COPYING document.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of either:
#
#	a) the GNU General Public License as published by the Free
#	Software Foundation; either version 1, or (at your option) any
#	later version, or
#
#	b) the "Artistic License" which comes with this Kit.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
#    the GNU General Public License or the Artistic License for more details.
#
#
#    For more information take a look at the official homepage at:
#      http://inguza.com/software/opalmod
#    or contact the author at:
#      ola@inguza.com
#

package OpaL::manipulate;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use POSIX qw(strftime);

require Exporter;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw( );
@EXPORT_OK = qw(perlmodifyadvanced perlmodify perlmodify_insertafter);

# If you are using CVS/RCS this can be quite handy.
#$VERSION = do{my@r=q$Revision: 1.14 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};

# If that is not what you want use this instead. Will be rewritten by
# create release.
my $version = '0.01';
$VERSION = $version;

###############################################################################
############################ PACKAGE GLOBALS ##################################
###############################################################################
use OpaL::action qw(pdebug cmdaction);
use OpaL::read qw(readscalarfile);

# First exported ones (those in @EXPORT or @EXPORT_OK)

# Then package other global ones. (not exported ones)
# Can be accessed through $OpaL::manipulate::variablename

# All file-scooped variables must be created before any method that uses them.
# my $myvar = '';

###############################################################################
########################### PRELOADED METHODS #################################
###############################################################################
# Preloaded methods go here.





# Autoload methods go after =cut, and are processed by the autosplit program.

# Modules must return true.
1;
__END__

###############################################################################
############################# DOCUMENTATION ###################################
###############################################################################
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

OpaL::manipulate - Perl extension for manipulating files.

=head1 SYNOPSIS

  use OpaL::manipulate qw(functions);

No functions or variables are exported automaticly so you have to specify
them here. 

=head1 DESCRIPTION

OpaL::manipulate is a module for manipulating files.

All functions are autoloaded so they will not be loaded into memory if you
have not used them before.

=head1 FUNCTIONS

=over 4

=item B<perlmodifyadvanced>

It simply applies the script to the file to change its content.
You also have to apply a message to tell what you are doing mostly for debugging and if any error occures. The error level tells how critical this action is
to the script.

USAGE:
    C<perlmodifyadvanced>("file", "script",
                       "message", errorlevel);

The errorlevel is optional.

=item B<perlmodify>

It simply fixes some stuff in the script string and then calls
perlmodifyadvanced.

USAGE:
    C<perlmodify>("file", "script",
               "message", errorlevel);

The errorlevel is optional.

=item B<perlmodify_insertafter>

This function searches for something (regular expression). It if is found it
inserts the text after it. But it will never insert the text twice.

You also have to apply a message to tell what you are doing mostly for
debugging and if any error occures. The error level tells how critical this
action is to the script.

USAGE:
    C<perlmodify_insertafter>("file", "find", "text",
                           "message", errorlevel);

The errorlevel is optional.

=back

=head1 AUTHOR

Ola Lundqvist <ola@inguza.com>

=head1 REQUIRES

B<OpaL::action>, B<OpaL::read>.

=head1 SEE ALSO

L<OpaL::action>

L<OpaL::read>

perl(1)

=cut

###############################################################################
########################### AUTOLOAD METHODS ##################################
###############################################################################

###############################################################################
# Name:		perlmodifyadvanced
# Description:	Modifiles a (text)file with the help of a perl-script.
#		eg. perl -pi -e script file.
# Arguments:	$file, $script, $message [, $level ]
# Uses:		system, perl, cmdaction
# Author:	Ola Lundqvist <ola@inguza.com>
# Date:		2000-05-04	Written
#		2000-05-13	Better argument definition.
#		2000-06-29	Added argument definition.
###############################################################################
sub perlmodifyadvanced {#($$$;$) {
    my $file = shift;
    my $script = shift;
    my $message = shift;
    my $level = shift;
    &cmdaction("perl -pi -e \'$script\' $file", $message, $level);
}

###############################################################################
# Name:		perlmodify
# Description:	Modifiles a (text)file with the help of a perl-script.
#		eg. perl -pi -e script file. And makes some fixes before.
# Arguments:	$file, $script, $message [, $level ]
# Uses:		system, perl, cmdaction
# Author:	Ola Lundqvist <ola@inguza.com>
# Date:		2000-05-04	Written
#		2000-05-13	Better argument definition.
#		2000-06-04	Added some fixes to make it more secure.
#		2000-06-29	Added argument definition.
###############################################################################
sub perlmodify {#($$$;$) {
    my ($file, $script, $message, $level) = @_;
    $script =~ s/\@/\\\@/g;
    $script =~ s/\%/\\\%/g;
    $script =~ s/\$([a-z]A-Z)/\\\$$1/g;
    &perlmodifyadvanced($file, $script, $message, $level);
}

###############################################################################
# Name:		perlmodify_insertafter
# Description:	Mdifiles a (text)file with the help of a perl-script.
#		eg. perl -pi -e script file.
# Arguments:	$file, $find, $text, $message [, $level ]
# Uses:		perlmodify
# Author:	Ola Lundqvist <ola@inguza.com>
# Date:		2000-05-04
#		2000-06-04	Fixed so that insert after do not make
#				repeated inserts. (never ever)
#		2000-06-29	Added argument definition.
###############################################################################
sub perlmodify_insertafter {#($$$$;$) {
    my $file = shift;
    my $find = shift;
    my $insert = shift;
    $insert =~ s/\$/\\\$/g;
    $insert =~ s/\n$//;
    my $message = shift;
    my $level = shift;
    my $data = &readscalarfile("$file");
    my $test = "$find$insert";
    $data =~ s/\$//g;
    $test =~ s/\$//g;
    $data =~ s/\*//g;
    $test =~ s/\*//g;
    $data =~ s/\+//g;
    $test =~ s/\+//g;
    $data =~ s/\-//g;
    $test =~ s/\-//g;
    $data =~ s/\@//g;
    $test =~ s/\@//g;
    $data =~ s/\%//g;
    $test =~ s/\%//g;
    $data =~ s/\n//g;
    $test =~ s/\n//g;
    $data =~ s/\///g;
    $test =~ s/\///g;
    $data =~ s/\(//g;
    $test =~ s/\(//g;
    $data =~ s/\)//g;
    $test =~ s/\)//g;
    $data =~ s/\[//g;
    $test =~ s/\]//g;
    $data =~ s/\.//g;
    $test =~ s/\.//g;
    $data =~ s/\s+/ /g;
    $test =~ s/\s+/ /g;
    if ($data !~ /$test/) {
	&perlmodify("$file",
		    "s|($find)|\$1$insert|",
		    $message,
		    $level);
    }
    else {
	pdebug(5, "Information already exists.");
    }
}