aix-pm-cvs — CVS commit messages

[aix-pm-cvs] hacks/misc fillup.pl,1.2,1.3

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/hacks/misc
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7676

Modified Files:
	fillup.pl 
Log Message:
redesigned command line option handling

Index: fillup.pl
===================================================================
RCS file: /cvsroot/aix-pm/hacks/misc/fillup.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** fillup.pl	26 Jul 2013 10:13:45 -0000	1.2
--- fillup.pl	8 Jul 2014 16:47:14 -0000	1.3
***************
*** 15,21 ****
    -i <input-file>
    -o <target-directory>
-   -dryrun ... only show what would be done
-   -doit   ... perform the copy
    -c <count> ... only copy that many times
  
  =head1 NOTES
--- 15,21 ----
    -i <input-file>
    -o <target-directory>
    -c <count> ... only copy that many times
+   --dryrun ... only show what would be done
+   --doit   ... perform the copy
  
  =head1 NOTES
***************
*** 27,31 ****
  =head1 BUGS
  
! persuably.
  
  =head1 AUTHOR
--- 27,31 ----
  =head1 BUGS
  
! presumably.
  
  =head1 AUTHOR
***************
*** 42,52 ****
  my $cnt= -1;
  
  while (my $arg= shift (@ARGV))
  {
!   if ($arg eq '-i') { $input= shift (@ARGV); }
!   elsif ($arg eq '-o') { $output= shift (@ARGV); }
!   elsif ($arg eq '-dryrun' || $arg eq '-n') { $dryrun= 1; }
!   elsif ($arg eq '-doit') { $dryrun= 0; }
!   elsif ($arg eq '-c') { $cnt= shift (@ARGV); }
    else { &usage; }
  }
--- 42,71 ----
  my $cnt= -1;
  
+ my @PAR= ();
  while (my $arg= shift (@ARGV))
  {
!      if ($arg eq '--') { push (@PAR, @ARGV); }
!   elsif ($arg =~ /^--(.+)/)
!   {
!     my ($opt, $val)= split ('=', $1, 2);
! 
!        if ($opt eq 'count') { $cnt= $val; }
!     elsif ($opt eq 'doit')  { $dryrun= 0; }
!     elsif ($opt eq 'dryrun' || $opt eq 'dry-run') { $dryrun= 1; }
!     elsif ($opt eq 'output') { $output= $val; }
!     else { usage(); }
!   }
!   elsif ($arg =~ /^-(.+)/)
!   {
!     my @opts= split ('', $1);
!     foreach my $opt (@opts)
!     {
!          if ($opt eq 'c') { $cnt=    shift (@ARGV); }
!       elsif ($opt eq 'i') { $input=  shift (@ARGV); }
!       elsif ($opt eq 'o') { $output= shift (@ARGV); }
!       elsif ($opt eq 'n') { $dryrun= 1; }
!       else { usage(); }
!     }
!   }
    else { &usage; }
  }
***************
*** 90,98 ****
    }
  
