opendir02.pl to HTML.

index -|- end

Generated: Mon Aug 16 14:14:29 2010 from opendir02.pl 2010/07/24 11.4 KB.

#!/usr/bin/perl -w
# NAME: opendir02.pl
# AIM: Attempt to open a known REMOTE directory, and get a file list
# Wow, successed with BOTH a direct opendir/readdir/closedir,
# and then 'stat' also works, *** AND ***
# open( DIR "dir $dir |"); @arr = <DIR>; close DIR;
# which says great things for perls windows implementation...
# 24/07/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use File::stat; # to get the file date and size like if ($sb = stat($fil)) {

my $in_dir = "\\\\DELL02\\public";
#my $in_dir = "\\\\PRO-2\\SharedDocs";

my $max_list = 20;
my $cnt = 0;
my $evenspace = 1;
my $test_stat = 1;

my $maxname = 0;
my $maxsize = 0;

my @repo_dirs = qw( CVS .svn .git );

my $os = $^O;

my $sep = "\\";
if ($os ne 'MSWin32') {
    $sep = '/';
}

# debug
my $dbg01 = 0;
my $dbg02 = 0;
my $dbg03 = 0;
my $dbg04 = 0;

sub prt($) { print shift; }

# Return directory name of file.
sub file_dirname {
    my ($fil) = shift;
    my ($nm,$dir) = fileparse($fil);
    return $dir;
}

sub trimall($) {
   my ($ln) = shift;
   $ln =~ s/\n/ /gm;   # replace CR (\n)
   $ln =~ s/\r/ /gm;   # replace LF (\r)
   $ln =~ s/\t/ /g;   # TAB(s) to a SPACE
   $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space
   $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space
   $ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/);   # all double space to SINGLE
   return $ln;
}

sub is_date_entry {
    my (@ar) = @_;
    if (scalar @ar == 3) {
        if (($ar[0] =~ /^\d+$/) && ($ar[1] =~ /^\d+$/) && ($ar[2] =~ /^\d+$/)) {
            return 1;
        }
    }
    return 0;
}
sub is_time_entry {
    my (@ar) = @_;
    if (scalar @ar == 2) {
        if (($ar[0] =~ /^\d+$/)&&($ar[1] =~ /^\d+$/)) {
            return 1;
        }
    }
    return 0;
}

sub dbs_d2u($) {
   my ($du) = shift;
   $du =~ s/\\/\//g;
   return $du;
}

sub is_a_respository_dir($) {
    my ($dir) = @_;
    my $ud = dbs_d2u($dir); # ensure UNIX path
    my @arr = split('/',$ud);   # split on UNIX path
    my ($d1,$d2);
    foreach $d1 (@arr) {
        foreach $d2 (@repo_dirs) {
            return 1 if ($d1 eq $d2);
        }
    }
    return 0;
}

