[原创代码] 分类记事工具rcder.pl

523066680

很像像wiki那样有目录树，有分类的记事，找了类似的软件zim
还行，打开速度比较慢。

用命令行的话也有不一样的缺点优点，我这个嘛……
未完成，主要是基础没学够却又急需用到，写的机制不太好，在考虑是不是修改整个机制。
用法 ，代码备注中有提到一些，常用的：
add             添加一个分类
rd                删除一个分类
cd                进入一个分类(模仿目录形式)
note 内容 ： 添加一项记事
del   编号1 编号2  ： 删除指定编号的记事
list   列出当前分类下的所有内容
list all 列出整个分类下的内容。

$Path:/verycd #list all
Notes:
+---2011-Apr-5
|       http://www.verycd.com/entries/518679/ 放浪男孩 comic
|       http://www.verycd.com/topics/2876939/ game 东方幻想系列
|
|       http://www.verycd.com/topics/2814764/ 黏黏世界
|
+---CG
|       《CG动画不完全收集》(Computer Graphics Animation Demo)
|       http://www.verycd.com/topics/255259/
|
+---动漫高清壁纸
|       《高清ACG壁纸》(HD ACG Wallpaper 停止更新)[压缩包]
|       http://www.verycd.com/topics/2797187/
|       《MINA ACG手机壁纸》(MINA ACG Phone Wallpapers)(480X854，带原图)[压缩包]

|       http://www.verycd.com/topics/2838059/
|       《高清晰动漫壁纸》(ACG)[压缩包]
|       http://www.verycd.com/topics/2822666/
|       高清壁纸
|       http://www.verycd.com/topics/2834430/
|       《1920高清自然风光图片》
|       http://www.verycd.com/topics/2823063/
|
+---高清资源
|       《人人影视纪录片特辑》[YYeTs人人影视][中英双语字幕]
|            http://www.verycd.com/topics/2789412/
|       BBC 频道，高清纪录片
|       《BBC：太阳系的奇迹》
|            http://www.verycd.com/topics/2847930/
|       BBC：大脑：神秘的历史
|            http://www.verycd.com/topics/2877004/
|       BBC：数学的故事
|           http://www.verycd.com/topics/2878349/
|           700MB版本4集  http://www.verycd.com/topics/2854607/
|           中文字幕在评论中可以找到
|       《世界上最美丽的地方：奥林匹克热带雨林》
|       http://www.verycd.com/topics/2773370/
|       《世界上最美丽的地方》
|       2011-Feb-20
|       http://www.verycd.com/topics/2878041/
|       http://www.verycd.com/topics/2797166/
|       http://www.verycd.com/topics/2773370/
|       http://www.verycd.com/topics/264809/
|       http://www.verycd.com/topics/2770521/ 世界上最美丽的地方 ：巴厘岛
|       《BBC 失落之地：扎瓜》
|       《奇异的生物 第三季》
|       《探索频道：动物的末日》
|       《BBC自然世界--非洲龙山》
|       最大影像：哈勃望远镜3D
|       http://www.verycd.com/topics/2887856/
|
+---计算机
|       《轻松玩转个人服务器》(刘晓辉 编著)插图版[PDF]
|       http://www.verycd.com/topics/2794899/
|
\---剧集
        快递高手：日本  http://www.verycd.com/entries/517814/

dir
dir all

+-----verycd
|     +-----2011-Apr-5
|     +-----CG
|     +-----动漫高清壁纸
|     +-----高清资源
|     +-----计算机
|     \-----剧集
|
+-----video
|     +-----sex
|     +-----搞笑
|     +-----历史
|     \-----社会
|
+-----web
|     +-----博客文摘
|     +-----查询应用
|     +-----翻墙
|     +-----论坛
|     +-----网盘、在线图册
|     |     \-----upload.ouliu.net
|     |
|     \-----资源网
|
\-----购书

523066680

#!/usr/bin/perl
system("title rcd.pl");
if ($#ARGV<0) {
	$folder="./";
	$file="rcd2.txt";
} else {
	print "$file\n";
	$ARGV[0]=~s#\\#/#g;
	@file=split "/",$ARGV[0];
	$file=pop @file;
	$folder=join "/",@file;
}

chdir "$folder" or die "Could not into Dest folder...";
if (! -e "$file") {
	open CREATE,">$file";
	print CREATE "/main\n";
	close CREATE;
}