!   my $c= "cp '$input' '$dest'";
  
    if ($dryrun)
    {
!     print $c, "\n";
      if ($i >= 20)
      {
--- 109,117 ----
    }
  
!   my @c= ('cp', $input, $dest);
  
    if ($dryrun)
    {
!     print join (' ', @c), "\n";
      if ($i >= 20)
      {
***************
*** 103,108 ****
    else
    {
!     my $rc= system ($c);
!     print "$c, rc='$rc'\n";
      if ($rc)
      {
--- 122,127 ----
    else
    {
!     my $rc= system (@c);
!     print join (' ', @c), ", rc='$rc'\n";
      if ($rc)
      {

[aix-pm-cvs] hacks/linux/aptitude .cvsignore, NONE, 1.1 x1.pl, NONE, 1.1

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/hacks/linux/aptitude
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv32200/hacks/linux/aptitude

Added Files:
	.cvsignore x1.pl 
Log Message:
write aptitude package information into a CSV file

--- NEW FILE: .cvsignore ---
packages.csv

--- NEW FILE: x1.pl ---
#!/usr/bin/perl 

=head1 PURPOSE

Test script for the package Debian::Aptitude .

Reads /var/lib/aptitude/pkgstates and saves it in CSV format.

=cut

use strict;

use Util::Simple_CSV;

use Data::Dumper;
$Data::Dumper::Indent= 1;

use lib 'lib';
use Debian::Aptitude;

my $pkg_states= '/var/lib/aptitude/pkgstates';

my $p= new Debian::Aptitude;
my $pkgs= $p->parse ($pkg_states);
# print "p: ", Dumper ($p);

my @columns= (qw(Package Architecture Unseen State Dselect-State Remove-Reason));

my $csv= new Util::Simple_CSV('no_array' => 1);

$csv->define_columns(@columns);
print "csv: ", Dumper ($csv);

$csv->{'data'}= $pkgs;
sub check
{
  my ($array_ref, $hash_ref)= @_;
  # print "hr: ", Dumper($hash_ref);
  return ($hash_ref->{'State'} == 2) ? 1 : 0;
}

# $csv->filter(\&check);
# print "csv: ", Dumper ($csv);
$csv->sort('Package');

$csv->save_csv_file('filename' => 'packages.csv');

exit (0);

[aix-pm-cvs] hacks/linux/aptitude/lib/Debian - New directory

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/hacks/linux/aptitude/lib/Debian
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv31781/aptitude/lib/Debian

Log Message:
Directory /cvsroot/aix-pm/hacks/linux/aptitude/lib/Debian added to the repository

[aix-pm-cvs] hacks/linux/aptitude/lib - New directory

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/hacks/linux/aptitude/lib
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv31757/aptitude/lib

Log Message:
Directory /cvsroot/aix-pm/hacks/linux/aptitude/lib added to the repository

[aix-pm-cvs] hacks/linux/aptitude - New directory

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/hacks/linux/aptitude
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv31714/aptitude

Log Message:
Directory /cvsroot/aix-pm/hacks/linux/aptitude added to the repository

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.42,1.43

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv19355/modules/util/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
extended view as string result

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.42
retrieving revision 1.43
diff -C2 -d -r1.42 -r1.43
*** Simple_CSV.pm	26 Mar 2014 10:10:13 -0000	1.42
--- Simple_CSV.pm	2 May 2014 13:22:40 -0000	1.43
***************
*** 911,915 ****
  =head2 $csv->extended_view ($columns)
  
! show records in "extended" format, similar to pgsql
  
  =cut
--- 911,915 ----
  =head2 $csv->extended_view ($columns)
  
! show records in "extended" format, similar to psql
  
  =cut
***************
*** 945,949 ****
    {
      printf ("-[ RECORD %d ]----------------------\n", ++$num);
!     # TODO: psql uses a slighty different format for the record separator
  
      foreach my $c (@used_columns)
--- 945,949 ----
    {
      printf ("-[ RECORD %d ]----------------------\n", ++$num);
!     # TODO: psql uses a slightly different format for the record separator
  
      foreach my $c (@used_columns)
***************
*** 958,961 ****
--- 958,996 ----
  }
  
+ sub _sprintf_extended_view
+ {
+   my $x= shift;
+ 
+   return undef unless (defined ($x));
+ 
+   my @used_columns= @{$x->{'columns'}};
+   my $lng= 0;
+   foreach my $c (@used_columns)
+   {
+     $lng= length ($c) if (length($c) > $lng);
+   }
+   my $fmt= sprintf ("%%-%ds%s%%s\n", $lng, $border_inter);
+ 
+   # print "lng='$lng' fmt=[$fmt]\n";
+   # print 'x=', Dumper ($x), "\n";
+   my $num= 0;
+   my $res= '';
+   foreach my $d (@{$x->{'data'}})
+   {
+     $res .= sprintf ("-[ RECORD %d ]----------------------\n", ++$num);
+     # TODO: psql uses a slightly different format for the record separator
+ 
+     foreach my $c (@used_columns)
+     {
+       if (exists ($d->{$c})) # TODO: flag to print even empty fields
+       {
+         $res .= sprintf ($fmt, $c, $d->{$c});
+       }
+     }
+   }
+ 
+   $res;
+ }
+ 
  sub get_extended_view
  {

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.41,1.42

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv11148/modules/util/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
added option to print all fields in extended view

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -C2 -d -r1.41 -r1.42
*** Simple_CSV.pm	3 Jan 2014 16:10:17 -0000	1.41
--- Simple_CSV.pm	26 Mar 2014 10:10:13 -0000	1.42
***************
*** 919,924 ****
    my $csv= shift;
    my $columns= shift;
  
!   my $x= $csv->get_extended_view ($columns);
    &_show_extended_view ($x);
  }
--- 919,925 ----
    my $csv= shift;
    my $columns= shift;
+   my $all= shift;
  
!   my $x= $csv->get_extended_view ($columns, $all);
    &_show_extended_view ($x);
  }
***************
*** 961,964 ****
--- 962,966 ----
    my $csv= shift;
    my $columns= shift;
+   my $all= shift;
  
    # get a hash of column names to look for, if nothing defined, take all columns
***************
*** 976,980 ****
        {
          my $v= $d->{$c};
! 	if (length ($v))
          { # we are looking for a colmun named c and if it has a defined content => take it!
            $item->{$c}= $v;
--- 978,982 ----
        {
          my $v= $d->{$c};
! 	if (length ($v) || $all)
          { # we are looking for a colmun named c and if it has a defined content => take it!
            $item->{$c}= $v;

[aix-pm-cvs] modules/util/Util JSON.pm,1.1,1.2

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5625/modules/util/Util

Modified Files:
	JSON.pm 
Log Message:
added code to write Perl structure to a JSON file, including blessed object

Index: JSON.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/JSON.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** JSON.pm	3 Dec 2013 15:35:18 -0000	1.1
--- JSON.pm	15 Jan 2014 19:45:17 -0000	1.2
***************
*** 4,8 ****
  use strict;
  
! use JSON;
  
  sub read_json_file
--- 4,8 ----
  use strict;
  
! use JSON -convert_blessed_universally;
  
  sub read_json_file
***************
*** 18,20 ****
--- 18,38 ----
  }
  
+ sub write_json_file
+ {
+   my $json_fnm= shift;
+   my $x= shift;
+ 
+   print "json_fnm=[$json_fnm]\n";
+   # print "x: ", main::Dumper ($x);
+ 
+   my $json= new JSON;
+   my $json_str= $json->allow_blessed->convert_blessed->encode($x);
+ 
+   open (J, '>:utf8', $json_fnm) or die ("can not write to [$json_fnm]");
+   syswrite (J, $json_str);
+   close (J);
+ 
+   1;
+ }
+ 
  1;

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.40,1.41

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv1540/modules/util/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
code beautify

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -C2 -d -r1.40 -r1.41
*** Simple_CSV.pm	3 Jan 2014 09:07:17 -0000	1.40
--- Simple_CSV.pm	3 Jan 2014 16:10:17 -0000	1.41
***************
*** 41,53 ****
      'separator' => $CSV_SEPARATOR,
      'line_end' => $CSV_LINE_END,
!     'updates' => 0,
!     'verbose' => 0,
!     'no_hash' => 0,
      'no_array' => 0,
      'filename' => undef,  # name of file read
!     'merged' => undef,    # array with names of merged files
  
!     'columns' => undef,   # list of column names
!     'index' => undef,     # hash of column names
      'column_count' => 0,  # number of columns defined
  
--- 41,53 ----
      'separator' => $CSV_SEPARATOR,
      'line_end' => $CSV_LINE_END,
!     'updates'  => 0,
!     'verbose'  => 0,
!     'no_hash'  => 0,
      'no_array' => 0,
      'filename' => undef,  # name of file read
!     'merged'   => undef,  # array with names of merged files
  
!     'columns'  => undef,  # list of column names
!     'index'    => undef,  # hash of column names
      'column_count' => 0,  # number of columns defined
  
***************
*** 409,413 ****
      my ($row, $data);
  
!     $row= shift (@old_rows) unless ($no_array);
      $data= shift (@old_data) unless ($no_hash);
  
--- 409,413 ----
      my ($row, $data);
  
!     $row=  shift (@old_rows) unless ($no_array);
      $data= shift (@old_data) unless ($no_hash);
  
***************
*** 417,426 ****
      if ($res == 1)
      {
!       push (@new_rows, $row) unless ($no_array);
        push (@new_data, $data) unless ($no_hash);
      }
      else
      {
!       push (@dropped_rows, $row) unless ($no_array);
        push (@dropped_data, $data) unless ($no_hash);
      }
--- 417,426 ----
      if ($res == 1)
      {
!       push (@new_rows, $row)  unless ($no_array);
        push (@new_data, $data) unless ($no_hash);
      }
      else
      {
!       push (@dropped_rows, $row)  unless ($no_array);
        push (@dropped_data, $data) unless ($no_hash);
      }

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.39,1.40

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv3828/modules/util/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
sort() function was only working for array part of the csv, added code to sort array as well as hash portion

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -C2 -d -r1.39 -r1.40
*** Simple_CSV.pm	10 Oct 2013 16:30:17 -0000	1.39
--- Simple_CSV.pm	3 Jan 2014 09:07:17 -0000	1.40
***************
*** 11,16 ****
  use Util::hexdump;
  
- =pod
- 
  =head1 NAME
  
--- 11,14 ----
***************
*** 19,23 ****
  =head1 SYNOPSIS
  
! =head2 my $obj= new Util::Simple_CSV (paramters);
  
  parameters:
--- 17,21 ----
  =head1 SYNOPSIS
  
! =head2 my $csv= new Util::Simple_CSV (paramters);
  
  parameters:
***************
*** 28,32 ****
  =cut
  
! my $VERSION= 0.06;
  
  my $CSV_SEPARATOR= ';';
--- 26,30 ----
  =cut
  
! my $VERSION= 0.07;
  
  my $CSV_SEPARATOR= ';';
***************
*** 109,115 ****
  }
  
! =pod
! 
! =head2 $obj->rename ($new_filename)
  
  set a new filename for this csv
--- 107,111 ----
  }
  
! =head2 $csv->rename ($new_filename)
  
  set a new filename for this csv
***************
*** 125,131 ****
  }
  
! =pod
! 
! =head2 $obj->get_csv_file ($filename)
  
  Read contents of $filename into already existing CSV object.  The data
--- 121,125 ----
  }
  
! =head2 $csv->get_csv_file ($filename)
  
  Read contents of $filename into already existing CSV object.  The data
***************
*** 153,159 ****
  }
  
! =pod
! 
! =head2 $obj->load_csv_file ($filename)
  
  Read contents of $filename into already existing CSV Object.  The data
--- 147,151 ----
  }
  
! =head2 $csv->load_csv_file ($filename)
  
  Read contents of $filename into already existing CSV Object.  The data
***************
*** 331,337 ****
  }
  
! =pod
! 
! =head2 $obj->define_columns (@column_names)
  
  defines the list of columns of the current csv file
--- 323,327 ----
  }
  
! =head2 $csv->define_columns (@column_names)
  
  defines the list of columns of the current csv file
***************
*** 352,358 ****
  }
  
! =pod
! 
! =head2 $obj->add_row (@data)
  
  add another data line to csv object
--- 342,346 ----
  }
  
