diff options
| -rw-r--r-- | MDK/Common.pm.pl | 3 | ||||
| -rw-r--r-- | MDK/Common/File.pm | 7 | ||||
| -rw-r--r-- | perl-MDK-Common.spec | 6 | ||||
| -rwxr-xr-x | perl_checker | 17 |
4 files changed, 29 insertions, 4 deletions
diff --git a/MDK/Common.pm.pl b/MDK/Common.pm.pl index 304ea49..b5e7f6e 100644 --- a/MDK/Common.pm.pl +++ b/MDK/Common.pm.pl @@ -1,6 +1,8 @@ print <<'EOF'; +package MDK::Common; + =head1 NAME MDK::Common - miscellaneous functions @@ -55,7 +57,6 @@ modify it under the same terms as Perl itself. =cut -package MDK::Common; use MDK::Common::DataStructure qw(:all); use MDK::Common::File qw(:all); diff --git a/MDK/Common/File.pm b/MDK/Common/File.pm index 413dfa6..208fd1c 100644 --- a/MDK/Common/File.pm +++ b/MDK/Common/File.pm @@ -34,6 +34,10 @@ array context it returns the lines creates a file and outputs the list (if the file exists, it is clobbered) +=item append_to_file(FILENAME, LIST) + +add the LIST at the end of the file + =item output_p(FILENAME, LIST) just like C<output> but creates directories if needed @@ -101,7 +105,7 @@ L<MDK::Common> use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); @ISA = qw(Exporter); -@EXPORT_OK = qw(dirname basename cat_ cat__ output output_p linkf symlinkf renamef mkdir_p rm_rf cp_af touch all glob_ substInFile expand_symlinks openFileMaybeCompressed catMaybeCompressed); +@EXPORT_OK = qw(dirname basename cat_ cat__ output output_p append_to_file linkf symlinkf renamef mkdir_p rm_rf cp_af touch all glob_ substInFile expand_symlinks openFileMaybeCompressed catMaybeCompressed); %EXPORT_TAGS = (all => [ @EXPORT_OK ]); sub dirname { local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } @@ -109,6 +113,7 @@ sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ } sub cat_ { local *F; open F, $_[0] or return; my @l = <F>; wantarray ? @l : join '', @l } sub cat__ { my ($f) = @_; my @l = <$f>; wantarray ? @l : join '', @l } sub output { my $f = shift; local *F; open F, ">$f" or die "output in file $f failed: $!\n"; print F foreach @_ } +sub append_to_file { my $f = shift; local *F; open F, ">>$f" or die "output in file $f failed: $!\n"; print F foreach @_ } sub output_p { my $f = shift; mkdir_p(dirname($f)); output($f, @_) } sub linkf { unlink $_[1]; link $_[0], $_[1] } sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] } diff --git a/perl-MDK-Common.spec b/perl-MDK-Common.spec index 9ad9857..9d922b9 100644 --- a/perl-MDK-Common.spec +++ b/perl-MDK-Common.spec @@ -2,7 +2,7 @@ # do not change the version here, change in MDK/Common.pm.pl %define version THEVERSION -%define release 10mdk +%define release 11mdk Summary: Various simple functions Name: perl-MDK-Common @@ -49,6 +49,10 @@ rm -rf $RPM_BUILD_ROOT # MODIFY IN THE CVS: cvs.mandrakesoft.com:/cooker soft/perl-MDK-Common %changelog +* Wed Jul 31 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-11mdk +- File.pm: add "append_to_file" +- perl_checker: a few more stricter rules + * Wed Jul 31 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-10mdk - perl_checker: cleaner, more usable (via .perl_checker for -exclude's) - perl_checker: more stricter syntax rules diff --git a/perl_checker b/perl_checker index 26a30cb..fd415a4 100755 --- a/perl_checker +++ b/perl_checker @@ -6,7 +6,7 @@ sub begin { @exclude_calls = qw(chomp chop chr crypt hex index lc lcfirst length oct ord pack reverse rindex sprintf substr uc ucfirst pos quotemeta split study abs atan2 cos exp hex int log oct rand sin sqrt srand pop push shift splice unshift grep join map reverse sort unpack delete each exists keys values binmode close closedir dbmclose dbmopen die eof fileno flock format getc print printf read readdir rewinddir seek seekdir select syscall sysread sysseek syswrite tell telldir truncate warn write pack read syscall sysread syswrite unpack vec chdir chmod chown chroot fcntl glob ioctl link lstat mkdir open opendir readlink rename rmdir stat symlink umask unlink utime caller continue die do dump eval exit goto last next redo return sub wantarray caller import local my package use defined dump eval formline local my reset scalar undef wantarray alarm exec fork getpgrp getppid getpriority kill pipe setpgrp setpriority sleep system times wait waitpid do import no package require use bless dbmclose dbmopen package ref tie tied untie use accept bind connect getpeername getsockname getsockopt listen recv send setsockopt shutdown socket socketpair msgctl msgget msgrcv msgsnd semctl semget semop shmctl shmget shmread shmwrite endgrent endhostent endnetent endpwent getgrent getgrgid getgrnam getlogin getpwent getpwnam getpwuid setgrent setpwent endprotoent endservent gethostbyaddr gethostbyname gethostent getnetbyaddr getnetbyname getnetent getprotobyname getprotobynumber getprotoent getservbyname getservbyport getservent sethostent setnetent setprotoent setservent gmtime localtime time times abs bless chomp chr exists formline glob import lc lcfirst map my no prototype qx qw readline readpipe ref sysopen tie tied uc ucfirst untie use qq Dumper packdrake Eth); @exclude_calls{@exclude_calls} = undef; - @exclude_uses = qw(globals diagnostics strict vars lib Carp Config Exporter Socket Locale::GetText CORE POSIX Gtk Data::Dumper CGI Net::FTP Gtk::XmHTML Gtk::Gdk Gtk::Gdk::ImlibImage Newt Newt::Component Newt::Grid DynaLoader IO::Socket Date::Manip packdrake); + @exclude_uses = qw(globals diagnostics strict vars lib Carp Config Exporter Socket Locale::GetText CORE POSIX Gtk Data::Dumper CGI Net::FTP Gtk::XmHTML Gtk::Gdk Gtk::Gdk::ImlibImage Newt Newt::Component Newt::Grid DynaLoader IO::Socket Date::Manip packdrake XML::Parser); while ($ARGV[0] =~ /-I(.*)/) { push @I, $1; @@ -136,6 +136,11 @@ sub get_exports { } sub syntax_warnings { + + if (/\W("\$\w+")/ && !/qq\(/ && !/^\s*case "\$/ && !/\b[A-Z]\w*\s+"\$\w+"/) { + warn_(qq($1 is better written without the double quotes), info()); + } + if (/^\s*my\b[^;]*=\s*(\(\)|undef);/) { warn_(q(no need to initialize variables, it's done by default), info()); } @@ -200,6 +205,16 @@ sub syntax_warnings { } sub syntax_warnings_after_removing_strings_and_regexps { + + + if (/\}->([{\[])/) { + warn_(qq("}->$2" is better written "}$2"), info()); + } + + if (/[\w>}]\[[^\]\[]*\]->([{\[])/) { + warn_(qq("]->$2" is better written "]$2"), info()); + } + if (/([\$@%]\w+=)[^~]/) { warn_(qq(missing space before "=" in $1), info()); } |