sub file_array_from_dir_list($) {
    my ($rlines) = @_;
    my $lc = scalar @{$rlines};
    prt( "Processing $lc lines...\n" );
    my $line = '';
    my $tln = '';
    my $act_folder = '';
    my $isrepo = 0;
    my @folders = ();
    my @filelist = ();
    foreach $line (@{$rlines}) {
        $tln = trimall($line);
        if (length($tln)) {
            #  Volume in drive C has no label.
            #  Volume Serial Number is D833-AEFA
            if ($line =~ /Volume in drive (.*)/ ) {
                # ignore
            } elsif ($line =~ /Volume Serial Number is (.*)/ ) {
                # ignore
            } elsif ($line =~ /Total Files Listed/ ) {
                # ignore
            } elsif ($line =~ /Directory of (.*)/ ) {
                $act_folder = $1;
                prt( "Folder [$act_folder] ...\n" ) if ($dbg01);
                $isrepo = is_a_respository_dir($act_folder);
                push(@folders,$act_folder);
            } elsif ($line =~ /\d+\s+File\(s\)\s+[\d,]+\s+bytes/ ) {
                prt( $line ) if ($dbg02);
            } elsif ($line =~ /\d+\s+Dir\(s\)\s+[\d,]+\s+bytes/ ) {
                prt( $line ) if ($dbg02);
            } else {
                my @arr = split(/\s/, $tln);
                my $ac = scalar @arr;
                my $pchk = 0;
                #prt( $line );
                if ($ac > 3) {
                    # from Windows 98 machine
                    # ..             <DIR>        01/02/04  16:32 ..
                    # IMAGE001 PNG         5 031  01/02/04  16:32 image001.png
                    # from XP machine
                    # 09/07/2008  19:24    <DIR>          Sue
                    # 09/07/2008  19:40            81,061 temp.DirBySize.pl.txt
                    # from Vista machine
                    # 01/10/2009  03:00 PM    <DIR>          28
                    # 10/05/2008  02:04 PM             4,180 chgdiff.txt
                    if (($arr[2] eq '<DIR>')||($arr[3] eq '<DIR>')) {
                        # ignore
                    } else {
                        # file names of interest
                        my @ar2 = split('/', $arr[0]); # get day/month/year
                        my @ar3 = split(':', $arr[1]); # get hour:minutes
                        if (is_date_entry(@ar2) && is_time_entry(@ar3)) {
                            my $sz = $arr[2];
                            my $nm = $arr[3];
                            #if ($fixtm && (($sz eq 'AM')||($sz eq 'PM'))) {
                            if (($sz eq 'AM')||($sz eq 'PM')) {
                                # 12 hour clock - have AM or PM
                                if ($sz eq 'PM') {
                                    $ar3[0] += 12;   # bump hour by 12
                                    $arr[1] = $ar3[0].':'.$ar3[1];
                                }
                                $sz = $arr[3];
                                $nm = $arr[4];
                                if ($ac > 5) {
                                    my $i = 5;
                                    while($i < $ac) {
                                        $nm .= ' '.$arr[$i];
                                        $i++;
                                    }
                                }
                            } else {
                                # 24 hour clock (no AM/PM)
                                if ($ac > 4) {
                                    my $i = 4;
                                    while($i < $ac) {
                                        $nm .= ' '.$arr[$i];
                                        $i++;
                                    }
                                }
                            }
                            if ((scalar @ar2 == 3)&&(scalar @ar3 == 2)) {
                                my $ft = int($ar2[2].$ar2[1].$ar2[0].$ar3[0].$ar3[1]);
                                if ($evenspace) {   # get maximum lengths
                                    $maxname = length($nm) if (length($nm) > $maxname);
                                    $maxsize = length($sz) if (length($sz) > $maxsize);
                                }
                                $sz =~ s/,//g; # remove the COMA
                                #                 0     1   2    3            4       5        6
                                push(@filelist, [$ft, $nm, $sz, $act_folder, $arr[0], $arr[1], $isrepo]);
                                #prt( "$ft, $nm, $sz, $act_folder $arr[0], $arr[1]\n") if ($dbg03);
                                prt( "$ft, $nm, $sz, $arr[0], $arr[1]\n") if ($dbg03);
                            } else {
                                $pchk = 1;
                            }
                        } else {
                            # first and second NOT DATE and TIME
                            # maybe a Windows 98 listing
                            # IMAGE001 PNG         5 031  01/02/04  16:32 image001.png
                            # MAROC    EXE    72 869 062  09/07/08  18:54 maroc.exe
                            # or some other wierd layout
                            mydie( "EEK: Handling of this just not yet done ;=((\n" );
                        }
                    }
                } else {
                    $pchk = 1;
                }
                if ($pchk) {
                    prt( "CHECK: " );
                    for (my $i = 0; $i < $ac; $i++) {
                        prt( $arr[$i].' ' );
                    }
                    prt("\n");
                }

            }
        }
    }
    return \@filelist;
}

sub get_YYYYMMDD_hhmmss2($) {
    my ($t) = shift;
    my @f = (localtime($t))[0..5];
    my $m = sprintf( "%04d/%02d/%02d %02d:%02d",
        $f[5] + 1900, $f[4] +1, $f[3], $f[2], $f[1]);
    return $m;
}