! =head2 $csv->add_row (@data)
  
  add another data line to csv object
***************
*** 381,387 ****
  }
  
! =pod
! 
! =head2 ($dropped_rows, $dropped_data)= $obj->filter ($check_function);
  
  $check_function is a code reference to a function that expects
--- 369,373 ----
  }
  
! =head2 ($dropped_rows, $dropped_data)= $csv->filter ($check_function);
  
  $check_function is a code reference to a function that expects
***************
*** 447,452 ****
  }
  
- =pod
- 
  =head2 $csv->find (field_name, patterns);
  
--- 433,436 ----
***************
*** 481,488 ****
  }
  
! 
! =pod
! 
! =head2 $obj->get_columns (names)
  
  retrieve all elements of named columns as an list of array references
--- 465,469 ----
  }
  
! =head2 $csv->get_columns (names)
  
  retrieve all elements of named columns as an list of array references
***************
*** 512,518 ****
  }
  
! =pod
! 
! =head2 $obj->get_column (name)
  
  retrieve all elements of named column
--- 493,497 ----
  }
  
! =head2 $csv->get_column (name)
  
  retrieve all elements of named column
***************
*** 538,544 ****
  }
  
! =pod
! 
! =head2 $obj->merge_csv_file ($filename)
  
  Merge contents of $filename into already existing CSV Object.  If
--- 517,521 ----
  }
  
! =head2 $csv->merge_csv_file ($filename)
  
  Merge contents of $filename into already existing CSV Object.  If
***************
*** 573,579 ****
  }
  
! =pod
! 
! =head2 $obj->merge ($other_obj)
  
  append contents of $other_object to $obj
--- 550,554 ----
  }
  
! =head2 $csv->merge ($other_obj)
  
  append contents of $other_object to $obj
***************
*** 665,671 ****
  }
  
! =pod
! 
! =head2 $obj->save_csv_file ((attrib => value)*)
  
  save data to CSV file
--- 640,644 ----
  }
  
! =head2 $csv->save_csv_file ((attrib => value)*)
  
  save data to CSV file
***************
*** 747,752 ****
  }
  
- =pod
- 
  =head2 $csv->index ($field, $to_lower)
  
--- 720,723 ----
***************
*** 801,804 ****
--- 772,782 ----
  }
  
+ =head2 $csv->sort ($field, $lower, $numeric)
+ 
+ Sort the CSV data according to $field which might be converted to lower
+ case or treated as numeric value.
+ 
+ =cut
+ 
  sub sort
  {
***************
*** 808,815 ****
    my $numeric= shift;
  
!   print "sorting by field=[$field]\n";
    my ($cnt, $idx)= $csv->index_array ($field, $lower);
  
    return undef unless ($cnt);
  
    my @new_rows= ();
--- 786,810 ----
    my $numeric= shift;
  
!   my $res1= $csv->sort_hash  ($field, $lower, $numeric);
!   my $res2= $csv->sort_array ($field, $lower, $numeric);
! 
!   ($res1, $res2);
! }
! 
! sub sort_array
! {
!   my $csv= shift;
!   my $field= shift;
!   my $lower= shift;
!   my $numeric= shift;
! 
!   print "sorting (array) by field=[$field]\n" if ($csv->{'verbose'});
!   return undef if ($csv->{'no_array'});
! 
    my ($cnt, $idx)= $csv->index_array ($field, $lower);
  
+ print "cnt=[$cnt]\n";
    return undef unless ($cnt);
+ print "doing the sort ...\n";
  
    my @new_rows= ();
***************
*** 828,831 ****
--- 823,857 ----
  }
  
