diff options
| -rw-r--r-- | MDK/Common/DataStructure.pm | 2 | ||||
| -rw-r--r-- | MDK/Common/File.pm | 113 | ||||
| -rw-r--r-- | MDK/Common/Func.pm | 130 | ||||
| -rw-r--r-- | MDK/Common/String.pm | 58 | ||||
| -rw-r--r-- | MDK/Common/System.pm | 131 | ||||
| -rw-r--r-- | perl-MDK-Common.spec | 5 |
6 files changed, 420 insertions, 19 deletions
diff --git a/MDK/Common/DataStructure.pm b/MDK/Common/DataStructure.pm index d2e1367..ecdb45f 100644 --- a/MDK/Common/DataStructure.pm +++ b/MDK/Common/DataStructure.pm @@ -41,7 +41,7 @@ returns the length of the list. Useful in list (opposed to array) context: sub f { "a", "b" } my $l = listlength f(); -where C<scalar f()> would return "b" +whereas C<scalar f()> would return "b" =item deref(REF) diff --git a/MDK/Common/File.pm b/MDK/Common/File.pm index 834db33..a548237 100644 --- a/MDK/Common/File.pm +++ b/MDK/Common/File.pm @@ -1,3 +1,90 @@ +=head1 NAME + +MDK::Common::File - miscellaneous file/filename manipulation functions + +=head1 SYNOPSIS + + use MDK::Common::File qw(:all); + +=head1 EXPORTS + +=over + +=item dirname(FILENAME) + +=item basename(FILENAME) + +returns the dirname/basename of the file name + +=item cat_(FILENAME) + +returns the file content: in scalar context it returns a single string, in +array context it returns the lines. + +If the file doesn't exist, it returns undef + +=item cat__(FILEHANDLE REF) + +returns the file content: in scalar context it returns a single string, in +array context it returns the lines + +=item output(FILENAME, LIST) + +creates a file and outputs the list (if the file exists, it is clobbered) + +=item linkf(SOURCE, DESTINATION) + +=item symlinkf(SOURCE, DESTINATION) + +=item renamef(SOURCE, DESTINATION) + +same as link/symlink/rename but removes the destination file first + +=item touch(FILENAME) + +ensure the file exists, set the modification time to current time + +=item all(DIRNAME) + +returns all the file in directory (except "." and "..") + +=item glob_(STRING) + +simple version of C<glob>: doesn't handle wildcards in directory (eg: +*/foo.c), nor special constructs (eg: [0-9] or {a,b}) + +=item substInFile { CODE } FILENAME + +executes the code for each line of the file. You can know the end of the file +is reached using C<eof> + +=item concat_symlink(DIRNAME, RELATIVE LINK) + +concat dirname and the symlink and removes "../" if possible: +C<concat_symlink("/usr/bin", "../../bin/ls")> gives "/bin/ls" + +=item expand_symlinks(FILENAME) + +expand the symlinks in the absolute filename: +C<expand_symlinks("/etc/X11/X")> gives "/usr/X11R6/bin/XFree86" + +=item openFileMaybeCompressed(FILENAME) + +opens the file and returns the file handle. If the file is not found, tries to +gunzip the file + .gz + +=item catMaybeCompressed(FILENAME) + +cat_ alike. If the file is not found, tries to gunzip the file + .gz + +=back + +=head1 SEE ALSO + +L<MDK::Common> + +=cut + package MDK::Common::File; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); @@ -7,7 +94,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); sub dirname { local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ } -sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = <F>; wantarray ? @l : join '', @l } +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 linkf { unlink $_[1]; link $_[0], $_[1] } @@ -49,19 +136,17 @@ sub glob_ { sub substInFile(&@) { - my $f = shift; - foreach my $file (@_) { - if (-e $file) { - local @ARGV = $file; - local ($^I, $_) = ''; - while (<>) { &$f($_); print } - } else { - local *F; my $old = select F; # that way eof return true - local $_ = ''; - &$f($_); - select $old; - eval { output($file, $_) }; - } + my ($f, $file) = @_; + if (-e $file) { + local @ARGV = $file; + local ($^I, $_) = ''; + while (<>) { &$f($_); print } + } else { + local *F; my $old = select F; # that way eof return true + local $_ = ''; + &$f($_); + select $old; + eval { output($file, $_) }; } } diff --git a/MDK/Common/Func.pm b/MDK/Common/Func.pm index 1b30a7e..fb7157f 100644 --- a/MDK/Common/Func.pm +++ b/MDK/Common/Func.pm @@ -1,3 +1,131 @@ +=head1 NAME + +MDK::Common::Func - miscellaneous functions + +=head1 SYNOPSIS + + use MDK::Common::Func qw(:all); + +=head1 EXPORTS + +=over + +=item may_apply(CODE REF, SCALAR) + +C<may_apply($f, $v)> is C<$f ? $f-E<gt>($v) : $v> + +=item may_apply(CODE REF, SCALAR, SCALAR) + +C<may_apply($f, $v, $otherwise)> is C<$f ? $f-E<gt>($v) : $otherwise> + +=item if_(BOOL, LIST) + +special constructs to workaround a missing perl feature: +C<if_($b, "a", "b")> is C<$b ? ("a", "b") : ()> + +example of use: C<f("a", if_(arch() =~ /i.86/, "b"), "c")> which is not the +same as C<f("a", arch()=~ /i.86/ && "b", "c")> + +=item if__(SCALAR, LIST) + +if_ alike. Test if the value is defined + +=item fold_left { CODE } LIST + +if you don't know fold_left (aka foldl), don't use it ;p + + fold_left { $::a + $::b } 1, 3, 6 + +gives 10 (aka 1+3+6) + +=item mapn { CODE } ARRAY REF, ARRAY REF, ... + +map lists in parallel: + + mapn { $_[0] + $_[1] } [1, 2], [2, 4] # gives 3, 6 + mapn { $_[0] + $_[1] + $_[2] } [1, 2], [2, 4], [3, 6] gives 6, 12 + +=item mapn_ { CODE } ARRAY REF, ARRAY REF, ... + +mapn alike. The difference is what to do when the lists have not the same +length: mapn takes the minimum common elements, mapn_ takes the maximum list +length and extend the lists with undef values + +=item map_index { CODE } LIST + +just like C<map>, but set C<$::i> to the current index in the list: + + map_index { "$::i $_" } "a", "b" + +gives "0 a", "1 b" + +=item grep_index { CODE } LIST + +just like C<grep>, but set C<$::i> to the current index in the list: + + grep_index { $::i == $_ } 0, 2, 2, 3 + +gives (0, 2, 3) + +=item find_index { CODE } LIST + +returns the index of the first element where CODE returns true + + find_index { /foo/ } "fo", "fob", "foobar", "foobir" + +gives 2 + +=item map_each { CODE } HASH + +returns the list of results of CODE applied with $::a (key) and $::b (value) + + map_each { "$::a is $::b" } 1=>2, 3=>4 + +gives "1 is 2", "3 is 4" + +=item grep_each { CODE } HASH + +returns the hash key/value for which CODE applied with $::a (key) and $::b +(value) is true: + + grep_each { $::b == 2 } 1=>2, 3=>4, 4=>2 + +gives 1=>2, 4=>2 + +=item before_leaving { CODE } + +the code will be executed when the current block is finished + + # create $tmp_file + my $b = before_leaving { unlink $tmp_file }; + # some code that may throw an exception, the "before_leaving" ensures the + # $tmp_file will be removed + +=item cdie(SCALAR) + +aka I<conditional die>. If a C<cdie> is catched, the execution continues +B<after> the cdie, not where it was catched (as happens with die & eval) + +If a C<cdie> is not catched, it mutates in real exception that can be catched +with C<eval> + +cdie is useful when you want to warn about something weird, but when you can +go on. In that case, you cdie "something weird happened", and the caller +decide wether to go on or not. Especially nice for libraries. + +=item catch_cdie { CODE1 } sub { CODE2 } + +If a C<cdie> occurs while executing CODE1, CODE2 is executed. If CODE2 +returns true, the C<cdie> is catched. + +=back + +=head1 SEE ALSO + +L<MDK::Common> + +=cut + package MDK::Common::Func; use MDK::Common::Math; @@ -29,7 +157,7 @@ sub fold_left(&@) { my ($f, $initial, @l) = @_; local ($::a, $::b); $::a = $initial; - foreach $::b (@_) { $::a = &$f() } + foreach $::b (@l) { $::a = &$f() } $::a } diff --git a/MDK/Common/String.pm b/MDK/Common/String.pm index 74b8e2b..3faa270 100644 --- a/MDK/Common/String.pm +++ b/MDK/Common/String.pm @@ -1,3 +1,61 @@ +=head1 NAME + +MDK::Common::String - formatting functions + +=head1 SYNOPSIS + + use MDK::Common::String qw(:all); + +=head1 EXPORTS + +=over + +=item bestMatchSentence(STRING, LIST) + +finds in the list the best corresponding string + +=item formatList(INT, LIST) + +if the list size is bigger than INT, replace the remaining elements with "...". + +formatList(3, qw(a b c d e)) # => "a, b, c, ..." + +=item formatError(STRING) + +the string is something like "error at foo.pl line 2" that you get when +catching an exception. formatError will remove the "at ..." so that you can +nicely display the returned string to the user + +=item formatTimeRaw(TIME) + +the TIME is an epoch as returned by C<time>, the formatted time looks like "23:59:00" + +=item formatLines(STRING) + +remove "\n"s when the next line doesn't start with a space. Otherwise keep +"\n"s to keep the indentation. + +=item formatAlaTeX(STRING) + +handle carriage return just like LaTeX: merge lines that are not separated by +an empty line + +=item warp_text(STRING, INT) + +return a list of lines which do not exceed INT characters + +=item warp_text(STRING) + +warp_text at a default width (80) + +=back + +=head1 SEE ALSO + +L<MDK::Common> + +=cut + package MDK::Common::String; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); diff --git a/MDK/Common/System.pm b/MDK/Common/System.pm index d383a1f..22fc675 100644 --- a/MDK/Common/System.pm +++ b/MDK/Common/System.pm @@ -1,3 +1,130 @@ +=head1 NAME + +MDK::Common::System - formatting functions + +=head1 SYNOPSIS + + use MDK::Common::System qw(:all); + +=head1 EXPORTS + +=over + +=item %compat_arch + +architecture compatibility mapping (eg: k6 => i586, k7 => k6 ...) + +=item %printable_chars + +7 bit ascii characters + +=item $sizeof_int + +sizeof(int) + +=item $bitof_int + +$sizeof_int * 8 + +=item typeFromMagic(FILENAME, LIST) + +find the first corresponding magic in FILENAME. eg of LIST: + + [ 'empty', 0, "\0\0\0\0" ], + [ 'grub', 0, "\xEBG", 0x17d, "stage1 \0" ], + [ 'lilo', 0x2, "LILO" ], + +where each entry is [ magic_name, offset, string, offset, string, ... ]. + +=item list_passwd() + +return the list of users as given by C<getpwent> (see perlfunc) + +=item list_home() + +return the list of home (eg: /home/foo, /home/pixel, ...) + +=item list_skels() + +return the directories where we can find dot files: homes, /root and /etc/skel + +=item syscall_(NAME, PARA) + +calls the syscall NAME + +=item psizeof(STRING) + +useful to know the length of a C<pack> format string. + + psizeof("I I I C C S") = 4 + 4 + 4 + 1 + 1 + 2 = 16 + +=item availableMemory() + +size of swap + memory + +=item availableRamMB() + +size of RAM as reported by the BIOS (it is a round number that can be +displayed or given as "mem=128M" to the kernel) + +!! "mem=..." is dangerous in 2.4 kernels + +=item gettimeofday() + +returns the epoch in microseconds + +=item unix2dos(STRING) + +takes care of CR/LF translation + +=item getVarsFromSh(FILENAME) + +returns a hash associating shell variables to their value. useful for config +files such as /etc/sysconfig files + +=item setVarsInSh(FILENAME, HASH REF) + +write file in shell format association a shell variable + value for each +key/value + +=item setVarsInSh(FILENAME, HASH REF, LIST) + +restrict the fields that will be printed to LIST + +=item setVarsInShMode(FILENAME, INT, HASH REF, LIST) + +like setVarsInSh with INT being the chmod value for the config file + +=item setVarsInCsh(FILENAME, HASH REF, LIST) + +same as C<setVarsInSh> for csh format + +=item template2file(FILENAME_IN, FILENAME_OUT, HASH) + +read in a template file, replace keys @@@key@@@ with value, save it in out +file + +=item template2userfile(PREFIX, FILENAME_IN, FILENAME_OUT, BOOL, HASH) + +read in a template file, replace keys @@@key@@@ with value, save it in every homes. +If BOOL is true, overwrite existing files. FILENAME_OUT must be a relative filename + +=item update_gnomekderc(FILENAME, STRING, HASH) + +modifies GNOME-like and KDE-like config files (aka windows-like). +If the category doesn't exist, it creates it. eg: + + update_gnomekderc("/etc/skels/.kderc", 'KDE', + kfmIconStyle => "Large") + +=back + +=head1 SEE ALSO + +L<MDK::Common> + +=cut + package MDK::Common::System; use MDK::Common::Math; @@ -6,7 +133,7 @@ use MDK::Common::File; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK %compat_arch $printable_chars $sizeof_int $bitof_int); #); @ISA = qw(Exporter); -@EXPORT_OK = qw(%compat_arch $printable_chars $sizeof_int $bitof_int typeFromMagic list_passwd list_home list_skels syscall_ psizeof availableMemory availableRamMB gettimeofday unix2dos getVarsFromSh setVarsInSh setVarsInShMode setVarsInCsh template2file template2userfile update_userkderc); #); +@EXPORT_OK = qw(%compat_arch $printable_chars $sizeof_int $bitof_int typeFromMagic list_passwd list_home list_skels syscall_ psizeof availableMemory availableRamMB gettimeofday unix2dos getVarsFromSh setVarsInSh setVarsInShMode setVarsInCsh template2file template2userfile update_gnomekderc); #); %EXPORT_TAGS = (all => [ @EXPORT_OK ]); @@ -156,7 +283,7 @@ sub template2userfile { m|/home/(.+?)/| and chown(getpwnam($1), getgrnam($1), $_); } } -sub update_userkderc { +sub update_gnomekderc { my ($file, $category, %subst) = @_; output $file, diff --git a/perl-MDK-Common.spec b/perl-MDK-Common.spec index 21716c9..bcf2471 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 %define version THEVERSION -%define release 0.2mdk +%define release 0.3mdk %define perl_sitelib %(eval "`perl -V:installsitelib`"; echo $installsitelib) Summary: Various simple functions @@ -39,6 +39,9 @@ rm -rf $RPM_BUILD_ROOT # MODIFY IN THE CVS: cvs.mandrakesoft.com:/cooker soft/perl-MDK-Common %changelog +* Fri Aug 3 2001 Pixel <pixel@mandrakesoft.com> 1.0-0.3mdk +- much doc added + * Wed Jul 25 2001 Pixel <pixel@mandrakesoft.com> 1.0-0.2mdk - another pre-release: some doc added, some fixes |