=Something
 增加了重新读入功能，主要是一些变更需要重新读入
 2011-1-3  date日期出现问题，原因:分隔符符-空格，个数不一，切割改为\s+
 2011-1-3  目录名支持附加信息，分离处理
  笔记，像copymove copytree 几个函数之间，有一些判断应该由另一个函数操作
  rename 修改中
 2011-1-12 函数权衡：函数只负责操作，尽量不用判断调用参数的合理性
           大部分输入信息的判断交给主循环
 2011-1-29 printf 引号中直接插入变量，如果含有%d会转义，需谨慎。所以改为外部引入。
           sub save 以及 listnote listx 的printf都需要改动
 2011-2-08 发现错别字=。=
=cut

=Descript environment variable
	变量描述
 	$file	全局变量 文件的完整路径，已辨别存在的
	$path	当前路径,去除info的
	$last	目录名的最后一个，去除$info的
	$front	/$last前面的字符
	$info	读取时路径后面的附加信息
	$fold{$path}=$info	key记录一个完整路径的存在，且value=附加信息
	$item{$front}{$last}	建立所有路径的父子关系，方便递归，索引，列出当前目录
	$num{$path}	记录当前路径的下一个下标，也记录了note的个数
	$rcder{$path}[$num{$path}++]=$_;	一个路径下的所有notes，下标即为记录的编号，然后+1
	$year-$mon-$day 日期，全局
=cut

#Backup
($week,$mon,$day,$time,$year)=split /\s+/,localtime(time);
$dest="./backup";
use File::Copy;
mkdir "$dest" if (! -e $dest);
copy "$file","$dest/$year-$mon-$day.x" if (! -e "$dest/$year-$mon-$day.x");

#Read data
&read();

print "TREE_\n";

$path="";
&dir($path,1);
print "\n"x2;

%command=(
	"exit"=>"quit of script",
	"save"=>"save all information to RCD text",
	"list"=>"look every notebook of tree",
	"dir"=>"list directory ,dir all to list all",
	"dirx"=>"list directory by tree mode",
	"rename"=>"rename for a directory",
	"add"=>"add a new folder for this tree",
	"del"=>"WRITING",
	"note"=>"write a new note in path",
	"date"=>"write a note,record time",
	"notemode"=>"make notes",
	"push"=>"","mark"=>"",
	"left"=>"","right"=>"",
	"front"=>"","next"=>"",
	"change"=>"",
	"help"=>"list command name and information."
);



=Descript variable in while loop //////////////
 $file    指定文件
 $path    当前路径
 @current    记录当前目录下的子目录名，使其可以通过编号方式操作。 
             脚本中的全局变量
 $inp     输入的信息，去除了\n的
 @arg     $inp分割后的各个部分
 $else    除了第一个信息的其余部分
///////////////////////////////////////////////
=cut

=Descript commands /////////////////////////////////////
 add  添加一个分类
  add \d 添加一个以日期为名字的分类
 rd   删除一个分类
 move 
 copy
 dir 列出当前子分类
   dir [n] 列出N层
   dir all 递归所有层
 tree  以树状形式列出当前分类
   tree [n]  N层
   tree all  所有层
 info information  给一个分类添加注释。
 note notes 将后面的参数添加到记录中。
 date notes 将后面的参数添加到记录中，前面插入当前日期。
 notemode 输入模式，允许输入多行，直到一行为 exit 时退出

 #left right push mark 中
 # \b=空格 \t=调格 \d=引入当前日期 
 #（循环过程的常用变量 $else中'\d'将替换为当前日期）

 left n info : 在指定信息前面插入信息，除了编号+1个空格，后面若有空格也算入。
 right n info: 在指定信息后面追加信息，只要是"$n "后面的都会作为信息包括空格。
   left,right: 默认没有自动添加空格分隔原来的信息
   example: "left 2 haha" = "haha第二条原信息"
            "left 2  haha " = " haha 第二条原信息"
            "left 2    " = "   第二条原信息"
      right 作用在后面，形式跟以上例子相同 
 push n1 [n2] [n3] .. info 在N个信息前面插入信息   默认带一个空格做分割 可用于整段推进
 mark n1 [n2] [n3] .. info 在N个信息后面追加信息   默认带一个空格做分割
   空格可能导致出错，若要插入空格，可以用\b \t (我这里修改'\b'为空格，不用担心退格)
   如果类似 push/mark 1 2 3 而后面没有信息，则将会把3作为信息添入 1 和 2 条目
 list
     list n
     list all
 listx
 del n1 [n2] [n3] ... 删除指定记录
 front,next 
 change
////////////////////////////////////////////////////////////////
=cut


$output="C:/Documents and Settings/Amateur/桌面";
$export=0;
my @current;