+ sub sort_hash
+ {
+   my $csv= shift;
+   my $field= shift;
+   my $lower= shift;
+   my $numeric= shift;
+ 
+   print "sorting (hash) by field=[$field]\n" if ($csv->{'verbose'});
+   return undef if ($csv->{'no_hash'});
+ 
+   my ($cnt, $idx)= $csv->index ($field, $lower);
+ # print "cnt=[$cnt]\n";
+   return undef unless ($cnt);
+ # print "doing the sort ...\n";
+   # print "idx: ", main::Dumper ($idx);
+ 
+   my @new_data= ();
+   if ($numeric)
+   {
+     foreach my $k (sort { $a <=> $b } keys %$idx) { push (@new_data, @{$idx->{$k}}); }
+   }
+   else
+   {
+     foreach my $k (sort { $a cmp $b } keys %$idx) { push (@new_data, @{$idx->{$k}}); }
+   }
+   my $d= $csv->{'data'};
+   # print "new_rows: ", main::Dumper (\@new_data);
+   $csv->{'data'}= \@new_data;
+   $d;
+ }
+ 
  sub split_wiki_header
  {
***************
*** 846,851 ****
  }
  
! # replace all print_refs by Dumper calls
  
  sub print_refs
  {
--- 872,878 ----
  }
  
! =begin comment
  
+ # replace all print_refs by Dumper calls
  sub print_refs
  {
***************
*** 857,861 ****
  }
  
! =pod
  
  =head2 $csv->show_header
--- 884,889 ----
  }
  
! =end comment
! =cut
  
  =head2 $csv->show_header
***************
*** 881,886 ****
  }
  
- =pod
- 
  =head2 $csv->extended_view ($columns)
  
--- 909,912 ----
***************
*** 980,985 ****
  __END__
  
- =pod
- 
  =head1 TODO
  
--- 1006,1009 ----
***************
*** 1007,1011 ****
  =head1 Copyright
  
! Copyright (c) 2006..2013 Gerhard Gonter.  All rights reserved.  This
  is free software; you can redistribute it and/or modify it under
  the same terms as Perl itself.
--- 1031,1035 ----
  =head1 Copyright
  
! Copyright (c) 2006..2014 Gerhard Gonter.  All rights reserved.  This
  is free software; you can redistribute it and/or modify it under
  the same terms as Perl itself.

[aix-pm-cvs] modules/util/Util MongoDB.pm,1.2,1.3

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv19523/modules/util/Util

Modified Files:
	MongoDB.pm 
Log Message:
added some POD

Index: MongoDB.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/MongoDB.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** MongoDB.pm	11 Nov 2013 02:57:54 -0000	1.2
--- MongoDB.pm	2 Jan 2014 20:23:34 -0000	1.3
***************
*** 7,10 ****
--- 7,25 ----
  use MongoDB;
  
+ =head2 my ($mongo_db, $mongo_col)= Util::MongoDB::connect ($config, $col_name)
+ 
+ Retrieve MongoDB parameters from $config and connect to it and open named collection, if specified.
+ 
+ $config is a hash which provides the fillowing keys:
+  * host
+  * db: Name of the MongoDB
+  * user
+  * pass
+ 
+ optionally:
+  * port can currently not specified
+ 
+ =cut
+ 
  sub connect
  {
***************
*** 12,22 ****
    my $col_name= shift;
  
!     my $m= MongoDB::Connection->new(host => $mdb->{'host'});
!     # print "m=[$m]\n";
!     unless (defined ($m))
!     {
  DIE:
        die "could not connect to MongoDB: ", main::Dumper ($mdb);
!     }
  
      my $r= $m->authenticate($mdb->{'db'}, $mdb->{'user'}, $mdb->{'pass'});
--- 27,40 ----
    my $col_name= shift;
  
!   my %c= ( host => $mdb->{'host'} );
!   $c{'port'}= $mdb->{'port'} if (exists ($mdb->{'port'}));
! 
!   my $m= MongoDB::Connection->new(%c);
!   # print "m=[$m]\n";
!   unless (defined ($m))
!   {
  DIE:
        die "could not connect to MongoDB: ", main::Dumper ($mdb);
!   }
  
      my $r= $m->authenticate($mdb->{'db'}, $mdb->{'user'}, $mdb->{'pass'});

[aix-pm-cvs] modules/util/Util Linux_lvm.pm,NONE,1.1

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7438/modules/util/Util

Added Files:
	Linux_lvm.pm 
Log Message:
playing around with aspects of Linux filesystems

--- NEW FILE: Linux_lvm.pm ---
#!/usr/bin/perl
# $Id: Linux_lvm.pm,v 1.1 2014/01/02 11:25:33 gonter Exp $

=pod

=head1 NAME

chfs.pl  --  change filesystem properties

=head1 USAGE

chfs.pl -a size=+I<n>I<S> F<path>

Write the commands necessary to expand the filesystem F<path> by adding
I<n> units of I<S> (K, M, G, T) bytes (1K= 1024 bytes).

=cut

package Util::Linux_lvm;

use strict;

use Data::Dumper;
$Data::Dumper::Indent= 1;

my @paths= qw(/usr/sbin /sbin);

my @caller= caller ();
# print "caller=[",join (':', @caller),"]\n";
# __PACKAGE__->main if (!defined (@caller) || ($caller[0] eq 'main' && $caller[1] eq '-'));
__PACKAGE__->main if (!defined (@caller));
__PACKAGE__->test if (($caller[0] eq 'main' && $caller[1] eq '-'));

sub new
{
  my $class= shift;
  bless {}, $class;
}

sub test
{
  print Dumper (\%main::);
}

sub main
{
  my @pgm= split ('/', $0);
  my $pgm= pop (@pgm);

  # print "b=[", $pgm, "]\n";

     if ($pgm eq 'chfs')    { main_fs1 ('chfs'); }
  elsif ($pgm eq 't_df')    { test_df (); }
  elsif ($pgm eq 't_mount') { test_mount (); }
  elsif ($pgm eq 't_gg1')   { test_gg1 (); }
  elsif ($pgm eq 'tunefs')  { main_tunefs (); }
  else { &usage; }
}

sub test_mount
{
  my $fs= &get_mount ();
  print 'fs=', Dumper ($fs), "\n";
}

sub test_df
{
  my $fs= &get_df ();
  print 'fs=', Dumper ($fs), "\n";
}

sub test_gg1
{
  my $fs= new Util::Linux_lvm;
  $fs->get_mount ();
  $fs->get_df ();
  print "fs=[$fs]: ", Dumper ($fs), "\n";
}

sub main_tunefs
{
  my @PARS;
  while (defined (my $arg= shift (@ARGV)))
  {
      push (@PARS, $arg);
  }

  foreach my $fs_name (@PARS)
  {
    my $x= get_tunefs ($fs_name);
print "tunefs: ", Dumper ($x);
  }
}

sub main_fs1
{
  my $pgm= shift;

  my @PARS;
  my $attr= ();
  while (defined (my $arg= shift (@ARGV)))
  {
    if ($arg =~ /^-/)
    {
      if ($arg eq '-a')
      {
        my ($an, $av)= split ('=', shift (@ARGV), '2');
        $attr->{$an}= $av;
      }
    }
    else
    {
      push (@PARS, $arg);
    }
  }

  my $fs= &get_mount ();
  ## print 'fs=', Dumper ($fs), "\n";
  ## print 'attr=', Dumper ($attr), "\n";

  my $fs_name= shift (@PARS) or &usage ('no fs name');

  my $fs_p= $fs->{$fs_name};

  if ($pgm eq 'chfs') { &chfs ($fs_p, $attr); }

  return 0;
}

sub usage
{
  my $msg= shift;
  print $msg, "\n";
  print <<EOX;
usage: $0 -a attr=value filesystem

attribs:
size=+3G

Examples:
  chfs.pl -a size=+5g /bla
EOX
  exit;
}

sub chfs
{
  my $fs_p= shift or &usage ('unknown fs');;
  my $attr= shift;

  if (exists ($attr->{'size'}))
  {
    my $sz= $attr->{'size'};
    if ($sz =~ /^\+?(\d+)[GM]$/)
    {
      my $dv= $fs_p->{'dev'};
      my $ty= $fs_p->{'type'};
      # hmm: /dev/mapper/uservg-user3lv
      my $lv_name;

      if ($dv =~ m#/dev/mapper/([\w]+)-([\w]+)$#)
      {
        my ($vg, $lv)= ($1, $2);
        $lv_name= join ('/', '/dev', $vg, $lv);
      }
      elsif ($dv =~ m#/dev/mapper/(base--os)-([\w]+)$#)
      {
        my ($vg, $lv)= ('base-os', $2); # Ubuntu :-/
        $lv_name= join ('/', '/dev', $vg, $lv);
        # TODO: is there a general rule about this name scheme?
      }
      else
      {
        print "device name '$dv' not recognized!\n";
        exit (1);
      }

      my $c1= &locate_binary ('lvextend') . " -L '$sz' '$lv_name'";
      my $c2;
      if ($ty eq 'ext3' || $ty eq 'ext4')
      {
        $c2= &locate_binary ('resize2fs') . " -p '$lv_name'";
      }
      elsif ($ty eq 'xfs')
      {
        $c2= &locate_binary ('xfs_growfs') . " '$lv_name'";
      }
      else
      {
        print "unknown filesystem type '$ty' for '$dv'\n";
        exit (3);
      }

      print "# perform these commands:\n";
      print $c1, "\n";
      print $c2, "\n";
    }
    else
    {
      &usage ("size not known '$sz'");
    }

  }
}

sub get_mount
{
  my $self= shift;
  $self= {} unless (defined ($self));

  my @mount= split (/\n/, `/bin/mount`);
  my %fs= ();
  foreach my $l (@mount)
  {
    ## print "# >>> l='$l'\n";

# /dev/mapper/uservg-user0lv on /u/user0 type ext3 (rw,_netdev,acl,usrquota,grpquota)
    if ($l =~ /^(\S+)\s+on\s+(.+)\s+type\s+(\S+)\s+\(([^)]+)\)$/)
    {
      my ($dev, $fs, $ty, $opts)= ($1, $2, $3, $4);
      my @opts= split (/,/, $opts);
      $self->{$fs}=
      {
        'dev'  => $dev,
        'fs'   => $fs,
        'type' => $ty,
        'opts' => \@opts,
      };
    }

  }

  $self;
}

sub get_df
{
  my $self= shift;
  $self= {} unless (defined ($self));

  my @df= split (/\n/, `/bin/df`);
  my @hdr= split (' ', shift (@df));

  my $key= undef;
  if ($hdr[-2] eq 'Mounted' && $hdr[-1] eq 'on') { splice (@hdr,-2,2,'fs'); $key= @hdr-1; }
  if ($hdr[0] eq 'Filesystem') { $hdr[0]= 'dev'; }

  unless (defined ($key))
  {
    print "key not defined\n";
    print "hdr: ", Dumper (\@hdr);
    return undef;
  }
  my $num_fields= @hdr;

  foreach my $l (@df)
  {
    my @f= split (' ', $l, $num_fields); # let's hope there are not too many blanks...
    my $x= $self->{$f[$key]};
    $x= $self->{$f[$key]}= {} unless (defined ($x));
    for (my $i= 0; $i < $num_fields; $i++)
    {
      $x->{$hdr[$i]}= $f[$i];
    }
  }
  
  $self;
}

sub get_tunefs
{
  my $fsdev= shift;

  my @cmd= ('/sbin/tune2fs', '-l', $fsdev);
  print "get_tunefs: ", Dumper (\@cmd);
  my @res= split ("\n", `@cmd`);
  my $res=
  {
    'version' => shift (@res),
    'pars' => my $p= {},
  };

  foreach my $l (@res)
  {
    if ($l =~ /^([\w][\w ]+):\s+(.+)/)
    {
      my ($an, $av)= ($1, $2);
      if ($an =~ m#Reserved blocks (gid|uid)#)
      {
        my $id= $1;

        if ($av =~ m#(\d+)\s+\((user|group)\s+([^)]+)\)#)
	{
          $av= { $id => $1, 'what' => $2, 'name' => $3 }; # TODO: "what" is not a good attribute name
	}
      }
      $p->{$an}= $av;
    }
    else
    {
      print "unknown line format: [$l]\n";
    }
  }

  $res;
}

sub locate_binary
{
  my $cmd= shift;

  foreach my $path (@paths)
  {
    my $bin= join ('/', $path, $cmd);
    return $bin if (-x $bin);
  }

  print "$cmd not found\n";
  exit (1);
  # return undef;
}

1;

__END__

=pod

=head1 TODO

=head2 VG names

Ubuntu uses a VG named "F<base-os>" for the volume group where it's root
filesystem resides.  In the F</dev/mappper/> directory, this becomes
"F<base--os>".  Is this generally handled this way?  If so, the matching
pattern needs to be modified.

=head2 doit

The script should possibly really perform the steps in a controlled
manner.

=head1 BUGS

This wasn't meant to be nice.

[aix-pm-cvs] modules/util/Util XML_Parser_Tree.pm,1.1,1.2

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv24935/modules/util/Util

Modified Files:
	XML_Parser_Tree.pm 
Log Message:
fixed wide characters to entity translation

Index: XML_Parser_Tree.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/XML_Parser_Tree.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** XML_Parser_Tree.pm	31 Dec 2013 20:10:35 -0000	1.1
--- XML_Parser_Tree.pm	1 Jan 2014 14:09:52 -0000	1.2
***************
*** 18,21 ****
--- 18,52 ----
  $Data::Dumper::Indent= 1;
  
+ my %tlt=
+ (
+   '&' => '&',
+   '<' => '&lt;',
+   '>' => '&gt;',
+   # "\x{7ec}" => '&#x2028
+ );
+ 
+ sub tlt_chr
+ {
+   my $c= shift;
+   # "\u2028" => '&#x2028;', # TODO: that needs special treatment
+ 
+   if (exists ($tlt{$c})) { return $tlt{$c}; }
+   if ((my $oc= ord($c)) >= 0x0100)
+   {
+     my $res= sprintf ('&#x%04x;', $oc);
+     # print "UTF8ENT: c=[$c] => oc=[$oc] => res=[$res]\n";
+     return $res;
+   }
+   $c;
+ }
+ 
+ sub tlt_str
+ {
+   my $s= shift;
+   $s=~ s#([&<>\x{0100}-\x{1ffff}])#tlt_chr($1)#ge;
+ 
+   $s;
+ }
+ 
  sub attr_to_string
  {
***************
*** 36,40 ****
      if ($tag eq '0')
      {
!       $s .= $val;
      }
      else
--- 67,72 ----
      if ($tag eq '0')
      {
! 
!       $s .= tlt_str ($val);
      }
      else

[aix-pm-cvs] modules/util/Util XML_Parser_Tree.pm,NONE,1.1

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv25796

Added Files:
	XML_Parser_Tree.pm 
Log Message:
serialize structure generated by XML::Parser in Tree mode

--- NEW FILE: XML_Parser_Tree.pm ---

=head1 NAME

  Util::XML_Parser_Tree

=head2 DESCRIPTION

Utility functions for structures generated by XML::Parser in tree mode.
Maybe they exist elsewhere, but I didn't find that...

=cut

package Util::XML_Parser_Tree;

use strict;

use Data::Dumper;
$Data::Dumper::Indent= 1;

sub attr_to_string
{
  my $attr= shift;
  join (' ', map { $_ . '="' . $attr->{$_} . '"' } sort keys %$attr);
}

sub to_string
{
  my $s;
  while (@_)
  {
    my $tag= shift;
    my $val= shift;

    # print "tag=[$tag] val=[$val]\n";

    if ($tag eq '0')
    {
      $s .= $val;
    }
    else
    {
      my @val= @$val;
      my $attr= attr_to_string (shift (@val));
      my $s2= to_string (@val);

      # print "tag=[$tag]\n"; print "attr=[$attr]\n"; print "s2=[$s2]\n"; 

      $s .= '<' . $tag;
      $s .= ' ' . $attr if ($attr);
      $s .= '>' . $s2 . '</'. $tag . '>';
    }
  }

  $s;
}

1;

[aix-pm-cvs] modules/util/Util/HTML img.pm, NONE, 1.1 toc.pm, NONE, 1.1

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util/HTML
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv25726/HTML

Added Files:
	img.pm toc.pm 
Log Message:
HTML stuff

--- NEW FILE: img.pm ---

package Util::HTML::img;

use strict;

sub new
{
  my $class= shift;
  my %obj= @_;

  my $obj= \%obj;
  bless $obj, $class;

  $obj;
}

1;


--- NEW FILE: toc.pm ---

package Util::HTML::toc;

use strict;

sub new
{
  my $class= shift;
  my %obj= @_;

  my $obj= \%obj;
  bless $obj, $class;
  $obj->{'columns'}= 5 unless (exists ($obj{'columns'}));

  $obj;
}


sub print_grid
{
  my $obj= shift;
  my $fnm= shift;

  open (FO, '>:utf8', $fnm) or die "can't write to [$fnm]";
  print "writing grid to '$fnm'\n";

  print FO <<EO_HTML;
<html>
<body>
<table>
EO_HTML

  my $cols= $obj->{'columns'};
  my $col= 0;
  my $tr_open= 0;
  foreach my $pic (@{$obj->{'pics'}})
  {
    if ($col == 0)
    {
      print FO <<EO_HTML;
<tr>
EO_HTML
      $tr_open= 1;
    }

    my ($dst, $tn, $num)= map { $pic->{$_} } qw(img tn num);
    print FO <<EO_HTML;
  <td>
     <a href="$dst"><img src="$tn" /><br />$num</a>
  </td>
EO_HTML

    $col++;
    if ($col >= $cols)
    {
      print FO <<EO_HTML;
</tr>
EO_HTML
      $col= 0;
      $tr_open= 0;
    }
  }

    if ($tr_open)
    {
      print FO <<EO_HTML;
</tr>
EO_HTML
      $col= 0;
      $tr_open= 0;
    }

  print FO <<EO_HTML;
</table>
</body>
</html>
EO_HTML
  close (FO);

}

1;

[aix-pm-cvs] modules/util/Util/HTML - New directory

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util/HTML
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv25680/HTML

Log Message:
Directory /cvsroot/aix-pm/modules/util/Util/HTML added to the repository

[aix-pm-cvs] modules/util/Util JSON.pm,NONE,1.1

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv25668/modules/util/Util

Added Files:
	JSON.pm 
Log Message:
added utility package for JSON files

--- NEW FILE: JSON.pm ---

package Util::JSON;

use strict;

use JSON;

sub read_json_file
{
  my $fnm= shift;

  # BEGIN load JSON data from file content
  local $/;
  # print "reading config [$fnm]\n";
  open( my $fh, '<:utf8', $fnm ) or return undef;
  my $json_text   = <$fh>;
  decode_json( $json_text );
}

1;

[aix-pm-cvs] modules/util/Util MongoDB.pm,1.1,1.2

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv8403/modules/util/Util

Modified Files:
	MongoDB.pm 
Log Message:
function to open a MongoDB connection with data in a commonly configuration file

Index: MongoDB.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/MongoDB.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** MongoDB.pm	5 Nov 2013 17:14:23 -0000	1.1
--- MongoDB.pm	11 Nov 2013 02:57:54 -0000	1.2
***************
*** 7,10 ****
--- 7,40 ----
  use MongoDB;
  
+ sub connect
+ {
+   my $mdb= shift;
+   my $col_name= shift;
+ 
+     my $m= MongoDB::Connection->new(host => $mdb->{'host'});
+     # print "m=[$m]\n";
+     unless (defined ($m))
+     {
+ DIE:
+       die "could not connect to MongoDB: ", main::Dumper ($mdb);
+     }
+ 
+     my $r= $m->authenticate($mdb->{'db'}, $mdb->{'user'}, $mdb->{'pass'});
+     goto DIE if ($r eq 'auth fails');
+ 
+     # print "authentication: r=[$r] ", main::Dumper ($r);
+ 
+   my $db= $m->get_database ($mdb->{'db'});
+   goto DIE unless (defined ($db));
+   # print "db=[$db] ", main::Dumper ($db);
+ 
+   return $db unless (defined ($col_name));
+ 
+   my $col= $db->get_collection ($col_name);
+   # print "col=[$col] ", main::Dumper ($col);
+ 
+   return ($db, $col);
+ }
+ 
  =head2 my ($data, $columns)= extract ($collection, $search, $fields)
  

[aix-pm-cvs] modules/util/Util MongoDB.pm, NONE, 1.1 Matrix.pm, 1.8, 1.9

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv8979

Modified Files:
	Matrix.pm 
Added Files:
	MongoDB.pm 
Log Message:
extract data from MongoDB to be used with Util::Simple_CSV and Util::Matrix

Index: Matrix.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Matrix.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Matrix.pm	21 May 2013 06:14:21 -0000	1.8
--- Matrix.pm	5 Nov 2013 17:14:23 -0000	1.9
***************
*** 1,4 ****
--- 1,5 ----
  #
  # $Id$
+ #
  
  package Util::Matrix;
***************
*** 14,17 ****
--- 15,22 ----
  my $border_lines= 1;
  
+ =head2 print ($column_names, $data)
+ 
+ =cut
+ 
  sub print
  {
***************
*** 124,129 ****
  }
  
- =pod
- 
  =head2 save_as_csv ($column_names, $data, $fnm, $csv_sep, $col_delimiter, $eol, $UTF8)
  
--- 129,132 ----
***************
*** 160,163 ****
--- 163,172 ----
  }
  
+ =head2 save_hash_as_csv ($column_names, $data, $fnm, $csv_sep, $col_delimiter, $eol, $UTF8)
+ 
+ save data in csv format, 
+ 
+ =cut
+ 
  sub save_hash_as_csv
  {
***************
*** 188,191 ****
--- 197,224 ----
  }
  
+ sub hash_to_array
+ {
+   my $column_names= shift;
+   my $d= shift;
+ 
+   my @data;
+   foreach my $row (@$d)
+   {
+     my @row;
+     @row= map { $row->{$_} } @$column_names;
+     push (@data, \@row);
+   }
+   (wantarray) ? @data : \@data;
+ }
  1;
  
+ __END__
+ 
+ =head1 BUGS
+ 
+ there should be more pod text
+ 
+ =head1 AUTHORE
+ 
+   Gerhard Gonter <gg...@cp...>
+ 

--- NEW FILE: MongoDB.pm ---
# $Id: MongoDB.pm,v 1.1 2013/11/05 17:14:23 gonter Exp $

package Util::MongoDB;

use strict;

use MongoDB;

=head2 my ($data, $columns)= extract ($collection, $search, $fields)

retrieve data from a given collection and returns $data as an array_ref to hash_refs
and $columns as a hash_ref with counters for each field.

$search and $fields are optional.

e.g.  ... TBD ...

=cut

sub extract
{
  my $coll= shift;
  my $search= shift;
  my $wanted_columns= shift;

  # print "wanted_columns: ", main::Dumper ($wanted_columns);
  my %wanted_columns;
  my $cnt_wanted_columns= 0;
  %wanted_columns= map { $_ => 1 + $cnt_wanted_columns++ } @$wanted_columns;
  # print "wanted_columns: ", main::Dumper (\%wanted_columns);

  # print "coll=[$coll]\n";
  my $cursor= $coll->find ($search);
  $cursor->fields (\%wanted_columns) if ($cnt_wanted_columns);
  my @data= ();
  my %has_columns= ();
  while (my $row= $cursor->next())
  { 
    # print "row: ", main::Dumper ($row);
    my %new_row;
    foreach my $f (keys %$row)
    {
      # print __LINE__, " f=[$f]\n";
      next if ($f eq '_id');
      next if ($cnt_wanted_columns && !exists ($wanted_columns{$f}));

      my $v= $row->{$f};
      # print __LINE__, " f=[$f] v=$v\n";
      $new_row{$f}= $v;
      $has_columns{$f}++;
    }
    # print "new_row: ", main::Dumper (\%new_row);
    push (@data, \%new_row);
  }

  (\@data, \%has_columns);
}

1;

[aix-pm-cvs] modules/util csv.pl,1.31,1.32

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5512

Modified Files:
	csv.pl 
Log Message:
updated POD section

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -d -r1.31 -r1.32
*** csv.pl	10 Oct 2013 16:30:17 -0000	1.31
--- csv.pl	11 Oct 2013 01:17:12 -0000	1.32
***************
*** 24,27 ****
--- 24,31 ----
  print data columns
  
+ =head2 --setcol name(,name*)
+ 
+ set column names.  useful when csv file does not start with column names.
+ 
  =head2 --sort name
  
***************
*** 38,41 ****
--- 42,48 ----
  =head2 -tchar ... CSV separator for input files
  
+   char can be a single character or a specifier:
+   wiki: try to read a table in wiki syntax
+ 
  =head2 -Tchar ... CSV separator for the output file
  
***************
*** 46,50 ****
    default .. (similar to PostgreSQL)
  
- 
  =head2 other options
  
--- 53,56 ----

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.38,1.39

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27873/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
added option to preset column names when csv does not provide them; only read column names if option --hdr is specified

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -C2 -d -r1.38 -r1.39
*** Simple_CSV.pm	24 Sep 2013 13:04:41 -0000	1.38
--- Simple_CSV.pm	10 Oct 2013 16:30:17 -0000	1.39
***************
*** 200,203 ****
--- 200,205 ----
    $obj->{'filename'}= $fnm;
  
+   unless ($obj->{'no_headings'})
+   {
    # TODO: make column header reading optional
    my $columns= <FI>;
***************
*** 239,244 ****
  print __LINE__, " columns: ", join (', ', @columns), "\n" if ($DEBUG > 1);
    $obj->define_columns (@columns);
  
-   $obj->load_csv_file_body (*FI);
    close (FI) if ($fi_open);
  }
--- 241,248 ----
  print __LINE__, " columns: ", join (', ', @columns), "\n" if ($DEBUG > 1);
    $obj->define_columns (@columns);
+   }
+ 
+   $obj->load_csv_file_body (*FI) unless ($obj->{'no_body'});
  
    close (FI) if ($fi_open);
  }

[aix-pm-cvs] modules/util csv.pl,1.30,1.31

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27873

Modified Files:
	csv.pl 
Log Message:
added option to preset column names when csv does not provide them; only read column names if option --hdr is specified

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** csv.pl	27 Sep 2013 17:14:30 -0000	1.30
--- csv.pl	10 Oct 2013 16:30:17 -0000	1.31
***************
*** 73,76 ****
--- 73,77 ----
  my @columns;
  my @sort_columns;
+ my @set_columns;
  my $sort_numeric= 0;
  
***************
*** 87,90 ****
--- 88,92 ----
      elsif ($arg eq '--out') { $out_file= shift (@ARGV); }
      elsif ($arg eq '--hdr') { $view= 'header'; }
+     elsif ($arg eq '--setcol') { push (@set_columns, split (',', shift (@ARGV))); }
      elsif ($arg eq '--col') { push (@columns, split (',', shift (@ARGV))); }
      elsif ($arg eq '--sort') { push (@sort_columns, split (',', shift (@ARGV))); }
***************
*** 123,130 ****
  }
  
! my $csv= new Util::Simple_CSV ('separator' => $CSV_SEP, 'strip_quotes' => $strip_quotes, 'UTF8' => $UTF8,
     # 'no_array' => 1
     );
  
  my $fnm= shift (@PAR);
  $csv->load_csv_file ($fnm);
--- 125,141 ----
  }
  
! my $csv= new Util::Simple_CSV ('separator' => $CSV_SEP,
!    'strip_quotes' => $strip_quotes,
!    'UTF8' => $UTF8,
     # 'no_array' => 1
     );
  
+ $csv->{'no_body'}= 1 if ($view eq 'header');
+ if (@set_columns)
+ {
+   $csv->define_columns (@set_columns);
+   $csv->{'no_headings'}= 1;
+ }
+ 
  my $fnm= shift (@PAR);
  $csv->load_csv_file ($fnm);

[aix-pm-cvs] modules/util csv.pl,1.29,1.30

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv16772/modules/util

Modified Files:
	csv.pl 
Log Message:
read csv from stdin if no parameter given

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.29
retrieving revision 1.30
diff -C2 -d -r1.29 -r1.30
*** csv.pl	24 Sep 2013 13:04:41 -0000	1.29
--- csv.pl	27 Sep 2013 17:14:30 -0000	1.30
***************
*** 109,116 ****
--- 109,124 ----
  unless (@PAR)
  {
+ 
+ =begin comment
+ 
    print <<EOX;
  usage: $0 [-options] fnm
  EOX
    exit (0);
+ 
+ =end comment
+ =cut
+ 
+   push (@PAR, '-');
  }
  

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.37,1.38

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv18316/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
added sort option (may be incomplete)

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -C2 -d -r1.37 -r1.38
*** Simple_CSV.pm	13 Sep 2013 16:52:23 -0000	1.37
--- Simple_CSV.pm	24 Sep 2013 13:04:41 -0000	1.38
***************
*** 749,752 ****
--- 749,754 ----
  index rows by given field name.  Use lowercase, if to_lower is true.
  
+ BUG: only works with data records.
+ 
  =cut
  
***************
*** 770,773 ****
--- 772,827 ----
  }
  
+ sub index_array
+ {
+   my $csv= shift;
+   my $field= shift;
+   my $lower= shift;
+ 
+   # print "csv: ", main::Dumper ($csv);
+   # print "columns: ", join (' ', @{$csv->{'columns'}}), "\n";
+   my $idx_field= $csv->{'index'}->{$field};
+   $idx_field= 0 unless (defined ($idx_field));
+   print "idx_field=[$idx_field]\n";
+ 
+   my %IDX= ();
+   my $cnt= 0;
+   foreach my $row (@{$csv->{'rows'}})
+   {
+     my $av= $row->[$idx_field];
+     $av=~ tr/A-Z/a-z/ if ($lower);
+     push (@{$IDX{$av}}, $row);
+     $cnt++;
+   }
+   $csv->{'idx_2'}->{$field}= \%IDX;
+   ($cnt, \%IDX);
+ }
+ 
+ sub sort
+ {
+   my $csv= shift;
+   my $field= shift;
+   my $lower= shift;
+   my $numeric= shift;
+ 
+   print "sorting by field=[$field]\n";
+   my ($cnt, $idx)= $csv->index_array ($field, $lower);
+ 
+   return undef unless ($cnt);
+ 
+   my @new_rows= ();
+   if ($numeric)
+   {
+     foreach my $k (sort { $a <=> $b } keys %$idx) { push (@new_rows, @{$idx->{$k}}); }
+   }
+   else
+   {
+     foreach my $k (sort { $a cmp $b } keys %$idx) { push (@new_rows, @{$idx->{$k}}); }
+   }
+   my $d= $csv->{'rows'};
+   # print "new_rows: ", main::Dumper (\@new_rows);
+   $csv->{'rows'}= \@new_rows;
+   $d;
+ }
+ 
  sub split_wiki_header
  {
***************
*** 943,946 ****
--- 997,1004 ----
  called encoding and utf8 is it's value?
  
+ =head2 sorting options
+ 
+ this may be incomplete and results may be unexpected.
+ 
  =head1 Copyright
  

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.36,1.37

[Gerhard G. <go...@us...>]

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv16245/modules/util/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
typo

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** Simple_CSV.pm	3 Sep 2013 11:54:05 -0000	1.36
--- Simple_CSV.pm	13 Sep 2013 16:52:23 -0000	1.37
***************
*** 21,25 ****
  =head2 my $obj= new Util::Simple_CSV (paramters);
  
! paraemeters:
    load => filename
    separator => csv_separator, default: ;
--- 21,25 ----
  =head2 my $obj= new Util::Simple_CSV (paramters);
  
! parameters:
    load => filename
    separator => csv_separator, default: ;