view release on metacpan or  search on metacpan

MapDisp2.pm  view on Meta::CPAN

  for my $i (0..$#a) { push @$r, [$a[$i],$a[$i],0]; }
  unshift @$r, ['', '__Select__',1]; 

  wantarray ? @$r : $r; 
}


sub mk_dir {
  my ($s, $dir) = @_; 
  # $dir - directory
  
  # $package,   $filename, $line,       $subroutine, $hasargs,
  # $wantarray, $evaltext, $is_require, $hints,      $bitmask
  my @c0 = caller(0); 		my @c1 = caller(1);
  my $cls = (exists $c1[3]) ? $c1[3] : ''; 
  my $prg = "$cls [$c0[2]] -> $c0[3]"; 

  if (! -d $dir) {
    eval { mkpath($dir,0,0777) };
    if ($@) { 
      my $m = "ERR: ($prg [" . __LINE__ . "]) ";
        $m .= "could not mkdir - $dir: $!: $@<br>\n";
      $s->echo_msg($m,0);
      return;
    } 
    if ($^O !~ /^MSWin/i) { 				# non window
        system("chmod -R ugo+w $dir"); 
    }
  }
}

sub backup_file {
  my ($s, $ffn, $ar) = @_; 
  # $ffn - file name
  # $ar  - parameter array 
  # $bdr - backup dir  

  my @c0 = caller(0); my @c1 = caller(1); 
  my $cls = (exists $c1[3]) ? $c1[3] : ''; 
  my $prg = "$cls [$c0[2]] -> $c0[3]"; 

  my $ds = ($^O =~ /MSWin/i)? '\\': '/'; 
  my ($bcp) = $s->get_params('bak_copies',$ar); 
     $bcp = ($bcp) ? $bcp : 10; 	# default it to 10 copies
  my ($fname, $path, $sfx) = fileparse($ffn,qr{\..*});
  
  my $bdr = "${path}baks"; 
  my $f1  = $ffn; 
  my $f2  = join $ds, $bdr, "$fname$sfx"; 
  
  $s->mk_dir($bdr) if (! -d $bdr);

  if (! -f $f2) {
    copy($f1,$f2) or 
      $s->echo_msg("ERR: ($prg [" .__LINE__ . 
      "]) Copy failed from $f1 to $f2: $!",0);
    return; 
  }

  opendir DD, "$bdr" or croak "ERR: ($prg) could not opendir - $bdr: $!\n";
  my @a = sort { (stat("$bdr/$a"))[9] <=>  (stat("$bdr/$b"))[9] } 
               (grep { /$fname/ && !/^\./ } readdir DD);
  closedir DD; 

  my $n = 0; 
  my ($m) = ($a[$#a] =~ /\.(\d+)$/); 
      $m  = 1 + $m; 
  $n = ($m) % $bcp; 
  $n = sprintf "%03d", $n; 
  $f2 = "$f2.$n";
  copy($f1,$f2) or 
      $s->echo_msg("ERR: ($prg [" .__LINE__ . 
      "]) Copy failed from $f1 to $f2: $!",0);
  return; 
}

1;

=head1 HISTORY

=over 4

=item * Version 0.10

This version extracted from MapDips on 07/22/2013.

=item * Version 0.20

  07/22/2013 (htu): start this PM
  
=cut

=head1 SEE ALSO (some of docs that I check often)

Oracle::Loader, Oracle::Trigger, CGI::AppBuilder, File::Xcopy,
CGI::AppBuilder::Message

=head1 AUTHOR

Copyright (c) 2013 Hanming Tu.  All rights reserved.

This package is free software and is provided "as is" without express
or implied warranty.  It may be used, redistributed and/or modified
under the terms of the Perl Artistic License (see
http://www.perl.com/perl/misc/Artistic.html)

=cut