CGI-AppBuilder-MapDisp2

 view release on metacpan or  search on metacpan

MapDisp2.pm  view on Meta::CPAN

How to use:

Return: None

=cut

sub upload_sas_script {
  my ($s, $q, $ar) = @_;

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

  $s->disp_header($q,$ar,1);

  # get parameters
  my $vs = 'task,file_name,app_user,dir_sep,sel_sn1';
  my ($tsk,$sfn,$apu,$ds,$svr) = $s->get_params($vs, $ar);
     $ds  = ($ds) ? $ds : '/'; 
  if (! $svr) {

MapDisp2.pm  view on Meta::CPAN

  
  $s->echo_msg("INFO: ($prg) File - $sfn is uploaded to $sdr.", 1);

  return;
} 


sub get_scrnames {
  my ($s, $ar) = @_;

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

  my $ds = (exists $ar->{dir_sep}) ? $ar->{dir_sep} : '';
     $ds = ($^O =~ /MSWin/i)? '\\': '/'	if ! $ds; 

  # get parent id, server id, study id and list id
  my $vs = 'pid,sid,study_id,list_id,app_user'; 
  my ($pid,$sn,$sid,$lid,$apu) = $s->get_params($vs,$ar); 
    $sn  = $ar->{sel_sn1} if !$sn && exists $ar->{sel_sn1}; 

MapDisp2.pm  view on Meta::CPAN

  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;

MapDisp2.pm  view on Meta::CPAN

    }
  }
}

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;