sub try_std_open_dir($) {
    my ($dir) = @_;
    if (opendir(DIR,$dir)) {
        my @files = readdir(DIR);
        closedir(DIR);
        my $flcnt = scalar @files;
        prt("Got [$flcnt] file, from dir [$dir]...show first $max_list lines\n");
        $cnt = 0;
        my ($ff,$sb,$dt,$sz);
        $dir .= $sep if ( !($dir =~ /(\/|\/)/) );
        foreach my $fl (@files) {
            next if (($fl eq '.')||($fl eq '..'));
            $cnt++;
            $ff = $dir.$fl;
            if ($sb = stat($ff)) {
                $dt = get_YYYYMMDD_hhmmss2( $sb->mtime );
                $sz = get_nn( $sb->size );
                $sz = " $sz" while (length($sz) < 16);
                prt(" $dt $sz $fl\n");
            } else {
                prt("$cnt: [$fl] NS\n");
            }
            last if ($cnt >= $max_list);
        }
    } else {
        prt("Open directory  FAILED on [$dir]\n");
    }
}

##################################################
# My particular 'nice number'
sub get_nn($) { # perl nice number nicenum add commas
   my ($n) = shift;
   if (length($n) > 3) {
      my $mod = length($n) % 3;
      my $ret = (($mod > 0) ? substr( $n, 0, $mod ) : '');
      my $mx = int( length($n) / 3 );
      for (my $i = 0; $i < $mx; $i++ ) {
         if (($mod == 0) && ($i == 0)) {
            $ret .= substr( $n, ($mod+(3*$i)), 3 );
         } else {
            $ret .= ',' . substr( $n, ($mod+(3*$i)), 3 );
         }
      }
      return $ret;
   }
   return $n;
}


sub show_ref_file_array($) {
    my ($rfa) = @_;
    #                 0     1   2    3            4       5        6
    #push(@filelist, [$ft, $nm, $sz, $act_folder, $arr[0], $arr[1], $isrepo]);
    my $lcnt = scalar @{$rfa};
    prt("Listing $lcnt files found...\n");
    my ($i,$ft,$nm,$sz,$nnsz,$dt,$tm,$minn,$len);
    $minn = 0;
    for ($i = 0; $i < $lcnt; $i++) {
        $ft = ${$rfa}[$i][0];
        $nm = ${$rfa}[$i][1];
        $sz = ${$rfa}[$i][2];
        $dt = ${$rfa}[$i][4];
        $tm = ${$rfa}[$i][5];
        $nnsz = get_nn($sz);
        $len = length($nnsz);
        $minn = $len if ($len > $minn);
    }
    $minn = 16 if ($minn < 16);
    for ($i = 0; $i < $lcnt; $i++) {
        $ft = ${$rfa}[$i][0];
        $nm = ${$rfa}[$i][1];
        $sz = ${$rfa}[$i][2];
        $dt = ${$rfa}[$i][4];
        $tm = ${$rfa}[$i][5];
        $nnsz = get_nn($sz);
        $nnsz = " $nnsz" while (length($nnsz) < $minn);
        prt(" $dt $tm $nnsz $nm\n");
    }
}

# Try use the windows 'dir' command...
sub try_dir_command($) {
    my ($dir) = @_;
    if (open (RDIR, "dir $dir |")) {
        my @arr = <RDIR>;
        $cnt = scalar @arr;
        prt("\nWow: Got [$dir] open... got $cnt lines...\n");
        close RDIR;
        if ($dbg04) {
            prt("Showing first $max_list lines...\n");
            $cnt = 0;
            foreach my $ln (@arr) {
                chomp $ln;
                if( length($ln) ) {
                    $cnt++;
                    prt("$cnt: [$ln]\n");
                } else {
                    next;
                }
                last if ($cnt >= $max_list);
            }
        }
        my $rfa = file_array_from_dir_list(\@arr);
        show_ref_file_array($rfa);

    } else {
        prt("Open FAILED on [$dir]\n");
    }
}

try_std_open_dir($in_dir);
try_dir_command($in_dir);

# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional