این دستور perltie است که می تواند در ارائه دهنده هاست رایگان OnWorks با استفاده از یکی از چندین ایستگاه کاری آنلاین رایگان ما مانند Ubuntu Online، Fedora Online، شبیه ساز آنلاین ویندوز یا شبیه ساز آنلاین MAC OS اجرا شود.
برنامه:
نام
perltie - چگونه یک کلاس شی را در یک متغیر ساده پنهان کنیم
خلاصه
کراوات VARIABLE, CLASSNAME, LIST
$object = VARIABLE گره خورده
باز کردن VARIABLE
شرح
قبل از انتشار نسخه 5.0 پرل، یک برنامه نویس می توانست از آن استفاده کند dbmopen() برای اتصال روی دیسک
پایگاه داده در یونیکس استاندارد dbm(3x) به صورت جادویی به %HASH در برنامه خود فرمت کنید.
با این حال، پرل آنها یا با یک کتابخانه dbm خاص ساخته شده بود، اما نه
هر دو، و شما نمی توانید این مکانیسم را به بسته ها یا انواع متغیرهای دیگر گسترش دهید.
حالا می توانید.
La کراوات () تابع یک متغیر را به یک کلاس (بسته) متصل می کند که آن را فراهم می کند
پیاده سازی برای روش های دسترسی برای آن متغیر. وقتی این جادو انجام شد،
دسترسی به یک متغیر گره خورده به طور خودکار فراخوانی متد را در کلاس مناسب راه اندازی می کند. در
پیچیدگی کلاس پشت فراخوانی متدهای جادویی پنهان است. نام روش ها به صورت ALL هستند
CAPS، که قراردادی است که پرل برای نشان دادن اینکه به طور ضمنی نامیده می شوند، استفاده می کند
به جای صریح - درست مانند شروع() و پایان() توابع.
در کراوات () فراخوانی، "VARIABLE" نام متغیری است که باید مسحور شود. "CLASSNAME" است
نام کلاسی که اشیاء از نوع صحیح را پیاده سازی می کند. هر گونه استدلال اضافی در
"LIST" به متد سازنده مناسب برای آن کلاس منتقل می شود - معنی
TIESCALAR(), TIEARRAY(), TIEHASH()، یا TIEHANDLE(). (معمولاً اینها استدلال هایی از این قبیل هستند
همانطور که ممکن است به منتقل شود dbminit() تابع C.) شیء برگردانده شده توسط "جدید"
روش نیز توسط کراوات () تابع، که اگر بخواهید مفید خواهد بود
به روش های دیگر در "CLASSNAME" دسترسی داشته باشید. (در واقع لازم نیست یک مرجع را به a برگردانید
"نوع" سمت راست (مثلاً HASH یا "CLASSNAME") تا زمانی که یک شیء با برکت مناسب باشد.) شما
همچنین می تواند یک مرجع به شی زیربنایی با استفاده از گره خورده است() تابع.
برخلاف dbmopen()از کراوات () تابع "استفاده" یا "نیاز" یک ماژول برای شما -- شما
باید خودتان این کار را به صراحت انجام دهید.
بستن اسکالرها
کلاسی که یک اسکالر گره خورده را پیاده سازی می کند باید متدهای زیر را تعریف کند: TIESCALAR، FETCH،
ذخیره کنید، و احتمالاً UNTIE و/یا DESTROY کنید.
بیایید هر کدام را به نوبه خود بررسی کنیم و به عنوان مثال از کلاس Tie برای اسکالرها استفاده کنیم که اجازه می دهد
کاربر برای انجام کاری شبیه به:
tie $his_speed, 'Nice', getppid();
کراوات $my_speed، 'خوب'، $$;
و اکنون هر زمان که به هر یک از آن متغیرها دسترسی پیدا کرد، اولویت سیستم فعلی آن است
بازیابی و برگردانده شد. اگر آن متغیرها تنظیم شده باشند، اولویت فرآیند است
تغییر کرد!
ما از Jarkko Hietaniemi استفاده خواهیم کرد[ایمیل محافظت شده]>'s BSD::کلاس منبع (شامل نمی شود) برای دسترسی
ثابت های PRIO_PROCESS، PRIO_MIN، و PRIO_MAX از سیستم شما، و همچنین
اولویت () و اولویت () تماس های سیستمی در اینجا مقدمه کلاس است.
بسته Nice;
استفاده از کپور;
استفاده از BSD::Resource;
سخت استفاده کنید
$Nice::DEBUG = 0 مگر اینکه تعریف شده باشد $Nice::DEBUG;
نام کلاس TIESCALAR، LIST
این سازنده کلاس است. این بدان معنی است که انتظار می رود که یک نعمت را برگرداند
اشاره به اسکالر جدیدی (احتمالاً ناشناس) که در حال ایجاد آن است. مثلا:
زیر TIESCALAR {
کلاس $ من = shift;
من $pid = shift || $$; # 0 یعنی من
if ($pid !~ /^\d+$/) {
ماهی کپور "Nice::Tie::Scalar دارای pid غیر عددی $pid" اگر $^W;
بازگشت unef;
}
مگر اینکه (0، $pid را بکشید) { # EPERM یا ERSCH، بدون شک
کپور "خوب::Tie::Scalar pid بد شد $pid: $!" اگر $^W;
بازگشت unef;
}
بازگشت bless \$pid, $class;
}
این کلاس Tie انتخاب کرده است که یک خطا را به جای ایجاد یک استثنا در صورت وجود خطا برگرداند
سازنده باید شکست بخورد. در حالی که اینگونه است dbmopen() کار می کند، کلاس های دیگر ممکن است خوب باشد
نمی خواهم اینقدر بخشنده باشم متغیر جهانی $^W را بررسی می کند تا ببیند آیا باید منتشر شود یا خیر
به هر حال کمی سر و صدا
واکشی این
این روش با هر بار دسترسی به متغیر گره خورده (خواندن) فعال می شود. آی تی
هیچ استدلالی را فراتر از ارجاع خود، که شی معرف آن است، نمی گیرد
اسکالر ما با آن سر و کار داریم. زیرا در این مورد ما فقط از یک مرجع SCALAR برای آن استفاده می کنیم
شی اسکالر گره خورده، یک $$self ساده به روش اجازه می دهد تا به مقدار واقعی ذخیره شده برسد
آنجا. در مثال زیر، آن مقدار واقعی شناسه فرآیندی است که به آن گره خوردهایم
متغیر ما
زیر واکشی {
من $self = shift;
اعتراف به "نوع اشتباه" مگر اینکه ref $self;
croak "خطای استفاده" اگر @_;
من $خوبی;
محلی($!) = 0;
$nicety = اولویت (PRIO_PROCESS, $$self);
if ($!) { croak "getpriority شکست: $!" }
بازگشت $nicety;
}
این بار تصمیم گرفته ایم در صورت شکست renice (یک استثناء) را منفجر کنیم - وجود دارد
جایی برای ما نیست که در غیر این صورت خطا را برگردانیم، و احتمالاً این کار درستی است.
ذخیره این، ارزش
این روش هر بار که متغیر گره خورده تنظیم شود (تخصیص داده شود) راه اندازی می شود. فراتر
مرجع خود، همچنین انتظار یک (و تنها یک) آرگومان دارد: مقدار جدید the
کاربر در حال تلاش برای اختصاص دادن است. نگران بازگشت یک مقدار از STORE نباشید. معنایی
تخصیصی که مقدار اختصاص داده شده را برمی گرداند با FETCH پیاده سازی می شود.
فروشگاه فرعی {
من $self = shift;
اعتراف به "نوع اشتباه" مگر اینکه ref $self;
$new_nicety من = shift;
croak "خطای استفاده" اگر @_;
if ($new_nicety < PRIO_MIN) {
کپور sprintf
"هشدار: اولویت %d کمتر از حداقل اولویت سیستم %d"،
$new_nicety، PRIO_MIN اگر $^W;
$new_nicety = PRIO_MIN;
}
if ($new_nicety > PRIO_MAX) {
کپور sprintf
"هشدار: اولویت %d بیشتر از حداکثر اولویت سیستم %d"،
$new_nicety، PRIO_MAX اگر $^W;
$new_nicety = PRIO_MAX;
}
مگر اینکه (اولویت تعیین شده (PRIO_PROCESS، $$self، $new_nicety)) {
اعتراف کنید "اصلاحیت ناموفق: $!";
}
}
این را باز کنید
این روش زمانی فعال می شود که "باز کردن" رخ دهد. این می تواند مفید باشد اگر کلاس
باید بداند چه زمانی تماس دیگری برقرار نخواهد شد. (البته به جز DESTROY.) به "The
برای جزئیات بیشتر در زیر "باز کردن" گوچا.
اینو نابود کن
این روش زمانی فعال می شود که متغیر گره خورده باید از بین برود. همانطور که با
دیگر کلاسهای شی، چنین روشی به ندرت ضروری است، زیرا Perl آن را توزیع میکند
حافظه شی در حال مرگ برای شما به طور خودکار - این C++ نیست، می دانید. ما از a استفاده خواهیم کرد
روش DESTROY در اینجا فقط برای اهداف اشکال زدایی است.
زیر تخریب {
من $self = shift;
اعتراف به "نوع اشتباه" مگر اینکه ref $self;
ماهی کپور "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
}
این در مورد تمام چیزی است که در آن وجود دارد. در واقع، این بیش از هر چیزی است که در آن وجود دارد، زیرا
ما در اینجا چند کار خوب به خاطر کامل بودن، استحکام و کلیات انجام داده ایم
زیبایی شناسی کلاس های TIESCALAR ساده تر قطعا امکان پذیر است.
بستن آرایه ها
کلاسی که یک آرایه معمولی گره خورده را پیاده سازی می کند باید متدهای زیر را تعریف کند: TIEARRAY،
FETCH، STORE، FETCHSIZE، STORESIZE، CLEAR و شاید UnTIE و/یا DESTROY.
FETCHSIZE و STORESIZE برای ارائه #آرایه $ و معادل "scalar(@array)" استفاده می شوند.
دسترسی به
اگر پرل باشد، روشهای POP، PUSH، SHIFT، UNSHIFT، SPLICE، DELETE و EXISTS مورد نیاز است.
عملگر با نام مربوطه (اما با حروف کوچک) باید روی آرایه گره خورده کار کند. در
کراوات:: آرایه کلاس می تواند به عنوان یک کلاس پایه برای پیاده سازی پنج مورد اول از این موارد استفاده شود
از روش های اساسی بالا پیاده سازی های پیش فرض DELETE و EXISTS در
کراوات:: آرایه به سادگی "قار کردن".
علاوه بر این، EXTEND زمانی فراخوانی میشود که perl تخصیص از پیش گسترشیافته در یک واقعی داشته باشد
آرایه.
برای این بحث، آرایهای را پیادهسازی میکنیم که عناصر آن در هنگام ایجاد اندازه ثابت هستند.
اگر سعی کنید عنصری بزرگتر از اندازه ثابت ایجاد کنید، یک استثنا می گیرید. برای
مثال:
از FixedElem_Array استفاده کنید.
tie @array, 'FixedElem_Array', 3;
$array[0] = 'cat'; # خوب.
$array[1] = 'سگ'; # استثنا، طول ("سگ") > 3.
کد مقدمه کلاس به شرح زیر است:
بسته FixedElem_Array.
استفاده از کپور;
سخت استفاده کنید
نام کلاس TIEARRAY، LIST
این سازنده کلاس است. این بدان معنی است که انتظار می رود که یک نعمت را برگرداند
مرجعی که از طریق آن آرایه جدید (احتمالاً یک مرجع آرایه ناشناس) قرار خواهد گرفت
دسترسی پیدا کرد.
در مثال ما، فقط برای اینکه به شما نشان دهیم که این کار را نمی کنید واقعا باید یک آرایه را برگرداند
مرجع، ما یک مرجع HASH را برای نشان دادن شی ما انتخاب می کنیم. HASH کار می کند
و همچنین یک نوع رکورد عمومی: فیلد "{ELEMSIZE}" حداکثر عنصر را ذخیره می کند
اندازه مجاز است، و فیلد "{ARRAY}" مرجع آرایه واقعی را نگه می دارد. اگر کسی
خارج از کلاس سعی می کند به شیء برگشتی ارجاع دهد (بی شک با فکر کردن به آن
آرایه ref)، آنها منفجر خواهند شد. این فقط به شما نشان می دهد که باید به آن احترام بگذارید
حریم خصوصی شی
زیر TIEARRAY {
کلاس $ من = shift;
my $elemsize = shift;
if ( @_ || $elemsize =~ /\D/ ) {
croak "usage: tie ARRAY, '" . __بسته__. "', elem_size";
}
بازگشت مبارک {
ELEMSIZE => $elemsize،
آرایه => []،
}، $class;
}
واکشی این، فهرست
این روش هر بار که یک عنصر مجزا در آرایه گره خورده باشد، راه اندازی می شود
قابل دسترسی (خواندن) این یک آرگومان را فراتر از ارجاع خود می برد: شاخصی که
ارزشی که ما سعی می کنیم بدست آوریم
زیر واکشی {
من $self = shift;
من $index = shift;
بازگشت $self->{ARRAY}->[$index];
}
اگر از یک شاخص آرایه منفی برای خواندن از یک آرایه استفاده شود، شاخص ترجمه می شود
با فراخوانی FETCHSIZE قبل از اینکه به FETCH منتقل شوید، به یک مثبت داخلی بروید. شما
ممکن است این ویژگی را با اختصاص یک مقدار واقعی به متغیر $NEGATIVE_INDICES غیرفعال کند
در کلاس آرایه گره خورده
همانطور که متوجه شده اید، نام روش FETCH (و همکاران) برای همه یکسان است
دسترسی ها، حتی اگر سازنده ها در نام ها متفاوت باشند (TIESCALAR در مقابل TIEARRAY). در حالی که
در تئوری، شما میتوانید کلاس یکسانی داشته باشید که چندین نوع گره خورده را سرویس میدهد، در عمل این
دست و پا گیر می شود، و راحت تر است که آنها را در یک نوع کراوات در هر کلاس نگه دارید.
این، فهرست، مقدار را ذخیره کنید
این روش هر بار که یک عنصر در آرایه گره خورده تنظیم شود، راه اندازی می شود
(نوشته شده است). این دو آرگومان را فراتر از مرجع خود می طلبد: شاخصی که در آن قرار داریم
تلاش برای ذخیره چیزی و ارزشی که می خواهیم در آنجا قرار دهیم.
در مثال ما، "undef" در واقع تعداد فاصله های "$self->{ELEMSIZE}" است، بنابراین ما یک
کار کمی بیشتر برای انجام در اینجا:
فروشگاه فرعی {
من $self = shift;
my( $index, $value ) = @_;
if ( طول $value > $self->{ELEMSIZE} ) {
croak "طول $value بیشتر از $self->{ELEMSIZE} است";
}
# جاهای خالی را پر کنید
$self->EXTEND( $index ) if $index > $self->FETCHSIZE();
# right justify برای حفظ اندازه عنصر برای عناصر کوچکتر
$self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s"، $value;
}
با شاخص های منفی مانند FETCH رفتار می شود.
این را واکشی کنید
تعداد کل آیتم های موجود در آرایه گره خورده مرتبط با شی را برمی گرداند این.
(معادل "scalar(@array)"). مثلا:
زیر FETCHSIZE {
من $self = shift;
بازگشت اسکالر @{$self->{ARRAY}};
}
این را ذخیره کنید، بشمارید
تعداد کل آیتم ها را در آرایه گره خورده مرتبط با شی تنظیم می کند این به
تعداد دفعات مشاهده. اگر این آرایه را بزرگتر کند، نگاشت کلاس از "undef" باید باشد
برای موقعیت های جدید بازگشت. اگر آرایه کوچکتر شود، ورودی های بیش از شمارش می شود
باید حذف شود
در مثال ما، 'undef' در واقع عنصری است که حاوی "$self->{ELEMSIZE}" تعداد
فضاها رعایت کنید:
زیر STORESIZE {
من $self = shift;
من $count = shift;
if ( $count > $self->FETCHSIZE() ) {
foreach ( $count - $self->FETCHSIZE() .. $count ) {
$self->STORE($_, '' );
}
} elif ( $count < $self->FETCHSIZE() ) {
foreach ( 0 .. $self->FETCHSIZE() - $count - 2 ) {
$self->POP();
}
}
}
این را گسترش دهید، بشمارید
تماس آموزنده آن آرایه احتمالاً رشد خواهد کرد تعداد دفعات مشاهده ورودی های. قابل استفاده است
بهینه سازی تخصیص این روش نیاز به هیچ کاری ندارد.
در مثال ما، میخواهیم مطمئن شویم که هیچ ورودی خالی ("undef") وجود ندارد، بنابراین "EXTEND"
از "STORESIZE" برای پر کردن عناصر در صورت نیاز استفاده می کند:
زیر EXTEND {
من $self = shift;
من $count = shift;
$self->STORESIZE( $count );
}
این کلید وجود دارد
بررسی کنید که عنصر در فهرست است کلید در آرایه گره خورده وجود دارد این.
در مثال ما، تعیین می کنیم که اگر یک عنصر از "$self->{ELEMSIZE}" تشکیل شده باشد.
فقط فضاها وجود ندارد:
زیر وجود دارد {
من $self = shift;
من $index = shift;
برگردان 0 اگر ! تعریف شده $self->{ARRAY}->[$index] ||
$self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE};
1 بازگشت؛
}
این را حذف کنید، کلید
عنصر موجود در فهرست را حذف کنید کلید از آرایه گره خورده این.
در مثال ما، یک مورد حذف شده فاصله های "$self->{ELEMSIZE}" است:
زیر حذف {
من $self = shift;
من $index = shift;
return $self->STORE( $index, '' );
}
این را پاک کن
پاک کردن (حذف، حذف، ...) همه مقادیر از آرایه گره خورده مرتبط با شی
این. مثلا:
زیر پاک کردن {
من $self = shift;
بازگشت $self->{ARRAY} = [];
}
این را فشار دهید، فهرست کنید
الحاق عناصر از لیست به آرایه مثلا:
زیر فشار {
من $self = shift;
لیست @ من = @_;
my $last = $self->FETCHSIZE();
$self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
return $self->FETCHSIZE();
}
این را پاپ کنید
آخرین عنصر آرایه را حذف کرده و آن را برگردانید. مثلا:
زیر POP {
من $self = shift;
بازگشت پاپ @{$self->{ARRAY}};
}
این را تغییر دهید
اولین عنصر آرایه را بردارید (بقیه عناصر را به پایین منتقل کنید) و آن را برگردانید.
مثلا:
زیر SHIFT {
من $self = shift;
بازگشت شیفت @{$self->{ARRAY}};
}
UNSHIFT این، LIST
عناصر LIST را در ابتدای آرایه وارد کنید و عناصر موجود را به بالا ببرید
جا باز کن مثلا:
زیر UNSHIFT {
من $self = shift;
لیست @ من = @_;
my $size = scalar( @list );
# جا برای لیست ما باز کنید
@{$self->{ARRAY}}[$size .. $#{$self->{ARRAY}} + $size ]
= @{$self->{ARRAY}};
$self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
}
SPLICE this, offset, length, LIST
معادل "Splice" را روی آرایه انجام دهید.
چاپ افست اختیاری است و به صورت پیش فرض صفر است، مقادیر منفی از انتهای آن به عقب می شمارند
آرایه
طول اختیاری است و به صورت پیش فرض بقیه آرایه است.
لیست ممکن است خالی باشد
لیستی از نسخه اصلی را برمی گرداند طول عناصر در چاپ افست.
در مثال ما، اگر یک میانبر وجود داشته باشد، از یک میانبر کوچک استفاده خواهیم کرد لیست:
SPLICE فرعی {
من $self = shift;
من $offset = shift || 0;
my $length = shift || $self->FETCHSIZE() - $offset;
لیست @ من = ();
اگر (@_) {
tie @list, __PACKAGE__, $self->{ELEMSIZE};
@list = @_;
}
بازگشت اسپلایس @{$self->{ARRAY}}، $offset، $length، @list;
}
این را باز کنید
هنگامی که "باز کردن" اتفاق می افتد نامیده می شود. («باز کردن» گوچا» را در زیر ببینید.)
اینو نابود کن
این روش زمانی فعال می شود که متغیر گره خورده باید از بین برود. همانطور که با
کلاس Scalar tie، این تقریباً هرگز در زبانی که خودش را انجام می دهد مورد نیاز نیست
جمع آوری زباله، بنابراین این بار آن را کنار می گذاریم.
بستن هاش
هش ها اولین نوع داده پرل بودند که گره خوردند (نگاه کنید به dbmopen()). کلاسی که a
هش گره خورده باید متدهای زیر را تعریف کند: TIEHASH سازنده است. FETCH و
STORE به جفت کلید و مقدار دسترسی پیدا کنید. EXISTS گزارش می دهد که آیا یک کلید در آن وجود دارد یا خیر
هش کنید و DELETE یکی را حذف می کند. CLEAR با حذف تمام کلید و مقدار، هش را خالی می کند
جفت FIRSTKEY و NEXTKEY اجرا می کنند کلیدها() و هر یک() توابع برای تکرار بیش از همه
کلیدها. SCALAR زمانی فعال می شود که هش گره خورده در زمینه اسکالر ارزیابی شود. UNTIE است
زمانی که "untie" اتفاق می افتد، فراخوانی می شود، و زمانی که متغیر گره خورده زباله باشد، DESTROY فراخوانی می شود
جمع آوری شده.
اگر این مقدار زیاد به نظر میرسد، میتوانید از Tie::StdHash صرفاً استاندارد به ارث ببرید.
ماژول برای اکثر روش های شما، تنها موارد جالب را بازتعریف می کند. به Tie::Hash for مراجعه کنید
جزئیات.
به یاد داشته باشید که پرل بین کلیدی که در هش وجود ندارد و کلید تمایز قائل می شود
موجود در هش اما دارای مقدار متناظر "undef". دو احتمال
می توان با توابع "exists()" و "defined()" تست کرد.
در اینجا نمونه ای از یک کلاس هش گره خورده تا حدودی جالب آورده شده است: به شما یک هش می دهد
نشان دهنده فایل های نقطه ای یک کاربر خاص است. شما با نام the در هش فهرست می کنید
فایل (منهای نقطه) و شما محتویات آن فایل نقطه را برمی گردانید. مثلا:
از DotFiles استفاده کنید.
%dot، 'DotFiles';
اگر ($dot{profile} =~ /MANPATH/ ||
$dot{login} =~ /MANPATH/ ||
$dot{cshrc} =~ /MANPATH/ )
{
چاپ "به نظر می رسد شما MANPATH خود را تنظیم کرده اید\n"؛
}
یا در اینجا نمونه دیگری از استفاده از کلاس tied ما وجود دارد:
% him، 'DotFiles'، 'daemon' را گره بزنید.
foreach $f ( کلیدهای %him ) {
printf "فایل دیمون دات %s اندازه %d\n است"،
$f، طول $him{$f};
}
در مثال DotFiles هش گره خورده خود، از یک هش معمولی برای شی حاوی چندین مورد استفاده می کنیم
فیلدهای مهم، که فقط فیلد "{LIST}" همان چیزی است که کاربر به آن فکر می کند
هش واقعی
USER که فایل های نقطه ای او را این شی نشان می دهد
HOME که در آن فایل های نقطه زندگی می کنند
CLOBBER
آیا باید سعی کنیم آن فایل های نقطه ای را تغییر دهیم یا حذف کنیم
هش نام فایل های نقطه و نگاشت محتوا را فهرست کنید
اینجا شروع است Dotfiles.pm:
بسته DotFiles;
استفاده از کپور;
ساب whowasi { (تماس گیرنده(1)[3]. '()'}
$DEBUG = 0;
اشکال زدایی فرعی { $DEBUG = @_ ? شیفت : 1 }
برای مثال، میخواهیم بتوانیم اطلاعات اشکالزدایی را برای کمک به ردیابی در طول ارسال کنیم
توسعه. ما همچنین یک تابع راحت را در داخل برای کمک به چاپ نگه می داریم
هشدارها؛ whowasi() نام تابعی را که آن را فراخوانی می کند برمی گرداند.
در اینجا روش هایی برای هش گره خورده DotFiles آمده است.
نام کلاس TIEHASH، LIST
این سازنده کلاس است. این بدان معنی است که انتظار می رود که یک نعمت را برگرداند
مرجعی که از طریق آن شی جدید (احتمالاً اما نه لزوماً ناشناس است
hash) قابل دسترسی خواهد بود.
سازنده اینجاست:
زیر تیهش {
من $self = shift;
my $user = shift || $>;
من $dotdir = shift || ''
croak "usage: @{[&whowasi]} [USER [DOTDIR]]" اگر @_;
$user = getpwuid($user) اگر $user =~ /^\d+$/;
$dir من = (getpwnam($user))[7]
|| croak "@{[&whowasi]}: بدون کاربر $user";
$dir .= "/$dotdir" اگر $dotdir;
من $node = {
USER => $user،
HOME => $dir،
LIST => {}،
CLOBBER => 0،
};
opendir (DIR، $dir)
|| croak "@{[&whowasi]}: نمی توان $dir: $ را باز کرد!";
foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
$dot =~ s/^\.//;
$node->{LIST}{$dot} = undef;
}
closeir DIR;
بازگشت bless $node, $self;
}
احتمالاً شایان ذکر است که اگر می خواهید مقادیر بازگشتی را با فایل تست کنید
از یک readdir، بهتر است دایرکتوری مورد نظر را در پیش بگیرید. در غیر این صورت، چون ما
نه chdir() در آنجا، فایل اشتباهی را آزمایش می کرد.
واکشی این، کلید
این روش هر بار که به عنصری در هش گره خورده دسترسی پیدا میکند فعال میشود
(خواندن). این یک آرگومان را فراتر از مرجع خود می برد: کلیدی که ارزش آن را داریم
تلاش برای واکشی
در اینجا واکشی برای مثال DotFiles ما آمده است.
زیر واکشی {
کپور &whowasi if $DEBUG;
من $self = shift;
من $dot = shift;
my $dir = $self->{HOME};
my $file = "$dir/.$dot";
مگر اینکه ($self->{LIST}->{$dot} || -f $file وجود داشته باشد) {
carp "@{[&whowasi]}: بدون $dot فایل" اگر $DEBUG;
بازگشت unef;
}
if (تعریف شده $self->{LIST}->{$dot}) {
بازگشت $self->{LIST}->{$dot};
} دیگری {
return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
}
}
نوشتن آن با فراخوانی یونیکس آسان بود گربه(1) فرمان، اما احتمالا این کار را می کند
برای باز کردن فایل به صورت دستی قابل حمل تر باشد (و تا حدودی کارآمدتر). البته،
از آنجا که فایلهای نقطهای یک مفهوم یونیکسی هستند، ما چندان نگران نیستیم.
این، کلید، مقدار را ذخیره کنید
این روش هر بار که یک عنصر در هش گره خورده تنظیم شود (نوشته شود) راه اندازی می شود.
این دو آرگومان فراتر از ارجاع خود به خود می گیرد: شاخصی که در تلاشیم
چیزی را ذخیره کنید، و ارزشی را که میخواهیم در آنجا قرار دهیم.
در اینجا در مثال DotFiles ما، مراقب خواهیم بود که اجازه ندهیم آنها سعی کنند فایل را بازنویسی کنند
فایل مگر اینکه با آن تماس گرفته باشند clobber() روش در مرجع شی اصلی
توسط کراوات ().
فروشگاه فرعی {
کپور &whowasi if $DEBUG;
من $self = shift;
من $dot = shift;
من $value = shift;
my $file = $self->{HOME}. "/.$dot";
my $user = $self->{USER};
croak "@{[&whowasi]}: $file قابل تغییر نیست"
مگر اینکه $self->{CLOBBER};
open(my $f, '>', $file) || croak "نمی توان $file: $ را باز کرد!";
چاپ $f $value;
بستن ($f);
}
اگر آنها می خواستند چیزی را لوس کنند، ممکن است بگویند:
$ob = tie %daemon_dots, 'daemon';
$ob->کلوبگر(1)؛
$daemon_dots{signature} = "یک دیمون واقعی\n";
راه دیگر برای قرار دادن ارجاع به شی زیرین، استفاده از آن است گره خورده است()
عملکرد، بنابراین ممکن است به طور متناوب با استفاده از:
%daemon_dots، 'daemon';
گره خورده(%daemon_dots)->کلوبگر(1)؛
روش clobber به سادگی:
ساب کلببر {
من $self = shift;
$self->{CLOBBER} = @_ ? شیفت : 1;
}
این را حذف کنید، کلید
این روش زمانی فعال می شود که یک عنصر را از هش حذف می کنیم، معمولاً با استفاده از
la حذف() عملکرد. دوباره، ما مراقب خواهیم بود تا بررسی کنیم که آیا آنها واقعاً می خواهند
فایل های clobber
زیر حذف {
کپور &whowasi if $DEBUG;
من $self = shift;
من $dot = shift;
my $file = $self->{HOME}. "/.$dot";
croak "@{[&whowasi]}: فایل $file را حذف نخواهد کرد"
مگر اینکه $self->{CLOBBER};
حذف $self->{LIST}->{$dot}؛
my $success = unlink($file);
carp "@{[&whowasi]}: نمی توان پیوند $file: $ را لغو کرد!" مگر اینکه $موفقیت;
$موفقیت؛
}
مقدار برگشتی توسط DELETE به مقدار برگشتی تماس به تبدیل می شود حذف(). اگر شما
می خواهید رفتار عادی را تقلید کنید حذف()، باید هر چه واکشی را برگردانید
برای این کلید برمی گشت. در این مثال، به جای آن، a را برگردانیم
مقداری که به تماس گیرنده می گوید که آیا فایل با موفقیت حذف شده است یا خیر.
این را پاک کن
این روش زمانی فعال می شود که قرار است کل هش پاک شود، معمولاً با اختصاص دادن
لیست خالی به آن
در مثال ما، که تمام فایل های نقطه کاربر را حذف می کند! خیلی خطرناکه
چیزی که آنها باید CLOBBER را روی چیزی بالاتر از 1 تنظیم کنند تا این اتفاق بیفتد.
زیر پاک کردن {
کپور &whowasi if $DEBUG;
من $self = shift;
croak "@{[&whowasi]}: همه فایلهای نقطهای را برای $self->{USER} حذف نمیکند.
مگر اینکه $self->{CLOBBER} > 1;
من $dot;
foreach $dot ( کلیدهای %{$self->{LIST}}) {
$self->DELETE($dot);
}
}
این کلید وجود دارد
این روش زمانی فعال می شود که کاربر از آن استفاده می کند وجود دارد() عملکرد بر روی یک خاص
هش در مثال خود، عنصر هش "{LIST}" را برای این مورد بررسی خواهیم کرد:
زیر وجود دارد {
کپور &whowasi if $DEBUG;
من $self = shift;
من $dot = shift;
بازگشت وجود دارد $self->{LIST}->{$dot};
}
اول این
این روش زمانی فعال می شود که کاربر قصد دارد از طریق هش تکرار کند
همانطور که از طریق a کلیدها(), ارزش های()، یا هر یک() زنگ زدن.
زیر FIRSTKEY {
کپور &whowasi if $DEBUG;
من $self = shift;
my $a = کلیدهای %{$self->{LIST}}; # هر تکرار کننده() را بازنشانی کنید
هر %{$self->{LIST}}
}
FIRSTKEY همیشه در زمینه اسکالر فراخوانی می شود و فقط باید اولین کلید را برگرداند.
ارزش های()و هر یک() در زمینه لیست، FETCH را برای کلیدهای برگشتی فراخوانی می کند.
NEXTKEY این، آخرین کلید
این روش در طول یک راه اندازی می شود کلیدها(), ارزش های()، یا هر یک() تکرار. آن دارد یک
آرگومان دوم که آخرین کلیدی است که به آن دسترسی پیدا شده است. این مفید است اگر
شما به سفارش یا فراخوانی تکرار کننده از بیش از یک دنباله اهمیت می دهید، یا
واقعاً چیزها را در هیچ جایی در هش ذخیره نمی کنید.
NEXTKEY همیشه در زمینه اسکالر فراخوانی می شود و فقط باید کلید بعدی را برگرداند.
ارزش های()و هر یک() در زمینه لیست، FETCH را برای کلیدهای برگشتی فراخوانی می کند.
برای مثال، ما از یک هش واقعی استفاده میکنیم، بنابراین کار سادهای را انجام میدهیم، اما این کار را انجام خواهیم داد
باید به طور غیر مستقیم از طریق فیلد LIST بروید.
زیر NEXTKEY {
کپور &whowasi if $DEBUG;
من $self = shift;
هر %{ $self->{LIST} } را برگردانید
}
SCALAR این
زمانی که هش در زمینه اسکالر ارزیابی می شود، این نام خوانده می شود. به منظور تقلید از
رفتار هش های گره خورده، این روش باید یک مقدار نادرست را هنگام هش گره خورده برگرداند
خالی در نظر گرفته می شود. اگر این روش وجود نداشته باشد، پرل تعدادی را آموزش دیده است
حدس می زند و زمانی که هش داخل یک تکرار است، true را برمی گرداند. اگر اینطور نیست،
FIRSTKEY فراخوانی می شود و اگر FIRSTKEY مقدار خالی را برگرداند، نتیجه یک مقدار نادرست خواهد بود
لیست، در غیر این صورت درست است.
حال، شما باید نه کورکورانه به پرل که همیشه کار درست را انجام می دهد تکیه کنید.
به خصوص، زمانی که هش را به طور مکرر پاک می کنید، perl به اشتباه true را برمی گرداند
تماس DELETE تا زمانی که خالی شود. بنابراین به شما توصیه می شود SCALAR خود را تهیه کنید
زمانی که میخواهید کاملاً مطمئن باشید که هش شما در اسکالر به خوبی رفتار میکند
متن نوشته.
در مثال ما فقط میتوانیم «اسکالر» را در هش زیربنایی که توسط آن ارجاع داده شده است صدا کنیم
"$self->{LIST}":
زیر اسکالار {
کپور &whowasi if $DEBUG;
من $self = shift;
بازگشتی اسکالر %{ $self->{LIST} }
}
این را باز کنید
زمانی که "باز کردن" رخ می دهد به این نام می گویند. "باز کردن" گوچا" را در زیر ببینید.
اینو نابود کن
این روش زمانی فعال می شود که هش گره خورده در حال خارج شدن از محدوده باشد. شما این کار را نمی کنید
واقعاً به آن نیاز دارید مگر اینکه بخواهید اشکال زدایی را اضافه کنید یا حالت کمکی برای تمیز کردن داشته باشید
بالا در اینجا یک تابع بسیار ساده وجود دارد:
زیر تخریب {
کپور &whowasi if $DEBUG;
}
توجه داشته باشید که توابعی مانند کلیدها() و ارزش های() ممکن است در صورت استفاده در بزرگ لیست های بزرگ را برگرداند
اشیاء، مانند فایل های DBM. ممکن است ترجیح دهید از آن استفاده کنید هر یک() تابع برای تکرار بیش از این.
مثال:
# آفست فایل تاریخچه را چاپ کنید
از NDBM_File استفاده کنید.
tie(%HIST، 'NDBM_File'، '/usr/lib/news/history'، 1، 0);
در حالی که (($key,$val) = هر %HIST) {
print $key, ' = ', unpack('L',$val), "\n";
}
باز کردن (%HIST);
بستن File Handles
این در حال حاضر تا حدی اجرا شده است.
کلاسی که یک filehandle گره خورده را پیاده سازی می کند باید متدهای زیر را تعریف کند: TIEHANDLE، at
حداقل یکی از PRINT، PRINTF، WRITE، READLINE، GETC، READ، و احتمالاً CLOSE، UNTIE و
از بین رفتن. کلاس همچنین می تواند ارائه دهد: BINMODE، OPEN، EOF، FILENO، SEEK، TELL - اگر
عملگرهای پرل مربوطه روی دسته استفاده می شود.
هنگامی که STDERR گره خورده است، روش PRINT آن برای صدور اخطارها و پیام های خطا فراخوانی می شود.
این ویژگی به طور موقت در طول تماس غیرفعال می شود، به این معنی که می توانید از "warn()" استفاده کنید.
داخل PRINT بدون شروع یک حلقه بازگشتی. و درست مانند "__WARN__" و "__DIE__"
کنترل کننده ها، روش STDERR's PRINT ممکن است برای گزارش خطاهای تجزیه کننده فراخوانی شود، بنابراین هشدارها
ذکر شده در "%SIG" در perlvar application.
همه اینها به ویژه زمانی مفید است که پرل در برنامه دیگری تعبیه شده باشد، جایی که خروجی دارد
به STDOUT و STDERR ممکن است باید به روش خاصی هدایت شوند. nvi و the را ببینید
ماژول آپاچی برای مثال.
هنگام گره زدن یک دسته، اولین آرگومان برای "کراوات" باید با یک ستاره شروع شود. بنابراین، اگر
شما در حال گره زدن STDOUT هستید، از *STDOUT استفاده کنید. اگر آن را به یک متغیر اسکالر اختصاص داده اید، بگویید
$handle، از *$handle استفاده کنید. "tie $handle" متغیر اسکالر $handle را گره می زند، نه دسته را
درون آن.
در مثال ما یک دسته فریاد ایجاد می کنیم.
بسته فریاد;
TIEHANDLE نام کلاس، فهرست
این سازنده کلاس است. این بدان معنی است که انتظار می رود که یک نعمت را برگرداند
به نوعی مرجع از مرجع می توان برای نگهداری برخی از اطلاعات داخلی استفاده کرد.
زیر تیهندل { چاپ " \n"؛ $i من؛ برکت \$i، shift }
این را بنویسید، فهرست کنید
این متد زمانی فراخوانی می شود که دسته از طریق تابع "syswrite" روی آن نوشته شود.
زیر نوشتن {
$r = shift;
my($buf,$len,$offset) = @_;
چاپ "WRITE call, \$buf=$buf, \$len=$len, \$offset=$offset";
}
این را چاپ کنید، فهرست کنید
این روش هر بار که دستگیره گره خورده با آن چاپ می شود، فعال می شود
توابع "print()" یا "say()". فراتر از مرجع خود، لیست را نیز انتظار دارد
که به تابع چاپ منتقل شد.
sub PRINT {$r = shift; $$r++; چاپ join($,,map(uc($_),@_)),$\ }
"say()" درست مانند "print()" عمل می کند به جز اینکه $\ به "\n" محلی می شود، بنابراین شما باید این کار را انجام دهید.
هیچ چیز خاصی برای رسیدگی به "say()" در "PRINT()".
این را چاپ کنید، فهرست
این روش هر بار که دستگیره گره خورده با آن چاپ می شود، فعال می شود
تابع "printf()". فراتر از مرجع خود، قالب و فهرست را نیز انتظار دارد
که به تابع printf منتقل شد.
چاپ فرعی {
تغییر مکان؛
من $fmt = shift;
print sprintf($fmt, @_);
}
این را بخوانید، فهرست کنید
این متد زمانی فراخوانی می شود که دسته از طریق "read" یا "sysread" خوانده شود.
توابع.
زیر خواندن {
من $self = shift;
my $bufref = \$_[0];
my(undef,$len,$offset) = @_;
چاپ "READ call, \$buf=$bufref, \$len=$len, \$offset=$offset";
# افزودن به $$bufref، $len را روی تعداد کاراکترهای خوانده شده تنظیم کنید
$len;
}
این را بخوانید
این روش زمانی فراخوانی می شود که دسته از طریق " خوانده شود " یا "readline HANDLE".
مطابق با "readline"، در زمینه اسکالر باید خط بعدی یا "undef" را برای no برگرداند
داده های بیشتر در زمینه لیست باید تمام خطوط باقیمانده یا یک لیست خالی برای را برگرداند
داده های بیشتری وجود ندارد رشته های برگشتی باید شامل جداکننده رکورد ورودی $/ باشد (نگاه کنید به
perlvar)، مگر اینکه "undef" (به معنای حالت "slurp") باشد.
زیر READLINE {
من $r = shift;
if (wantarray) {
بازگشت ("همه باقیمانده\n"،
"خطها\n"،
"به eof\n");
} دیگری {
بازگشت "READLINE نامیده می شود". ++$$r . "بار\n";
}
}
این را دریافت کنید
این متد زمانی فراخوانی می شود که تابع "getc" فراخوانی شود.
sub GETC { print "Don't GETC, Get Perl"; بازگشت "a"؛ }
EOF این
این متد زمانی فراخوانی می شود که تابع "eof" فراخوانی شود.
با شروع Perl 5.12، یک پارامتر عدد صحیح اضافی ارسال می شود. خواهد بود
صفر اگر "eof" بدون پارامتر فراخوانی شود. 1 اگر به "eof" یک filehandle به عنوان a داده شود
پارامتر، به عنوان مثال "eof(FH)"؛ و 2 در مورد بسیار خاص که دسته فایل گره خورده است
"ARGV" و "eof" با یک لیست پارامتر خالی، به عنوان مثال "eof()" فراخوانی می شود.
زیر EOF { طول $stringbuf نیست }
این را ببند
این روش زمانی فراخوانی می شود که دسته از طریق تابع "close" بسته شود.
sub CLOSE { print "CLOSE call.\n" }
این را باز کنید
مانند سایر انواع کراوات، این روش زمانی فراخوانی می شود که "باز کردن" اتفاق بیفتد. آی تی
هنگامی که این اتفاق می افتد ممکن است برای "بستن خودکار" مناسب باشد. "باز کردن" گوچا" را در زیر ببینید.
اینو نابود کن
مانند سایر انواع کراوات، این روش زمانی فراخوانی می شود که دسته گره خورده باشد
در شرف نابود شدن این برای رفع اشکال و احتمالاً پاکسازی مفید است.
sub DESTROY { print " \n" }
در اینجا نحوه استفاده از مثال کوچک ما آمده است:
کراوات (*FOO،'فریاد');
چاپ FOO "Hello\n";
$a = 4; $b = 6;
چاپ FOO $a، " plus "، $b، " برابر است "، $a + $b، "\n";
چاپ ;
باز کردن این
شما می توانید برای همه انواع کراوات یک متد UNTIE تعریف کنید که در آن فراخوانی می شود باز کردن (). نگاه کنید به "The
"باز کردن" گوچا" در زیر.
La "باز کردن" گوچا
اگر قصد دارید از شی برگشتی از هر یک استفاده کنید کراوات () or گره خورده است()، و اگر
کلاس هدف tie یک ویرانگر را تعریف می کند، یک مشکل ظریف وجود دارد باید محافظت در برابر
به عنوان راهاندازی، این مثال (که مسلماً نسبتاً ساختگی) از کراوات را در نظر بگیرید. تمام کاری که انجام می دهد استفاده است
یک فایل برای نگه داشتن گزارشی از مقادیر اختصاص داده شده به یک اسکالر.
بسته به یاد داشته باشید.
سخت استفاده کنید
استفاده از هشدارها؛
از IO::File استفاده کنید.
زیر TIESCALAR {
کلاس $ من = shift;
my $filename = shift;
my $handle = IO::File->new( "> $filename" )
یا "نمی توان $filename: $!\n" را باز کرد.
print $handle "The Start\n";
bless {FH => $handle, Value => 0}, $class;
}
زیر واکشی {
من $self = shift;
بازگشت $self->{Value};
}
فروشگاه فرعی {
من $self = shift;
من $value = shift;
my $handle = $self->{FH};
چاپ $handle "$value\n";
$self->{Value} = $value;
}
زیر تخریب {
من $self = shift;
my $handle = $self->{FH};
print $handle "The End\n";
بستن $handle;
}
1;
در اینجا یک مثال است که از این کراوات استفاده می کند:
سخت استفاده کنید
استفاده از یادآوری;
من $فرد;
tie $fred, 'Remember', 'myfile.txt';
$فرد = 1;
$فرد = 4;
$فرد = 5;
باز کردن $fred;
سیستم "cat myfile.txt"؛
این خروجی زمانی است که اجرا می شود:
آغاز
1
4
5
پایان
تا کنون خیلی خوب. کسانی از شما که به آن توجه کردهاید متوجه این موضوع شدهاند
شی گره خورده تاکنون استفاده نشده است. بنابراین اجازه دهید یک متد اضافی به کلاس Remember اضافه کنیم
اجازه دهید نظرات در فایل گنجانده شود. بگو، چیزی شبیه به این:
نظر فرعی {
من $self = shift;
من $text = shift;
my $handle = $self->{FH};
چاپ $handle $text، "\n";
}
و در اینجا مثال قبلی برای استفاده از روش "کامنت" اصلاح شده است (که نیاز به
شی گره خورده):
سخت استفاده کنید
استفاده از یادآوری;
من ($fred، $x)؛
$x = tie $fred، 'به خاطر بسپار'، 'myfile.txt';
$فرد = 1;
$فرد = 4;
نظر $x "تغییر...";
$فرد = 5;
باز کردن $fred;
سیستم "cat myfile.txt"؛
وقتی این کد اجرا می شود خروجی وجود ندارد. در اینجا دلیل آن است:
هنگامی که یک متغیر گره خورده است، با آبجکتی که مقدار بازگشتی آن است مرتبط می شود
عملکرد TIESCALAR، TIEARRAY یا TIEHASH. این شی معمولاً فقط یک مرجع دارد،
یعنی مرجع ضمنی از متغیر گره خورده. چه زمانی باز کردن () نامیده می شود، که
مرجع از بین می رود. سپس، مانند مثال اول بالا، ویرانگر شی
(DESTROY) نامیده می شود که برای اشیایی که مرجع معتبرتری ندارند عادی است. و
بنابراین پرونده بسته می شود.
با این حال، در مثال دوم، ما مرجع دیگری به شی گره خورده را در x$ ذخیره کرده ایم.
یعنی وقتی باز کردن () تماس گرفته می شود، همچنان یک مرجع معتبر به آن وجود خواهد داشت
شی موجود است، بنابراین destructor در آن زمان فراخوانی نمی شود، و بنابراین فایل فراخوانی می شود
بسته نشده است دلیل اینکه خروجی وجود ندارد این است که بافرهای فایل نبوده اند
بر روی دیسک ریخته شد.
اکنون که می دانید مشکل چیست، برای جلوگیری از آن چه کاری می توانید انجام دهید؟ قبل از
معرفی روش اختیاری UNTIE تنها راه، پرچم خوب قدیمی "-w" بود. کدام
هر نمونه ای را که در آن تماس می گیرید را مشاهده می کند باز کردن () و هنوز ارجاعات معتبری به آن وجود دارد
شی گره خورده اگر اسکریپت دوم در بالای این نزدیک به بالا «از اخطارها «باز کردن» استفاده کنید یا بود
با پرچم "-w" اجرا شود، Perl این پیام هشدار را چاپ می کند:
در حالی که 1 مرجع داخلی هنوز وجود دارد، تلاش شد
برای اینکه اسکریپت به درستی کار کند و اخطار بیصدا شود، مطمئن شوید که اسکریپت معتبر نیست
ارجاع به شی گره خورده قبل از باز کردن () نامیده میشود:
unef $x;
باز کردن $fred;
اکنون که UNTIE وجود دارد، طراح کلاس می تواند تصمیم بگیرد که کدام بخش از عملکرد کلاس
واقعاً با «باز کردن» و با شیء در حال نابودی همراه هستند. چه چیزی باعث می شود
حس برای یک کلاس مشخص به این بستگی دارد که آیا مراجع داخلی به گونه ای نگهداری می شوند
روش های غیر مرتبط با کراوات را می توان روی شی فراخوانی کرد. اما در بیشتر موارد احتمالاً باعث می شود
منطقی است که عملکردی را که در DESTROY وجود داشت به روش UNTIE منتقل کنید.
اگر روش UNTIE وجود داشته باشد، هشدار بالا رخ نمی دهد. در عوض روش UNTIE
از تعداد مراجع "اضافی" عبور می کند و در صورت لزوم می تواند اخطار خود را صادر کند.
به عنوان مثال برای تکرار حالت بدون UNTIE از این روش می توان استفاده کرد:
زیر UNTIE
{
من ($obj,$count) = @_;
carp "تلاش شد در حالی که $count مراجع داخلی هنوز وجود دارد" اگر $count;
}
با استفاده از خدمات onworks.net از perltie آنلاین استفاده کنید