while (1) {
	if ($export==0) {
		if ($path eq "") {print "\$Path:/ #";} else {print "\$Path:$path #";}
		$inp=<STDIN>;
		chomp $inp;

		if ($inp=~m/(.*)>(.*)/) {
			$inp=$1;
			open EXPORT,">${output}/$2";
			select EXPORT;
			$export=1;
		}
	} else {
		$export=0;
		close EXPORT;
		select STDOUT;
		next;
	}
	#deal 
	$inp=~s/\\d/${year}-${mon}-${day}/ig;  #这里\d代替时间
	@arg=split /\s+/,$inp;
	if ($#arg<0) {print "Empty\n"; next;}
	$else=substr($inp,length($arg[0]));  #除了第一参数后面的所有字符。
	#采用substr的原因，从$inp中提取至$else，而不是在$else中截取
	$else=~s/^\s+//; #去前面N空格
	if ($arg[0]=~/^exit/i) {
		&save;
		exit;
	} elsif ($arg[0]=~/^save$/i) {
		&save;
	} elsif ($arg[0]=~/^export$/i) {
		print "EXPORT MODE,TESTING\n";
		open WRITE,">$output/test.txt";
		select WRITE;
	} elsif ($arg[0]=~/^dir/i) {
		if ($arg[1]=~/\d+/) {
			$max=$arg[1];
		} elsif ($arg[1]=~/all/i) {
			$max="all";
		} else {
			&dir($path,1);
			next;
		}
		print "Folders:\n\n";
		if ($arg[0]=~/dirx/i) {
			&treex($path,0,$max);
		} else {
			&tree($path,0,$max);
		}
		print "\n";
	} elsif ($arg[0]=~/^cd$/i) {
		if ($#arg<1) {
			print "No arguments\n";
			next;
		} elsif ($arg[1]=~/^\d+$/) {
			if (exists $fold{$path."/".$current[$arg[1]]}) {
				$path=$path."/".$current[$arg[1]];
			} else {print "ERR : Bad codes\n";}
		} else {
			if (exists $item{$path}{$arg[1]}) {
				$path=$path . "/" . $arg[1];
			} elsif (exists $fold{$arg[1]}) {
				$path=$arg[1];
			} elsif ($arg[1] eq "..") {
				@tmp=split("/",$path);
				pop @tmp;
				$path=join "/",@tmp;	#20101224 改了方式，关于+号匹配有问题不解释
				print "$path\n";
				#$path=~s#/\w+$##;	20101217，中文不被匹配，修改为用split
			} elsif ($arg[1] eq "/") {
				$path="";
			} else {print "Folder:#$arg[1]# not exist\n\n"; next;}
		}
		&dir($path,1);
		print "\n";
		&listnote($path,0,1);
		print "\n";
	} elsif ($arg[0]=~/^add$/i) {
		if (&mkdir($else)==1) {
			&dir($path,1);
		}
	} elsif ($arg[0]=~/^info$/i) {		#MARK可能需要优化
		if ($#arg<1) {
			print "ERR: To few arguments \n";
			#如果参数只有目录名，没有info，意思是将info清空
		} elsif ($arg[2]=~m#/#) {
			print "ERR: information could not include / \n";
		} elsif (exists $fold{$path."/".$arg[1]}) {
			$fold{$path."/".$arg[1]}=$arg[2];
			&dir($path,1);
		} elsif (exists $fold{$path."/".$current[$arg[1]]}) {
			$fold{$path."/".$current[$arg[1]]}=$arg[2];
			&dir($path,1);
		} else {print "ERR: $arg[1] not exists\n";}
		if ($#arg>2) {print "info如果有空格，空格后的内容会被当做多余参数而去除\n";}
	} elsif ($arg[0]=~/^rd$/i) {
		if (exists $fold{$path."/".$else}) {
			&deltree($path."/".$else,$else);
		} elsif ($arg[1]=~/^\d+$/) {
			if (exists $fold{$path."/".$current[$arg[1]]}) {
				$else=$current[$arg[1]];
				&deltree($path."/".$else,$else);
			} else {print "ERR : Bad codes\n";}
		} else {
			print "Folder: $arg[1] dose not exists! \n";
		}
		&dir($path,1);
	} elsif ($arg[0]=~/^rename$/i) {
		if ($#arg<2) {
			print "ERR: too few arguments\n";
			next;
		}
		if ($arg[1]=~m#/#) {print "Err: arg1 Could not include:/\n";next;}
		if ($arg[2]=~m#/#) {print "Err: arg2 Could not include:/\n";next;}
		if ($arg[2]=~m#^\d+$#) {print "Err: arg2 Could not be a number\n";next;}
		#这里不用判断是否含空格，因为参数就是以空格隔开
		if (exists $fold{$path."/".$arg[2]}) {
			print "ERR: Folder $arg[2] does exists!\n";
			next;
		}
		if (exists $fold{$path."/".$arg[1]}) {
			&rename($arg[1],$arg[2],$path);
		} elsif ($arg[1]=~/^\d+$/) {
			if (exists $fold{$path."/".$current[$arg[1]]}) {
				&rename($current[$arg[1]],$arg[2],$path);
			} else {
				print "ERR: Argument: $arg[1] out of range \n";
				next;
			}
		} else {
			print "ERR: Folder $arg[1] does not exists!\n";
		}
	} elsif ($arg[0]=~/^move$/i) {
		if ($#arg<2) {print "Too few arguments\n";next;}
		foreach (1..($#arg-1)) {
			if ($arg[$_] ne $arg[$#arg]) {
				&copymove($arg[$_] , $arg[$#arg] , "move");
			} else {
				print "ERR: $arg[$_] eq $arg[$#_]\n";
			}
		}
	} elsif ($arg[0]=~/^movex$/i) {
		if ($#arg<2) {print "Too few arguments\n";next;}
		foreach (1..($#arg-1)) {
			if ($arg[$_]!=$arg[$#_]) {
				&copymove($current[$arg[$_]] , $current[$arg[$#arg]] , "move");
			} else {
				print "ERR: $arg[$_]==$arg[$#_]\n";
			}
		}
	} elsif ($arg[0]=~/^copy$/i) {
		if ($#arg<2) {print "Too few arguments\n";next;}
		foreach (1..($#arg-1)) {
			&copymove($arg[$_] , $arg[$#arg] , "copy");
		}
 	} elsif ($arg[0]=~/^del$/i) {
		if ($else eq "") {print "ERR:No argument!\n\n";next;}
		if ($else=~/(\d+)/) {
			while ($else=~s/(\d+)//) {
				$rcder{$path}[$1]="\n";
			}
			&updata();
			&listnote($path,0,1);
		} else {
			print "ERR: Arguments not a number!\n\n";
		}
	} elsif ($arg[0]=~/^note$/i) {
		if ($path eq "") {&SayRootErr; next;}
		if ($#arg<1) {
			print "Information is empty!\n";
		} else {
			$rcder{$path}[$num{$path}++]=" ".$else."\n";
			&listnote($path,0,1);
		}
	} elsif ($arg[0]=~/^notemode$/i){
		$end=0;
		while ($end==0) {
			$inp=<STDIN>;
			chomp $inp;
			if ($inp=~/^exit$/i) {
				$end=1;
			} else {
				$rcder{$path}[$num{$path}++]=" $inp\n";
			}
		}
		&listnote($path,0,1);
	} elsif ($arg[0]=~/^date$/i) {
		if ($path eq "") {&SayRootErr; next;}
		if ($#arg<1) {
			print "Information is empty!\n";
		} else {
			$rcder{$path}[$num{$path}++]=" ".
				"${year}-${mon}-${day} ".$else."\n";
			&listnote($path,0,1);
		}
	} elsif ($arg[0]=~/^mark$/i) {
		if ($path eq "") {&SayRootErr; next;}
		$fo=0;
		if ($#arg<2) {
			print "ERR: Arguments < 2\n";
		} elsif ($arg[1]=~/^\d+$/) {
			$arg[$#arg]=~s/\\t/\t/ig;
			$arg[$#arg]=~s/\\b/ /ig;
			foreach (1..($#arg-1)) {
				if ($arg[$_]=~/^\d+$/) {
					if ((0<=$arg[$_]) and ($arg[$_]<$num{$path})) { #num记录的比实际下标>1
					chomp $rcder{$path}[$arg[$_]];
					$rcder{$path}[$arg[$_]].=" $arg[$#arg]\n";
					$fo++;
					} else {print "ERR: $arg[$_] out of array\n";}
				} else {print "ERR: $arg[$_] not a number\n";}
			}
		} else {print "ERR: arg1 not a number\n";}
		&listnote($path,0,1) if ($fo>0);
	} elsif ($arg[0]=~/^push$/i) {
		if ($path eq "") {&SayRootErr; next;}
		$fo=0;
		if ($#arg<2) {
			print "ERR: Arguments < 2\n";
		} elsif ($arg[1]=~/^\d+$/) {
			$arg[$#arg]=~s/\\t/\t/ig;
			$arg[$#arg]=~s/\\b/ /ig;
			$arg[$#arg]=~s/\$date/${year}-${mon}-${day}/ig;
			foreach (1..($#arg-1)) {
				if ($arg[$_]=~/^\d+$/) {
					if ((0<=$arg[$_]) and ($arg[$_]<$num{$path})) { #num记录的比实际下标>1
					$rcder{$path}[$arg[$_]]=" "."$arg[$#arg]" . $rcder{$path}[$arg[$_]] ;
					$fo++;
					} else {print "ERR: $arg[$_] out of array\n";}
				} else {print "ERR: $arg[$_] not a number\n";}
			}
		} else {print "ERR: arg1 not a number\n";}
		&listnote($path,0,1) if ($fo>0);
	} elsif ($arg[0]=~/^left$/i) {
		if ($path eq "") {&SayRootErr; next;}
		if ($#arg<1) {
			print "ERR: Arguments < 2\n";
		} elsif ($arg[1]=~/^\d+$/) {
			if ( (0<=$arg[1]) and ($arg[1]<=$num{$path}) ) {
				$else=~s/^$arg[1] //;	#去这个编号+一个空格，后面若有空格也保留
				$else=~s/\\t/\t/ig;
				$else=~s/\\b/ /ig;      #我这里\b是空格 blank
				$rcder{$path}[$arg[1]]=~s/^ //; #因为机制中，原信息前留一个空格 MARK
				$rcder{$path}[$arg[1]]=" ". $else . $rcder{$path}[$arg[1]];
				&listnote($path,0,1);
			} else {print "ERR: $arg[$1] out of range\n";}
		} else {print "ERR: arg1 not a number\n";}
	} elsif ($arg[0]=~/^right$/i) {
		if ($path eq "") {&SayRootErr; next;}
		if ($#arg<1) {
			print "ERR: Arguments < 2\n";
		} elsif ($arg[1]=~/^\d+$/) {
			if ( (0<=$arg[1]) and ($arg[1]<=$num{$path}) ) {
				$else=~s/^$arg[1] //;	#去这个编号+一个空格，后面若有空格也保留
				$else=~s/\\t/\t/ig;
				$else=~s/\\b/ /;
				chomp $rcder{$path}[$arg[1]];
				$rcder{$path}[$arg[1]].="$else\n";
				&listnote($path,0,1);
			} else {print "ERR: $arg[$1] out of range\n";}
		} else {print "ERR: arg1 not a number\n";}
	} elsif ($arg[0]=~/^next$/i) {
		if ($path eq "") {
			print "提示:根目录不支持写入信息\n";
			next;
		}
		if ($#arg<1) {
			print "提示: 参数个数 小于 1\n";
		} elsif ($arg[1]=~/^\d+$/) {
			if ((0<=$arg[1]) and ($arg[1]<$num{$path})) {	#num记录的比实际下标>1
				print "在第 $arg[1] 条目后面追加信息,exit退出:\n";
				$end=0;
				while ($end==0) {
					$inp=<STDIN>;
					if ($inp=~/^exit\n$/i) {
						$end=1;
					} else {
						$rcder{$path}[$arg[1]].=" ".$inp;
					}
				}
				&updata();
				&listnote($path,0,1);
			} else {print "ERR: $arg[1] out of array\n";}
		} else {print "ERR: arg1 not a number\n";}
	} elsif ($arg[0]=~/^front$/i) {
		if ($path eq "") {&SayRootErr; next;}
		if ($#arg<1) {
			print "提示: 参数个数 小于 1\n";
		} elsif ($arg[1]=~/^\d+$/) {
			if ((0<=$arg[1]) and ($arg[1]<$num{$path})) {	#num记录的比实际下标>1
				print "在第 $arg[1] 条目前面追加信息,exit退出:\n";
				$end=0;
				$str="";
				while ($end==0) {
					$inp=<STDIN>;
					if ($inp=~/^exit\n$/i) {
						$end=1;
					} else {
						$str.=" ".$inp;
					}
				}
				$rcder{$path}[$arg[1]]=$str.$rcder{$path}[$arg[1]];
				&updata();
				&listnote($path,0,1);
			} else {print "ERR: $arg[1] out of array\n";}
		} else {print "ERR: arg1 not a number\n";}
	} elsif ($arg[0]=~/^change$/i) {
		if ($path eq "") {&SayRootErr; next;}
		if ($#arg<1) {
			print "ERR: Arguments < 2\n";
		} elsif ($arg[1]=~/^\d+$/) {
			if ((0<=$arg[1]) and ($arg[1]<$num{$path})) {	#num记录的比实际下标>1
				print "EVER: $rcder{$path}[$arg[1]]\nINPUT:";
				$inp=<STDIN>;  #包含换行符的
				$rcder{$path}[$arg[1]]=" ".$inp;
				&listnote($path,0,1);
			} else {print "ERR: $_ out of array\n";}
		} else {print "ERR: arg1 not a number\n";}
	} elsif ($arg[0]=~/^list$/i) {
		$max=1;
		if ($else=~/^\s*$/i) {&listnote($path,0,1);next;}
		if ($arg[1]=~/\d+/) {$max=$arg[1];}
		if ($arg[1]=~/all/i) {$max="all";}
		if ( ($arg[1]=~/\w+/) and (exists $fold{$path."/".$arg[1]}) ) {
			&listx($path."/".$arg[1],0,$max);
		} else {
			&listx($path,0,$max);
		}
		print "\n";
	} elsif ($arg[0]=~/^help$/i) {
		foreach (sort keys %command) {
			printf  "%-10s %s\n",$_,$command{$_};
		}
	} elsif ($arg[0]=~/^clear$/i) {
		&clear();
	} else {
		$tmp=$path."/".$arg[0];
		if (exists $fold{$tmp}) {
			if ($else ne "") {
				$n=$num{$tmp}++;
				$rcder{$tmp}[$n]=" ".$else ."\n";
				&listx($tmp,0,4);
			} else {
				print "Empty note!\n";
			}
		} else {
			print "Error command\n";
		}
	}
}

<STDIN>;


=Function Descript /////////////////////////////
	read	从文本读入信息
	save	保存信息
	updata	重新读取信息，即调用save 再 read
	tree	PathNow DepthLevel(0Begin) MaxDepth STR_space_n
		参数：当前路径   当前层次(初调用时统一为0)   最大层数  积累的缩进空格数
	treex	PathNow DepthLevel(0Begin) MaxDepth STR_space_n Last?(0 or 1)
		比tree多一个$last 值为1或0，自身判断是否递归到最深一层用的，貌似没用上
	dir	PathNow print/Unprint(1 or 0)
		作用，给当前目录编号，名单储存在@current，方便命令操作。
		参数1则显示，参数0则只是更新当前名单到@current
	mkdir	在当前建立分类，单参数，包括名称和info，函数会帮你做一些判断
	copymove	FolderA  FolderB  ("copy" or "move")字符参数 
			如果是move就在完成后删除FolderA
	copytree	PathA PathB (复制A到B)
	deltree	FullPath LastName Sure?("y"/"n")  
		FullPath,又另给LastName，是为了方便函数操作，不用另外处理
	listnote	Path DepthLevel MaxDepth
	listx	PathNow DepthLevel(0Begin) MaxDepth STR_space_n Last?
	clear
	SayRootErr
///////////////////////////////////////////////
=cut

sub read {
	open READ,"<$file";  # $file是全局变量
	undef %rcder;
	undef %item;
	undef %num;
	foreach (<READ>) {
		#chop;
		if (m#^/#) {
			chomp;
			@path=split "/",$_;
			$last=pop @path;
			$front=join "/",@path;
			$path=$_;		#path now
			$path=~s/ +(.*)//;	#包括空格在内的和空格后面的都replace
			if ($last=~s/ +(.*)//) {		#子目录名，也去除信息并提取到info
				$fold{$path}=$1;	#文件夹存在，并且有信息
			} else {
				$fold{$path}="";
			}
			$item{$front}{$last}="";	#for the tree , easy to list
			$num{$path}=0;			#number for record of each path
		} else {
			$rcder{$path}[$num{$path}++]="$_";  #the Real array to record
		}
	}
	close READ;
}

# @_ [0] [1] 
sub export {

}

sub save {
	open WRITE,">$file";	# $file是全局变量
	foreach (sort keys %fold) {
		print WRITE "$_ $fold{$_}\n";
		foreach $f ( @{$rcder{$_}} ) {
			print WRITE "$f" if ($f ne "\n");
		}
	}
	close WRITE;
	print "Information has been saved\n";
}

sub updata {
	&save();
	print "在重新读入\n";
	$pathnow=$path;
	&read();
	$path=$pathnow;  #path会被刷新，让其恢复。
	#不必 &dir($path,0); 更新@current，因为正是恢复目录
}


# @_ [0] [1] [2] [3] [4] - >  
# PathNow DepthLevel(0Begin) MaxDepth STR_space_n Last?
sub treex {
	my ($path,$level,$max)=@_;
	my $tmpstr;
	my $arr_n;
	my $test;
	my $last;
   	@test=split "/",$path;


	$arr_n=0;
	foreach (keys %{$item{$_[0]}}) {$arr_n++;}

	$str=substr($_[3],0,-6);
	if ($_[4]==0) {$next="+-----";} else {$next="\\-----";}
	if ($level>0) {
		print "$str$next$test[$#test]\n";
	}	#第一参数第一层，是当前目录，不显示，只显示下面层的
	if (($arr_n==0) and ($_[4]==1)) {print "$_[3]\n";}

	if ($arr_n>0) {
	if (($level<$max) or ($max eq "all")) {
 		$test=0;
		$last=0;
		foreach (sort keys %{$item{$_[0]}}) {
			if ($test<($arr_n-1)) {
				$tmpstr="|     ";
			} else {
				$tmpstr="      ";
				$last=1;
			}
			&treex( $_[0]."/".$_ , 
				$level+1 , 
				$max , 
				$_[3].$tmpstr,
				$last
			);
			$test++;
		}
	}
	}
}

# @_ [0] [1] - >  PathNow print/Unprint(1 or 0)
sub dir {
	my $num=0;
	undef @current;
	print "Folders:\n";
	foreach (sort keys %{$item{$_[0]}}) {
		$current[$num]=$_;
		if ($_[1]==1) {
			printf "%2d -> %s\t%s\n",$num++,$_,$fold{$path."/".$_};
		}
	}
	print "\n";
}

# @_ [0] -> string -> include "name information"
# 建立目录:名字不能带/ 不能是数字 不能为空 不能是已经存在的
# info的名字不能带/ 不过在第一行判断里已经判断了整个字符串不能带/
sub mkdir {
	my $arg=$_[0];
	my $create=0;
	if ($arg=~m#/#) {print "Could not include \/ \n";next;}
	if ($arg=~s/ +(.*)//) {$info=$1;} else {$info="";}
	if ($arg eq "") {
		print "Arguments is emtpy!";
	} elsif ($arg=~/^\d+$/) {
		print "Could not be a number\n";
	} elsif (exists $fold{$path."/".$arg}) {
		print "ERR : ./$arg folder exists\n";
	} else {
		$fold{$path."/".$arg}=$info;
		$item{$path}{$arg}="";
		$num{$path."/".$arg}=0;
		$create=1;
	}
	return $create;
}

# @_ [0] [1] [2] [3] - >  PathNow DepthLevel(0Begin) MaxDepth STR_space_n
sub tree {
	my ($path,$level,$max)=@_;
	my $strlen;
	@test=split "/",$path;
	$path=$test[$#test];
	$strlen=length $_[0];
	if ($level!=0) {
		if ($_[0] eq "") {print "/\n";} else {print " "x$_[3] . "/$path\n";}
	}
	if (($level<$max) or ($max eq "all")) {
		foreach (sort keys %{$item{$_[0]}}) {
			&tree($_[0]."/".$_ , $level+1 , $max , $strlen);
		}
	}
}


#$_ [0] [1] -> FolderA  FolderB  ["copy" or "move"]
sub copymove {
	$fullpatha=$path."/".$_[0];
	$fullpathb=$path."/".$_[1];
	$ok=0;
	if (exists $fold{$fullpatha}) {$ok++;} else {
		print "ERR: $fullpatha does not exists\n";
	}
	if (exists $fold{$fullpathb}) {$ok++;} else {
		print "ERR: $fullpathb does not exists\n";
	}
	if ($ok==2) {
		print "\n";
		&copytree($fullpatha,$fullpathb);
		if ($_[2] eq "move") {
			&deltree($fullpatha,$_[0],"sure");
		}
	}
}

# $_ [0] [1] [2] FolderName NewFolderName CurrentPath
# 作用:将整个目录树搬到一个新目录名的树中，然后用于重命名。
sub rename {
	#临时机制:当前的目录独立处理，其所有子目录用foreach获取
	#不与当前其他目录混淆
	my $front;
	my $last;
	my $tmp;
########  Main Folder ######
	$fold{$path."/".$_[1]}=$fold{$path."/".$_[0]};
	$rcder{$path."/".$_[1]}=$rcder{$path."/".$_[0]};
	$item{$path}{$_[1]}="";
	$num{$path."/".$_[1]}=$rcder{$path."/".$_[0]};
########
	foreach (keys %fold) {
		if (m#^$path/$_[0]/#) {  #筛选出其路径下所有子目录
			$tmp=$_;
			$tmp=~s#^$path/$_[0]/#$path/$_[1]/#;
			print "\"$_\" change to \"$tmp\"\n";
			$fold{$tmp}=$fold{$_};    #get info
			$rcder{$tmp}=$rcder{$_};  #get notes
			$num{$tmp}=$rcder{$_};    #num in array
			@tmp=split "/",$tmp;
			$last=pop @tmp;
			$front=join "/",@tmp;
			$item{$front}{$last}="";
		}
	}
	&deltree($path."/".$_[0],$_[0],"sure");
	return 1;
}

# $_[0] [1] [2] FullPathA FullPathB (A to B)
sub copytree {
	my $path=$_[0];
	my $arr_n;
	my $last;
	my @test;

   	@test=split "/",$path;
	$last=pop @test;

	print "Copy $_[0] -> $_[1]\n";
	$item{$_[1]}{$last}="";			#MARK1
	$fold{$_[1]."/".$last}=$fold{$_[1]};	#MARK2
	$num=0;
	foreach ( @{$rcder{$_[0]}}) {
			$rcder{$_[1]."/".$last}[$num++]=$_;
	}
	$num{$_[1]."/".$last}=$num;	#MARK3
	foreach (keys %{$item{$_[0]}}) {$arr_n++;}

	if ($arr_n>0) {
		foreach (sort keys %{$item{$_[0]}}) {
			&copytree(
				$_[0]."/".$_,
				$_[1]."/".$last
			);
		}
	}
}


# $_ [0] [1] [2]->  FullPath LastName Sure?
sub deltree {
	if (! $_[1]) {
		print "ERR: no arg2. notice for programer\n";
		return 0;
	}
	if ($_[2] eq "sure") {
		$sure="y";
	} else {		
		print "Folder $_[0] dose exists\n";
		print "DelTree - Are you sure ? (Y/N): ";
		$sure=<STDIN>;
	}
	if ($sure=~/y/i) {
		delete $item{$path}{$_[1]};  #path是全局变量 $_[1]是lastname
		foreach (keys %fold) {
			if (/^$_[0](\/|$)/s) {		#20101219修改，还应该辨认结尾是否为/ 否则会误删 例如: 
							# rd /a 却删除了 /a1 /a2  而一个目录也有可能是结尾所以没有/
				print "Delete $_\n";
				delete $fold{$_};
				delete $rcder{$_};
				delete $item{$_};
			}
		}
	}
}

#list record note of path
# @_ [0] [1] [2] -> Path DepthLevel MaxDepth
sub listnote {
	my ($path,$level,$max)=@_;
	my $n=0;
	$level++;
	if ($path=~m#(/\w+)$#) {$path=$1;}


	if ($_[1]>0) {
		if ($_[0] eq "") {
			print "/\n";
		} else {
			print "  "x$_[1] . "$path\n";
		}
	} else {
		print "Notes:\n";
	}

	foreach ( @{$rcder{$_[0]}}) {
		if ($level==1) {
			printf "    "x$_[1] . "%2d %s",$n++,$_;
		} else {
			print "    "x$_[1] . "$_";
		}
	}
	if (($level<$max) or ($max eq "all")) {
		foreach (sort keys %{$item{$_[0]}}) {
			&listnote($_[0]."/".$_ , $level , $_[2]);
		}
	}
}

# @_ [0] [1] [2] [3] [4] - >  
# PathNow DepthLevel(0Begin) MaxDepth STR_space_n Last?
sub listx {
	my ($path,$level,$max)=@_;
	my $tmpstr;
	my $arr_n;
	my $test;
	my $last;
   	@test=split "/",$path;

	$str=substr($_[3],0,-4);

	if ($_[4]==0) {$next="+---";} else {$next="\\---";}
	if ($level>0) {
		print "$str$next$test[$#test]\n";
	} else {
		print "Notes:\n";
	}
	#第一层，是当前目录，不显示当前目录，只显示下面层的

	foreach (keys %{$item{$_[0]}}) {$arr_n++;}
	if (($level!=$max) and ($arr_n>0)) {
		$next2="|";
	} else {
		$next2=" ";
	}

	foreach ( @{$rcder{$_[0]}}) {print "$_[3]$next2  $_";}
	if (defined $rcder{$_[0]}[0]) {print "$_[3]$next2\n";}

	if ($arr_n>0) {
	if (($level<$max) or ($max eq "all")) {
	$last=0;$test=0;
		foreach (sort keys %{$item{$_[0]}}) {
			if ($test<($arr_n-1)) {
				$tmpstr="|   ";
			} else {
				$tmpstr="    ";
				$last=1;
			}
			&listx( $_[0]."/".$_ , 
				$level+1 , 
				$max , 
				$_[3].$tmpstr,
				$last
			);
			$test++;
		}
	}
	}
}

sub clear {
	system("cls");
	if ($path eq "") {
		print "Path:/ \n\n";
	} else {
		print "Path:$path \n\n";
	}
}

sub SayRootErr {
	print "Sorry,in the Root Directory,";
	print "dose not support writting\n\n";
}
复制代码

batman

exist你真能整，882行。。。